package Net::OICQ::ClientEvent;# $Id: ClientEvent.pm,v 1.7 2003/10/17 20:01:52 tans Exp $# Copyright (c) 2003 Shufeng Tan.  All rights reserved.# # This package is free software and is provided "as is" without express# or implied warranty.  It may be used, redistributed and/or modified# under the terms of the Perl Artistic License (see# http://www.perl.com/perl/misc/Artistic.html)use 5.006;use strict;use warnings;use Crypt::OICQ qw(encrypt decrypt);use Net::OICQ::Event;eval "no encoding; use bytes;" if $] >= 5.008;our @ISA = qw(Net::OICQ::Event);my $RS = $Net::OICQ::RS;my $FS = $Net::OICQ::FS;sub new {    my ($class, $packet, $oicq) = @_;    my $self = {        OICQ => $oicq,        Header => substr($packet, 0, 11),    };    bless $self, $class;    my $cmdcode = $self->cmdcode;    my $cmd     = $self->cmd;    if ($cmd =~ /reg_new_id_/) {        $oicq->log_t("Client Cmd $cmd ($cmdcode) hexdump:\n",                     $oicq->hexdump($packet));        return undef;    }    my ($crypt, $key);    if ($cmd eq 'login') {        $key   = substr($packet, 11, 16);        $crypt = substr($packet, 27, -1);        $oicq->log_t("Client uses temp key:\n", $oicq->hexdump($key));    } else {        $key   = $oicq->{Key};        $crypt = substr($packet, 11, -1);    }    my $plain;    eval { $plain = decrypt(undef, $crypt, $key) };    $@ && $oicq->{Debug} && $oicq->log_t($@);    return undef unless defined $plain;    $self->{Data} = $plain;    return $self;}sub uid {    substr(shift->{Header}, 7, 4)}# Default handler for packets from clientsub default {    my ($self) = @_;    my $oicq = $self->{OICQ};    return 1 unless $oicq->{Debug};    my $uid = $self->uid;    my $uid_u = unpack('N', $uid);    $oicq->log("Id changed to ", $uid_u, "\n") if $uid ne $oicq->{_Id};    $oicq->log("Id=$uid_u Cmd=0x", unpack("H*", $self->cmdcode),               "(", $self->cmd, ") plain data:\n",               $oicq->hexdump($self->{Data}));    return 1;}sub login {    my ($self) = @_;    my $uid = $self->uid;    my $oicq = $self->{OICQ};    # Check if self is setup for this uid    unless (defined $oicq->{_Id} and $oicq->{_Id} eq $uid) {        my $uid_u = unpack('N', $uid);        die "No passwd for $uid_u" unless defined $ENV{OICQ_PW};        $oicq->log("login uses ENV OICQ_PW as passwd for $uid_u\n");        $oicq->set_user($uid_u, $ENV{OICQ_PW});    }    return unless $oicq->{Debug};    my $plain = $self->{Data};    $oicq->log("Data encryted with temp key:\n", $oicq->hexdump($plain));    $oicq->log("PWKey:\n", $oicq->hexdump($oicq->{PWKey}));    $self->test_b0(substr($plain, 0, 0x10), $oicq);    $oicq->logf("0x11-0x16: client IP and UDP port %s:%d\n",                join('.', map(ord($_), split('', substr($plain, 0x11, 4)))),                unpack('n', substr($plain, 0x15, 2)));    $oicq->desect($plain,        ['H*', 'C_LOGIN', 0x00, 0x10],        ['H*', 'C_LOGIN', 0x10, 1],        ['H*', 'C_LOGIN', 0x11, 6],        ['H*', 'C_LOGIN', 0x17, 0x1d],        ['H*', 'C_LOGIN', 0x34, 1],        ['H*', 'C_LOGIN', 0x35]);    1;}sub test_b0 {    my ($self, $b0, $oicq) = @_;    my %possible_key = (        'PWMD5'    => Digest::MD5::md5($oicq->{Passwd}),        'PWMD5MD5' => Digest::MD5::md5(Digest::MD5::md5($oicq->{Passwd})),        'PWIDMD5'  => Digest::MD5::md5($oicq->{Passwd}.$oicq->{Id}),        'IDPWMD5'  => Digest::MD5::md5($oicq->{Id}.$oicq->{Passwd}),    );    my $plain;    foreach my $descr (sort keys(%possible_key)) {        my $key = $possible_key{$descr};        $oicq->log("Decrypting 0x00-0x0f with $descr...");        eval { $plain = decrypt(undef, $b0, $key) };        $@ && $oicq->{Debug} && $oicq->log_t($@);        if (defined $plain) {            $oicq->log("succeeded: '$plain'\n");            $oicq->{PWKey} = $key;            last;        }        $oicq->log("failed.\n");    }}sub logout {    my ($self) = @_;    my $oicq  = $self->{OICQ};    return unless $oicq->{Debug};    my $plain = $self->{Data};    $oicq->log("Logout packet is ",               ($plain eq $oicq->{PWKey}) ? "" : "not ",               "PWKey encrypted with session key\n");    1;}sub send_msg {    my ($self) = @_;    my $oicq  = $self->{OICQ};    return unless $oicq->{Debug};    my $plain = $self->{Data};    $oicq->desect($plain,       ['N',  'srcid', 0x00, 0x04],       ['N',  'dstid', 0x04, 0x04],       ['H*', 'C_SMTS_CONST', 0x08, 2],       ['N',  'srcid again', 0x0a, 0x04],       ['N',  'dstid again', 0x0e, 0x04],       ['H*', 'MD5(dstid+PWKey)', 0x12, 0x10],       ['H*', 'C_SMTS', 0x22, 0x13]);    1;}sub recv_msg {    my ($self) = @_;    my $oicq  = $self->{OICQ};     return unless $oicq->{Debug};    my $plain = $self->{Data};    $oicq->log_t("Client ack recv msg thru svr:");    $oicq->desect($plain,        ['N',  'srcid', 0x00, 4],        ['N',  'dstid', 0x04, 4],        ['H*', 'C_RMTS', 0x08]);    1;}sub get_online_friends {    my ($self) =@_;    my $oicq  = $self->{OICQ};    return unless $oicq->{Debug};    my $plain = $self->{Data};    $oicq->desect($plain, ['H*', 'Request online friend list', 0]);    1;}sub update_info {    my ($self) = @_;    my $oicq  = $self->{OICQ};    return unless $oicq->{Debug};    my $plain = $self->{Data};    my @field = split(/$RS/, $plain);    $oicq->log("Fields separated by 0x1f:\n");    for(my $i = 0; $i < @field; $i++) {        $oicq->logf("%2d: %s\n", $i, $field[$i]);    }    return 1;}sub get_friends_list {  my ($self) = @_;  my $oicq  = $self->{OICQ};  return unless $oicq->{Debug};  my $plain = $self->{Data};  $oicq->desect($plain, ['H*', 'Request entire friends list', 0]);  1;               }sub get_user_info { default(@_) }sub recv_service_msg { default(@_) }sub search_users { default(@_) }sub keep_alive { default(@_) }sub set_mode { default(@_) }sub add_contact_1 { default(@_) }sub add_contact_2 { default(@_) }sub del_contact { default(@_) }sub forbid_contact { default(@_) }sub ack_service_msg { default(@_) }sub recv_friend_status { default(@_) }sub unknown { default(@_) }sub reg_new_id_1 { return }              sub reg_new_id_2 { return }1;