serverevent.pm

来自「perl qq」· PM 代码 · 共 658 行 · 第 1/2 页

            $oicq->{Away} = $idletime;
        }
    }
    $oicq->{Away} or return 0;

    my $autoreply = $oicq->{LastAutoReply};
    if (defined($autoreply->{$dstid}) && time - $autoreply->{$dstid} < 300) {
        return 0;
    }
    my $me = $oicq->get_nickname($oicq->{Id}) || $oicq->{Id};
    my $mm = $oicq->get_nickname($dstid) || $dstid;
    my $msg = "对不起$mm, $me不在.你的话已记下来了:\n".substr($mesg, 0, 100);
    $oicq->send_msg($dstid, $msg);
    $autoreply->{$dstid} = time;
    if (defined $ui) {
        $ui->msg($oicq->{Id}, $dstid, time, "Auto-reply:\n$msg\n");
    }
    return 1;
}

sub get_online_friends {
    my ($self) = @_;
    my $plain = $self->{Data};
    my $oicq = $self->{OICQ};
##############################added by alexe
    my $count=length($plain)%37;
    my @friends;
    my $i=1;
    for(my $i2 = 1; $i2<$count; $i2+=1) {
        my $fid =  unpack('N', substr($plain, $i, 4));
	#my $addr=$self->show_address(substr($plain, $i+5, 6));
	my $ip=unpack("N",substr($plain,$i+5,4));
	my $port=unpack("n",substr($plain,$i+9,2));
        my $mode = ord(substr($plain, $i+12, 1));
	#my $key  = substr($plain, $i+15, 16);
	print "$fid		$ip/$port		$mode\n";
	push(@friends,$fid);
	$i+=38;
    }
    my %online_friends=(
	    name=>"online_friends",
	    result=>\@friends,
    );
    return(\%online_friends);
####################################################################
}

sub recv_service_msg {
    my ($self) = @_;
    my $oicq = $self->{OICQ};
    my ($code, $srcid, $myid, $mesg) = split(/$RS/, $self->{Data});
    if (defined $oicq->{Socket}) {
        $oicq->ack_service_msg($code, $srcid, $self->seq);
    }
    my $ui = $oicq->{UI};
    if ($code eq "02") {
        my $text = "$srcid asked for permission to contact you ($myid):\n$mesg";
        $oicq->log_t($text);
        if (defined $ui) {
            $ui->beep;
            my $ok = $ui->ask("$text\nDo you accept this request? [y/n] ");
            defined $ok or return;
            if ($ok =~ /^y/i) {
                $oicq->accept_contact($srcid);
                $ui->warn("Accepted contact request from $srcid\n");
            } elsif ($ok =~ /^n/i) {
                $oicq->reject_contact($srcid);
                $ui->warn("Rejected contact request from $srcid\n");
            } else {
                $ui->warn("Ignored contact request from $srcid\n");
            }
        }
        return;
    }
    return unless defined $ui;
    if ($code eq "03") {
        $ui->info("$srcid has accepted your contact request\n$mesg\n");
    } elsif ($code eq "04") {
        $ui->info("$srcid has rejected your contact request\n$mesg\n");
    } else {
        $ui->info("Code $code message from $srcid to $myid\n");
        if ($srcid eq '10000') {
            $oicq->{Trash} = "Code $code from $srcid to $myid:\n$mesg\n";
        } else {
            $ui->info("$mesg\n");
        }
    }
    return;
}

sub search_users {
    my ($self) = @_;
    my $plain = $self->{Data};
    my $oicq = $self->{OICQ};
    my @list;
    foreach my $line (split(/$RS/, $plain)) {
        my @f = split(/$FS/, $line);
        next unless defined $f[3];
	#$f[3] = $oicq->get_face($f[3]);
        push @list, \@f;
    }
    my $ui = $oicq->{UI};
    if (defined $ui) {
        $ui->show_search_result(\@list);
    }
    return 1;
}

sub keep_alive {
    my $self = shift;
    my $oicq = $self->{OICQ};
    my $plain = $self->{Data};
    $oicq->{UserCount} = (split($RS, $plain))[2];
}

