clientevent.pm

MSN fast change name is new utility 4 you

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 client

sub 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;