package Net::OICQ::ServerEvent;# $Id: ServerEvent.pm,v 1.8 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;eval "no encoding; use bytes;" if $] >= 5.008;use Crypt::OICQ qw(encrypt decrypt);use Net::OICQ::Event;our @ISA = qw(Net::OICQ::Event);my @MsgPrecursors = ("\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x01",		     "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01",		     "..\x00\x00\x00\x01\x01\x00.\x00\x01");my @AutoMsgPrecursors = ("\x00\x00\x00\x01\x00\x00\x00\x00\x02");# Separatorsmy $FS = $Net::OICQ::FS;   # Field separatormy $RS = $Net::OICQ::RS;   # Record separatormy $InfoHeader = \@Net::OICQ::InfoHeader;sub new {    my ($class, $packet, $oicq) = @_;    my $self = {        OICQ  => $oicq,        Header => substr($packet, 0, 7),    };    bless $self, $class;    my $cmdcode = $self->cmdcode;    my $cmd     = $self->cmd;    if ($cmd =~ /reg_new_id_/) {        $oicq->log_t("Cmd $cmd ($cmdcode):\n", $oicq->hexdump($packet));        return undef;    }    my $crypt = substr($packet, 7, -1);    my $plain;    if ($cmd eq 'login') {        eval { $plain = decrypt(undef, $crypt, $oicq->{PWKey}) };        $@ && $oicq->{Debug} && $oicq->log_t($@);        unless (defined $plain) {            eval { $plain = decrypt(undef, $crypt, $oicq->{RandKey}) };        }        $@ && $oicq->log_t($@);    } else {        eval { $plain = decrypt(undef, $crypt, $oicq->{Key}) };    }    return undef unless defined $plain;    $self->{Data} = $plain;    return $self;}# Default method for server datasub default {    my ($self) = @_;    my $oicq = $self->{OICQ};    my $ui = $oicq->{UI};    if (defined $ui) {        $ui->info("Server ack to ", $self->cmd, ": 0x",                  unpack('H*', $self->{Data}), "\n");    }    return unless $oicq->{Debug};    $oicq->log_t("Decryted data from server:\n", $oicq->hexdump($self->{Data}));}# Server replies with session keysub login {    my ($self) = @_;    my $oicq  = $self->{OICQ};    my $plain = $self->{Data};    if (length($plain) < 0x11) {   # Server did not return a session key        if (substr($plain, 0, 1) ne "\x01") {            $oicq->log_t("wrong passwd for $oicq->{Id}, hexdump:\n",                         $oicq->hexdump($plain));            return undef;        }        if (substr($plain, 1, 4) ne $oicq->{_Id}) {            $oicq->log_t("server reply to login request from ",                         unpack('L', substr($plain, 1, 4)), ":\n",                         $oicq->hexdump($plain));            return undef;        }        # Find new server address        $oicq->log_t("redirected to server $oicq->{SvrIP}:$oicq->{SvrPort}");        $oicq->{SvrPort} = unpack('n', substr($plain, 9, 2));        $oicq->{SvrIP} = join('.', map {ord} split('',  substr($plain, 5, 4)));        $oicq->{Socket} = undef;        $oicq->desect($plain,            ['H*', 'Flag', 0, 1],            ['N',  'uid',  1, 4],            ['H*', 'IP',   5, 4],            ['n',  'Port', 9, 2]);        return 0;    }    my $key = substr($plain, 1, 0x10);    $oicq->{Key} = $key;    $oicq->desect($plain,        ['H*', 'S_LOGIN', 0, 1],        ['H*', 'session key', 0x01, 0x10],        ['N',  'uid',     0x11, 0x04],        ['H*', 'S_LOGIN', 0x15, 0x0f],        ['H*', 'S_LOGIN', 0x24, 0x01],        ['H*', 'S_LOGIN', 0x25, 0x02],        ['H*', 'S_LOGIN', 0x27, 0x18],        ['H*', 'S_LOGIN', 0x3f, 0x0e],        ['H*', 'S_LOGIN', 0x4d, 0x20],        ['H*', 'S_LOGIN', 0x6d, 0x12],        ['H*', 'S_LOGIN', 0x7f]);    return 1;}sub logout {    my ($self) = @_;    my $oicq = $self->{OICQ};    $oicq->log("Impossible: logout packet from server?\n",               $oicq->hexdump($self->{Data}));    return;}# Server replies with user infosub get_user_info {    my ($self) = @_;    my $oicq = $self->{OICQ};    my $plain = $self->{Data};    my @field = split(/$FS/, $plain);    return unless defined $field[0];    return if $field[0] =~ /^-/;    $oicq->{MyInfo} = [@field] if $field[0] == $oicq->{Id};    $oicq->{Info}->{$field[0]} = {} unless defined $oicq->{Info}->{$field[0]};    my $hashref = $oicq->{Info}->{$field[0]};    $hashref->{Nickname} = $field[1];    $hashref->{Age}      = $field[7];    $hashref->{Sex}      = $field[8];    $hashref->{Face}     = $oicq->get_face($field[21]);    my $datfile = "$oicq->{Dir}/$oicq->{Id}/$field[0].dat";    my $dat = new FileHandle(">$datfile");    if (defined $dat) {        print $dat "\$_ = {\n";        for(my $j = 0; $j<=$#field; $j++) {            printf $dat "%-15s => '%s',\n", $InfoHeader->[$j], $field[$j];        }        print $dat "};\n";        $dat->close;        my $ui = $oicq->{UI};        if (defined $ui && defined $ui->{show_user_info}) {            $ui->show_user_info(\@field);            delete $ui->{show_user_info};        }    } else {        $oicq->log_t("Failed to open user info file >$datfile");    }    return 1;}# Server acksub send_msg {    my ($self) = @_;    my $oicq = $self->{OICQ};    my $plain = $self->{Data};    my $text = $plain eq "\0" ?                   "Message transmitted by server" :                   "Server ack to send_msg: 0x" . unpack('H*', $plain);    my $ui = $oicq->{UI};    if (defined $ui) {        $ui->info("$text\n");    }    if ($oicq->{Debug} or not defined $oicq->{UI}) {        $oicq->log_t($text);    }    return 1;}sub recv_msg {    my ($self) = @_;    my $oicq  = $self->{OICQ};    my $plain = $self->{Data};    my $srcid = unpack('N', substr($plain, 0, 4));    my $dstid = unpack('N', substr($plain, 4, 4));    defined $oicq->{Info}->{$srcid} or $oicq->{Info}->{$srcid} = {};    $oicq->{Info}->{$srcid}->{Client} = substr($plain, 0x14, 2);    if ($oicq->{Debug} > 1) {        print 'recv_msg data(8,14)=0x', unpack('H*', substr($plain, 8, 14)),              "\nMD5($dstid Key)=0x", unpack('H*', substr($plain, 30, 16)),              "\ndecrypted data:\n", $oicq->hexdump($plain), "\n";    }    return if length($plain) < 0x32;    my $time  = unpack('N', substr($plain, 0x32, 4));    my $mesg = $self->get_msg(substr($plain, 0x36));    my $ui = $oicq->{UI};    if (defined $ui) {        if (defined $mesg) {            $ui->msg($srcid, $dstid, $time, $mesg);        } else {            $ui->error("get_msg error logged, probably due to new MsgPrecursor\n");        }    }    if ($oicq->{Debug} or $oicq->{LogChat}) {        $oicq->log_t("Received message from $srcid:\n$mesg");    }    if (defined $oicq->{Socket} and defined $mesg) {        $oicq->ack_msg($plain);        my $chatbot = $oicq->{Info}->{$srcid}->{ChatBot};        (defined $chatbot && -f $chatbot) or $chatbot = $oicq->{ChatBot};        if (defined $chatbot && -f $chatbot) {            eval { require $chatbot; on_message($oicq, $srcid, $mesg) };            if ($@) {               $oicq->log_t("on_message error: $@");               defined $ui && $ui->error($@);            }        } else {            $self->check_autoreply($oicq, $srcid, $mesg);        }    }    $oicq->desect($plain,        ['N',  'srcid', 0x00, 4],        ['N',  'dstid', 0x04, 4],        ['H*', 'S_RMTS', 0x08, 0x0d],        ['N',  'srcid again', 0x16, 4],        ['N',  'dstid again', 0x1a, 4],        ['H*', 'S_RMTS', 0x1e, 0x23]);    return 1;}# Extract message from decrypted data using MsgPrecursorsub get_msg {    my ($self, $plain) = @_;    my $oicq = $self->{OICQ};    foreach my $precursor (@MsgPrecursors) {	if ($plain =~ /^$precursor(.*)$/s) {	    return $1;	}    }    foreach my $precursor (@AutoMsgPrecursors) {        if ($plain =~ /^$precursor(.*)$/s) {            return "Auto-Reply:\n" . $1;	}    }    $oicq->log("Unable to get message from data:\n", $oicq->hexdump($plain));    $plain =~ s/^(.{11})/'#'.unpack("H*", $1).'#'/se;    return $plain;}