sub add_contact_1 {
    my ($self) = @_;
    my $plain = $self->{Data};
    my $oicq = $self->{OICQ};
    my ($id, $reply) = split(/$RS/, $plain);
    my $ui = $oicq->{UI};
    unless (defined $ui) {
        $oicq->log_t("Server reply to add_contact request by $id: $reply\n");
        return;
    }
    $ui->info("Server reply to add_contact request by $id: $reply\n");
    if ($reply =~ /^\d+$/ && $reply > 0) {
        unless (defined $oicq->{ContactId}) {
            $ui->error("ContactId was not set\n");
            return;
        }
        my $mmid = $oicq->{ContactId};
        $ui->warn("$mmid requires authentication message\n");
        my $msg = $ui->ask("$mmid requires authentication message\n" .
                           "Enter authentication message: ");
        defined $msg or return 0;
        chomp $msg;
        $oicq->add_contact_2($msg);
    }
    1;
}

sub add_contact_2 {
    my ($self) = @_;
    my $oicq = $self->{OICQ};
    return unless defined $oicq->{UI};
    my $plain = $self->{Data};
    my $ui = $oicq->{UI};
    defined $ui && $ui->info("Server responded to add_contact_2: $plain\n");
    1;
}

# get_friends_list provided by Chen Peng

sub get_friends_list {
    my ($self) = @_;
    my $plain = $self->{Data};
    my $oicq = $self->{OICQ};
    my $flag = substr($plain, 0, 2);
    my $p = 2;
    my $len = length($plain);
    my @friends;
    while ($p < $len) {
        my $fid = unpack('N', substr($plain, $p, 4));
        $p += 6; # one 0x00 to seperate
        my $age = ord(substr($plain, $p, 1)); $p += 1;
        my $sex = ord(substr($plain, $p, 1)); $p += 1;
        my $name_len = ord(substr($plain, $p, 1)); $p += 1;
        my $nickname = substr($plain, $p, $name_len); $p += $name_len;
	#print "$fid	$age	$sex	$nickname\n";
	$p+=2;
	my $flag=substr($plain,$p,1);$p+=1;
	my $com_flag=substr($plain,$p,1);$p+=1;
	push(@friends,"$fid,$age,$sex,$nickname");
    }
    unless ($flag eq "\xff\xff") {
	    $oicq->get_friends_list($flag);
    } 
    my %friends_list=(
	    name=>"friends_list",
	    reuslt=>\@friends,
    );
    return \%friends_list;
}

sub show_address {
    my ($self, $data) = @_;
    my $ip = join('.', map(ord, split('', substr($data, 0, 4))));
    my $port = unpack('n', substr($data, 4, 2));
    return "$ip:$port";
}

sub recv_friend_status {
    my ($self) = @_;
    my $plain = $self->{Data};
    my $oicq  = $self->{OICQ};
    my $srcid = unpack('N', substr($plain,  0, 4));
    my $dstid = unpack('N', substr($plain, -4, 4));
    my $status = unpack('H*', substr($plain, 13));
    my $addr = $self->show_address(substr($plain, 5, 6));
    my $mode = ord(substr($plain, 12, 1));
    defined $oicq->{Info}->{$srcid} or $oicq->{Info}->{$srcid} = {};
    my $info = $oicq->{Info}->{$srcid};
    $info->{Addr} = $addr if $addr =~ /[1-9]/;
    $info->{Mode} = $mode;
    $info->{Key}  = substr($plain, 13, 20);

    my $ui = $oicq->{UI};
    if (defined $ui) {
        $ui->on_mode_change($srcid, $mode);
    } else {
        $oicq->log_t("$srcid changed mode to $mode");
    }
    return 1 unless $oicq->{Debug};
    $oicq->log("Data decrypted by recv_friend_status:\n",
               $oicq->hexdump($plain));
    1;
}

sub set_mode {
	my ($self)=@_;
	my $plain=$self->{Data};
	my $oicq  = $self->{OICQ};
	my $reply=substr($plain,0,1);
	if ($reply eq "\x30")
	{print "set_mode ok\n";}
}

sub update_info { default(@_) }

sub del_contact { default(@_) }

sub forbid_contact { default(@_) }

sub ack_service_msg { default(@_) }

