archive
/
milkbone
1
0
Fork 0
Code Pull Requests Projects Releases Activity
A feature-rich, modular AOL Instant Messenger client written chiefly by Bill Atkins and Dan Chokola in their high school days.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
91 Commits
1 Branch
0 Tags
773 KiB
 
 
 
Branch: master
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'master'
${ noResults }
milkbone/plugins/Net-OSCAR/Net/OSCAR/Callbacks.pm

526 lines
20 KiB
Raw Permalink Blame History

package Net::OSCAR::Callbacks;
$VERSION = '0.62';
use strict;
use vars qw($VERSION);
use Carp;
use Net::OSCAR::Common qw(:all);
use Net::OSCAR::TLV;
use Net::OSCAR::Buddylist;
use Net::OSCAR::_BLInternal;
use Net::OSCAR::OldPerl;
sub capabilities() {
my $caps;
#AIM_CAPS_CHAT
$caps .= pack("C*", map{hex($_)} split(/[ \t\n]+/, "0x74 0x8F 0x24 0x20 0x62 0x87 0x11 0xD1 0x82 0x22 0x44 0x45 0x53 0x54 0x00 0x00"));
return $caps;
}
sub process_snac($$) {
my($connection, $snac) = @_;
my($conntype, $family, $subtype, $data, $reqid) = ($connection->{conntype}, $snac->{family}, $snac->{subtype}, $snac->{data}, $snac->{reqid});
my $reqdata = delete $connection->{reqdata}->[$family]->{pack("N", $reqid)};
my $session = $connection->{session};
my %tlv;
tie %tlv, "Net::OSCAR::TLV";
$connection->log_printf(OSCAR_DBG_DEBUG, "Got SNAC 0x%04X/0x%04X", $snac->{family}, $snac->{subtype});
if($conntype == CONNTYPE_LOGIN and $family == 0x17 and $subtype == 0x7) {
$connection->log_print(OSCAR_DBG_SIGNON, "Got authentication key.");
my($key) = unpack("n/a*", $data);
if(defined($connection->{auth})) {
$connection->log_print(OSCAR_DBG_SIGNON, "Sending password.");
%tlv = signon_tlv($session, $connection->{auth}, $key);
$connection->snac_put(family => 0x17, subtype => 0x2, data => tlv_encode(\%tlv));
} else {
$connection->log_print(OSCAR_DBG_SIGNON, "Giving client authentication challenge.");
$session->callback_auth_challenge($key, "AOL Instant Messenger (SM)");
}
} elsif($conntype == CONNTYPE_LOGIN and $family == 0x17 and $subtype == 0x3) {
$connection->log_print(OSCAR_DBG_SIGNON, "Got authorization response.");
%tlv = %{tlv_decode($data)};
if($tlv{0x08}) {
my($error) = unpack("n", $tlv{0x08});
$session->crapout($connection, "Invalid screenname.") if $error == 0x01;
$session->crapout($connection, "Invalid password.") if $error == 0x05;
$session->crapout($connection, "You've been connecting too frequently.") if $error == 0x18;
my($errstr) = ((ERRORS)[$error]) || "unknown error";
$errstr .= " ($tlv{0x04})" if $tlv{0x04};
$session->crapout($connection, $errstr, $error);
return 0;
} else {
$connection->log_print(OSCAR_DBG_SIGNON, "Login OK - connecting to BOS");
$connection->{closing} = 1;
$connection->disconnect;
$session->{screenname} = $tlv{0x01};
$session->{email} = $tlv{0x11};
$session->addconn(
$tlv{0x6},
CONNTYPE_BOS,
"BOS",
$tlv{0x05}
);
}
} elsif($family == 0x1 and $subtype == 0x7) {
$connection->log_print(OSCAR_DBG_NOTICE, "Got Rate Info Resp.");
$connection->log_print(OSCAR_DBG_NOTICE, "Sending Rate Ack.");
$connection->snac_put(family => 0x01, subtype => 0x08, data => pack("nnnnn", 1, 2, 3, 4, 5));
$connection->log_print(OSCAR_DBG_NOTICE, "BOS handshake complete!");
if($conntype == CONNTYPE_BOS) {
$connection->log_print(OSCAR_DBG_SIGNON, "Signon BOS handshake complete!");
$connection->log_print(OSCAR_DBG_DEBUG, "Requesting personal info.");
$connection->snac_put(family => 0x1, subtype => 0xE);
$connection->log_print(OSCAR_DBG_DEBUG, "Doing buddylist unknown 0x2.");
$connection->snac_put(family => 0x13, subtype => 0x2);
$connection->log_print(OSCAR_DBG_DEBUG, "Requesting buddylist.");
$connection->snac_put(family => 0x13, subtype => 0x5, data => chr(0)x6);
$connection->log_print(OSCAR_DBG_DEBUG, "Requesting locate rights.");
$connection->snac_put(family => 0x2, subtype => 0x2);
$connection->log_print(OSCAR_DBG_DEBUG, "Requesting buddy rights");
$connection->snac_put(family => 0x3, subtype => 0x2);
$connection->log_print(OSCAR_DBG_DEBUG, "Requesting ICBM param info.");
$connection->snac_put(family => 0x4, subtype => 0x4);
$connection->log_print(OSCAR_DBG_DEBUG, "Requesting BOS rights.");
$connection->snac_put(family => 0x9, subtype => 0x2);
} elsif($conntype == CONNTYPE_CHATNAV) {
$connection->ready();
$session->{chatnav} = $connection;
if($session->{chatnav_queue}) {
foreach my $snac(@{$session->{chatnav_queue}}) {
$connection->log_print(OSCAR_DBG_DEBUG, "Putting SNAC.");
$connection->snac_put(%$snac);
}
}
delete $session->{chatnav_queue};
} elsif($conntype == CONNTYPE_ADMIN) {
$session->{admin} = $connection;
if($session->{admin_queue}) {
foreach my $snac(@{$session->{admin_queue}}) {
$connection->log_print(OSCAR_DBG_DEBUG, "Putting SNAC.");
$connection->snac_put(%$snac);
}
}
$connection->ready();
delete $session->{admin_queue};
} elsif($conntype == CONNTYPE_CHAT) {
$connection->ready();
$session->callback_chat_joined($connection->name, $connection) unless $connection->{sent_joined}++;
}
} elsif($subtype == 0x1) {
$subtype = $reqid >> 16;
my $error = "";
if($family == 0x4) {
$error = "Your message to could not be sent for the following reason: ";
delete $session->{cookies}->{$reqid};
} else {
$error = "Error in ".$connection->{description}.": ";
}
my($errno) = unpack("n", substr($data, 0, 2, ""));
$session->log_printf(OSCAR_DBG_DEBUG, "Got error %d on req 0x%04X/0x%08X.", $errno, $family, $reqid);
return if $errno == 0;
my $tlv = tlv_decode($data) if $data;
$error .= (ERRORS)[$errno] || "unknown error";
$error .= " (".$tlv->{4}.")." if $tlv and $tlv->{4};
send_error($session, $connection, $errno, $error, 0, $reqdata);
} elsif($family == 0x1 and $subtype == 0xf) {
$connection->log_print(OSCAR_DBG_NOTICE, "Got user information response.");
} elsif($family == 0x9 and $subtype == 0x3) {
$connection->log_print(OSCAR_DBG_NOTICE, "Got BOS rights.");
} elsif($family == 0x3 and $subtype == 0x3) {
$connection->log_print(OSCAR_DBG_NOTICE, "Got buddylist rights.");
} elsif($family == 0x2 and $subtype == 0x3) {
$connection->log_print(OSCAR_DBG_NOTICE, "Got locate rights.");
} elsif($family == 0x4 and $subtype == 0x5) {
$connection->log_print(OSCAR_DBG_NOTICE, "Got ICBM parameters - warheads armed.");
} elsif($family == 0x3 and $subtype == 0xB) {
my $buddy = $session->extract_userinfo($data);
my $screenname = $buddy->{screenname};
$connection->log_print(OSCAR_DBG_DEBUG, "Incoming bogey - er, I mean buddy - $screenname");
my $group = $session->findbuddy($screenname);
return unless $group; # Without this, remove_buddy screws things up until signoff/signon
$buddy->{buddyid} = $session->{buddies}->{$group}->{members}->{$screenname}->{buddyid};
$buddy->{online} = 1;
foreach my $key(keys %$buddy) {
$session->{buddies}->{$group}->{members}->{$screenname}->{$key} = $buddy->{$key};
}
$session->callback_buddy_in($screenname, $group, $session->{buddies}->{$group}->{members}->{$screenname});
} elsif($family == 0x3 and $subtype == 0xC) {
my ($buddy) = new Net::OSCAR::Screenname(unpack("C/a*", $data));
my $group = $session->findbuddy($buddy);
$session->{buddies}->{$group}->{members}->{$buddy}->{online} = 0;
$connection->log_print(OSCAR_DBG_DEBUG, "And so, another former ally has abandoned us. Curse you, $buddy!");
$session->callback_buddy_out($buddy, $group);
} elsif($family == 0x1 and $subtype == 0x5) {
my $tlv = tlv_decode($data);
my($svctype) = unpack("n", $tlv->{0xD});
my $conntype;
my %chatdata;
if($svctype == CONNTYPE_LOGIN) {
$conntype = "authorizer";
} elsif($svctype == CONNTYPE_CHATNAV) {
$conntype = "chatnav";
} elsif($svctype == CONNTYPE_CHAT) {
%chatdata = %{$session->{chats}->{$reqid}};
$conntype = "chat $chatdata{name}";
} elsif($svctype == CONNTYPE_ADMIN) {
$conntype = "admin";
} elsif($svctype == CONNTYPE_BOS) {
$conntype = "BOS";
} else {
$svctype = sprintf "unknown (0x%04X)", $svctype;
}
$connection->log_print(OSCAR_DBG_NOTICE, "Got redirect for $svctype.");
$session->{chats}->{$reqid} = $session->addconn($tlv->{0x6}, $svctype, $conntype, $tlv->{0x5});
if($svctype == CONNTYPE_CHAT) {
my($key, $val);
while(($key, $val) = each(%chatdata)) { $session->{chats}->{$reqid}->{$key} = $val; }
}
} elsif($family == 0xB and $subtype == 0x2) {
$connection->log_print(OSCAR_DBG_NOTICE, "Got minimum report interval.");
} elsif($family == 0x1 and $subtype == 0x13) {
$connection->log_print(OSCAR_DBG_NOTICE, "Got MOTD.");
} elsif($family == 0x1 and $subtype == 0x3) {
$connection->log_print($connection->{conntype} == CONNTYPE_BOS ? OSCAR_DBG_SIGNON : OSCAR_DBG_NOTICE, "Got server ready. Sending set versions.");
if($connection->{conntype} != CONNTYPE_BOS) {
$connection->snac_put(family => 0x1, subtype => 0x17, data =>
pack("n*", 1, 3, $connection->{conntype}, 1)
);
} else {
$connection->snac_put(family => 0x1, subtype => 0x17, data =>
pack("n*", 1, 3, 0x13, 1, 2, 1, 3, 1, 4, 1, 6, 1, 8, 1, 9, 1, 0xA, 1, 0xB, 1, 0xC, 1)
);
}
$connection->log_print(OSCAR_DBG_NOTICE, "Sending Rate Info Req.");
$connection->snac_put(family => 0x01, subtype => 0x06);
} elsif($family == 0x4 and $subtype == 0x7) {
$connection->log_print(OSCAR_DBG_DEBUG, "Got incoming IM.");
my($from, $msg, $away, $chat, $chaturl) = $session->im_parse($data);
if($from) {
# Ignore invites for chats that we're already in
if($chat and not
grep { $_->{url} eq $chaturl }
grep { $_->{conntype} == CONNTYPE_CHAT }
@{$session->{connections}}
) {
$session->callback_chat_invite($from, $msg, $chat, $chaturl);
} elsif(!$chat) {
$session->callback_im_in($from, $msg, $away);
}
}
} elsif($family == 0x4 and $subtype == 0x14) {
$connection->log_print(OSCAR_DBG_DEBUG, "Got typing notification.");
my ($unknown1, $unknown2, $type1, $sn, $type2 ) = unpack("N2nC/a*n", $data);
$session->callback_typing_status($sn, $type2);
} elsif($family == 0x1 and $subtype == 0xA) {
$connection->log_print(OSCAR_DBG_NOTICE, "Got rate change.");
my($group, $window, $clear, $alert, $limit, $disconnect, $current, $max) = unpack("xx n N*", $data);
my($rate, $worrisome);
if($current <= $disconnect) {
$rate = RATE_DISCONNECT;
$worrisome = 1;
} elsif($current <= $limit) {
$rate = RATE_LIMIT;
$worrisome = 1;
} elsif($current <= $alert) {
$rate = RATE_ALERT;
if($current - $limit < 500) {
$worrisome = 1;
} else {
$worrisome = 0;
}
} else { # We're clear
$rate = RATE_CLEAR;
$worrisome = 0;
}
$session->callback_rate_alert($rate, $clear, $window, $worrisome);
} elsif($family == 0x1 and $subtype == 0x10) {
$connection->log_print(OSCAR_DBG_DEBUG, "Got evil.");
my $enemy = undef;
my($newevil) = unpack("n", substr($data, 0, 2, ""));
$newevil /= 10;
$enemy = $session->extract_userinfo($data) if $data;
$session->callback_evil($newevil, $enemy->{screenname});
} elsif($family == 0x4 and $subtype == 0xC) {
$connection->log_print(OSCAR_DBG_DEBUG, "Got IM ack $reqid.");
my($reqid) = unpack("xxxx N", $data);
delete $session->{cookies}->{$reqid};
$session->callback_im_ok($reqdata, $reqid);
} elsif($family == 0x1 and $subtype == 0x1F) {
$connection->log_print(OSCAR_DBG_SIGNON, "Got memory request.");
} elsif($family == 0x13 and $subtype == 0x3) {
$connection->log_print(OSCAR_DBG_NOTICE, "Got buddylist 0x0003.");
$session->{gotbl} = 1;
#$connection->snac_put(family => 0x13, subtype => 0x7);
} elsif($family == 0x13 and $subtype == 0x6) {
$connection->log_print(OSCAR_DBG_SIGNON, "Got buddylist.");
$session->{blarray} = [] unless exists($session->{blarray});
substr($data, 0, 3) = "";
substr($data, -4, 4) = "" if $snac->{flags2};
$session->{blarray}->[$snac->{flags2}] = $data;
if($snac->{flags2}) {
$connection->log_print(OSCAR_DBG_SIGNON, "Got buddylist part - need $snac->{flags2} more parts.");
} else {
delete $session->{gotbl};
return unless Net::OSCAR::_BLInternal::blparse($session, join("", reverse @{$session->{blarray}}));
delete $session->{blarray};
$connection->snac_put(family => 0x13, subtype => 0x7);
got_buddylist($session, $connection);
}
} elsif($family == 0x13 and $subtype == 0x0E) {
$session->{budmods}--;
$connection->log_print(OSCAR_DBG_DEBUG, "Got blmod ack ($session->{budmods} left).");
my(@errors) = unpack("n*", $data);
# If this is the last packet and there are/were no problems, send bl_ok
$session->callback_buddylist_ok() unless $session->{budmods} > 0 or $session->{buderrors} or grep { $_ } @errors;
my @reqdata = @$reqdata;
foreach my $error(@errors) {
my($errdata) = shift @reqdata;
if($error != 0) {
$session->{buderrors} = 1;
my($type, $gid, $bid) = ($errdata->{type}, $errdata->{gid}, $errdata->{bid});
if(exists($session->{blold}->{$type}) and exists($session->{blold}->{$type}->{$gid}) and exists($session->{blold}->{$type}->{$gid}->{$bid})) {
$session->{blinternal}->{$type}->{$gid}->{$bid} = $session->{blold}->{$type}->{$gid}->{$bid};
} else {
delete $session->{blinternal}->{$type} unless exists($session->{blold}->{$type});
delete $session->{blinternal}->{$type}->{$gid} unless exists($session->{blold}->{$type}) and exists($session->{blold}->{$type}->{$gid});
delete $session->{blinternal}->{$type}->{$gid}->{$bid} unless exists($session->{blold}->{$type}) and exists($session->{blold}->{$type}->{$gid}) and exists($session->{blold}->{$type}->{$gid}->{$bid});
}
$session->callback_buddylist_error($error, $errdata->{desc});
}
}
if($session->{budmods} == 0) {
Net::OSCAR::_BLInternal::BLI_to_NO($session) if $session->{buderrors};
delete $session->{qw(blold buderrors)};
}
} elsif($family == 0x13 and $subtype == 0x0F) {
if($session->{gotbl}) {
delete $session->{gotbl};
$connection->log_print(OSCAR_DBG_WARN, "Couldn't get your buddylist - probably because you don't have one.");
got_buddylist($session, $connection);
} else {
$connection->log_print(OSCAR_DBG_INFO, "Buddylist error:", hexdump($data));
}
} elsif($family == 0x1 and $subtype == 0x18) {
$connection->log_print(OSCAR_DBG_DEBUG, "Got hostversions.");
} elsif($family == 0x1 and $subtype == 0x1F) {
croak "GOT SENDMEMBLK REQUEST!!";
} elsif($family == 0x2 and $subtype == 0x6) {
my $buddy = $session->extract_userinfo($data);
my $screenname = $buddy->{screenname};
$connection->log_print(OSCAR_DBG_DEBUG, "Incoming buddy info - $screenname");
$session->callback_buddy_info($screenname, $buddy);
} elsif($family == 0x1 and $subtype == 0x10) {
$connection->log_print(OSCAR_DBG_DEBUG, "Somebody thinks you're evil!");
my($evil) = unpack("n", substr($data, 0, 2, ""));
$evil /= 10;
my $eviller = "";
if($data) {
$eviller = $session->extract_userinfo($data);
}
$session->callback_evil($evil, $eviller);
} elsif($family == 0xD and $subtype == 9) {
my $chat;
substr($data, 0, 4) = "";
($chat->{exchange}) = unpack("n", substr($data, 0, 2, ""));
my($namelen) = unpack("C", substr($data, 0, 1, ""));
$chat->{url} = substr($data, 0, $namelen, "");
substr($data, 0, 21) = ""; # 0 2 15 66 2 0 68 4 0 0 6A
($chat->{name}) = unpack("n/a*", $data);
substr($data, 0, length($chat->{name})+2) = "";
$session->log_print(OSCAR_DBG_DEBUG, "ChatNav told us where to find $chat->{name}");
# Generate a random request ID
my($reqid) = "";
$reqid = pack("n", 4);
$reqid .= randchars(2);
($reqid) = unpack("N", $reqid);
# We can ignore the rest of this packet.
$session->{chats}->{$reqid} = $chat;
# And now, on a very special Chat Request...
$session->{bos}->snac_put(family => 0x01, subtype => 0x04, reqid => $reqid, data =>
pack("nnn nCa*n",
CONNTYPE_CHAT, 1, 5+length($chat->{url}),
$chat->{exchange}, length($chat->{url}), $chat->{url}, 0
)
);
} elsif($family == 0x04 and $subtype == 0x0C) {
$session->log_print(OSCAR_DBG_DEBUG, "Acknowledged.");
} elsif($family == 0x0E and $subtype == 0x02) {
$connection->log_print(OSCAR_DBG_DEBUG, "Got update on room info.");
my($namelen) = unpack("xx C", substr($data, 0, 4, ""));
substr($data, 0, $namelen - 1, "");
substr($data, 0, 2) = "";
my($detaillevel) = unpack("C", substr($data, 0, 1, ""));
my($tlvcount) = unpack("n", substr($data, 0, 2, ""));
my $tlv = tlv_decode($data);
$session->callback_chat_joined($connection->{name}, $connection) unless $connection->{sent_joined}++;
my $occupants = 0;
($occupants) = unpack("n", $tlv->{0x6F}) if $tlv->{0x6F};
for(my $i = 0; $i < $occupants; $i++) {
my($occupant, $occlen) = $session->extract_userinfo($tlv->{0x73});
substr($data, 0, $occlen) = "";
$session->callback_chat_buddy_in($occupant->{screenname}, $connection);
}
} elsif($family == 0x0E and $subtype == 0x03) {
while($data) {
my($occupant, $chainlen) = $session->extract_userinfo($data);
substr($data, 0, $chainlen) = "";
$session->callback_chat_buddy_in($occupant->{screenname}, $connection, $occupant);
}
} elsif($family == 0x0E and $subtype == 0x04) {
while(substr($data, 0, 1) ne chr(0)) {
my($emigree) = unpack("C/a*", $data);
substr($data, 0, 1+length($emigree)) = "";
$session->callback_chat_buddy_out($emigree, $connection);
}
} elsif($family == 0x0E and $subtype == 0x06) {
substr($data, 0, 10) = "";
my $tlv = tlv_decode($data);
my ($sender) = unpack("C/a*", $tlv->{0x03});
my $mtlv = tlv_decode($tlv->{0x05});
my $message = $mtlv->{0x01};
$session->callback_chat_im_in($sender, $connection, $message);
} elsif($family == 0x07 and $subtype == 0x05) {
$connection->log_print(OSCAR_DBG_DEBUG, "Admin request successful!");
my($reqtype) = unpack("n", substr($data, 0, 2, ""));
my $tlv = tlv_decode(substr($data, 0, 6, ""));
my $reqdesc = "";
my($subreq) = unpack("n", $tlv->{0x3}) if $tlv->{0x3};
$subreq ||= 0;
if($reqtype == 2) {
$reqdesc = ADMIN_TYPE_PASSWORD_CHANGE;
} elsif($reqtype == 3) {
if($subreq == 0x11) {
$reqdesc = ADMIN_TYPE_EMAIL_CHANGE;
} else {
$reqdesc = ADMIN_TYPE_SCREENNAME_FORMAT;
}
} elsif($reqtype == 0x1E) {
$reqdesc = ADMIN_TYPE_ACCOUNT_CONFIRM;
}
delete $session->{adminreq}->{$reqdesc} if $reqdesc;
$reqdesc ||= sprintf "unknown admin reply type 0x%04X/0x%04X", $reqtype, $subreq;
my $errdesc = "";
if(!exists($tlv->{1})) {
my $tlv = tlv_decode($data);
if($reqdesc eq "account confirm") {
$errdesc = "Your account is already confirmed.";
} else {
my($result) = unpack("n", $tlv->{0x08});
if($result == 2) {
$errdesc = ADMIN_ERROR_BADPASS;
} elsif($result == 6) {
$errdesc = ADMIN_ERROR_BADINPUT;
} elsif($result == 0xB or $result == 0xC) {
$errdesc = ADMIN_ERROR_BADLENGTH;
} elsif($result == 0x13) {
$errdesc = ADMIN_ERROR_TRYLATER;
} elsif($result == 0x1D) {
$errdesc = ADMIN_ERROR_REQPENDING;
} else {
$errdesc = sprintf "Unknown error 0x%04X.", $result;
}
}
$session->callback_admin_error($reqdesc, $errdesc, $tlv->{4});
} else {
if($reqdesc eq "screenname format") {
$session->{screenname} = $data;
}
$session->callback_admin_ok($reqdesc);
}
} elsif($family == 0x07 and $subtype == 0x05) {
$session->log_print(OSCAR_DBG_DEBUG, "Account confirmed.");
$session->callback_admin_ok(ADMIN_TYPE_ACCOUNT_CONFIRM);
} elsif($family == 0x09 and $subtype == 0x02) {
$session->crapout($connection, "A session using this screenname has been opened in another location.");
} else {
$connection->log_print(OSCAR_DBG_NOTICE, "Unknown SNAC: ".hexdump($snac->{data}));
}
return 1;
}
sub got_buddylist($$) {
my($session, $connection) = @_;
$session->set_info("") unless $session->profile;
$connection->log_print(OSCAR_DBG_DEBUG, "Adding ICBM parameters.");
$connection->snac_put(family => 0x4, subtype => 0x2, data =>
pack("n*", 0, 0, 0x3 | 0xb, 8000, 0x3E7, 0x3E7, 0, 0)
);
$connection->log_print(OSCAR_DBG_DEBUG, "Setting idle.");
$connection->snac_put(family => 0x1, subtype => 0x11, data => pack("N", 0));
$connection->ready();
$session->{is_on} = 1;
$session->callback_signon_done() unless $session->{sent_done}++;
$connection->snac_put(family => 0x2, subtype => 0xB, data => pack("Ca*", length(normalize($session->screenname)), normalize($session->screenname)));
$connection->log_print(OSCAR_DBG_DEBUG, "Setting directory info.");
$connection->snac_put(family => 0x02, subtype => 0x09);
$connection->snac_put(family => 0x02, subtype => 0x0F);
}
1;