sub unknown { default(@_) }

sub reg_new_id_1 { return }

sub reg_new_id_2 { return }

################################added by alexe
sub group_cmd{
    my($self)=@_;
    my $plain=$self->{Data};
    my $oicq=$self->{OICQ};
    my $sub_cmd=substr($plain,0,1);
    my $reply=substr($plain,1,1);
    unless ($reply eq "\x00"){print "group_cmd not right\n";return;}
    foreach (keys %sub_group_cmd){
	    if($sub_group_cmd{$_} eq $sub_cmd)
            {$sub_cmd=$_;}
    }		    
    if($sub_cmd eq "QQ_GROUP_CMD_SEARCH_GROUP")
    {
    my $search_type=substr($plain,2,1);
    my $int_group_id=unpack("N",substr($plain,3,4));
    my $ext_group_id=unpack("N",substr($plain,7,4));
    my $group_type=substr($plain,0xb,1);
    my $group_creator_uid=unpack("N",substr($plain,0xc,4));
    my $group_cate=unpack("n",substr($plain,0x12,2));
    my $group_name_length=ord(substr($plain,0x14,1));
    my $group_name=substr($plain,0x15,$group_name_length);
    my $group_auth_type=substr($plain,0x17+$group_name_length,1);
    my $group_desc_length=ord(substr($plain,0x17+$group_name_length+1,1));
    my $group_desc=substr($plain,0x15+$group_name_length+1+1,$group_desc_length);
    my %group_search_reply=(
	    name=>"group_search",
	    int_group_id=>$int_group_id,
	    group_name=>$group_name,
	    group_desc=>$group_desc,
    );
    if($oicq->{Print}){
    foreach (keys %group_search_reply){print "$_=$group_search_reply{$_}\n";}
    }
    return(\%group_search_reply);
    }
    elsif($sub_cmd eq "QQ_GROUP_CMD_GET_GROUP_INFO"){
	my $int_group_id=unpack("N",substr($plain,2,4));
	my $ext_group_id=unpack("N",substr($plain,6,4));
	my $group_type=substr($plain,0xa,1);
	my $group_creator_uid=unpack("N",substr($plain,0xb,4));
	my $group_auth_type=substr($plain,0xf,1);
	my $group_cate=unpack("n",substr($plain,0x12,2));
	my $group_name_length=ord(substr($plain,0x18,1));
	my $group_name=substr($plain,0x19,$group_name_length);
	my $group_notice_len=ord(substr($plain,0x19+$group_name_length+2,1));
	my $group_notice=substr($plain,0x1a+$group_name_length+2,$group_notice_len);
	my $group_desc_len=ord(substr($plain,0x1a+$group_name_length+$group_notice_len+2,1));
	my $group_desc=substr($plain,0x1b+$group_name_length+$group_notice_len+2,$group_desc_len);
	my %group_info_reply=(
		name=>"group_info",
		int_group_id=>$int_group_id,
		group_name=>$group_name,
		group_notice=>$group_notice,
                group_desc=>$group_desc,
	    );
	if($oicq->{Print}){
	foreach (keys %group_info_reply){print "$_=$group_info_reply{$_}\n";}
}
        return(\%group_info_reply);
    }
    elsif($sub_cmd eq "QQ_GROUP_CMD_JOIN_GROUP"){  }
    elsif($sub_cmd eq "QQ_GROUP_CMD_JOIN_GROUP_AUTH"){  }
    elsif($sub_cmd eq "QQ_GROUP_CMD_GET_ONLINE_MEMBER"){
	my $int_group_id=unpack("N",substr($plain,2,4));
	my $i=7;
	my $co=(length($plain)-7)/4;
	my @group_online_uid;
	foreach(1...$co){
		push(@group_online_uid,unpack("N",substr($plain,$i,4)));	
		$i+=4;
	}
	my %group_online_member=(
		name=>"group_online_member",
		result=>@group_online_uid,	
	);
	if($oicq->{Print}){
	foreach (@group_online_uid){print "$_\n";}
}
	return(\%group_online_member);
    }
    elsif($sub_cmd eq "QQ_GROUP_CMD_GET_MEMBER_INFO"){
    }
}
################
1;