[1115] in BarnOwl Developers
[D-O-H] r1074 - in branches/barnowl_perlaim/owl: . perl/modules perl/modules/AIM perl/modules/AIM/lib perl/modules/AIM/lib/BarnOwl perl/modules/AIM/lib/BarnOwl/Module perl/modules/AIM/lib/Net perl/modules/AIM/lib/Net/OSCAR perl/modules/AIM/lib/Net/OSCAR/Callbacks perl/modules/AIM/lib/Net/OSCAR/Callbacks/0 perl/modules/AIM/lib/Net/OSCAR/Callbacks/1 perl/modules/AIM/lib/Net/OSCAR/Callbacks
daemon@ATHENA.MIT.EDU (geofft@MIT.EDU)
Thu Oct 29 18:13:10 2009
Resent-From: nelhage@mit.edu
Resent-To: barnowl-dev-mtg@charon.mit.edu
X-Original-To: nelhage@nelhage.com
Date: Sun, 1 Jun 2008 03:51:41 -0400 (EDT)
To: dirty-owl-hackers@MIT.EDU
From: geofft@MIT.EDU
Reply-to: dirty-owl-hackers@MIT.EDU
Author: geofft
Date: 2008-06-01 03:51:40 -0400 (Sun, 01 Jun 2008)
New Revision: 1074
Added:
branches/barnowl_perlaim/owl/perl/modules/AIM/
branches/barnowl_perlaim/owl/perl/modules/AIM/Makefile.PL
branches/barnowl_perlaim/owl/perl/modules/AIM/inc/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/BarnOwl/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/BarnOwl/Module/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/BarnOwl/Module/AIM.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Buddylist.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/0/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/0/error.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/incoming_extended_information.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/incoming_warning.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/migrate.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/pause.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/rate_change.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/rate_info_response.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/self_information.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/server_ready.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/service_redirect_response.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/unpause.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/13/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/13/chat_navigator_response.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_buddy_arrival.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_buddy_departure.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_room_status.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/incoming_chat_IM.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/16/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/16/buddy_icon_downloaded.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/16/buddy_icon_uploaded.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_3_response.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_add.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_delete.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_error.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_modification_acknowledgement.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_modify.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/end_buddylist_modifications.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/start_buddylist_modifications.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/2/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/2/incoming_profile.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/21/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/21/ICQ_meta_response.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/23/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/23/authentication_key.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/23/authorization_response.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_rights_response.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_signoff.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_status_update.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/IM_acknowledgement.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/chat_invitation_decline.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/incoming_IM.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/typing_notification.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/7/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/7/admin_request_response.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/7/confirm_account_response.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/9/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/9/BOS_rights_response.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/INDEX
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Common.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Chat.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Direct.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Server.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Constants.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/MethodInfo.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Proxy.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Screenname.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/0/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/0/BOS_signon.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/personal_info_request.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/rate_acknowledgement.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/rate_info_request.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_extended_status.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_service_versions.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_tool_versions.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/19/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/19/buddylist_request.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/19/buddylist_rights_request.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/2/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/2/get_away.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/2/locate_rights_request.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/23/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/23/initial_signon_request.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/23/signon.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/3/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/3/buddy_rights_request.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/IM_parameter_request.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/add_IM_parameters.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/outgoing_IM.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/9/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/9/BOS_rights_request.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/TLV.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Utility.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.dtd
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.parsed-xml
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.xml
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Template.pm
branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/_BLInternal.pm
Modified:
branches/barnowl_perlaim/owl/Makefile.in
Log:
Skeleton AIM module, and Net::OSCAR 1.925
Modified: branches/barnowl_perlaim/owl/Makefile.in
===================================================================
--- branches/barnowl_perlaim/owl/Makefile.in 2008-06-01 03:40:29 UTC (rev 1073)
+++ branches/barnowl_perlaim/owl/Makefile.in 2008-06-01 07:51:40 UTC (rev 1074)
@@ -31,7 +31,7 @@
TESTER_SRC = tester.c
EXE = barnowl
-PERL_MODULES = Jabber
+PERL_MODULES = Jabber AIM
MODULE_DIRS = $(PERL_MODULES:%=perl/modules/%)
BASE_OBJS = $(BASE_SRCS:.c=.o)
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/Makefile.PL
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/Makefile.PL (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/Makefile.PL 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,8 @@
+use strict;
+use warnings;
+
+use inc::Module::Install;
+
+barnowl_module('AIM');
+
+WriteAll;
Copied: branches/barnowl_perlaim/owl/perl/modules/AIM/inc (from rev 1072, branches/barnowl_perlaim/owl/perl/modules/Jabber/inc)
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/BarnOwl/Module/AIM.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/BarnOwl/Module/AIM.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/BarnOwl/Module/AIM.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,44 @@
+use warnings;
+use strict;
+
+=head1 NAME
+
+BarnOwl::Module::AIM
+
+=head1 DESCRIPTION
+
+BarnOwl module implementing AIM support via Net::OSCAR
+
+=cut
+
+package BarnOwl::Module::AIM;
+
+use Net::OSCAR;
+
+sub cmd_aimlogin {
+ my ($cmd, $user, $pass) = @_;
+ if (undef $user) {
+ BarnOwl::start_question('Username: ', sub {
+ cmd_aimlogin($cmd, @_);
+ });
+ } elsif (undef $pass) {
+ BarnOwl::start_password('Password: ', sub {
+ cmd_aimlogin($cmd, $user, @_);
+ });
+ } else {
+ $oscar = Net::OSCAR->new();
+ $oscar->set_callback_im_in(\&on_im_in);
+ $oscar->signon($user, $pass);
+ }
+}
+
+sub on_im_in {
+ my ($oscar, $sender, $message, $is_away) = @_;
+ my $msg = BarnOwl::Message->new(
+ type => 'AIM',
+ sender => $sender,
+ body => $message,
+ away => $is_away,
+ );
+ BarnOwl::queue_message($msg);
+}
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Buddylist.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Buddylist.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Buddylist.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,119 @@
+=pod
+
+Net::OSCAR::Buddylist -- tied hash class whose keys are Net::OSCAR::Screennames
+and which also maintains the ordering of its keys.
+
+OSCAR screennames don't compare like normal scalars; they're case and whitespace-insensitive.
+This is a tied hash class that has that behavior for its keys.
+
+=cut
+
+package Net::OSCAR::Buddylist;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.37 $';
+
+use strict;
+use vars qw($VERSION);
+
+use Carp;
+use Net::OSCAR::Screenname;
+use Net::OSCAR::Utility qw(normalize);
+
+sub new {
+ my $pkg = shift;
+ $pkg->{nonorm} = 0;
+ $pkg->{nonorm} = shift if @_;
+ $pkg->TIEHASH(@_);
+}
+
+sub setorder {
+ my $self = shift;
+
+ # Anything not specified gets shoved at the end
+ my @end = grep { my $inbud = $_; not grep { $_ eq $inbud } @_ } @{$self->{ORDERFORM}};
+
+ @{$self->{ORDERFORM}} = @_;
+ push @{$self->{ORDERFORM}}, @end;
+}
+
+sub TIEHASH {
+ my $class = shift;
+ my $self = { DATA => {}, ORDERFORM => [], CURRKEY => -1};
+ return bless $self, $class;
+}
+
+sub FETCH {
+ my($self, $key) = @_;
+ confess "\$self was undefined!" unless defined($self);
+ return undef unless $key;
+ $self->{DATA}->{$self->{nonorm} ? $key : normalize($key)};
+}
+
+sub STORE {
+ my($self, $key, $value) = @_;
+ if(exists $self->{DATA}->{$self->{nonorm} ? $key : normalize($key)}) {
+ my $foo = 0;
+ for(my $i = 0; $i < scalar @{$self->{ORDERFORM}}; $i++) {
+ next unless $key eq $self->{ORDERFORM}->[$i];
+ $foo = 1;
+ $self->{ORDERFORM}->[$i] = $self->{nonorm} ? $key : Net::OSCAR::Screenname->new($key);
+ last;
+ }
+ } else {
+ push @{$self->{ORDERFORM}}, $self->{nonorm} ? $key : Net::OSCAR::Screenname->new($key);
+ }
+ $self->{DATA}->{$self->{nonorm} ? $key : normalize($key)} = $value;
+}
+
+sub DELETE {
+ my($self, $key) = @_;
+ my $retval = delete $self->{DATA}->{$self->{nonorm} ? $key : normalize($key)};
+ my $foo = 0;
+ for(my $i = 0; $i < scalar @{$self->{ORDERFORM}}; $i++) {
+ next unless $key eq $self->{ORDERFORM}->[$i];
+ $foo = 1;
+ splice(@{$self->{ORDERFORM}}, $i, 1);
+
+ # What if the user deletes a key while iterating? We need to correct for the new index.
+ if($self->{CURRKEY} != -1 and $i <= $self->{CURRKEY}) {
+ $self->{CURRKEY}--;
+ }
+
+ last;
+ }
+ return $retval;
+}
+
+sub CLEAR {
+ my $self = shift;
+ $self->{DATA} = {};
+ $self->{ORDERFORM} = [];
+ $self->{CURRKEY} = -1;
+ return $self;
+}
+
+sub EXISTS {
+ my($self, $key) = @_;
+ return exists $self->{DATA}->{$self->{nonorm} ? $key : normalize($key)};
+}
+
+sub FIRSTKEY {
+ $_[0]->{CURRKEY} = -1;
+ goto &NEXTKEY;
+}
+
+sub NEXTKEY {
+ my ($self, $currkey) = @_;
+ $currkey = ++$self->{CURRKEY};
+
+ if($currkey >= scalar @{$self->{ORDERFORM}}) {
+ return wantarray ? () : undef;
+ } else {
+ my $key = $self->{ORDERFORM}->[$currkey];
+ my $normalkey = $self->{nonorm} ? $key : normalize($key);
+ return wantarray ? ($key, $self->{DATA}->{$normalkey}) : $key;
+ }
+}
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/0/error.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/0/error.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/0/error.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,19 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $error = "";
+if($family == 0x4) {
+ $error = "Your message could not be sent for the following reason: ";
+} else {
+ $error = "Error in ".$connection->{description}.": ";
+}
+$session->log_printf(OSCAR_DBG_DEBUG, "Got error %d on req 0x%04X/0x%08X.", $data{errno}, $family, $reqid);
+return if $data{errno} == 0;
+$error .= (ERRORS)[$data{errno}] || "unknown error";
+$error .= " (".$data{error_details}.")." if $data{error_details};
+send_error($session, $connection, $data{errno}, $error, 0, $reqdata);
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/incoming_extended_information.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/incoming_extended_information.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/incoming_extended_information.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,28 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+if(exists($data{upload_checksum})) {
+ # OSCAR will send the upload request again on the icon connection.
+ # Since we already have the sending queued up on that connection,
+ # just ignore the repeat request.
+ if($connection->{conntype} != CONNTYPE_ICON) {
+ if($session->{icon} and $session->{is_on}) {
+ $connection->log_print(OSCAR_DBG_INFO, "Uploading buddy icon.");
+ $session->svcdo(CONNTYPE_ICON, protobit => "icon_upload", protodata => {
+ icon => $session->{icon}
+ });
+ }
+ }
+} elsif(exists($data{resend_checksum})) {
+ $connection->log_print(OSCAR_DBG_INFO, "Got icon resend request!");
+ $session->set_icon($session->{icon}) if $session->{icon};
+} elsif(exists($data{status_message})) {
+ $session->callback_extended_status($data{status_message});
+} else {
+ $connection->log_print(OSCAR_DBG_WARN, "Unknown extended info request");
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/incoming_warning.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/incoming_warning.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/incoming_warning.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,9 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->callback_evil($data{new_level} / 10, Net::OSCAR::Screenname->new(\$data{screenname}) || undef);
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/migrate.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/migrate.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/migrate.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,63 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+# It looks like we get a blank family if the server sends
+# no migration families (full migration.) Filter out
+# this dummy entry.
+my @migfamilies = grep { $_ != 0 } @{$data{families}};
+
+$connection->log_print(OSCAR_DBG_WARN, "Migration families received: ", join(" ", @migfamilies));
+$session->loglevel(10);
+
+my $pause_queue;
+if(@{$data{families}} == keys %{$connection->{families}} or @migfamilies == 0) {
+ $connection->log_print(OSCAR_DBG_WARN, "Full migration, disconnecting...");
+ $pause_queue = $connection->{pause_queue};
+
+ # Don't let it think that we've lost the BOS connection
+ my $conntype = $connection->{conntype};
+ $connection->{conntype} = -1 if $connection->{conntype} == CONNTYPE_BOS;
+ $session->delconn($connection);
+ $connection->{conntype} = $conntype;
+
+ $session->log_print(OSCAR_DBG_WARN, "Disconnected.");
+} else {
+ $connection->log_print(OSCAR_DBG_WARN, "Partial migration");
+
+ # Get the list of families which aren't being migrated
+ my @all_families = keys %{$connection->{families}};
+ $connection->{families} = {};
+ foreach my $fam (@all_families) {
+ next if grep { $_ == $fam } @migfamilies;
+ $connection->{families}->{$fam} = 1;
+ }
+
+ # Filter the pause queue according to the migration split
+ my $all_pause_queue = $connection->{pause_queue};
+ $connection->{pause_queue} = [];
+ foreach my $item (@$all_pause_queue) {
+ if(grep { $item->{family} == $_ } @migfamilies) {
+ push @$pause_queue, $item;
+ } else {
+ push @{$connection->{pause_queue}}, $item;
+ }
+ }
+
+ $connection->log_printf(OSCAR_DBG_WARN, "Migration pause queue: %d/%d", @{$pause_queue || []}, @{$connection->{pause_queue} || []});
+}
+
+$session->log_print(OSCAR_DBG_WARN, "Creating new connection");
+my $newconn = $session->addconn(
+ auth => $data{cookie},
+ conntype => $connection->{conntype},
+ description => $connection->{description},
+ peer => $data{peer},
+ paused => 1,
+ pause_queue => $pause_queue
+);
+$session->log_print(OSCAR_DBG_WARN, "Created.");
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/pause.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/pause.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/pause.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,16 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->{__old_loglevel} = $session->loglevel();
+$session->loglevel(10);
+$connection->log_print(OSCAR_DBG_WARN, "Server initiated migration. Migration support is experimental. Please tell matthewg\@zevils.com that this happened and whether or not it worked! Include the information below.");
+$connection->log_print(OSCAR_DBG_WARN, "Migration families sent: ", join(" ", keys %{$connection->{families}}));
+$connection->proto_send(protobit => "pause_ack", protodata => {
+ families => [keys %{$connection->{families}}]
+});
+$connection->pause();
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/rate_change.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/rate_change.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/rate_change.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,37 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my($rate, $worrisome);
+
+if($session->{rate_manage_mode} != OSCAR_RATE_MANAGE_NONE) {
+ delete $data{message_type};
+
+ my $cinfo = $connection->{rate_limits}->{$data{class_id}};
+ $cinfo->{$_} = $data{$_} foreach keys(%data);
+}
+
+
+if($data{current} <= $data{disconnect}) {
+ $rate = RATE_DISCONNECT;
+ $worrisome = 1;
+} elsif($data{current} <= $data{limit}) {
+ $rate = RATE_LIMIT;
+ $worrisome = 1;
+} elsif($data{current} <= $data{alert}) {
+ $rate = RATE_ALERT;
+ if($data{current} - $data{limit} < 500) {
+ $worrisome = 1;
+ } else {
+ $worrisome = 0;
+ }
+} else { # We're clear
+ $rate = RATE_CLEAR;
+ $worrisome = 0;
+}
+
+$session->callback_rate_alert($rate, $data{clear}, $data{window}, $worrisome, 0);
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/rate_info_response.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/rate_info_response.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/rate_info_response.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,68 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+use Net::OSCAR::Utility qw(millitime);
+
+sub {
+
+$connection->unpause();
+
+if($session->{rate_manage_mode} != OSCAR_RATE_MANAGE_NONE) {
+ $connection->{rate_limits} ||= {classmap => {}};
+
+ my $rinfo = $connection->{rate_limits};
+ my $time = millitime();
+ foreach my $class (@{$data{classes}}) {
+ $class->{time_offset} = $time - $class->{last_time};
+ $rinfo->{$class->{class_id}} = $class;
+ }
+
+ my $map = $rinfo->{classmap};
+ foreach my $class (@{$data{classmembers}}) {
+ my $id = $class->{class_id};
+ foreach my $snacfam (@{$class->{snacs}}) {
+ my $key = pack("nn", $snacfam->{family}, $snacfam->{subtype});
+ $map->{$key} = $id;
+ }
+ }
+}
+
+$connection->proto_send(protobit => "rate_acknowledgement",
+ classes => [map {$_->{class_id}} @{$data{classes}}]);
+$connection->log_print(OSCAR_DBG_NOTICE, "BOS handshake complete!");
+
+if($conntype == CONNTYPE_BOS) {
+ $connection->log_print(OSCAR_DBG_SIGNON, "Signon BOS handshake complete!");
+
+ $connection->proto_send(protobit => "personal_info_request");
+ $session->set_stealth(1) if $session->{stealth};
+
+ $connection->proto_send(protobit => "buddylist_rights_request");
+ $connection->proto_send(protobit => "buddylist_request");
+ $connection->proto_send(protobit => "locate_rights_request");
+ $connection->proto_send(protobit => "buddy_rights_request");
+ $connection->proto_send(protobit => "IM_parameter_request");
+ $connection->proto_send(protobit => "BOS_rights_request");
+} elsif($conntype == CONNTYPE_CHAT) {
+ $connection->ready();
+
+ $session->callback_chat_joined($connection->name, $connection) unless $connection->{sent_joined}++;
+} else {
+ if($conntype == CONNTYPE_CHATNAV) {
+ $connection->proto_send(protobit => "chat_navigator_rights_request");
+ }
+
+ $session->{services}->{$conntype} = $connection;
+ $connection->ready();
+
+ if($session->{svcqueues}->{$conntype}) {
+ foreach my $proto_item(@{$session->{svcqueues}->{$conntype}}) {
+ $connection->proto_send(%$proto_item);
+ }
+ }
+
+ delete $session->{svcqueues}->{$conntype};
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/self_information.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/self_information.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/self_information.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,29 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->{ip} = $data{ip} if $data{ip};
+
+if(exists($data{stealth_status})) {
+ my $stealth_state;
+ if($data{stealth_status} & 0x100) {
+ $stealth_state = 1;
+ } else {
+ $stealth_state = 0;
+ }
+
+ if($stealth_state xor $session->{stealth}) {
+ $connection->log_print(OSCAR_DBG_DEBUG, "Stealth state changed: ", $stealth_state);
+ $session->{stealth} = $stealth_state;
+ $session->callback_stealth_changed($stealth_state);
+ }
+}
+
+
+if($data{session_length}) {
+ $connection->log_print(OSCAR_DBG_DEBUG, "Someone else signed on with this screenname? Session length == $data{session_length}");
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/server_ready.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/server_ready.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/server_ready.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,11 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->{families} = { map { $_ => 1 } @{$data{families}} };
+send_versions($connection, 0);
+$connection->proto_send(protobit => "rate_info_request", nopause => 1);
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/service_redirect_response.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/service_redirect_response.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/service_redirect_response.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,29 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $conntype;
+my %chatdata;
+
+my $svctype = $data{service_type};
+
+my $svcmap = tlv();
+$svcmap->{$_} = $_ foreach (CONNTYPE_LOGIN, CONNTYPE_CHATNAV, CONNTYPE_CHAT, CONNTYPE_ADMIN, CONNTYPE_BOS, CONNTYPE_ICON);
+$conntype = $svcmap->{$svctype} || sprintf("unknown (0x%04X)", $svctype);
+if($svctype == CONNTYPE_CHAT) {
+ %chatdata = %{$session->{chats}->{$reqid}};
+ $conntype = "chat $chatdata{name}";
+}
+
+$connection->log_print(OSCAR_DBG_NOTICE, "Got redirect for $svctype.");
+
+my $newconn = $session->addconn(auth => $data{auth_cookie}, conntype => $svctype, description => $conntype, peer => $data{server_ip});
+if($svctype == CONNTYPE_CHAT) {
+ $session->{chats}->{$reqid} = $newconn;
+ my($key, $val);
+ while(($key, $val) = each(%chatdata)) { $session->{chats}->{$reqid}->{$key} = $val; }
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/unpause.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/unpause.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/1/unpause.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,11 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->log_print(OSCAR_DBG_WARN, "Migration cancelled by server!");
+$connection->unpause();
+$connection->loglevel(delete $connection->{__old_loglevel});
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/13/chat_navigator_response.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/13/chat_navigator_response.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/13/chat_navigator_response.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,27 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+return if exists($data{exchange}); # This was a rights request
+
+foreach my $room (@{$data{room}}) {
+ # Generate a random request ID
+ my($reqid) = "";
+ $reqid = pack("n", 4);
+ $reqid .= randchars(2);
+ ($reqid) = unpack("N", $reqid);
+
+ $session->{chats}->{$reqid} = $room;
+
+ $session->svcdo(CONNTYPE_BOS, protobit => "service_request", reqid => $reqid, protodata => {
+ type => CONNTYPE_CHAT,
+ chat => {
+ exchange => $room->{exchange},
+ url => $room->{url}
+ }
+ });
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_buddy_arrival.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_buddy_arrival.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_buddy_arrival.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,11 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+foreach (@{$data{arrivals}}) {
+ $session->callback_chat_buddy_in(Net::OSCAR::Screenname->new(\$_->{screenname}), $connection, $_);
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_buddy_departure.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_buddy_departure.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_buddy_departure.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,11 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+foreach (@{$data{departures}}) {
+ $session->callback_chat_buddy_out(Net::OSCAR::Screenname->new(\$_), $connection);
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_room_status.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_room_status.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/chat_room_status.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,11 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->callback_chat_joined($connection->{name}, $connection) unless $connection->{sent_joined}++;
+
+$session->callback_chat_buddy_in(Net::OSCAR::Screenname->new(\$_->{screenname}), $connection) foreach @{$data{occupants}};
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/incoming_chat_IM.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/incoming_chat_IM.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/14/incoming_chat_IM.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,9 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->callback_chat_im_in($data{sender}, $connection, $data{message});
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/16/buddy_icon_downloaded.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/16/buddy_icon_downloaded.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/16/buddy_icon_downloaded.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,13 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $screenname = $data{screenname};
+my $user_info = $session->{userinfo}->{$screenname} ||= {};
+$user_info->{icon_checksum} = $data{checksum};
+$user_info->{icon} = $data{icon};
+$session->callback_buddy_icon_downloaded($user_info->{screenname}, $data{icon});
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/16/buddy_icon_uploaded.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/16/buddy_icon_uploaded.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/16/buddy_icon_uploaded.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,9 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->callback_buddy_icon_uploaded();
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,22 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->{blarray} ||= [];
+substr($data{data}, 0, 3) = "";
+substr($data{data}, -4, 4) = "" if $snac->{flags2};
+push @{$session->{blarray}}, $data{data};
+
+if($snac->{flags2}) {
+ $connection->log_printf(OSCAR_DBG_SIGNON, "Got buddylist segment -- need %d more.", $snac->{flags2});
+} else {
+ delete $session->{gotbl};
+
+ Net::OSCAR::_BLInternal::blparse($session, join("", @{$session->{blarray}}));
+ delete $session->{blarray};
+ got_buddylist($session, $connection);
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_3_response.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_3_response.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_3_response.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,22 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->{gotbl} = 1;
+
+$session->{bl_limits}->{groups} = $data{maximums}->[1];
+$session->{bl_limits}->{permits} = $data{maximums}->[2];
+$session->{bl_limits}->{denies} = $data{maximums}->[3];
+
+# Buddy limit is minimum of this and the buddy rights response value
+if($session->{bl_limits}->{buddies}) {
+ if($data{maximums}->[0] < $session->{bl_limits}->{buddies}) {
+ $session->{bl_limits}->{buddies} = $data{maximums}->[0];
+ }
+} else {
+ $session->{bl_limits}->{buddies} = $data{maximums}->[0];
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_add.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_add.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_add.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,20 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $type = "add";
+%data = protoparse($session, "buddylist_change")->unpack($snac->{data});
+
+foreach my $change (@{$data{changes}}) {
+ $connection->log_print_cond(OSCAR_DBG_DEBUG, sub { "Buddylist change $type:\n", Data::Dumper::Dumper($change) });
+ if($type eq "delete") {
+ Net::OSCAR::_BLInternal::blentry_clear($session, %$change);
+ } else {
+ Net::OSCAR::_BLInternal::blentry_set($session, %$change);
+ }
+}
+
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_delete.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_delete.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_delete.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,20 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $type = "delete";
+%data = protoparse($session, "buddylist_change")->unpack($snac->{data});
+
+foreach my $change (@{$data{changes}}) {
+ $connection->log_print_cond(OSCAR_DBG_DEBUG, sub { "Buddylist change $type:\n", Data::Dumper::Dumper($change) });
+ if($type eq "delete") {
+ Net::OSCAR::_BLInternal::blentry_clear($session, %$change);
+ } else {
+ Net::OSCAR::_BLInternal::blentry_set($session, %$change);
+ }
+}
+
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_error.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_error.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_error.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,16 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+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_cond(OSCAR_DBG_INFO, sub { "Buddylist error:", hexdump($data{data}) });
+}
+
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_modification_acknowledgement.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_modification_acknowledgement.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_modification_acknowledgement.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,52 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+if(!ref($session->{budmods}) || !@{$session->{budmods}}) {
+ $connection->log_print(OSCAR_DBG_WARN, "Unexpected blmod ack!");
+ return;
+}
+my $budmods = $session->{budmods};
+
+$connection->log_print(OSCAR_DBG_DEBUG, "Got blmod ack (", scalar(@$budmods), " left).");
+my(@errors) = @{$data{error}};
+
+my @reqdata = @$reqdata;
+foreach my $error(reverse @errors) {
+ my($errdata) = shift @reqdata;
+ last unless $errdata;
+ 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});
+ }
+
+ $connection->proto_send(%{pop @$budmods}); # Stop making changes
+ delete $session->{budmods};
+ $session->callback_buddylist_error($error, $errdata->{desc});
+ last;
+ }
+}
+
+if($session->{buderrors}) {
+ Net::OSCAR::_BLInternal::BLI_to_NO($session) if $session->{buderrors};
+ delete $session->{qw(blold buderrors budmods)};
+} else {
+ if(@$budmods) {
+ $connection->proto_send(%{shift @$budmods});
+ }
+
+ if(!@$budmods) {
+ delete $session->{budmods};
+ $session->callback_buddylist_ok;
+ }
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_modify.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_modify.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/buddylist_modify.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,20 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $type = "modify";
+%data = protoparse($session, "buddylist_change")->unpack($snac->{data});
+
+foreach my $change (@{$data{changes}}) {
+ $connection->log_print_cond(OSCAR_DBG_DEBUG, sub { "Buddylist change $type:\n", Data::Dumper::Dumper($change) });
+ if($type eq "delete") {
+ Net::OSCAR::_BLInternal::blentry_clear($session, %$change);
+ } else {
+ Net::OSCAR::_BLInternal::blentry_set($session, %$change);
+ }
+}
+
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/end_buddylist_modifications.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/end_buddylist_modifications.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/end_buddylist_modifications.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,15 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->{__BLI_locked} = 0;
+$session->callback_buddylist_changed(Net::OSCAR::_BLInternal::BLI_to_NO($session));
+
+if($session->{__BLI_commit_later}) {
+ $session->{__BLI_commit_later} = 0;
+ $session->commit_buddylist();
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/start_buddylist_modifications.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/start_buddylist_modifications.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/19/start_buddylist_modifications.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,11 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+# Someone else is modifying our buddylist.
+# Lock it so that commit_buddylist() is deferred.
+$session->{__BLI_locked} = 1;
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/2/incoming_profile.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/2/incoming_profile.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/2/incoming_profile.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,10 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->postprocess_userinfo(\%data);
+$session->callback_buddy_info($data{screenname}, \%data);
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/21/ICQ_meta_response.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/21/ICQ_meta_response.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/21/ICQ_meta_response.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,61 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $uin = $data{our_uin};
+
+if($data{type} == 2010) {
+ $session->{icq_meta_info_cache}->{$uin} ||= {};
+
+ (%data) = protoparse($session, "ICQ_meta_info_response")->unpack($data{typedata});
+ if($data{status} != 10) {
+ delete $session->{icq_meta_info_cache}->{$uin};
+
+ my $error = "Bad ICQ meta info response";
+ if($data{status} == 20) {
+ $error = "Could not get ICQ info for $uin.";
+ }
+
+ send_error($session, $connection, $data{status}, $error, 0, $reqdata);
+ return;
+ }
+
+ if(!exists(ICQ_META_INFO_INVERSE()->{$data{subtype}})) {
+ $session->log_printf(OSCAR_DBG_WARN, "Bad ICQ meta response subtype %d", $data{subtype});
+ return;
+ }
+ my $subtype = ICQ_META_INFO_INVERSE()->{$data{subtype}};
+
+ (%data) = protoparse($session, "ICQ_meta_info_response:_$subtype")->unpack($data{response_data});
+ if($subtype eq "basic") {
+ $session->{icq_meta_info_cache}->{$uin}->{home} = delete $data{home};
+ $session->{icq_meta_info_cache}->{$uin}->{basic} = \%data;
+ } elsif($subtype eq "office") {
+ $session->{icq_meta_info_cache}->{$uin}->{office} = \%data;
+ } elsif($subtype eq "background") {
+ $session->{icq_meta_info_cache}->{$uin}->{background} = \%data;
+ $session->{icq_meta_info_cache}->{$uin}->{background}->{spoken_languages} =
+ [delete @data{qw(language_1 language_2 language_3)}];
+ } elsif($subtype eq "notes") {
+ $session->{icq_meta_info_cache}->{$uin}->{notes} = $data{notes};
+ } elsif($subtype eq "email") {
+ $session->{icq_meta_info_cache}->{$uin}->{email_addresses} = $data{addresses};
+ } elsif($subtype eq "interests") {
+ $session->{icq_meta_info_cache}->{$uin}->{interests} = $data{interests};
+ } elsif($subtype eq "affiliations") {
+ $session->{icq_meta_info_cache}->{$uin}->{past_affiliations} = $data{past_affilations};
+ $session->{icq_meta_info_cache}->{$uin}->{present_affiliations} = $data{affiliations};
+ } elsif($subtype eq "homepage") {
+ $session->{icq_meta_info_cache}->{$uin}->{email_addresses} = $data{homepage};
+ }
+
+ if(!$snac->{flags2}) {
+ $session->callback_buddy_icq_info($uin, delete $session->{icq_meta_info_cache}->{$uin});
+ }
+} else {
+ $session->log_printf(OSCAR_DBG_WARN, "Unknown ICQ meta response %d", $data{type});
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/23/authentication_key.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/23/authentication_key.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/23/authentication_key.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,17 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+if(defined($connection->{auth})) {
+ $connection->log_print(OSCAR_DBG_SIGNON, "Sending password.");
+ my(%signon_data) = signon_tlv($session, delete($connection->{auth}), $data{key});
+
+ $session->svcdo(CONNTYPE_BOS, protobit => "signon", protodata => \%signon_data);
+} else {
+ $connection->log_print(OSCAR_DBG_SIGNON, "Giving client authentication challenge.");
+ $session->callback_auth_challenge($data{key}, "AOL Instant Messenger (SM)");
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/23/authorization_response.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/23/authorization_response.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/23/authorization_response.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,32 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+if($data{error}) {
+ my $error = $data{error};
+ $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 .= " ($data{error_details})" if $data{error_details};
+ $session->crapout($connection, $errstr, $error);
+ return 0;
+} else {
+ $connection->log_print(OSCAR_DBG_SIGNON, "Login OK - connecting to BOS");
+ $session->addconn(
+ auth => $data{auth_cookie},
+ conntype => CONNTYPE_BOS,
+ description => "basic OSCAR service",
+ peer => $data{server_ip}
+ );
+ $connection->{closing} = 1;
+ $connection->disconnect;
+ $session->{screenname} = $data{screenname};
+ $session->{email} = $data{email};
+
+ Net::OSCAR::Screenname->new(\$session->{screenname});
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_rights_response.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_rights_response.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_rights_response.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,16 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+# Maximum number of buddies is minimum of this and the "buddylist 3 response" value
+if($session->{bl_limits}->{buddies}) {
+ if($data{maxbuddies} < $session->{bl_limits}->{buddies}) {
+ $session->{bl_limits}->{buddies} = $data{maxbuddies};
+ }
+} else {
+ $session->{bl_limits}->{buddies} = $data{maxbuddies};
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_signoff.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_signoff.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_signoff.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,21 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $buddy = $data{screenname};
+my($grpname, $group) = $session->findbuddy($buddy);
+return unless $grpname;
+
+ delete $session->{userinfo}->{$buddy};
+my $budinfo = $group->{members}->{$buddy};
+foreach (keys %$budinfo) {
+ delete $budinfo->{$_} unless /^(?:buddyid|data|__BLI.*|alias|online|comment|screenname)$/;
+}
+$budinfo->{online} = 0;
+
+$connection->log_print(OSCAR_DBG_DEBUG, "And so, another former ally has abandoned us. Curse you, $buddy!");
+$session->callback_buddy_out($budinfo->{screenname}, $grpname);
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_status_update.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_status_update.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/3/buddy_status_update.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,40 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->log_print(OSCAR_DBG_DEBUG, "Incoming bogey - er, I mean buddy - $data{screenname}");
+$session->postprocess_userinfo(\%data);
+my $screenname = $data{screenname};
+
+my($grpname, $group) = $session->findbuddy($screenname);
+return unless $grpname; # Without this, remove_buddy screws things up until signoff/signon
+my $budinfo = $group->{members}->{$screenname};
+
+$data{buddyid} = $budinfo->{buddyid};
+$data{online} = 1;
+foreach my $key(keys %data) {
+ next if $key eq "__UNKNOWN";
+ $budinfo->{$key} = delete $data{$key};
+}
+if(exists($budinfo->{idle}) and !exists($data{idle})) {
+ delete $budinfo->{idle};
+ delete $budinfo->{idle_since};
+}
+
+# Sync $session->{userinfo}->{$foo} with buddylist entry
+if(exists($session->{userinfo}->{$screenname})) {
+ if($session->{userinfo}->{$screenname} != $budinfo) {
+ my $info = $session->{userinfo}->{$screenname};
+ foreach my $key(keys %$info) {
+ $budinfo->{$key} = $info->{$key};
+ }
+ $session->{userinfo}->{$screenname} = $budinfo;
+ }
+} else {
+ $session->{userinfo}->{$screenname} = $budinfo;
+}
+$session->callback_buddy_in($screenname, $grpname, $budinfo);
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/IM_acknowledgement.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/IM_acknowledgement.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/IM_acknowledgement.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,9 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->callback_im_ok($reqdata, $reqid);
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/chat_invitation_decline.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/chat_invitation_decline.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/chat_invitation_decline.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,10 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+#$session->callback_rendezvous_reject($data{cookie});
+delete $session->{rv_proposals}->{$data{cookie}};
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/incoming_IM.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/incoming_IM.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/incoming_IM.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,144 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+use Socket qw(inet_ntoa);
+sub {
+
+my $sender = Net::OSCAR::Screenname->new(\$data{screenname});
+my $sender_info = $session->{userinfo}->{$sender} ||= {};
+
+if($data{channel} == 1) { # Regular IM
+ %data = protoparse($session, "standard_IM_footer")->unpack($data{message_body});
+
+ # Typing status
+ my $typing_status = 0;
+ if(exists($data{supports_typing_status})) {
+ $sender_info->{typing_status} = 1;
+ } else {
+ delete $sender_info->{typing_status};
+ }
+
+
+ # Buddy icon
+ my $new_icon = 0;
+ if(exists($data{icon_data}->{icon_length}) and $session->{capabilities}->{buddy_icons}) {
+ if(!exists($sender_info->{icon_timestamp})
+ or $data{icon_data}->{icon_timestamp} > $sender_info->{icon_timestamp}
+ or $data{icon_data}->{icon_checksum} != $sender_info->{icon_checksum}
+ ) {
+ $new_icon = 1;
+ }
+ }
+
+ $sender_info->{$_} = $data{icon_data}->{$_} foreach keys %{$data{icon_data}};
+
+ $session->callback_new_buddy_icon($sender, $sender_info) if $new_icon;
+
+
+ # Okay, finally we're done with silly processing of embedded flags
+ $session->callback_im_in($sender, $data{message}, exists($data{is_automatic}) ? 1 : 0);
+
+} elsif($data{channel} == 2) {
+ %data = protoparse($session, "rendezvous_IM")->unpack($data{message_body});
+ my $type = OSCAR_CAPS_INVERSE()->{$data{capability}};
+ $session->{rv_proposals}->{$data{cookie}} ||= {};
+ my $rv = $session->{rv_proposals}->{$data{cookie}};
+
+ if($data{status} eq "cancel") {
+ $connection->log_print(OSCAR_DBG_DEBUG, "Peer rejected proposal.");
+ $session->callback_rendezvous_reject($data{cookie});
+ $session->delconn($rv->{connection}) if $rv->{connection};
+ delete $session->{rv_proposals}->{$data{cookie}};
+ return;
+ } elsif($data{status} eq "accept") {
+ $connection->log_print(OSCAR_DBG_DEBUG, "Peer accepted proposal.");
+ $rv->{accepted} = 1;
+
+ delete $session->{rv_proposals}->{$data{cookie}};
+ $session->callback_rendezvous_accept($data{cookie});
+ return;
+ }
+
+ if(!$type) {
+ $connection->log_print_cond(OSCAR_DBG_INFO, sub { "Unknown rendezvous type: ", hexdump($data{capability}) });
+ $session->rendezvous_reject($data{cookie});
+ return;
+ }
+
+ if(!$rv->{cookie}) {
+ $rv->{type} = $type;
+ $rv->{sender} = $sender;
+ $rv->{recipient} = $session->{screenname};
+ $rv->{cookie} = $data{cookie};
+ } elsif($rv->{peer} ne $sender) {
+ $connection->log_printf(OSCAR_DBG_WARN, "$sender tried to send a rendezvous which was previously sent by %s; discarding.", $rv->{peer});
+ return;
+ }
+
+ if($type eq "chat") {
+ my %svcdata = protoparse($session, "chat_invite_rendezvous_data")->unpack($data{svcdata});
+
+ # Ignore invites for chats that we're already in
+ if(not grep { $_->{url} eq $svcdata{url} }
+ grep { $_->{conntype} == CONNTYPE_CHAT }
+ @{$session->{connections}}
+ ) {
+ # Extract chat ID from char URL
+ $rv->{chat_url} = $svcdata{url};
+ $svcdata{url} =~ /-.*?-(.*?)(\0*)$/;
+ my $chat = $1;
+ $chat =~ s/%([0-9A-Z]{1,2})/chr(hex($1))/eig;
+ $rv->{name} = $chat;
+ $rv->{exchange} = $svcdata{exchange};
+
+ $session->callback_chat_invite($sender, $data{invitation_msg}, $chat, $svcdata{url});
+ }
+ } elsif($type eq "filexfer") {
+ # If proposal is being revised, no svcdata will be present.
+ my %svcdata;
+ if($data{svcdata}) {
+ %svcdata = protoparse($session, "file_transfer_rendezvous_data")->unpack($data{svcdata});
+
+ $rv->{direction} = "receive";
+ $rv->{accepted} = 0;
+ $rv->{filenames} = $svcdata{files};
+ $rv->{total_size} = $svcdata{size};
+ $rv->{file_count} = $svcdata{file_count};
+ $rv->{using_proxy} = 0;
+ $rv->{tried_proxy} = 0;
+ $rv->{tried_listen} = 0;
+ $rv->{tried_connect} = 0;
+ } elsif($rv->{connection}) {
+ $session->delconn($rv->{connection});
+ delete $rv->{connection};
+ }
+
+ $rv->{port} = $data{port};
+ $rv->{external_ip} = $data{client_external_ip} ? inet_ntoa(pack("N", $data{client_external_ip})) : "";
+ $rv->{ip} = $data{client_1_ip} ? inet_ntoa(pack("N", $data{client_1_ip})) : $rv->{external_ip};
+ $rv->{ft_state} = "unconnected";
+
+ $connection->log_printf(OSCAR_DBG_DEBUG, "Got proposal %s for %s:%d (external %s)", hexdump($rv->{cookie}), $rv->{ip}, $rv->{port}, $rv->{external_ip});
+ } elsif($type eq "sendlist") {
+ my %svcdata = protoparse($session, "buddy_list_transfer_rendezvous_data")->unpack($data{svcdata});
+ delete $session->{rv_proposals}->{$data{cookie}};
+
+ my $list = bltie();
+ foreach my $group (@{$svcdata{group}}) {
+ $list->{$group->{name}} = [];
+
+ my $grouplist = $list->{$group->{name}};
+ foreach my $buddy (@{$group->{buddies}}) {
+ push @$grouplist, Net::OSCAR::Screenname->new(\$buddy->{name});
+ }
+ }
+
+ $session->callback_buddylist_in($sender, $list);
+ } else {
+ $connection->log_print(OSCAR_DBG_INFO, "Unsupported rendezvous type '$type'");
+ $session->rendezvous_reject($data{cookie});
+ }
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/typing_notification.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/typing_notification.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/4/typing_notification.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,9 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->callback_typing_status(Net::OSCAR::Screenname->new(\$data{screenname}), $data{typing_status});
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/7/admin_request_response.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/7/admin_request_response.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/7/admin_request_response.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,58 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $reqdesc = "";
+$data{subrequest} ||= 0;
+if($data{request_type} == 2) {
+ $reqdesc = ADMIN_TYPE_PASSWORD_CHANGE;
+} elsif($data{request_type} == 3) {
+ if(exists($data{new_email})) {
+ $reqdesc = ADMIN_TYPE_EMAIL_CHANGE;
+ } else {
+ $reqdesc = ADMIN_TYPE_SCREENNAME_FORMAT;
+ }
+} elsif($data{request_type} == 0x1E) {
+ $reqdesc = ADMIN_TYPE_ACCOUNT_CONFIRM;
+}
+delete $session->{adminreq}->{0+$reqdesc} if $reqdesc;
+$reqdesc ||= sprintf "unknown admin reply type 0x%04X/0x%04X", $data{request_type}, $data{subrequest};
+
+my $errdesc = "";
+if(exists($data{error_code})) {
+ if($reqdesc eq "account confirm") {
+ $errdesc = "Your account is already confirmed.";
+ } else {
+ if($data{error_code} == 1) {
+ $errdesc = ADMIN_ERROR_DIFFSN;
+ } elsif($data{error_code} == 2) {
+ $errdesc = ADMIN_ERROR_BADPASS;
+ } elsif($data{error_code} == 6) {
+ $errdesc = ADMIN_ERROR_BADINPUT;
+ } elsif($data{error_code} == 0xB or $data{error_code} == 0xC) {
+ $errdesc = ADMIN_ERROR_BADLENGTH;
+ } elsif($data{error_code} == 0x13) {
+ $errdesc = ADMIN_ERROR_TRYLATER;
+ } elsif($data{error_code} == 0x1D) {
+ $errdesc = ADMIN_ERROR_REQPENDING;
+ } elsif($data{error_code} == 0x21) {
+ $errdesc = ADMIN_ERROR_EMAILLIM;
+ } elsif($data{error_code} == 0x23) {
+ $errdesc = ADMIN_ERROR_EMAILBAD;
+ } else {
+ $errdesc = sprintf("Unknown error 0x%04X.", $data{error_code});
+ }
+ }
+ $session->callback_admin_error($reqdesc, $errdesc, $data{error_url});
+} else {
+ if($reqdesc eq "screenname format") {
+ $session->{screenname} = Net::OSCAR::Screenname->new(\$data{new_screenname});
+ } elsif($reqdesc eq "email change") {
+ $session->{email} = $data{new_email};
+ }
+ $session->callback_admin_ok($reqdesc);
+}
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/7/confirm_account_response.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/7/confirm_account_response.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/7/confirm_account_response.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,9 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->callback_admin_ok(ADMIN_TYPE_ACCOUNT_CONFIRM);
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/9/BOS_rights_response.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/9/BOS_rights_response.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/9/BOS_rights_response.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,9 @@
+package Net::OSCAR::Callbacks;
+use strict;
+use warnings;
+use vars qw($connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$session->set_info("");
+
+};
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/INDEX
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/INDEX (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks/INDEX 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,13 @@
+0: Miscellaneous
+1: Basic stuff
+2: User information
+3: Buddies
+4: IMs
+7: Administrative
+9: Session info
+13: Chat navigation
+14: Chat
+16: Buddy icons
+19: Server-side buddylists
+21: ICQ
+23: Authentication
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Callbacks.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,80 @@
+=pod
+
+Net::OSCAR::Callbacks -- Process responses from OSCAR server
+
+=cut
+
+package Net::OSCAR::Callbacks;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.134 $';
+
+use strict;
+use vars qw($VERSION);
+use Carp;
+
+use Net::OSCAR::Common qw(:all);
+use Net::OSCAR::Constants;
+use Net::OSCAR::Utility;
+use Net::OSCAR::TLV;
+use Net::OSCAR::Buddylist;
+use Net::OSCAR::_BLInternal;
+use Net::OSCAR::XML;
+
+our %protohandlers;
+
+sub process_snac($$) {
+ our($connection, $snac) = @_;
+ our($conntype, $family, $subtype, $data, $reqid) = ($connection->{conntype}, $snac->{family}, $snac->{subtype}, $snac->{data}, $snac->{reqid});
+
+ our $reqdata = delete $connection->{reqdata}->[$family]->{pack("N", $reqid)};
+ our $session = $connection->{session};
+
+ my $protobit = snac_to_protobit(%$snac);
+ if(!$protobit) {
+ return $session->callback_snac_unknown($connection, $snac, $data);
+ }
+
+ our %data = protoparse($session, $protobit)->unpack($data || "");
+ $connection->log_printf(OSCAR_DBG_DEBUG, "Got SNAC 0x%04X/0x%04X: %s", $snac->{family}, $snac->{subtype}, $protobit);
+
+ if(!exists($protohandlers{$protobit})) {
+ $protohandlers{$protobit} = eval {
+ require "Net/OSCAR/Callbacks/$family/$protobit.pm";
+ };
+ if($@) {
+ my $olderr = $@;
+ $protohandlers{$protobit} = eval {
+ require "Net/OSCAR/Callbacks/0/$protobit.pm";
+ };
+ if($@) {
+ $protohandlers{$protobit} = sub {};
+ }
+ }
+ }
+ $protohandlers{$protobit}->();
+
+ return 1;
+}
+
+sub got_buddylist($$) {
+ my($session, $connection) = @_;
+
+ $connection->proto_send(protobit => "add_IM_parameters");
+ $connection->ready();
+
+ $session->set_extended_status("") if $session->{capabilities}->{extended_status};
+ $connection->proto_send(protobit => "set_idle", protodata => {duration => 0});
+ $connection->proto_send(protobit => "buddylist_done");
+
+ $session->{is_on} = 1;
+ $session->callback_signon_done() unless $session->{sent_done}++;
+}
+
+sub default_snac_unknown($$$$) {
+ my($session, $connection, $snac, $data) = @_;
+ $session->log_printf_cond(OSCAR_DBG_WARN, sub { "Unknown SNAC %d/%d: %s", $snac->{family},$snac->{subtype}, hexdump($snac->{data}) });
+}
+
+1;
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Common.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Common.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Common.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,185 @@
+=pod
+
+Net::OSCAR::Common -- Net::OSCAR public constants
+
+=cut
+
+package Net::OSCAR::Common;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.67 $';
+
+use strict;
+use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS $VERSION);
+use Scalar::Util qw(dualvar);
+require Exporter;
+@ISA = qw(Exporter);
+
+%EXPORT_TAGS = (
+ standard => [qw(
+ ADMIN_TYPE_PASSWORD_CHANGE
+ ADMIN_TYPE_EMAIL_CHANGE
+ ADMIN_TYPE_SCREENNAME_FORMAT
+ ADMIN_TYPE_ACCOUNT_CONFIRM
+ ADMIN_ERROR_UNKNOWN
+ ADMIN_ERROR_DIFFSN
+ ADMIN_ERROR_BADPASS
+ ADMIN_ERROR_BADINPUT
+ ADMIN_ERROR_BADLENGTH
+ ADMIN_ERROR_TRYLATER
+ ADMIN_ERROR_REQPENDING
+ ADMIN_ERROR_CONNREF
+ ADMIN_ERROR_EMAILLIM
+ ADMIN_ERROR_EMAILBAD
+ VISMODE_PERMITALL
+ VISMODE_DENYALL
+ VISMODE_PERMITSOME
+ VISMODE_DENYSOME
+ VISMODE_PERMITBUDS
+ MODBL_ACTION_ADD
+ MODBL_ACTION_DEL
+ MODBL_WHAT_BUDDY
+ MODBL_WHAT_GROUP
+ MODBL_WHAT_PERMIT
+ MODBL_WHAT_DENY
+ TYPINGSTATUS_STARTED
+ TYPINGSTATUS_TYPING
+ TYPINGSTATUS_FINISHED
+ RATE_CLEAR
+ RATE_ALERT
+ RATE_LIMIT
+ RATE_DISCONNECT
+ OSCAR_RATE_MANAGE_NONE
+ OSCAR_RATE_MANAGE_AUTO
+ OSCAR_RATE_MANAGE_MANUAL
+ GROUPPERM_OSCAR
+ GROUPPERM_AOL
+ OSCAR_SVC_AIM
+ OSCAR_SVC_ICQ
+ OSCAR_DIRECT_IM
+ OSCAR_DIRECT_FILESHARE
+ OSCAR_DIRECT_FILEXFER
+ OSCAR_RV_AUTO
+ OSCAR_RV_NOPROXY
+ OSCAR_RV_NODIRECT
+ OSCAR_RV_MANUAL
+ )],
+ loglevels => [qw(
+ OSCAR_DBG_NONE
+ OSCAR_DBG_WARN
+ OSCAR_DBG_INFO
+ OSCAR_DBG_SIGNON
+ OSCAR_DBG_NOTICE
+ OSCAR_DBG_DEBUG
+ OSCAR_DBG_PACKETS
+ OSCAR_DBG_XML
+ OSCAR_DBG_XML2
+ )]
+);
+$EXPORT_TAGS{all} = [@{$EXPORT_TAGS{standard}}, @{$EXPORT_TAGS{loglevels}}];
+@EXPORT_OK = @{$EXPORT_TAGS{all}};
+
+# Log levels
+use constant OSCAR_DBG_NONE => 0;
+use constant OSCAR_DBG_WARN => 1;
+use constant OSCAR_DBG_INFO => 2;
+use constant OSCAR_DBG_SIGNON => 3;
+use constant OSCAR_DBG_NOTICE => 4;
+use constant OSCAR_DBG_DEBUG => 6;
+use constant OSCAR_DBG_PACKETS => 10;
+use constant OSCAR_DBG_XML => 30;
+use constant OSCAR_DBG_XML2 => 35;
+
+# Buddylist modification
+use constant MODBL_ACTION_ADD => dualvar(1, "add");
+use constant MODBL_ACTION_DEL => dualvar(2, "delete");
+use constant MODBL_WHAT_BUDDY => dualvar(1, "buddy");
+use constant MODBL_WHAT_GROUP => dualvar(2, "group");
+use constant MODBL_WHAT_PERMIT => dualvar(3, "permit");
+use constant MODBL_WHAT_DENY => dualvar(4, "deny");
+
+# Typing statuses
+use constant TYPINGSTATUS_STARTED => dualvar(2, "typing started");
+use constant TYPINGSTATUS_TYPING => dualvar(1, "typing in progress");
+use constant TYPINGSTATUS_FINISHED => dualvar(0, "typing completed");
+
+# Administrative functions
+use constant ADMIN_TYPE_PASSWORD_CHANGE => dualvar(1, "password change");
+use constant ADMIN_TYPE_EMAIL_CHANGE => dualvar(2, "email change");
+use constant ADMIN_TYPE_SCREENNAME_FORMAT => dualvar(3, "screenname format");
+use constant ADMIN_TYPE_ACCOUNT_CONFIRM => dualvar(4, "account confirm");
+
+# Adminsitrative responses
+use constant ADMIN_ERROR_UNKNOWN => dualvar(0, "unknown error");
+use constant ADMIN_ERROR_BADPASS => dualvar(1, "incorrect password");
+use constant ADMIN_ERROR_BADINPUT => dualvar(2, "invalid input");
+use constant ADMIN_ERROR_BADLENGTH => dualvar(3, "screenname/email/password is too long or too short");
+use constant ADMIN_ERROR_TRYLATER => dualvar(4, "request could not be processed; wait a few minutes and try again");
+use constant ADMIN_ERROR_REQPENDING => dualvar(5, "request pending");
+use constant ADMIN_ERROR_CONNREF => dualvar(6, "couldn't connect to the admin server");
+use constant ADMIN_ERROR_DIFFSN => dualvar(7, "the new screenname is not equivalent to the old screenname");
+use constant ADMIN_ERROR_EMAILLIM => dualvar(8, "the email address has too many screennames");
+use constant ADMIN_ERROR_EMAILBAD => dualvar(9, "the email address is invalid");
+
+# Direct connect types
+use constant OSCAR_DIRECT_IM => dualvar(1, "direct IM");
+use constant OSCAR_DIRECT_FILESHARE => dualvar(2, "file sharing");
+use constant OSCAR_DIRECT_FILEXFER => dualvar(3, "file transfer");
+
+# Rendezvous autonegotiate modes
+use constant OSCAR_RV_AUTO => "auto";
+use constant OSCAR_RV_NOPROXY => "never proxy";
+use constant OSCAR_RV_NODIRECT => "always proxy";
+use constant OSCAR_RV_MANUAL => "manual negotiation";
+
+
+# Visibility modes
+use constant VISMODE_PERMITALL => dualvar(0x1, "permit all");
+use constant VISMODE_DENYALL => dualvar(0x2, "deny all");
+use constant VISMODE_PERMITSOME => dualvar(0x3, "permit some");
+use constant VISMODE_DENYSOME => dualvar(0x4, "deny some");
+use constant VISMODE_PERMITBUDS => dualvar(0x5, "permit buddies");
+
+# Rate warning types
+use constant RATE_CLEAR => dualvar(1, "clear");
+use constant RATE_ALERT => dualvar(2, "alert");
+use constant RATE_LIMIT => dualvar(3, "limit");
+use constant RATE_DISCONNECT => dualvar(4, "disconnect");
+
+# Rate handling modes
+use constant OSCAR_RATE_MANAGE_NONE => dualvar(0, "none");
+use constant OSCAR_RATE_MANAGE_AUTO => dualvar(1, "auto");
+use constant OSCAR_RATE_MANAGE_MANUAL => dualvar(2, "manual");
+
+# Group permissions
+use constant GROUPPERM_OSCAR => dualvar(0x18, "AOL Instant Messenger users");
+use constant GROUPPERM_AOL => dualvar(0x04, "AOL subscribers");
+
+# Services - deprecated, modules should no longer use these directly
+use constant OSCAR_SVC_AIM => (
+ host => 'login.oscar.aol.com',
+ port => 5190,
+ supermajor => 0x0109,
+ major => 5,
+ minor => 5,
+ subminor => 0,
+ build => 0x0E0B,
+ subbuild => 0x00000104,
+ clistr => "AOL Instant Messenger, version 5.5.3595/WIN32",
+ hashlogin => 0,
+ betainfo => "",
+);
+use constant OSCAR_SVC_ICQ => ( # Courtesy of SDiZ Cheng
+ host => 'login.icq.com',
+ port => 5190,
+ supermajor => 0x010A,
+ major => 5,
+ minor => 0x2D,
+ subminor => 0,
+ build => 0xEC1,
+ subbuild => 0x55,
+ clistr => "ICQ Inc. - Product of ICQ (TM).2003a.5.45.1.3777.85",
+ hashlogin => 1,
+);
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Chat.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Chat.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Chat.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,67 @@
+=pod
+
+Net::OSCAR::Connection::Chat -- OSCAR chat connections
+
+=cut
+
+package Net::OSCAR::Connection::Chat;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.10 $';
+
+use strict;
+use Carp;
+
+use Net::OSCAR::TLV;
+use Net::OSCAR::Callbacks;
+use vars qw(@ISA $VERSION);
+use Net::OSCAR::Common qw(:all);
+use Net::OSCAR::Constants;
+use Net::OSCAR::Utility;
+use Net::OSCAR::XML;
+@ISA = qw(Net::OSCAR::Connection);
+
+sub invite($$;$) {
+ my($self, $who, $message) = @_;
+ $message ||= "Join me in this Buddy Chat";
+
+ $self->log_print(OSCAR_DBG_DEBUG, "Inviting $who to join us.");
+
+ my $svcdata = protoparse($self, "chat_invite_rendezvous_data")->pack(
+ exchange => $self->{exchange},
+ url => $self->{url}
+ );
+
+ my $cookie = randchars(8);
+ my %rvdata = (
+ capability => OSCAR_CAPS()->{chat}->{value},
+ charset => "us-ascii",
+ cookie => $cookie,
+ invitation_msg => $message,
+ push_pull => 1,
+ status => "propose",
+ svcdata => $svcdata
+ );
+
+ return $self->{session}->send_message($who, 2, protoparse($self, "rendezvous_IM")->pack(%rvdata), 0, $cookie);
+}
+
+sub chat_send($$;$$) {
+ my($self, $msg, $noreflect, $away) = @_;
+
+ my %protodata = (
+ cookie => randchars(8),
+ message => $msg
+ );
+ $protodata{reflect} = "" unless $noreflect;
+ $protodata{is_automatic} = "" if $away;
+
+ $self->proto_send(protobit => "outgoing_chat_IM", protodata => \%protodata);
+}
+
+sub part($) { shift->disconnect(); }
+sub url($) { shift->{url}; }
+sub name($) { shift->{name}; }
+sub exchange($) { shift->{exchange}; }
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Direct.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Direct.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Direct.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,456 @@
+=pod
+
+Net::OSCAR::Connection::Direct -- OSCAR direct connections
+
+=cut
+
+package Net::OSCAR::Connection::Direct;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.13 $';
+
+use strict;
+use Carp;
+
+use vars qw(@ISA $VERSION $REVISION);
+use Socket;
+use Symbol;
+use Net::OSCAR::Common qw(:all);
+use Net::OSCAR::Constants;
+use Net::OSCAR::Utility;
+use Net::OSCAR::XML;
+@ISA = qw(Net::OSCAR::Connection);
+
+sub process_one($;$$$) {
+ my($self, $read, $write, $error) = @_;
+ my $snac;
+
+ if($error) {
+ $self->{sockerr} = 1;
+ $self->disconnect();
+
+ if($self->{rv}->{ft_state} eq "connecting" or $self->{rv}->{ft_state} eq "connected") {
+ $self->log_print(OSCAR_DBG_INFO, "Couldn't connect to rendezvous peer; revising rendezvous.");
+ $self->{session}->rendezvous_revise($self->{rv}->{cookie});
+ }
+
+ return;
+ }
+
+ #$self->log_printf(OSCAR_DBG_DEBUG,
+ # "Called process_one on direct connection: st=%s, fts=%s, dir=%s, acp=%s, r=$read, w=$write, e=$error",
+ # $self->{state}, $self->{rv}->{ft_state}, $self->{rv}->{direction}, $self->{rv}->{accepted}
+ #);
+ if($read and $self->{rv}->{ft_state} eq "listening") {
+ my $newsock = gensym();
+
+ if(accept($newsock, $self->{socket})) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Accepted incoming connection.");
+ $self->{session}->callback_connection_changed($self, "deleted");
+ close($self->{socket});
+ $self->{socket} = $newsock;
+ $self->set_blocking(0);
+
+ if($self->{rv}->{direction} eq "send") {
+ $self->{state} = "write";
+ } else {
+ $self->{state} = "read";
+ }
+
+ $self->{rv}->{ft_state} = "connected";
+ $self->{session}->callback_connection_changed($self, $self->{state});
+
+ return 1;
+ } else {
+ $self->log_print(OSCAR_DBG_WARN, "Failed to accept incoming connection: $!");
+ return 0;
+ }
+ } elsif($write and $self->{rv}->{ft_state} eq "proxy_connect") {
+ $self->log_print(OSCAR_DBG_DEBUG, "Connected to proxy.");
+ $self->{connected} = 1;
+ my $ret;
+
+ if($self->{sent_proxy_init}++) {
+ my $packet = protoparse($self->{session}, "direct_connect_proxy_init")->pack(
+ msg_type => 2,
+ screenname => $self->{rv}->{peer},
+ cookie => $self->{rv}->{cookie},
+ capability => OSCAR_CAPS()->{filexfer}->{value}
+ );
+ $ret = $self->write(pack("n", length($packet)) . $packet);
+ } else {
+ $ret = $self->write();
+ }
+
+ return $ret unless $ret;
+
+ delete $self->{sent_proxy_init};
+ $self->{rv}->{ft_state} = "proxy_ack";
+ $self->{state} = "read";
+ $self->{session}->callback_connection_changed($self, "read");
+ } elsif($read and $self->{rv}->{ft_state} eq "proxy_ack") {
+ my $ret = $self->get_proxy_header("direct_connect_proxy_reply");
+ return $ret unless $ret;
+
+ if($ret->{magic} != 1098 or $ret->{msg_type} != 3) {
+ $self->{sockerr} = 1;
+ $self->disconnect();
+
+ $self->log_print(OSCAR_DBG_INFO, "Bad response from proxy; revising rendezvous.");
+ $self->{session}->rendezvous_revise($self->{rv}->{cookie});
+
+ return undef;
+ } else {
+ $self->{rv}->{ft_state} = "proxy_connected";
+ $self->{state} = "read";
+ $self->{session}->callback_connection_changed($self, "read");
+
+ my %protodata = (
+ status => "accept",
+ cookie => $self->{rv}->{cookie},
+ capability => OSCAR_CAPS()->{$self->{rv}->{type}} ? OSCAR_CAPS()->{$self->{rv}->{type}}->{value} : $self->{rv}->{type},
+ client_1_ip => $ret->{ip},
+ port => $ret->{port}
+ );
+ $self->{session}->send_message($self->{rv}->{sender}, 2, protoparse($self->{session}, "rendezvous_IM")->pack(%protodata));
+ }
+ } elsif($read and $self->{rv}->{ft_state} eq "proxy_connect") {
+ my $ret = $self->get_proxy_header();
+ return $ret unless $ret;
+
+ if($ret->{magic} != 1098 or $ret->{msg_type} != 5) {
+ $self->{sockerr} = 1;
+ $self->disconnect();
+
+ $self->log_print(OSCAR_DBG_INFO, "Bad response from proxy; revising rendezvous.");
+ $self->{session}->rendezvous_revise($self->{rv}->{cookie});
+
+ return undef;
+ } else {
+ $self->log_print(OSCAR_DBG_DEBUG, "Rendezvous peer connected to proxy.");
+ $self->{rv}->{ft_state} = "connected";
+ if($self->{rv}->{direction} eq "send") {
+ $self->{state} = "write";
+ } else {
+ $self->{state} = "read";
+ }
+
+ $self->{session}->callback_connection_changed($self, $self->{state});
+ }
+ } elsif($write and $self->{rv}->{ft_state} eq "connecting") {
+ $self->log_print(OSCAR_DBG_DEBUG, "Connected.");
+ $self->{connected} = 1;
+
+ my %protodata;
+ $protodata{status} = "accept";
+ $protodata{cookie} = $self->{rv}->{cookie};
+ $protodata{capability} = OSCAR_CAPS()->{$self->{rv}->{type}} ? OSCAR_CAPS()->{$self->{rv}->{type}}->{value} : $self->{rv}->{type};
+ $self->{session}->send_message($self->{rv}->{sender}, 2, protoparse($self->{session}, "rendezvous_IM")->pack(%protodata));
+
+ $self->{rv}->{ft_state} = "connected";
+ $self->{rv}->{accepted} = 1;
+ if($self->{rv}->{direction} eq "receive") {
+ $self->{state} = "read";
+ $self->{session}->callback_connection_changed($self, $self->{state});
+ }
+ } elsif($write and $self->{rv}->{ft_state} eq "connected") {
+ if($self->{rv}->{direction} eq "send") {
+ return 1 unless $self->{rv}->{accepted};
+ }
+
+ $self->log_print(OSCAR_DBG_DEBUG, "Sending OFT header (SYN).");
+ my $ret;
+ if($self->{sent_oft_header}) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Flushing buffer");
+ $ret = $self->write(); # Flush buffer
+ } else {
+ $self->log_print(OSCAR_DBG_DEBUG, "Sending initial header");
+ $self->{sent_oft_header} = 1;
+ if($self->{rv}->{direction} eq "send" and !$self->{got_files}) {
+ $self->{checksum} = $self->checksum($self->{rv}->{data}->[0]);
+ $self->{byte_count} = $self->{rv}->{total_size};
+ $self->{bytes_left} = length($self->{rv}->{data}->[0]);
+ $self->{filename} = $self->{rv}->{filenames}->[0];
+ }
+ $ret = $self->send_oft_header();
+ }
+ return $ret unless $ret;
+
+ if($self->{rv}->{direction} eq "receive") {
+ if($self->{rv}->{file_count} == 1 or ($self->{sent_oft_header} and $self->{sent_oft_header} >= 2)) {
+ $self->{rv}->{ft_state} = "data";
+ } else {
+ $self->log_print(OSCAR_DBG_DEBUG, "Sending second header.");
+ $self->{sent_oft_header} = 2;
+ $ret = $self->send_oft_header();
+ return $ret unless $ret;
+ $self->{rv}->{ft_state} = "data";
+ }
+ }
+
+ delete $self->{sent_oft_header};
+ $self->{state} = "read";
+ $self->{session}->callback_connection_changed($self, "read");
+ } elsif($read and $self->{rv}->{ft_state} eq "connected") {
+ $self->log_print(OSCAR_DBG_DEBUG, "Getting OFT header");
+ my $ret = $self->get_oft_header();
+ return $ret unless $ret;
+
+ if($self->{rv}->{direction} eq "send") {
+ $self->{rv}->{ft_state} = "data";
+ } elsif($self->{got_files}) {
+ $self->{sent_oft_header} = 2;
+ $self->log_print(OSCAR_DBG_DEBUG, "Sending second header.");
+ $ret = $self->send_oft_header();
+ if($ret) {
+ delete $self->{sent_oft_header};
+ $self->{rv}->{ft_date} = "data";
+ $self->{state} = "read";
+ $self->{session}->callback_connection_changed($self, "read");
+ return;
+ }
+ }
+
+ $self->{state} = "write";
+ $self->{session}->callback_connection_changed($self, "write");
+ } elsif($self->{rv}->{ft_state} eq "data") {
+ my $ret;
+
+ if($write and $self->{rv}->{direction} eq "send") {
+ $self->log_print(OSCAR_DBG_DEBUG, "Sending data");
+ if($self->{sent_data}++) {
+ $ret = $self->write();
+ } else {
+ $ret = $self->write($self->{rv}->{data}->[0]);
+ }
+
+ if($ret) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Done sending data");
+
+ shift @{$self->{rv}->{data}};
+ shift @{$self->{rv}->{filenames}};
+ $self->{sent_data} = 0;
+
+ $self->{rv}->{ft_state} = "fin";
+ $self->{state} = "read";
+ $self->{session}->callback_connection_changed($self, "read");
+ } else {
+ return $ret;
+ }
+ } elsif($read and $self->{rv}->{direction} eq "receive") {
+ $self->log_printf(OSCAR_DBG_DEBUG, "Receiving %d bytes of data", $self->{read_size});
+ if($self->{got_data}++) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Getting more data");
+ $ret = $self->read();
+ } else {
+ $self->log_print(OSCAR_DBG_DEBUG, "Doing initial read");
+ $ret = $self->read($self->{read_size});
+ }
+
+ if($ret) {
+ $self->log_printf(OSCAR_DBG_DEBUG, "Got complete file, %d bytes.", length($ret));
+
+ $self->{rv}->{data} ||= [];
+ push @{$self->{rv}->{data}}, $ret;
+ shift @{$self->{rv}->{filenames}};
+ $self->{bytes_recv} = length($ret);
+ $self->{got_data} = 0;
+ $self->{received_checksum} = $self->checksum($ret);
+
+ if($self->{received_checksum} != $self->{checksum}) {
+ $self->log_printf(OSCAR_DBG_WARN, "Checksum mismatch: %lu/%lu", $self->{checksum}, $self->{received_checksum});
+ $self->log_print(OSCAR_DBG_WARN, "Data: ", hexdump($ret));
+ $self->{sockerr} = 1;
+ $self->disconnect();
+ return undef;
+ } else {
+ $self->log_print(OSCAR_DBG_WARN, "Data: ", hexdump($ret));
+ }
+
+ $self->{rv}->{ft_state} = "fin";
+ $self->{state} = "write";
+ $self->{session}->callback_connection_changed($self, "write");
+ } else {
+ return $ret;
+ }
+ }
+ } elsif($self->{rv}->{ft_state} eq "fin") {
+ if($read and $self->{rv}->{direction} eq "send") {
+ $self->log_print(OSCAR_DBG_DEBUG, "Getting OFT fin header");
+ my $ret = $self->get_oft_header();
+ return $ret unless $ret;
+
+ if(@{$self->{rv}->{data}}) {
+ $self->{rv}->{ft_state} = "connected";
+ $self->{state} = "write";
+ $self->{session}->callback_connection_changed($self, "write");
+ } else {
+ $self->disconnect();
+ }
+
+ return 1;
+ } elsif($write and $self->{rv}->{direction} eq "receive") {
+ $self->log_print(OSCAR_DBG_DEBUG, "Sending OFT fin header");
+ my $ret = $self->send_oft_header();
+ return $ret unless $ret;
+
+ if(++$self->{got_files} < $self->{rv}->{file_count}) {
+ $self->{rv}->{ft_state} = "connected";
+ $self->{state} = "read";
+ $self->{session}->callback_connection_changed($self, "read");
+ } else {
+ $self->disconnect();
+ }
+ return 1;
+ }
+ }
+}
+
+sub send_oft_header($) {
+ my $self = shift;
+
+ my $total_size = 0;
+ $total_size += length($_) foreach @{$self->{rv}->{data}};
+
+ my $type;
+ my $cookie;
+ if($self->{rv}->{ft_state} eq "connected" and ($self->{sent_oft_header} and $self->{sent_oft_header} != 2)) {
+ if($self->{rv}->{direction} eq "send") {
+ $type = 0x101;
+ $cookie = chr(0) x 8;
+ } else {
+ $type = 0x202;
+ $cookie = $self->{rv}->{cookie};
+ }
+ } else {
+ $type = 0x204;
+ $cookie = $self->{rv}->{cookie};
+ }
+
+ my %protodata = (
+ type => $type,
+ cookie => $cookie,
+ file_count => $self->{rv}->{file_count},
+ files_left => scalar(@{$self->{rv}->{data}}),
+ byte_count => $self->{byte_count},
+ bytes_left => $self->{bytes_left},
+ mtime => time(),
+ ctime => 0,
+ bytes_received => $self->{bytes_recv},
+ checksum => $self->{checksum},
+ received_checksum => $self->{received_checksum},
+ filename => $self->{filename}
+ );
+ $self->write(protoparse($self->{session}, "file_transfer_header")->pack(%protodata));
+}
+
+sub get_oft_header($) {
+ my $self = shift;
+
+ my $header = $self->read(6);
+ return $header unless $header;
+ my($magic, $length) = unpack("a4 n", $header);
+
+ if($magic ne "OFT2") {
+ $self->log_print(OSCAR_DBG_WARN, "Got unexpected data while reading file transfer header!");
+ $self->{sockerr} = 1;
+ $self->disconnect();
+ return undef;
+ }
+
+ my $data = $self->read($length - 6);
+ return $data unless $data;
+
+ my %protodata = protoparse($self->{session}, "file_transfer_header")->unpack($header . $data);
+ if($self->{rv}->{direction} eq "receive") {
+ if(
+ $protodata{file_count} != $self->{rv}->{file_count} or
+ $protodata{byte_count} != $self->{rv}->{total_size}
+ ) {
+ $self->log_print(OSCAR_DBG_WARN, "Rendezvous header data doesn't match initial proposal!");
+ $self->{sockerr} = 1;
+ $self->disconnect();
+ return undef;
+ } else {
+ $self->{read_size} = $protodata{bytes_left};
+ $self->{checksum} = $protodata{checksum};
+ $self->{byte_count} = $protodata{byte_count};
+ $self->{bytes_left} = $protodata{bytes_left};
+ $self->{filename} = $protodata{filename};
+ }
+ } else {
+ if($protodata{cookie} ne $self->{rv}->{cookie}) {
+ $self->log_print(OSCAR_DBG_WARN, "Rendezvous header cookie doesn't match initial proposal!");
+ $self->{sockerr} = 1;
+ $self->disconnect();
+ return undef;
+ }
+ }
+
+ $self->log_print(OSCAR_DBG_DEBUG, "Got OFT header.");
+ return 1;
+}
+
+# Adopted from Gaim's implementation
+sub checksum($$) {
+ my($self, $part) = @_;
+ my $check = sprintf("%lu", (0xFFFF0000 >> 16) & 0xFFFF);
+
+ for(my $i = 0; $i < length($part); $i++) {
+ my $oldcheck = $check;
+
+ my $byte = ord(substr($part, $i, 1));
+ my $val = ($i & 1) ? $byte : ($byte << 8);
+ $check -= $val;
+ $check = sprintf("%lu", $check);
+
+ if($check > $oldcheck) {
+ $check--;
+ $check = sprintf("%lu", $check);
+ }
+ }
+
+ $check = (($check & 0x0000FFFF) + ($check >> 16));
+ $check = (($check & 0x0000FFFF) + ($check >> 16));
+ $check = $check << 16;
+
+ return sprintf("%lu", $check);
+}
+
+sub get_proxy_header($;$) {
+ my ($self, $protobit) = @_;
+ my $socket = $self->{socket};
+ my ($buffer, $len);
+ my $nchars;
+ $protobit ||= "direct_connect_proxy_hdr";
+
+ if(!$self->{buff_gotproxy}) {
+ my $header = $self->read(2);
+ if(!defined($header)) {
+ return undef;
+ } elsif($header eq "") {
+ return "";
+ }
+
+ $self->{buff_gotproxy} = 2;
+ ($self->{proxy_size}) = unpack("n", $header);
+ }
+
+ if($self->{proxy_size} > 0) {
+ my $data = $self->read($self->{proxy_size}, 2);
+ if(!defined($data)) {
+ return undef;
+ } elsif($data eq "") {
+ return "";
+ }
+
+ $self->log_print_cond(OSCAR_DBG_PACKETS, sub { "Got ", hexdump($data) });
+ delete $self->{buff_gotproxy};
+ return {protoparse($self->{session}, $protobit)->unpack($data)};
+ } else {
+ delete $self->{buff_gotproxy};
+ return "";
+ }
+}
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Server.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Server.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection/Server.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,85 @@
+=pod
+
+Net::OSCAR::Connection::Server -- Net::OSCAR server connection
+
+=cut
+
+package Net::OSCAR::Connection::Server;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.5 $';
+@ISA = qw(Net::OSCAR::Connection);
+
+use strict;
+use vars qw($VERSION @ISA);
+use Carp;
+use Socket;
+use Symbol;
+
+use Net::OSCAR::Common qw(:all);
+use Net::OSCAR::Constants;
+use Net::OSCAR::Connection;
+use Net::OSCAR::ServerCallbacks;
+
+sub new($@) {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ $self->listen($self->{session}->{port}) unless exists($self->{socket});
+
+ $self->{oscar_state} = "listening";
+ $self->{signon_done} = 0;
+
+ return $self;
+}
+
+sub process_one($;$$$) {
+ my($self, $read, $write, $error) = @_;
+ my $snac;
+
+ if($error) {
+ $self->{sockerr} = 1;
+ return $self->disconnect();
+ }
+
+ if($write && $self->{outbuff}) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Flushing output buffer.");
+ $self->flap_put();
+ }
+
+ if($read && !$self->{connected}) {
+ $self->log_print(OSCAR_DBG_NOTICE, "Incoming connection.");
+
+ my $socket = gensym();
+ accept($socket, $self->{socket});
+ my $peer = $self->{session}->addconn(socket => $socket, conntype => CONNTYPE_SERVER, description => "new peer");
+
+ $peer->set_blocking(0);
+ $peer->{connected} = 1;
+ $peer->{state} = "write";
+ $peer->{oscar_state} = "new";
+ $self->{session}->callback_connection_changed($peer, "write");
+ return 1;
+ } elsif($write and $self->{oscar_state} eq "new") {
+ $self->log_print(OSCAR_DBG_DEBUG, "Putting connack.");
+ $self->flap_put(pack("N", 1), FLAP_CHAN_NEWCONN);
+ $self->{state} = "readwrite";
+ $self->{session}->callback_connection_changed($self, "readwrite");
+ $self->{oscar_state} = "ready";
+
+ $self->{families} = {};
+ $self->{families}->{$_} = 1 foreach (1..30);
+ } elsif($read) {
+ my $no_reread = 0;
+
+ while(1) {
+ my $flap = $self->flap_get($no_reread) or return 0;
+ next if length($flap) == 4;
+ my $snac = $self->snac_decode($flap) or return 0;
+ Net::OSCAR::ServerCallbacks::process_snac($self, $snac);
+ } continue {
+ $no_reread = 1;
+ }
+ }
+}
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Connection.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,641 @@
+=pod
+
+Net::OSCAR::Connection -- individual Net::OSCAR service connection
+
+=cut
+
+package Net::OSCAR::Connection;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.95 $';
+
+use strict;
+use vars qw($VERSION);
+use Carp;
+use Socket;
+use Symbol;
+use Digest::MD5;
+use Fcntl;
+use POSIX qw(:errno_h);
+use Scalar::Util qw(weaken);
+use List::Util qw(max);
+
+use Net::OSCAR::Common qw(:all);
+use Net::OSCAR::Constants;
+use Net::OSCAR::Utility;
+use Net::OSCAR::TLV;
+use Net::OSCAR::Callbacks;
+use Net::OSCAR::XML;
+
+if($^O eq "MSWin32") {
+ eval '*F_GETFL = sub {0};';
+ eval '*F_SETFL = sub {0};';
+ eval '*O_NONBLOCK = sub {0}; ';
+}
+
+sub new($@) {
+ my($class, %data) = @_;
+ $class = ref($class) || $class || "Net::OSCAR::Connection";
+ my $self = { %data };
+
+ # Avoid circular references
+ weaken($self->{session});
+
+ bless $self, $class;
+ $self->{seqno} = 0;
+ $self->{icq_seqno} = 0;
+ $self->{outbuff} = "";
+ $self->{state} ||= "write";
+ $self->{paused} = 0 unless $self->{paused};
+ $self->{families} = {};
+ $self->{buffsize} = 65535;
+ $self->{buffer} = \"";
+
+ $self->connect($self->{peer}) if exists($self->{peer});
+
+ return $self;
+}
+
+sub pause($) {
+ my $self = shift;
+ $self->{pause_queue} ||= [];
+ $self->{paused} = 1;
+}
+
+sub unpause($) {
+ my $self = shift;
+ return unless $self->{paused};
+ $self->{paused} = 0;
+
+ $self->log_print(OSCAR_DBG_WARN, "Flushing pause queue");
+ foreach my $item(@{$self->{pause_queue}}) {
+ $self->log_printf(OSCAR_DBG_WARN, "Flushing SNAC 0x%04X/0x%04X", $item->{family}, $item->{subtype});
+ $self->snac_put(%$item);
+ }
+ $self->log_print(OSCAR_DBG_WARN, "Pause queue flushed");
+
+ delete $self->{pause_queue};
+}
+
+sub proto_send($%) {
+ my($self, %data) = @_;
+ $data{protodata} ||= {};
+
+ my %snac = protobit_to_snac($data{protobit}); # or croak "Couldn't find protobit $data{protobit}";
+ confess "BAD SELF!" unless ref($self);
+ confess "BAD DATA!" unless ref($data{protodata});
+
+ $snac{data} = protoparse($self->{session}, $data{protobit})->pack(%{$data{protodata}});
+ foreach (qw(reqdata reqid flags1 flags2)) {
+ $snac{$_} = $data{$_} if exists($data{$_});
+ }
+
+ if(exists($snac{family})) {
+ if($snac{family} == -1 and exists($data{family})) {
+ $snac{family} = $data{family};
+ }
+
+ if($self->{paused} and !$data{nopause}) {
+ $self->log_printf(OSCAR_DBG_WARN, "Adding SNAC 0x%04X/0x%04X to pause queue", $snac{family}, $snac{subtype});
+ push @{$self->{pause_queue}}, \%snac;
+ } else {
+ $self->log_printf(OSCAR_DBG_DEBUG, "Put SNAC 0x%04X/0x%04X: %s", $snac{family}, $snac{subtype}, $data{protobit});
+ $self->snac_put(%snac);
+ }
+ } else {
+ $snac{channel} ||= 0+FLAP_CHAN_SNAC;
+ $self->log_printf(OSCAR_DBG_DEBUG, "Putting raw FLAP: %s", $data{protobit});
+ $self->flap_put($snac{data}, $snac{channel});
+ }
+}
+
+
+
+sub fileno($) {
+ my $self = shift;
+ return undef unless $self->{socket};
+ return fileno $self->{socket};
+}
+
+sub flap_encode($$;$) {
+ my ($self, $msg, $channel) = @_;
+
+ $channel ||= FLAP_CHAN_SNAC;
+ return protoparse($self->{session}, "flap")->pack(
+ channel => $channel,
+ seqno => ++$self->{seqno},
+ msg => $msg
+ );
+}
+
+sub write($$) {
+ my($self, $data) = @_;
+
+ my $had_outbuff = 1 if $self->{outbuff};
+ $self->{outbuff} .= $data;
+
+ my $nchars = syswrite($self->{socket}, $self->{outbuff}, length($self->{outbuff}));
+ if(!defined($nchars)) {
+ return "" if $! == EAGAIN;
+ $self->log_print(OSCAR_DBG_NOTICE, "Couldn't write to socket: $!");
+ $self->{sockerr} = 1;
+ $self->disconnect();
+ return undef;
+ }
+
+ my $wrote = substr($self->{outbuff}, 0, $nchars, "");
+
+ if($self->{outbuff}) {
+ $self->log_print(OSCAR_DBG_NOTICE, "Couldn't do complete write - had to buffer ", length($self->{outbuff}), " bytes.");
+ $self->{state} = "readwrite";
+ $self->{session}->callback_connection_changed($self, "readwrite");
+ return 0;
+ } elsif($had_outbuff) {
+ $self->{state} = "read";
+ $self->{session}->callback_connection_changed($self, "read");
+ return 1;
+ }
+ $self->log_print_cond(OSCAR_DBG_PACKETS, sub { "Put '", hexdump($wrote), "'" });
+
+ return 1;
+}
+
+sub flap_put($;$$) {
+ my($self, $msg, $channel) = @_;
+ my $had_outbuff = 0;
+
+ $channel ||= FLAP_CHAN_SNAC;
+
+ return unless $self->{socket} and CORE::fileno($self->{socket}) and getpeername($self->{socket}); # and !$self->{socket}->error;
+
+ $msg = $self->flap_encode($msg, $channel) if $msg;
+ $self->write($msg);
+}
+
+# We need to do non-buffered reading so that stdio's buffers don't screw up select, poll, etc.
+# Thus, for efficiency, we do our own buffering.
+# To prevent a single OSCAR conneciton from monopolizing processing time, for instance if it has
+# a flood of incoming data wide enough that we never run out of stuff to read, we'll only fill
+# the buffer once per call to process_one.
+#
+# no_reread value of 2 indicates that we should only read if we have to
+sub read($$;$) {
+ my($self, $len, $no_reread) = @_;
+ $no_reread ||= 0;
+
+ $self->{buffsize} ||= $len;
+ my $buffsize = $self->{buffsize};
+ $buffsize = $len if $len > $buffsize;
+ my $readlen;
+ if($no_reread == 2) {
+ $readlen = $len - length(${$self->{buffer}});
+ } else {
+ $readlen = $buffsize - length(${$self->{buffer}});
+ }
+
+ if($readlen > 0 and $no_reread != 1) {
+ my $buffer = "";
+ my $nchars = sysread($self->{socket}, $buffer, $buffsize - length(${$self->{buffer}}));
+ if(${$self->{buffer}}) {
+ ${$self->{buffer}} .= $buffer;
+ } else {
+ $self->{buffer} = \$buffer;
+ }
+
+ if(!${$self->{buffer}} and !defined($nchars)) {
+ return "" if $! == EAGAIN;
+ $self->log_print(OSCAR_DBG_NOTICE, "Couldn't read from socket: $!");
+ $self->{sockerr} = 1;
+ $self->disconnect();
+ return undef;
+ } elsif(!${$self->{buffer}} and $nchars == 0) { # EOF
+ $self->log_print(OSCAR_DBG_NOTICE, "Got EOF on socket");
+ $self->{sockerr} = 1;
+ $self->disconnect();
+ return undef;
+ }
+ }
+
+ if(length(${$self->{buffer}}) < $len) {
+ return "";
+ } else {
+ my $ret;
+ delete $self->{buffsize};
+ if(length(${$self->{buffer}}) == $len) {
+ $ret = $self->{buffer};
+ $self->{buffer} = \"";
+ } else {
+ $ret = \substr(${$self->{buffer}}, 0, $len, "");
+ }
+ $self->log_print_cond(OSCAR_DBG_PACKETS, sub { "Got '", hexdump($$ret), "'" });
+ return $$ret;
+ }
+}
+
+sub flap_get($;$) {
+ my ($self, $no_reread) = @_;
+ my $socket = $self->{socket};
+ my ($buffer, $channel, $len);
+ my $nchars;
+
+ if(!$self->{buff_gotflap}) {
+ my $header = $self->read(6, $no_reread);
+ if(!defined($header)) {
+ return undef;
+ } elsif($header eq "") {
+ return "";
+ }
+
+ $self->{buff_gotflap} = 1;
+ (undef, $self->{channel}, undef, $self->{flap_size}) =
+ unpack("CCnn", $header);
+ }
+
+ if($self->{flap_size} > 0) {
+ my $data = $self->read($self->{flap_size}, $no_reread || 2);
+ if(!defined($data)) {
+ return undef;
+ } elsif($data eq "") {
+ return "";
+ }
+
+ $self->log_print_cond(OSCAR_DBG_PACKETS, sub { "Got ", hexdump($data) });
+ delete $self->{buff_gotflap};
+ return $data;
+ } else {
+ delete $self->{buff_gotflap};
+ return "";
+ }
+}
+
+sub snac_encode($%) {
+ my($self, %snac) = @_;
+
+ $snac{family} ||= 0;
+ $snac{subtype} ||= 0;
+ $snac{flags1} ||= 0;
+ $snac{flags2} ||= 0;
+ $snac{data} ||= "";
+ $snac{reqdata} ||= "";
+ $snac{reqid} ||= ($snac{subtype}<<16) | (unpack("n", randchars(2)))[0];
+ $self->{reqdata}->[$snac{family}]->{pack("N", $snac{reqid})} = $snac{reqdata} if $snac{reqdata};
+
+ my $snac = protoparse($self->{session}, "snac")->pack(%snac);
+ return $snac;
+}
+
+sub snac_put($%) {
+ my($self, %snac) = @_;
+
+ if($snac{family} and !$self->{families}->{$snac{family}}) {
+ $self->log_printf(OSCAR_DBG_WARN, "Tried to send unsupported SNAC 0x%04X/0x%04X", $snac{family}, $snac{subtype});
+
+ my $newconn = $self->{session}->connection_for_family($snac{family});
+ if($newconn) {
+ return $newconn->snac_put(%snac);
+ } else {
+ $self->{session}->crapout($self, "Couldn't find supported connection for SNAC 0x%04X/0x%04X", $snac{family}, $snac{subtype});
+ }
+ } else {
+ $snac{channel} ||= 0+FLAP_CHAN_SNAC;
+ confess "No family/subtype" unless exists($snac{family}) and exists($snac{subtype});
+
+ if($self->{session}->{rate_manage_mode} != OSCAR_RATE_MANAGE_NONE and $self->{rate_limits}) {
+ my $key = $self->{rate_limits}->{classmap}->{pack("nn", $snac{family}, $snac{subtype})};
+ if($key) {
+ my $rinfo = $self->{rate_limits}->{$key};
+ if($rinfo) {
+ $rinfo->{current_state} = max(
+ $rinfo->{max},
+ $self->{session}->_compute_rate($rinfo)
+ );
+ $rinfo->{last_time} = millitime() - $rinfo->{time_offset};
+ }
+ }
+ }
+
+ $self->flap_put($self->snac_encode(%snac), $snac{channel});
+ }
+}
+
+sub snac_get($;$) {
+ my($self, $no_reread) = @_;
+ my $snac = $self->flap_get($no_reread) or return 0;
+ return $self->snac_decode($snac);
+}
+
+sub snac_decode($$) {
+ my($self, $snac) = @_;
+ my(%data) = protoparse($self->{session}, "snac")->unpack($snac);
+
+ if($data{flags1} & 0x80) {
+ my($minihdr_len) = unpack("n", $data{data});
+ $self->log_print(OSCAR_DBG_DEBUG, "Got miniheader of length $minihdr_len");
+ substr($data{data}, 0, 2+$minihdr_len) = "";
+ }
+
+ return \%data;
+}
+
+sub snac_dump($$) {
+ my($self, $snac) = @_;
+ return "family=".$snac->{family}." subtype=".$snac->{subtype};
+}
+
+sub disconnect($) {
+ my($self) = @_;
+
+ $self->{session}->delconn($self);
+}
+
+sub set_blocking($$) {
+ my $self = shift;
+ my $blocking = shift;
+ my $flags = 0;
+
+ if($^O ne "MSWin32") {
+ fcntl($self->{socket}, F_GETFL, $flags);
+ if($blocking) {
+ $flags &= ~O_NONBLOCK;
+ } else {
+ $flags |= O_NONBLOCK;
+ }
+ fcntl($self->{socket}, F_SETFL, $flags);
+ } else {
+ # Cribbed from http://nntp.x.perl.org/group/perl.perl5.porters/42198
+ ioctl($self->{socket},
+ 0x80000000 | (4 << 16) | (ord('f') << 8) | 126,
+ $blocking
+ ) or warn "Couldn't set Win32 blocking: $!\n";
+ }
+
+ return $self->{socket};
+}
+
+
+sub connect($$) {
+ my($self, $host) = @_;
+ my $temp;
+ my $port;
+
+ return $self->{session}->crapout($self, "Empty host!") unless $host;
+ $host =~ s/:(.+)//;
+ if(!$1) {
+ if(exists($self->{session})) {
+ $port = $self->{session}->{port};
+ } else {
+ return $self->{session}->crapout($self, "No port!");
+ }
+ } else {
+ $port = $1;
+ if($port =~ /^[^0-9]/) {
+ $port = $self->{session}->{port};
+ }
+ }
+ $self->{host} = $host;
+ $self->{port} = $port;
+
+ $self->log_print(OSCAR_DBG_NOTICE, "Connecting to $host:$port.");
+ if(defined($self->{session}->{proxy_type})) {
+ if($self->{session}->{proxy_type} eq "SOCKS4" or $self->{session}->{proxy_type} eq "SOCKS5") {
+ require Net::SOCKS or die "SOCKS proxying not available - couldn't load Net::SOCKS: $!\n";
+
+ my $socksver;
+ if($self->{session}->{proxy_type} eq "SOCKS4") {
+ $socksver = 4;
+ } else {
+ $socksver = 5;
+ }
+
+ my %socksargs = (
+ socks_addr => $self->{session}->{proxy_host},
+ socks_port => $self->{session}->{proxy_port} || 1080,
+ protocol_version => $socksver
+ );
+ $socksargs{user_id} = $self->{session}->{proxy_username} if exists($self->{session}->{proxy_username});
+ $socksargs{user_password} = $self->{session}->{proxy_password} if exists($self->{session}->{proxy_password});
+ $self->{socks} = new Net::SOCKS(%socksargs) or return $self->{session}->crapout($self, "Couldn't connect to SOCKS proxy: $@");
+
+ $self->{socket} = $self->{socks}->connect(peer_addr => $host, peer_port => $port) or return $self->{session}->crapout({}, "Couldn't establish connection via SOCKS: $@\n");
+
+ $self->{ready} = 0;
+ $self->{connected} = 1;
+ $self->set_blocking(0);
+ } elsif($self->{session}->{proxy_type} eq "HTTP" or $self->{session}->{proxy_type} eq "HTTPS") {
+
+ require MIME::Base64;
+
+ my $authen = $self->{session}->{proxy_username};
+ $authen .= ":$self->{session}->{proxy_password}" if $self->{session}->{proxy_password};
+ $authen = encode_base64 $authen if $authen;
+
+ my $request = "CONNECT $host:$port HTTP/1.1\r\n";
+ $request .= "Proxy-Authorization: Basic $authen\r\n" if $authen;
+ $request .= "User-Agent: Net::OSCAR\r\n";
+ $request .= "\r\n";
+
+ $self->{socket} = gensym;
+ socket($self->{socket}, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
+ if($self->{session}->{local_ip}) {
+ bind($self->{socket}, sockaddr_in(0, inet_aton($self->{session}->{local_ip}))) or croak "Couldn't bind to desired IP: $!\n";
+ }
+ $self->set_blocking(0);
+
+ my $addr = inet_aton($self->{session}{proxy_host}) or return $self->{session}->crapout($self, "Couldn't resolve $self->{session}{proxy_host}.");
+ if(!connect($self->{socket}, sockaddr_in($self->{session}{proxy_port}, $addr))) {
+ return $self->{session}->crapout($self, "Couldn't connect to $self->{session}{proxy_host}:$self->{session}{proxy_port}: $!")
+ unless $! == EINPROGRESS;
+ }
+
+ # TODO: I don't know what happens if authentication or connection fails
+ #
+ my $buffer;
+ syswrite ($self->{socket}, $request);
+ sysread ($self->{socket}, $buffer, 1024)
+ or return $self->{session}->crapout($self, "Couldn't read from $self->{session}{proxy_host}:$self->{session}{proxy_port}: $!");
+
+ return $self->{session}->crapout($self, "Couldn't connect to proxy: $self->{session}{proxy_host}:$self->{session}{proxy_port}: $!")
+ unless $buffer =~ /connection\s+established/i;
+
+ $self->set_blocking(0);
+ $self->{ready} = 0;
+ $self->{connected} = 1;
+ } else {
+ die "Unknown proxy_type $self->{session}->{proxy_type} - valid types are SOCKS4, SOCKS5, HTTP, and HTTPS\n";
+ }
+ } else {
+ $self->{socket} = gensym;
+ socket($self->{socket}, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
+ if($self->{session}->{local_ip}) {
+ bind($self->{socket}, sockaddr_in(0, inet_aton($self->{session}->{local_ip}))) or croak "Couldn't bind to desired IP: $!\n";
+ }
+ $self->set_blocking(0);
+
+ my $addr = inet_aton($host) or return $self->{session}->crapout($self, "Couldn't resolve $host.");
+ if(!connect($self->{socket}, sockaddr_in($port, $addr))) {
+ return 1 if $! == EINPROGRESS;
+ return $self->{session}->crapout($self, "Couldn't connect to $host:$port: $!");
+ }
+
+ $self->{ready} = 0;
+ $self->{connected} = 0;
+ }
+
+ binmode($self->{socket}) or return $self->{session}->crapout($self, "Couldn't set binmode: $!");
+ return 1;
+}
+
+sub listen($$) {
+ my($self, $port) = @_;
+ my $temp;
+
+ $self->{host} = $self->{local_addr} || "0.0.0.0";
+ $self->{port} = $port;
+
+ $self->log_print(OSCAR_DBG_NOTICE, "Listening.");
+ if(defined($self->{session}->{proxy_type})) {
+ die "Proxying not support for listening sockets.\n";
+ } else {
+ $self->{socket} = gensym;
+ socket($self->{socket}, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
+
+ setsockopt($self->{socket}, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or return $self->{session}->crapout($self, "Couldn't set listen socket options: $!");
+
+ my $sockaddr = sockaddr_in($self->{session}->{local_port} || $port || 0, inet_aton($self->{session}->{local_ip} || 0));
+ bind($self->{socket}, $sockaddr) or return $self->{session}->crapout("Couldn't bind to desired IP: $!");
+ $self->set_blocking(0);
+ listen($self->{socket}, SOMAXCONN) or return $self->{session}->crapout("Couldn't listen: $!");
+
+ $self->{state} = "read";
+ $self->{rv}->{ft_state} = "listening";
+ }
+
+ binmode($self->{socket}) or return $self->{session}->crapout("Couldn't set binmode: $!");
+ return 1;
+}
+
+
+
+sub get_filehandle($) { shift->{socket}; }
+
+# $read/$write tell us if select indicated readiness to read and/or write
+# Ditto for $error
+sub process_one($;$$$) {
+ my($self, $read, $write, $error) = @_;
+ my $snac;
+
+ if($error) {
+ $self->{sockerr} = 1;
+ return $self->disconnect();
+ }
+
+ if($write && $self->{outbuff}) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Flushing output buffer.");
+ $self->flap_put();
+ }
+
+ if($write && !$self->{connected}) {
+ $self->log_print(OSCAR_DBG_NOTICE, "Connected.");
+ $self->{connected} = 1;
+ $self->{state} = "read";
+ $self->{session}->callback_connection_changed($self, "read");
+ return 1;
+ } elsif($read && !$self->{ready}) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Getting connack.");
+ my $flap = $self->flap_get();
+ if(!defined($flap)) {
+ $self->log_print(OSCAR_DBG_NOTICE, "Couldn't connect.");
+ return 0;
+ } else {
+ $self->log_print(OSCAR_DBG_DEBUG, "Got connack.");
+ }
+
+ return $self->{session}->crapout($self, "Got bad connack from server") unless $self->{channel} == FLAP_CHAN_NEWCONN;
+
+ if($self->{conntype} == CONNTYPE_LOGIN) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Got connack. Sending connack.");
+ $self->flap_put(pack("N", 1), FLAP_CHAN_NEWCONN) unless $self->{session}->{svcdata}->{hashlogin};
+ $self->log_print(OSCAR_DBG_SIGNON, "Connected to login server.");
+ $self->{ready} = 1;
+ $self->{families} = {23 => 1};
+
+ if(!$self->{session}->{svcdata}->{hashlogin}) {
+ $self->proto_send(protobit => "initial_signon_request",
+ protodata => {screenname => $self->{session}->{screenname}},
+ nopause => 1
+ );
+ } else {
+ $self->proto_send(protobit => "ICQ_signon_request",
+ protodata => {signon_tlv($self->{session}, delete($self->{auth}))},
+ nopause => 1
+ );
+ }
+ } else {
+ $self->log_print(OSCAR_DBG_NOTICE, "Sending BOS-Signon.");
+ $self->proto_send(protobit => "BOS_signon",
+ reqid => 0x01000000 | (unpack("n", substr($self->{auth}, 0, 2)))[0],
+ protodata => {cookie => substr(delete($self->{auth}), 2)},
+ nopause => 1
+ );
+ }
+ $self->log_print(OSCAR_DBG_DEBUG, "SNAC time.");
+ $self->{ready} = 1;
+ } elsif($read) {
+ my $no_reread = 0;
+ while(1) {
+ if(!$self->{session}->{svcdata}->{hashlogin}) {
+ $snac = $self->snac_get($no_reread) or return 0;
+ Net::OSCAR::Callbacks::process_snac($self, $snac);
+ } else {
+ my $data = $self->flap_get($no_reread) or return 0;
+ $snac = {data => $data, reqid => 0, family => 0x17, subtype => 0x3};
+ if($self->{channel} == FLAP_CHAN_CLOSE) {
+ $self->{conntype} = CONNTYPE_LOGIN;
+ $self->{family} = 0x17;
+ $self->{subtype} = 0x3;
+ $self->{data} = $data;
+ $self->{reqid} = 0;
+ $self->{reqdata}->[0x17]->{pack("N", 0)} = "";
+ Net::OSCAR::Callbacks::process_snac($self, $snac);
+ } else {
+ my $snac = $self->snac_decode($data);
+ if($snac) {
+ Net::OSCAR::Callbacks::process_snac($self, $snac);
+ } else {
+ return 0;
+ }
+ }
+ }
+ } continue {
+ $no_reread = 1;
+ }
+ }
+}
+
+sub ready($) {
+ my($self) = shift;
+
+ return if $self->{sentready}++;
+ send_versions($self, 1);
+ $self->unpause();
+}
+
+sub session($) { return shift->{session}; }
+
+sub peer_ip($) {
+ my($self) = @_;
+
+ my $sockaddr = getpeername($self->{socket});
+ my($port, $iaddr) = sockaddr_in($sockaddr);
+ return inet_ntoa($iaddr);
+}
+
+sub local_ip($) {
+ my($self) = @_;
+
+ my $sockaddr = getsockname($self->{socket});
+ my($port, $iaddr) = sockaddr_in($sockaddr);
+ return inet_ntoa($iaddr);
+}
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Constants.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Constants.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Constants.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,170 @@
+=pod
+
+Net::OSCAR::Constants -- internal Net::OSCAR constants
+
+=cut
+
+package Net::OSCAR::Constants;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.11 $';
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION);
+use Scalar::Util qw(dualvar);
+use Net::OSCAR::TLV;
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw(
+ FLAP_CHAN_NEWCONN FLAP_CHAN_SNAC FLAP_CHAN_ERR FLAP_CHAN_CLOSE
+ CONNTYPE_LOGIN CONNTYPE_BOS CONNTYPE_ADMIN CONNTYPE_CHAT CONNTYPE_CHATNAV CONNTYPE_ICON CONNTYPE_DIRECT_IN CONNTYPE_DIRECT_OUT CONNTYPE_SERVER
+ OSCAR_CAPS OSCAR_CAPS_INVERSE OSCAR_CAPS_SHORT_INVERSE OSCAR_TOOLDATA
+ GROUP_PERMIT GROUP_DENY BUDTYPES ERRORS
+
+ ICQ_META_INFO ICQ_META_INFO_INVERSE
+);
+
+
+use constant FLAP_CHAN_NEWCONN => dualvar(0x01, "new connection");
+use constant FLAP_CHAN_SNAC => dualvar(0x02, "SNAC");
+use constant FLAP_CHAN_ERR => dualvar(0x03, "error");
+use constant FLAP_CHAN_CLOSE => dualvar(0x04, "close connection");
+
+use constant CONNTYPE_LOGIN => dualvar(0, "login service");
+use constant CONNTYPE_BOS => dualvar(0x2, "basic OSCAR services");
+use constant CONNTYPE_ADMIN => dualvar(0x7, "administrative service");
+use constant CONNTYPE_CHAT => dualvar(0xE, "chat connection");
+use constant CONNTYPE_CHATNAV => dualvar(0xD, "chat navigator");
+use constant CONNTYPE_ICON => dualvar(0x10, "icon service");
+use constant CONNTYPE_DIRECT_IN => dualvar(0xfe, "direct connect listener");
+use constant CONNTYPE_DIRECT_OUT => dualvar(0xff, "direct connect connection");
+use constant CONNTYPE_SERVER => dualvar(0xfd, "OSCAR server");
+
+use constant GROUP_PERMIT => 0x0002;
+use constant GROUP_DENY => 0x0003;
+
+use constant OSCAR_CAPS => {
+ chat => {description => "chatrooms", value => pack("C*", map{hex($_)} split(/[ \t\n]+/,
+ "0x74 0x8F 0x24 0x20 0x62 0x87 0x11 0xD1 0x82 0x22 0x44 0x45 0x53 0x54 0x00 0x00"))},
+ interoperate => {description => "ICQ/AIM interoperation", value => pack("C*", map{hex($_)} split(/[ \t\n]+/,
+ "0x09 0x46 0x13 0x4d 0x4c 0x7f 0x11 0xd1 0x82 0x22 0x44 0x45 0x53 0x54 0x00 0x00"))},
+ extstatus => {description => "iChat extended status messages", value => pack("C*", map{hex($_)} split(/[ \t\n]+/,
+ "0x09 0x46 0x00 0x00 0x4c 0x7f 0x11 0xd1 0x82 0x22 0x44 0x45 0x53 0x54 0x00 0x00"))},
+ buddyicon => {description => "buddy icons", value => pack("C*", map{hex($_)} split(/[ \t\n]+/,
+ "0x09 0x46 0x13 0x46 0x4c 0x7f 0x11 0xd1 0x82 0x22 0x44 0x45 0x53 0x54 0x00 0x00"))},
+ fileshare => {description => "file sharing", value => pack("C*", map{hex($_)} split(/[ \t\n]+/,
+ "0x09 0x46 0x13 0x48 0x4c 0x7f 0x11 0xd1 0x82 0x22 0x44 0x45 0x53 0x54 0x00 0x00"))},
+ filexfer => {description => "file transfers", value => pack("C*", map{hex($_)} split(/[ \t\n]+/,
+ "0x09 0x46 0x13 0x43 0x4c 0x7f 0x11 0xd1 0x82 0x22 0x44 0x45 0x53 0x54 0x00 0x00"))},
+ secureim => {description => "encrypted IM", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09, 0x46, 0x00, 0x01, 0x4c, 0x7f, 0x11, 0xd1, 0x82, 0x22, 0x44, 0x45, 0x53, 0x54, 0x00, 0x00"))},
+ hiptop => {description => "hiptop", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09, 0x46, 0x13, 0x23, 0x4c, 0x7f, 0x11, 0xd1, 0x82, 0x22, 0x44, 0x45, 0x53, 0x54, 0x00, 0x00"))},
+ voice => {description => "voice chat", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09, 0x46, 0x13, 0x41, 0x4c, 0x7f, 0x11, 0xd1, 0x82, 0x22, 0x44, 0x45, 0x53, 0x54, 0x00, 0x00"))},
+ icq => {description => "EveryBuddy ICQ support", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09, 0x46, 0x13, 0x44, 0x4c, 0x7f, 0x11, 0xd1, 0x82, 0x22, 0x44, 0x45, 0x53, 0x54, 0x00, 0x00"))},
+ directim => {description => "direct IM", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09, 0x46, 0x13, 0x45, 0x4c, 0x7f, 0x11, 0xd1, 0x82, 0x22, 0x44, 0x45, 0x53, 0x54, 0x00, 0x00"))},
+ addins => {description => "add-ins", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09, 0x46, 0x13, 0x47, 0x4c, 0x7f, 0x11, 0xd1, 0x82, 0x22, 0x44, 0x45, 0x53, 0x54, 0x00, 0x00"))},
+ icqrelay => {description => "ICQ server relay", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09, 0x46, 0x13, 0x49, 0x4c, 0x7f, 0x11, 0xd1, 0x82, 0x22, 0x44, 0x45, 0x53, 0x54, 0x00, 0x00"))},
+ games => {description => "games", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09, 0x46, 0x13, 0x4a, 0x4c, 0x7f, 0x11, 0xd1, 0x82, 0x22, 0x44, 0x45, 0x53, 0x54, 0x00, 0x00"))},
+ games2 => {description => "games 2", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09, 0x46, 0x13, 0x4a, 0x4c, 0x7f, 0x11, 0xd1, 0x22, 0x82, 0x44, 0x45, 0x53, 0x54, 0x00, 0x00"))},
+ sendlist => {description => "buddy list sending", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09, 0x46, 0x13, 0x4b, 0x4c, 0x7f, 0x11, 0xd1, 0x82, 0x22, 0x44, 0x45, 0x53, 0x54, 0x00, 0x00"))},
+ icqutf8 => {description => "ICQ UTF-8", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09, 0x46, 0x13, 0x4e, 0x4c, 0x7f, 0x11, 0xd1, 0x82, 0x22, 0x44, 0x45, 0x53, 0x54, 0x00, 0x00"))},
+ icqutf8old => {description => "old ICQ UTF-8", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x2e, 0x7a, 0x64, 0x75, 0xfa, 0xdf, 0x4d, 0xc8, 0x88, 0x6f, 0xea, 0x35, 0x95, 0xfd, 0xb6, 0xdf"))},
+ icqrtf => {description => "ICQ RTF", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x97, 0xb1, 0x27, 0x51, 0x24, 0x3c, 0x43, 0x34, 0xad, 0x22, 0xd6, 0xab, 0xf7, 0x3f, 0x14, 0x92"))},
+ apinfo => {description => "AP info", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0xaa, 0x4a, 0x32, 0xb5, 0xf8, 0x84, 0x48, 0xc6, 0xa3, 0xd7, 0x8c, 0x50, 0x97, 0x19, 0xfd, 0x5b"))},
+ trilliancrypt => {description => "Trillian encryption", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0xf2, 0xe7, 0xc7, 0xf4, 0xfe, 0xad, 0x4d, 0xfb, 0xb2, 0x35, 0x36, 0x79, 0x8b, 0xdf, 0x00, 0x00"))},
+ secureim => {description => "SecureIM encryption", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09 0x46 0x01 0xff 0x4c 0x7f 0x11 0xd1 0x82 0x22 0x44 0x45 0x53 0x54 0x00 0x00"))},
+ video => {description => "A/V chat", value => pack("C*", map{hex($_)} split(/[ \t\n,]+/,
+ "0x09 0x46 0x01 0x05 0x4c 0x7f 0x11 0xd1 0x82 0x22 0x44 0x45 0x53 0x54 0x00 0x00"))},
+};
+use constant OSCAR_CAPS_INVERSE => { map { OSCAR_CAPS()->{$_}->{value} => $_ } keys %{OSCAR_CAPS()} };
+use constant OSCAR_CAPS_SHORT_INVERSE => { map { substr(OSCAR_CAPS()->{$_}->{value}, 2, 2) => $_ } keys %{OSCAR_CAPS()} };
+
+use constant OSCAR_TOOLDATA => tlv(
+ 0x0001 => {version => 0x0004, toolid => 0x0110, toolversion => 0x08E5},
+ 0x0013 => {version => 0x0003, toolid => 0x0110, toolversion => 0x08E5},
+ 0x0002 => {version => 0x0001, toolid => 0x0110, toolversion => 0x08E5},
+ 0x0003 => {version => 0x0001, toolid => 0x0110, toolversion => 0x08E5},
+ 0x0004 => {version => 0x0001, toolid => 0x0110, toolversion => 0x08E5},
+ 0x0005 => {version => 0x0001, toolid => 0x0001, toolversion => 0x0001, nobos => 1},
+ 0x0006 => {version => 0x0001, toolid => 0x0110, toolversion => 0x08E5},
+ 0x0007 => {version => 0x0001, toolid => 0x0010, toolversion => 0x08E5, nobos => 1},
+ 0x0008 => {version => 0x0001, toolid => 0x0104, toolversion => 0x0001},
+ 0x0009 => {version => 0x0001, toolid => 0x0110, toolversion => 0x08E5},
+ 0x000A => {version => 0x0001, toolid => 0x0110, toolversion => 0x08E5},
+ 0x000B => {version => 0x0001, toolid => 0x0110, toolversion => 0x08E5},
+ 0x000C => {version => 0x0001, toolid => 0x0104, toolversion => 0x0001, nobos => 1},
+ 0x000D => {version => 0x0001, toolid => 0x0010, toolversion => 0x08E5, nobos => 1},
+ 0x000E => {version => 0x0001, toolid => 0x0010, toolversion => 0x08E5, nobos => 1},
+ 0x000F => {version => 0x0001, toolid => 0x0010, toolversion => 0x08E5, nobos => 1},
+ 0x0010 => {version => 0x0001, toolid => 0x0010, toolversion => 0x08E5, nobos => 1},
+ 0x0015 => {version => 0x0001, toolid => 0x0110, toolversion => 0x047C, nobos => 1},
+ 0x0017 => {version => 0x0000, toolid => 0x0000, toolversion => 0x0000, nobos => 1},
+ 0x0018 => {version => 0x0001, toolid => 0x0010, toolversion => 0x08E5, nobos => 1},
+ 0xFFFF => {version => 0x0000, toolid => 0x0000, toolversion => 0x0000, nobos => 1},
+);
+
+use constant BUDTYPES => ("buddy", "group", "permit entry", "deny entry", "visibility/misc. data", "presence", undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, "buddy icon data");
+
+use constant ERRORS => split(/\n/, <<EOF);
+Invalid error
+Invalid SNAC
+Sending too fast to host
+Sending too fast to client
+%s is not logged in, so the attempted operation (sending an IM, getting user information) was unsuccessful
+Service unavailable
+Service not defined
+Obsolete SNAC
+Not supported by host
+Not supported by client
+Refused by client
+Reply too big
+Responses lost
+Request denied
+Busted SNAC payload
+Insufficient rights
+%s is in your permit or deny list
+Too evil (sender)
+Too evil (receiver)
+User temporarily unavailable
+No match
+List overflow
+Request ambiguous
+Queue full
+Not while on AOL
+Unknown error 25
+Unknown error 26
+Unknown error 27
+Unknown error 28
+There have been too many recent signons from this address. Please wait a few minutes and try again.
+EOF
+
+
+use constant ICQ_META_INFO => {
+ basic => 200,
+ office => 210,
+ background => 220,
+ notes => 230,
+ email => 235,
+ interests => 240,
+ affiliations => 250,
+ homepage => 270
+};
+use constant ICQ_META_INFO_INVERSE => { map { ICQ_META_INFO()->{$_} => $_ } keys %{ICQ_META_INFO()} };
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/MethodInfo.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/MethodInfo.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/MethodInfo.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,52 @@
+=pod
+
+Net::OSCAR::MethodInfo -- Mappings from method names to (SNAC,family). Used by
+rate management functionality
+
+=cut
+
+package Net::OSCAR::MethodInfo;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.2 $';
+
+use strict;
+use warnings;
+use vars qw(@ISA $VERSION $REVISION);
+use Net::OSCAR::XML;
+
+sub encode($) {
+ my %snac = protobit_to_snac($_[0]);
+ my($family, $subtype) = ($snac{family}, $snac{subtype});
+ return pack("nn", $family, $subtype);
+}
+
+our %methods = (
+ set_stealth => encode("set_extended_status"),
+ get_info => encode("get_info"),
+ get_away => encode("get_away"),
+ send_typing_status => encode("typing_notification"),
+ evil => encode("outgoing_warning"),
+ get_icon => encode("buddy_icon_download"),
+ set_extended_status => encode("set_extended_status"),
+ set_info => encode("set_info"),
+ change_password => encode("change_account_info"),
+ confirm_account => encode("confirm_account_request"),
+ change_email => encode("change_account_info"),
+ format_screenname => encode("change_account_info"),
+ set_idle => encode("set_idle"),
+ chat_join => encode("chat_navigator_room_create"),
+ chat_accept => encode("chat_invitation_accept"),
+ chat_decline => encode("chat_invitation_decline"),
+ auth_response => encode("signon"),
+ get_icq_info => encode("ICQ_meta_request"),
+ send_message => encode("outgoing_IM"),
+ svcreq => encode("service_request"),
+ send_im => encode("outgoing_IM"),
+ file_send => encode("outgoing_IM"),
+ rendezvous_revise => encode("outgoing_IM"),
+ rendezvous_reject => encode("outgoing_IM"),
+ chat_send => encode("outgoing_chat_IM")
+);
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Proxy.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Proxy.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Proxy.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,15 @@
+package Net::OSCAR::Proxy;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.6 $';
+
+use strict;
+use vars qw($VERSION $REVISION);
+
+sub use_socks {
+ require Net::SOCKS or return -1;
+
+}
+
+1;
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Screenname.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Screenname.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Screenname.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,54 @@
+=pod
+
+Net::OSCAR::Screenname -- OSCAR screenname class
+
+This class overrides a few operators to transparently get
+appropriate behavior for OSCAR screennames. Screennames
+are case-insensitive and whitespace-insensitive. So, if you
+do
+ $a = Net::OSCAR::Screenname->new("Some Dude");
+ print "Yay!\n" if $a eq "somedude";
+will be true.
+
+=cut
+
+package Net::OSCAR::Screenname;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.24 $';
+
+use strict;
+use vars qw($VERSION);
+
+use Net::OSCAR::Utility qw(normalize);
+
+use overload
+ "cmp" => "compare",
+ '""' => "stringify",
+ "bool" => "boolify";
+
+sub new($$) {
+ return $_[1] if ref($_[0]) or UNIVERSAL::isa($_[1], "Net::OSCAR::Screenname");
+ my $class = ref($_[0]) || $_[0] || "Net::OSCAR::Screenname";
+ shift;
+ my $name = $_[0];
+ my $self = ref($name) eq "SCALAR" ? $name : \"$name";
+ bless $self, $class;
+ return $self;
+}
+
+sub compare {
+ my($self, $comparand) = @_;
+
+ return normalize($$self) cmp normalize($comparand);
+}
+
+sub stringify { my $self = shift; return $$self; }
+
+sub boolify {
+ my $self = shift;
+ return 0 if !defined($$self) or $$self eq "" or $$self eq "0";
+ return 1;
+}
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/0/BOS_signon.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/0/BOS_signon.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/0/BOS_signon.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,30 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use Net::OSCAR::Common qw(:all);
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $cookie = pack("n", $reqid & 0xFFFF) . $data{cookie};
+if($COOKIES{$cookie}) {
+ my $peer = delete $COOKIES{$cookie};
+ my $screenname = $peer->{sn};
+ print "$screenname initiating BOS handshake.\n";
+ $connection->{screenname} = $screenname;
+
+ my $sess = $SESSIONS->{$screenname};
+ push @{$sess->{sessions}}, $connection;
+ $sess->{extstatus} ||= "";
+ $sess->{away} = 0;
+ $sess->{stealth} = 0;
+
+ $connection->proto_send(protobit => "server_ready", protodata => {
+ families => [grep { !OSCAR_TOOLDATA()->{$_}->{nobos} } keys %{OSCAR_TOOLDATA()}]
+ });
+} else {
+ $connection->log_print(OSCAR_DBG_DEBUG, "No cookie: $cookie");
+ $session->delconn($connection);
+}
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/personal_info_request.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/personal_info_request.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/personal_info_request.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,18 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->proto_send(reqid => $reqid, protobit => "self_information", protodata => {
+ screenname => $screenname,
+ evil => 0,
+ flags => 0x20,
+ onsince => time(),
+ idle => 0,
+ session_length => 0,
+ ip => 0
+});
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/rate_acknowledgement.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/rate_acknowledgement.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/rate_acknowledgement.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,10 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+# Do nothing
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/rate_info_request.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/rate_info_request.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/rate_info_request.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,13 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->proto_send(reqid => $reqid, protobit => "rate_info_response", protodata => {
+ classes => [],
+ classmembers => []
+});
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_extended_status.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_extended_status.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_extended_status.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,14 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+if($data{status_message}) {
+ $SESSIONS->{$screenname}->{status}->{extstatus} = $data{status_message}->{message};
+} elsif($data{stealth}) {
+ $SESSIONS->{$screenname}->{status}->{stealth} = $data{stealth}->{state} & 0x100;
+}
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_service_versions.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_service_versions.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_service_versions.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,10 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+send_versions($connection, 0, 1);
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_tool_versions.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_tool_versions.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/1/set_tool_versions.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,11 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+print "$screenname finished signing on.\n";
+$connection->{signon_done} = 1;
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/19/buddylist_request.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/19/buddylist_request.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/19/buddylist_request.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,22 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $blist;
+
+my $visdata = tlv_encode(tlv(
+ 0xCA => 0,
+ 0xCB => 0xFFFFFFFF,
+));
+$blist = "xxx";
+$blist .= pack("n5a*", 0, 0, 0xCB, 4, length($visdata), $visdata);
+$blist .= pack("na*n4", length("Buddies"), "Buddies", 1, 0, 1, 0);
+my $i = 1;
+$blist .= pack("na*n4", length($_), $_, 1, $i++, 0, 0) foreach @{$SCREENNAMES->{$screenname}->{blist}};
+
+$connection->proto_send(reqid => $reqid, protobit => "buddylist", protodata => {data => $blist});
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/19/buddylist_rights_request.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/19/buddylist_rights_request.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/19/buddylist_rights_request.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,12 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->proto_send(protobit => "buddylist_3_response", reqid => $reqid, protodata => {maximums => [
+ 200, 50, 128, 128, 1, 1, 50, 0, 0, 3, 0, 0, 0, 128, 128, 20, 200, 1, 0, 1, 0
+]});
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/2/get_away.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/2/get_away.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/2/get_away.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,19 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->proto_send(reqid => $reqid, protobit => "incoming_profile", protodata => {
+ screenname => $data{screenname},
+ awaymsg => "Got away message at " . scalar(ctime(time())),
+ evil => 0,
+ flags => 0x20,
+ onsince => 0,
+ membersince => 0,
+ idle => 0,
+ capabilities => ""
+});
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/2/locate_rights_request.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/2/locate_rights_request.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/2/locate_rights_request.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,10 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->proto_send(protobit => "locate_rights_response", reqid => $reqid);
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/23/initial_signon_request.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/23/initial_signon_request.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/23/initial_signon_request.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,27 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+if(exists($SCREENNAMES->{$data{screenname}})) {
+ $screenname = $data{screenname};
+ my $key = sprintf("%08d", int(rand(99999999)));
+ print "$screenname would like to sign on. Generated key '$key'\n";
+
+ $SESSIONS->{$screenname} ||= {};
+ $SESSIONS->{$screenname}->{keys} ||= {};
+ $SESSIONS->{$screenname}->{sessions} ||= [];
+ $SESSIONS->{$screenname}->{status} ||= {
+ online => 0,
+ };
+
+ $SESSIONS->{$screenname}->{keys}->{$key} = 1;
+ $connection->proto_send(protobit => "authentication_key", protodata => {key => $key});
+} else {
+ $connection->proto_send(protobit => "authorization_response", protodata => {error => 1});
+ $session->delconn($connection);
+}
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/23/signon.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/23/signon.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/23/signon.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,44 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use Net::OSCAR::Constants;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $hash;
+($screenname, $hash) = ($data{screenname}, $data{auth_response});
+
+if(!$SCREENNAMES->{$screenname}) {
+ $connection->proto_send(protobit => "authorization_response", protodata => {error => 1});
+}
+
+my @valid_hashes = map {
+ [$_, encode_password($session, exists($data{pass_is_hashed}) ? md5($SCREENNAMES->{$screenname}->{pw}) : $SCREENNAMES->{$screenname}->{pw}, $_)];
+} keys %{$SESSIONS->{$screenname}->{keys}};
+
+my $valid = 0;
+foreach (@valid_hashes) {
+ next unless $_->[1] eq $hash;
+ $valid = 1;
+ delete $SCREENNAMES->{$screenname}->{keys}->{$_->[0]};
+ last;
+}
+
+if($valid) {
+ my $key = randchars(256);
+ $connection->proto_send(protobit => "authorization_response", protodata => {
+ screenname => $SCREENNAMES->{$screenname}->{sn},
+ email => $SCREENNAMES->{$screenname}->{email},
+ auth_cookie => $key,
+ server_ip => "127.0.0.1"
+ });
+ $session->delconn($connection);
+
+ $COOKIES{$key} = {sn => $screenname, conntype => CONNTYPE_BOS};
+} else {
+ $connection->proto_send(protobit => "authorization_response", protodata => {error => 5});
+ $session->delconn($connection);
+}
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/3/buddy_rights_request.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/3/buddy_rights_request.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/3/buddy_rights_request.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,10 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->proto_send(protobit => "buddy_rights_response", reqid => $reqid);
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/IM_parameter_request.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/IM_parameter_request.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/IM_parameter_request.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,10 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->proto_send(protobit => "IM_parameter_response", reqid => $reqid, protodata => {channel => $data{channel}});
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/add_IM_parameters.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/add_IM_parameters.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/add_IM_parameters.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,10 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->proto_send(protobit => "IM_parameter_response", reqid => $reqid, protodata => {channel => $data{channel}});
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/outgoing_IM.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/outgoing_IM.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/4/outgoing_IM.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,26 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+my $target = $SESSIONS->{$data{screenname}};
+if(!$target or !$target->{sessions}->[0]) {
+ return srv_send_error($connection, $family, 4);
+}
+
+$connection->proto_send(reqid => $reqid, protobit => "IM_acknowledgement", protodata => {
+ cookie => $data{cookie},
+ channel => $data{channel},
+ screenname => $data{screenname}
+});
+
+
+$data{screenname} = $screenname;
+$data{evil} = 0;
+$data{flags} = 0;
+
+$target->{sessions}->[0]->proto_send(protobit => "incoming_IM", protodata => {%data});
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/9/BOS_rights_request.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/9/BOS_rights_request.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/9/BOS_rights_request.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,10 @@
+package Net::OSCAR::ServerCallbacks;
+use strict;
+use warnings;
+use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
+sub {
+
+$connection->proto_send(protobit => "BOS_rights_response", reqid => $reqid);
+
+};
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,78 @@
+=pod
+
+Net::OSCAR::ServerCallbacks -- Process responses from OSCAR client
+
+=cut
+
+package Net::OSCAR::ServerCallbacks;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.8 $';
+
+use strict;
+use vars qw($VERSION);
+use Carp;
+
+use Net::OSCAR::Common qw(:all);
+use Net::OSCAR::Constants;
+use Net::OSCAR::Utility;
+use Net::OSCAR::TLV;
+use Net::OSCAR::Buddylist;
+use Net::OSCAR::_BLInternal;
+use Net::OSCAR::XML;
+
+use Digest::MD5 qw(md5);
+use POSIX qw(ctime);
+
+our %protohandlers;
+our $SESSIONS = bltie();
+our $SCREENNAMES = bltie();
+our %COOKIES;
+$SCREENNAMES->{somedude} = {sn => "Some Dude", pw => "somepass", email => 'some@dude.com', blist => [qw(SomeDude OtherDude)]};
+$SCREENNAMES->{otherdude} = {sn => "Other Dude", pw => "otherpass", email => 'other@dude.com', blist => [qw(SomeDude OtherDude)]};
+
+
+sub srv_send_error($$$) {
+ my($connection, $family, $errno) = @_;
+
+ $connection->proto_send(family => $family, protobit => "error", protodata => {errno => $errno});
+}
+
+sub process_snac($$) {
+ our($connection, $snac) = @_;
+ our($conntype, $family, $subtype, $data, $reqid) = ($connection->{conntype}, $snac->{family}, $snac->{subtype}, $snac->{data}, $snac->{reqid});
+ our $screenname = $connection->{screenname};
+
+ our $reqdata = delete $connection->{reqdata}->[$family]->{pack("N", $reqid)};
+ our $session = $connection->{session};
+
+ our $protobit = snac_to_protobit(%$snac);
+ if(!$protobit) {
+ return $session->callback_snac_unknown($connection, $snac, $data);
+ }
+
+ our %data = protoparse($session, $protobit)->unpack($data);
+ $connection->log_printf(OSCAR_DBG_DEBUG, "Got SNAC 0x%04X/0x%04X: %s", $snac->{family}, $snac->{subtype}, $protobit);
+
+ if(!exists($protohandlers{$protobit})) {
+ $protohandlers{$protobit} = eval {
+ require "Net/OSCAR/ServerCallbacks/$family/$protobit.pm";
+ };
+ if($@) {
+ my $olderr = $@;
+ $protohandlers{$protobit} = eval {
+ require "Net/OSCAR/ServerCallbacks/0/$protobit.pm";
+ };
+ }
+ }
+
+ if($protohandlers{$protobit}) {
+ $protohandlers{$protobit}->();
+ } else {
+ #srv_send_error($connection, $family, 1);
+ print "Unhandled protobit: $protobit\n";
+ }
+}
+
+1;
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/TLV.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/TLV.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/TLV.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,146 @@
+=pod
+
+Net::OSCAR::TLV -- tied hash for OSCAR TLVs
+
+Keys in hashes tied to this class will be treated as numbers.
+This class also preserves the ordering of its keys.
+
+=cut
+
+package Net::OSCAR::TLV;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.31 $';
+
+use strict;
+use vars qw($VERSION @EXPORT @ISA);
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(tlv);
+
+# Extra arguments: an optional scalar which modifies the behavior of $self->{foo}->{bar} = "baz"
+# Iff foo doesn't exist, the scalar will be evaluated and assigned as the value of foo.
+# So, instead of having foo be {bar => "baz"} , it could be another TLV.
+# It will be given the key bar.
+sub new {
+ my $pkg = shift;
+ my $self = $pkg->TIEHASH(@_);
+}
+
+
+sub getorder {
+ my $self = shift;
+ return map { (unpack("n", $_))[0] } @{$self->{ORDER}};
+}
+
+sub setorder {
+ my $self = shift;
+
+ # Anything not specified gets shoved at the end
+ my @end = grep { my $inbud = $_; not grep { $_ eq $inbud } @_ } @{$self->{ORDER}};
+
+ @{$self->{ORDER}} = map { pack("n", 0+$_) } @_;
+ push @{$self->{ORDER}}, @end;
+}
+
+sub TIEHASH {
+ my $class = shift;
+ my $self = { DATA => {}, ORDER => [], CURRKEY => -1, AUTOVIVIFY => shift};
+ return bless $self, $class;
+}
+
+sub FETCH {
+ my($self, $key) = @_;
+ $self->{DATA}->{pack("n", 0+$key)};
+}
+
+sub STORE {
+ my($self, $key, $value) = @_;
+ my($normalkey) = pack("n", 0+$key);
+
+ #print STDERR "Storing: ", Data::Dumper->Dump([$value], ["${self}->{$key}"]);
+ if(!exists $self->{DATA}->{$normalkey}) {
+ if(
+ $self->{AUTOVIVIFY} and
+ ref($value) eq "HASH" and
+ !tied(%$value) and
+ scalar keys %$value == 0
+ ) {
+ #print STDERR "Autovivifying $key: $self->{AUTOVIVIFY}\n";
+ eval $self->{AUTOVIVIFY};
+ #print STDERR "New value: ", Data::Dumper->Dump([$self->{DATA}->{$normalkey}], ["${self}->{$key}"]);
+ } else {
+ #print STDERR "Not autovivifying $key.\n";
+ #print STDERR "No autovivify.\n" unless $self->{AUTOVIVIFY};
+ #printf STDERR "ref(\$value) eq %s\n", ref($value) unless ref($value) eq "HASH";
+ #print STDERR "tied(\%\$value)\n" unless !tied(%$value);
+ #printf STDERR "scalar keys \%\$value == %d\n", scalar keys %$value unless scalar keys %$value == 0;
+ }
+ push @{$self->{ORDER}}, $normalkey;
+ } else {
+ #print STDERR "Not autovivifying $key: already exists\n";
+ }
+ $self->{DATA}->{$normalkey} = $value;
+ return $value;
+}
+
+sub DELETE {
+ my($self, $key) = @_;
+ my($packedkey) = pack("n", 0+$key);
+ delete $self->{DATA}->{$packedkey};
+ for(my $i = 0; $i < scalar @{$self->{ORDER}}; $i++) {
+ next unless $packedkey eq $self->{ORDER}->[$i];
+ splice(@{$self->{ORDER}}, $i, 1);
+
+ # What if the user deletes a key while iterating? We need to correct for the new index.
+ if($self->{CURRKEY} != -1 and $i <= $self->{CURRKEY}) {
+ $self->{CURRKEY}--;
+ }
+
+ last;
+ }
+}
+
+sub CLEAR {
+ my $self = shift;
+ $self->{DATA} = {};
+ $self->{ORDER} = [];
+ $self->{CURRKEY} = -1;
+ return $self;
+}
+
+sub EXISTS {
+ my($self, $key) = @_;
+ my($packedkey) = pack("n", 0+$key);
+ return exists $self->{DATA}->{$packedkey};
+}
+
+sub FIRSTKEY {
+ $_[0]->{CURRKEY} = -1;
+ goto &NEXTKEY;
+}
+
+sub NEXTKEY {
+ my ($self) = @_;
+
+ my $currkey = ++$self->{CURRKEY};
+ if($currkey >= scalar @{$self->{ORDER}}) {
+ return wantarray ? () : undef;
+ }
+
+ my $packedkey = $self->{ORDER}->[$currkey];
+ my($key) = unpack("n", $packedkey);
+ return wantarray ? ($key, $self->{DATA}->{$packedkey}) : $key;
+}
+
+
+sub tlv(;@) {
+ my %tlv = ();
+ tie %tlv, "Net::OSCAR::TLV";
+ while(@_) { my($key, $value) = (shift, shift); $tlv{$key} = $value; }
+ return \%tlv;
+}
+
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Utility.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Utility.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/Utility.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,294 @@
+=pod
+
+Net::OSCAR::Utility -- internal utility functions for Net::OSCAR
+
+=cut
+
+package Net::OSCAR::Utility;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.29 $';
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION);
+use Digest::MD5 qw(md5);
+use Carp;
+
+use Net::OSCAR::TLV;
+use Net::OSCAR::Common qw(:loglevels);
+use Net::OSCAR::Constants;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(
+ randchars log_print log_printf log_print_cond log_printf_cond hexdump normalize tlv_decode tlv_encode send_error bltie
+ signon_tlv encode_password send_versions hash_iter_reset millitime
+);
+
+eval {
+ require Time::HiRes;
+};
+our $finetime = $@ ? 0 : 1;
+
+
+sub millitime() {
+ my $time = $finetime ? Time::HiRes::time() : time();
+ return int($time * 1000);
+}
+
+sub randchars($) {
+ my $count = shift;
+ my $retval = "";
+ for(my $i = 0; $i < $count; $i++) { $retval .= chr(int(rand(256))); }
+ return $retval;
+}
+
+
+sub log_print($$@) {
+ my($obj, $level) = (shift, shift);
+ my $session = exists($obj->{session}) ? $obj->{session} : $obj;
+ return unless defined($session->{LOGLEVEL}) and $session->{LOGLEVEL} >= $level;
+
+ my $message = "";
+ $message .= $obj->{description}. ": " if $obj->{description};
+ $message .= join("", @_). "\n";
+
+ if($session->{callbacks}->{log}) {
+ $session->callback_log($level, $message);
+ } else {
+ $message = "(".$session->{screenname}.") $message" if $session->{SNDEBUG};
+ print STDERR $message;
+ }
+}
+
+sub log_printf($$@) {
+ my($obj, $level, $fmtstr) = (shift, shift, shift);
+
+ $obj->log_print($level, sprintf($fmtstr, @_));
+}
+
+sub log_printf_cond($$&) {
+ my($obj, $level, $sub) = @_;
+ my $session = exists($obj->{session}) ? $obj->{session} : $obj;
+ return unless defined($session->{LOGLEVEL}) and $session->{LOGLEVEL} >= $level;
+
+ log_printf($obj, $level, &$sub);
+}
+
+sub log_print_cond($$&) {
+ my($obj, $level, $sub) = @_;
+ my $session = exists($obj->{session}) ? $obj->{session} : $obj;
+ return unless defined($session->{LOGLEVEL}) and $session->{LOGLEVEL} >= $level;
+
+ log_print($obj, $level, &$sub);
+}
+
+sub hexdump($;$) {
+ my $stuff = shift;
+ my $forcehex = shift || 0;
+ my $retbuff = "";
+ my @stuff;
+
+ return "" unless defined($stuff);
+ for(my $i = 0; $i < length($stuff); $i++) {
+ push @stuff, substr($stuff, $i, 1);
+ }
+
+ return $stuff unless $forcehex or grep { $_ lt chr(0x20) or $_ gt chr(0x7E) } @stuff;
+ while(@stuff) {
+ my $i = 0;
+ $retbuff .= "\n\t";
+ my @currstuff = splice(@stuff, 0, 16);
+
+ foreach my $currstuff(@currstuff) {
+ $retbuff .= " " unless $i % 4;
+ $retbuff .= " " unless $i % 8;
+ $retbuff .= sprintf "%02X ", ord($currstuff);
+ $i++;
+ }
+ for(; $i < 16; $i++) {
+ $retbuff .= " " unless $i % 4;
+ $retbuff .= " " unless $i % 8;
+ $retbuff .= " ";
+ }
+
+ $retbuff .= " ";
+ $i = 0;
+ foreach my $currstuff(@currstuff) {
+ $retbuff .= " " unless $i % 4;
+ $retbuff .= " " unless $i % 8;
+ if($currstuff ge chr(0x20) and $currstuff le chr(0x7E)) {
+ $retbuff .= $currstuff;
+ } else {
+ $retbuff .= ".";
+ }
+ $i++;
+ }
+ }
+ return $retbuff;
+}
+
+sub normalize($) {
+ my $temp = shift;
+ $temp =~ tr/ //d if $temp;
+ return $temp ? lc($temp) : "";
+}
+
+sub tlv_decode($;$) {
+ my($tlv, $tlvcnt) = @_;
+ my($type, $len, $value, %retval);
+ my $currtlv = 0;
+ my $strpos = 0;
+
+ my $retval = tlv;
+
+ $tlvcnt = 0 unless $tlvcnt;
+ while(length($tlv) >= 4 and (!$tlvcnt or $currtlv < $tlvcnt)) {
+ ($type, $len) = unpack("nn", $tlv);
+ $len = 0x2 if $type == 0x13;
+ $strpos += 4;
+ substr($tlv, 0, 4) = "";
+ if($len) {
+ ($value) = substr($tlv, 0, $len, "");
+ } else {
+ $value = "";
+ }
+ $strpos += $len;
+ $currtlv++ unless $type == 0;
+ $retval->{$type} = $value;
+ }
+
+ return $tlvcnt ? ($retval, $strpos) : $retval;
+}
+
+sub tlv_encode($) {
+ my $tlv = shift;
+ my($buffer, $type, $value) = ("", 0, "");
+
+ confess "You must use a tied Net::OSCAR::TLV hash!" unless defined($tlv) and ref($tlv) eq "HASH" and defined(%$tlv) and defined(tied(%$tlv)) and tied(%$tlv)->isa("Net::OSCAR::TLV");
+ while (($type, $value) = each %$tlv) {
+ $value ||= "";
+ $buffer .= pack("nna*", $type, length($value), $value);
+
+ }
+ return $buffer;
+}
+
+sub send_error($$$$$;@) {
+ my($oscar, $connection, $error, $desc, $fatal, @reqdata) = @_;
+ $desc = sprintf $desc, @reqdata;
+ $oscar->callback_error($connection, $error, $desc, $fatal);
+}
+
+sub bltie(;$) {
+ my $retval = {};
+ tie %$retval, "Net::OSCAR::Buddylist", @_;
+ return $retval;
+}
+
+sub signon_tlv($;$$) {
+ my($session, $password, $key) = @_;
+
+ my %protodata = (
+ screenname => $session->{screenname},
+ clistr => $session->{svcdata}->{clistr},
+ supermajor => $session->{svcdata}->{supermajor},
+ major => $session->{svcdata}->{major},
+ minor => $session->{svcdata}->{minor},
+ subminor => $session->{svcdata}->{subminor},
+ build => $session->{svcdata}->{build},
+ subbuild => $session->{svcdata}->{subbuild},
+ );
+
+ if($session->{svcdata}->{hashlogin}) {
+ $protodata{password} = encode_password($session, $password);
+ } else {
+ if($session->{auth_response}) {
+ $protodata{auth_response} = delete $session->{auth_response};
+ } else {
+ # As of AIM 5.5, the password can be MD5'd before
+ # going into the things-to-cat-together-and-MD5.
+ # This lets applications that store AIM passwords
+ # store the MD5'd password. We do it by default
+ # because, well, AIM for Windows does. We support
+ # the old way to preserve compatibility with
+ # our auth_challenge/auth_response API.
+
+ $protodata{pass_is_hashed} = "";
+ my $hashpass = $session->{pass_is_hashed} ? $password : md5($password);
+
+ $protodata{auth_response} = encode_password($session, $hashpass, $key);
+ }
+ }
+
+ return %protodata;
+}
+
+sub encode_password($$;$) {
+ my($session, $password, $key) = @_;
+
+ if(!$session->{svcdata}->{hashlogin}) { # Use new SNAC-based method
+ my $md5 = Digest::MD5->new;
+
+ $md5->add($key);
+ $md5->add($password);
+ $md5->add("AOL Instant Messenger (SM)");
+ return $md5->digest();
+ } else { # Use old roasting method. Courtesy of SDiZ Cheng.
+ my $ret = "";
+ my @pass = map {ord($_)} split(//, $password);
+
+ my @encoding_table = map {hex($_)} qw(
+ F3 26 81 C4 39 86 DB 92 71 A3 B9 E6 53 7A 95 7C
+ );
+
+ for(my $i = 0; $i < length($password); $i++) {
+ $ret .= chr($pass[$i] ^ $encoding_table[$i]);
+ }
+
+ return $ret;
+ }
+}
+
+sub send_versions($$;$) {
+ my($connection, $send_tools, $server) = @_;
+ my $conntype = $connection->{conntype};
+ my @services;
+
+ if($conntype != CONNTYPE_BOS and !$server) {
+ @services = (1, $conntype);
+ } else {
+ @services = sort {$b <=> $a} grep {not OSCAR_TOOLDATA()->{$_}->{nobos}} keys %{OSCAR_TOOLDATA()};
+ }
+
+ my %protodata = (service => []);
+ foreach my $service (@services) {
+ my %service = (
+ service_id => $service,
+ service_version => OSCAR_TOOLDATA->{$service}->{version}
+ );
+ if($send_tools) {
+ $service{tool_id} = OSCAR_TOOLDATA->{$service}->{toolid};
+ $service{tool_version} = OSCAR_TOOLDATA->{$service}->{toolversion};
+ }
+
+ push @{$protodata{service}}, \%service;
+ }
+
+ if($send_tools) {
+ $connection->proto_send(protobit => "set_tool_versions", protodata => \%protodata, nopause => 1);
+ } elsif($server) {
+ $connection->proto_send(protobit => "host_versions", protodata => \%protodata, nopause => 1);
+ } else {
+ $connection->proto_send(protobit => "set_service_versions", protodata => \%protodata, nopause => 1);
+ }
+}
+
+# keys(%foo) in void context, the standard way of reseting
+# a hash iterator, appears to leak memory.
+#
+sub hash_iter_reset($) {
+ while((undef, undef) = each(%{$_[0]})) {}
+}
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.dtd
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.dtd (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.dtd 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,139 @@
+# The top-level structure is a 'define'. This defines either a building-block --
+# a 'struct' which can get pulled into the various SNACs -- or a SNAC. SNACs have
+# family and subtype, and optionally a channel.
+#
+# 'ref' is like #include. There are some basic structures, like userinfo, which appear
+# inside multiple SNACs.
+#
+# Then there are the data types:
+# Numeric types: byte (8-bit), word (16-bit), dword (32-bit).
+# Raw character data: data
+# This can have a 'length prefix' attached to it.
+# The length prefix is a numeric type. The value of the length prefix
+# is the number of bytes of character data. The existence of this
+# length prefix is why it might be useful for data to have sub-data.
+# Data types can have 'counts'. A count of -1 represents an infinite count.
+# Counted data is passed around as a listref. For instance, a capabilities block
+# is a series of 16-byte values, so by attaching count=-1 to that data item,
+# you can pass in a listref with the individual capabilities. There is also
+# fixed-length character data, specified via the length attribute on the data element.
+# Data can be null-terminated and padded. The value for the pad attribute specifies
+# the octet value to use for padding.
+#
+# There are also enums, which are exactly like numeric types except the raw numeric
+# values gets translated into some other values, so if you have a message-type
+# word, you can have 1 => "foo", and you'll get a "foo" when decoding a 1 and a
+# 1 when encoding a "foo".
+#
+# Things that have, or can have, length prefixes, take an optional 'default_generate'
+# attribute. If set to yes, this will give them a default value of "present but empty".
+#
+# Note that if you have counted character data, you will get a listref of hashrefs.
+# For instance:
+# <data count="-1">
+# <word name="foo" />
+# <word name="bar" />
+# </data>
+# Will give you:
+# [
+# { foo => 1, bar => 2 },
+# { foo => 1, bar => 4 },
+# ]
+#
+# You can also have tlvchains and TLVs...
+#
+# If you attach a name to a TLV, as opposed to elements within that TLV,
+# presence of that name in the data hash will correspond with presence of
+# that TLV in the TLV chain, without regard to the value of said TLV.
+#
+#
+# family=0 is a global fallback SNAC family. That is:
+# <define family="0" subtype="1" />
+# will get picked up on for all SNACs of subtype 1 where there is no define for
+# that specific family.
+
+<!ELEMENT oscar (define)+>
+
+<!ELEMENT define (ref|byte|word|dword|data|tlvchain|enum)+>
+<!ATTLIST define
+ name ID #REQUIRED
+ channel CDATA #IMPLIED
+ family CDATA #IMPLIED
+ subtype CDATA #IMPLIED
+ flags1 CDATA #IMPLIED
+ flags2 CDATA #IMPLIED
+>
+
+<!ELEMENT ref (EMPTY)>
+<!ATTLIST ref
+ name IDREF #REQUIRED
+>
+
+<!ELEMENT byte (#PCDATA)>
+<!ATTLIST byte
+ name CDATA #IMPLIED
+ count CDATA #IMPLIED
+>
+<!ELEMENT word (#PCDATA)>
+<!ATTLIST word
+ name CDATA #IMPLIED
+ order (network|vax) #DEFAULT network
+ count CDATA #IMPLIED
+>
+<!ELEMENT dword (#PCDATA)>
+<!ATTLIST dword
+ name CDATA #IMPLIED
+ order (network|vax) #DEFAULT network
+ count CDATA #IMPLIED
+>
+<!ELEMENT data (ref|byte|word|dword|data|tlvchain|enum)+>
+<!ATTLIST data
+ name CDATA #IMPLIED
+ prefix_order (network|vax) #DEFAULT network
+ length_prefix (byte|word|dword) #IMPLIED
+ length CDATA #IMPLIED
+ count CDATA #IMPLIED
+ default_generate (yes|no) #DEFAULT no
+ null_terminated (yes|no) #DEFAULT no
+ pad CDATA #IMPLIED
+>
+<!ELEMENT enum (edef+)>
+<!ATTLIST enum
+ type (byte|word|dword) #REQUIRED
+ name CDATA #implied
+ order (network|vax) #DEFAULT network
+ count CDATA #implied
+>
+<!ELEMENT edef (EMPTY)>
+<!ATTLIST edef
+ default (yes|no) #DEFAULT no
+ name CDATA #REQUIRED
+ value CDATA #REQUIRED
+>
+<!ELEMENT tlvchain (tlv*)>
+<!ATTLIST tlvchain
+ subtyped (yes|no) #DEFAULT no <!-- A 'subtyped' TLV is type/subtype/length/value, where subtype and length are both bytes. It's used in extended status. -->
+ count_prefix (byte|word|dword) #IMPLIED
+ length_prefix (byte|word|dword) #IMPLIED
+ prefix_order (network|vax) #DEFAULT network
+ length CDATA #IMPLIED
+ default_generate (yes|no) #DEFAULT no
+>
+
+<!ELEMENT tlv (ref|byte|word|dword|data|tlvchain|enum)+>
+<!ATTLIST tlv
+ type CDATA #REQUIRED
+ subtype CDATA #IMPLIED <!-- For subtyped TLVs -->
+
+ default_generate (yes|no) #DEFAULT no
+ <!--
+ If the TLV has a name, that key being present in the data will
+ correspond to the existance of that TLV, without regard to its value
+ -->
+ name CDATA #IMPLIED
+ <!--
+ If the TLV has a count, it will get listified.
+ Behavior of TLVs which have a count but not a name is undefined.
+ -->
+ count CDATA #IMPLIED
+>
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.parsed-xml
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.parsed-xml (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.parsed-xml 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,7038 @@
+$xmlparse = [
+ 'oscar',
+ [
+ {},
+ 0,
+ '
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'flap'
+ },
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {},
+ 0,
+ '42'
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'channel'
+ },
+ 0,
+ '2'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'seqno'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'msg',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'snac'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'family'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'subtype'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'flags1'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'flags2'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'reqid'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'data'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'TLV'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'type'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'data',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'subtyped_TLV'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'type'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'subtype'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'data',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'userinfo'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'evil'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {
+ 'count_prefix' => 'word'
+ },
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'flags'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'dword',
+ [
+ {
+ 'name' => 'membersince'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '3'
+ },
+ 'dword',
+ [
+ {
+ 'name' => 'onsince'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '4'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'idle'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '13'
+ },
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'length' => '16',
+ 'name' => 'capabilities'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '25'
+ },
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'length' => '2',
+ 'name' => 'shortcaps'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '29'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {
+ 'subtyped' => 'yes'
+ },
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'subtype' => '1',
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'icon_md5sum'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'subtype' => '-1',
+ 'type' => '2'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'extended_status',
+ 'length_prefix' => 'word'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '5'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '12'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'invitation_message'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '10001'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {}
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'chat_url',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '15'
+ },
+ 'dword',
+ [
+ {
+ 'name' => 'session_length'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '10'
+ },
+ 'dword',
+ [
+ {
+ 'name' => 'ip'
+ }
+ ]
+ ],
+ 0,
+ '
+
+
+ ',
+ 'tlv',
+ [
+ {
+ 'name' => 'sub_info',
+ 'type' => '512'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '4',
+ 'name' => 'service_request',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'type'
+ }
+ ],
+ 0,
+ '
+
+
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'name' => 'chat',
+ 'type' => '1'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'exchange'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'url',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '1',
+ 'name' => 'error',
+ 'family' => '-1'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'errno'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '4'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'error_details'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '5',
+ 'name' => 'service_redirect_response',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '13'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'service_type'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '6'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'auth_cookie'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '5'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'server_ip'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '1',
+ 'flags2' => '6',
+ 'name' => 'BOS_signon',
+ 'channel' => '1',
+ 'family' => '0'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'cookie'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'signon',
+ 'family' => '23'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'screenname'
+ }
+ ]
+ ],
+ 0,
+ '
+
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '37'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'auth_response'
+ }
+ ]
+ ],
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '76'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'pass_is_hashed'
+ }
+ ]
+ ],
+ 0,
+ '
+
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'password'
+ }
+ ]
+ ],
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '3'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'clistr'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '22'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'supermajor'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '23'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'major'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '24'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'minor'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '25'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'subminor'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '26'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'build'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '20'
+ },
+ 'dword',
+ [
+ {
+ 'name' => 'subbuild'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '15'
+ },
+ 'data',
+ [
+ {},
+ 0,
+ 'en'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '14'
+ },
+ 'data',
+ [
+ {},
+ 0,
+ 'us'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '74'
+ },
+ 'byte',
+ [
+ {},
+ 0,
+ '1'
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_signon_request',
+ 'channel' => '1'
+ },
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {},
+ 0,
+ '1'
+ ],
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'signon'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '6',
+ 'name' => 'initial_signon_request',
+ 'family' => '23'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'screenname'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'default_generate' => 'yes',
+ 'type' => '75'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'default_generate' => 'yes',
+ 'type' => '90'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '7',
+ 'name' => 'authentication_key',
+ 'family' => '23'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'key',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '3',
+ 'name' => 'authorization_response',
+ 'family' => '23'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '8'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'error'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '4'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'error_details'
+ }
+ ]
+ ],
+ 0,
+ '
+
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'screenname'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '17'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'email'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '6'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'auth_cookie'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '5'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'server_ip'
+ }
+ ]
+ ],
+ 0,
+ '
+
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '19'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'registration_status'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '84'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'password_change_url'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'rate_class_info'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'class_id'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'window_size'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'levels'
+ },
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'clear'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'alert'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'limit'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'disconnect'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'current'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'max'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'last_time'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'current_state'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '7',
+ 'name' => 'rate_info_response',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count_prefix' => 'word',
+ 'name' => 'classes'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'rate_class_info'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'classmembers'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'class_id'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count_prefix' => 'word',
+ 'name' => 'snacs'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'family'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'subtype'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '8',
+ 'name' => 'rate_acknowledgement',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'classes'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '14',
+ 'name' => 'personal_info_request',
+ 'family' => '1'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'buddylist_rights_request',
+ 'family' => '19'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '4',
+ 'name' => 'buddylist_request',
+ 'family' => '19'
+ }
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'locate_rights_request',
+ 'family' => '2'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '3',
+ 'name' => 'locate_rights_response',
+ 'family' => '2'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'max_profile_len'
+ },
+ 0,
+ '1024'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'max_capabilities'
+ },
+ 0,
+ '16'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '3'
+ },
+ 'word',
+ [
+ {},
+ 0,
+ '10'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '4'
+ },
+ 'word',
+ [
+ {},
+ 0,
+ '4096'
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'buddy_rights_request',
+ 'family' => '3'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '3',
+ 'name' => 'buddy_rights_response',
+ 'family' => '3'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'maxbuddies'
+ },
+ 0,
+ '600'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'maxwatchers'
+ },
+ 0,
+ '750'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '3'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'maxnotifies'
+ },
+ 0,
+ '512'
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'IM_parameters'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'channel'
+ },
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'flags'
+ },
+ 0,
+ '3'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'max_size'
+ },
+ 0,
+ '8000'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'max_send_warn'
+ },
+ 0,
+ '999'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'max_recv_warn'
+ },
+ 0,
+ '999'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'min_msg_interval'
+ },
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'add_IM_parameters',
+ 'family' => '4'
+ },
+ 'ref',
+ [
+ {
+ 'name' => 'IM_parameters'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '4',
+ 'name' => 'IM_parameter_request',
+ 'family' => '4'
+ },
+ 'ref',
+ [
+ {
+ 'name' => 'IM_parameters'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '5',
+ 'name' => 'IM_parameter_response',
+ 'family' => '4'
+ },
+ 'ref',
+ [
+ {
+ 'name' => 'IM_parameters'
+ }
+ ]
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'BOS_rights_request',
+ 'family' => '9'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '3',
+ 'name' => 'BOS_rights_response',
+ 'family' => '9'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'max_permits'
+ },
+ 0,
+ '200'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'max_denies'
+ },
+ 0,
+ '200'
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '15',
+ 'name' => 'self_information',
+ 'family' => '1'
+ },
+ 'ref',
+ [
+ {
+ 'name' => 'userinfo'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'minimum_report_interval',
+ 'family' => '11'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '19',
+ 'name' => 'MOTD',
+ 'family' => '1'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '3',
+ 'name' => 'server_ready',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'families'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '23',
+ 'name' => 'set_service_versions',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'service'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'service_id'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'service_version'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'set_tool_versions',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'service'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'service_id'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'service_version'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'tool_id'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'tool_version'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '6',
+ 'name' => 'rate_info_request',
+ 'family' => '1'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '10',
+ 'name' => 'rate_change',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'enum',
+ [
+ {
+ 'name' => 'message_type',
+ 'type' => 'word'
+ },
+ 0,
+ '
+ ',
+ 'edef',
+ [
+ {
+ 'value' => '1',
+ 'name' => 'change'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'edef',
+ [
+ {
+ 'value' => '2',
+ 'name' => 'warning'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'edef',
+ [
+ {
+ 'value' => '3',
+ 'name' => 'alert'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'edef',
+ [
+ {
+ 'value' => '4',
+ 'name' => 'clear'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'rate_class_info'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '8',
+ 'name' => 'outgoing_warning',
+ 'family' => '4'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'is_anonymous'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '16',
+ 'name' => 'incoming_warning',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'new_level'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'userinfo'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '31',
+ 'name' => 'memory_request',
+ 'family' => '1'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '24',
+ 'name' => 'host_versions',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'server'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'service_id'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'service_version'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '7',
+ 'name' => 'buddylist_done',
+ 'family' => '19'
+ }
+ ],
+ 0,
+ '
+
+
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '3',
+ 'name' => 'buddylist_3_response',
+ 'family' => '19'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '4'
+ },
+ 'word',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'maximums'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'word',
+ [
+ {},
+ 0,
+ '254'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '3'
+ },
+ 'word',
+ [
+ {},
+ 0,
+ '508'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '5'
+ },
+ 'word',
+ [
+ {},
+ 0,
+ '0'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '6'
+ },
+ 'word',
+ [
+ {},
+ 0,
+ '97'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '7'
+ },
+ 'word',
+ [
+ {},
+ 0,
+ '10'
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '6',
+ 'name' => 'buddylist',
+ 'family' => '19'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'data'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '14',
+ 'name' => 'buddylist_modification_acknowledgement',
+ 'family' => '19'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'error'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '15',
+ 'name' => 'buddylist_error',
+ 'family' => '19'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'data'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'buddylist_modification'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'entry_name',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'group_id'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'buddy_id'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'entry_type'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'entry_data',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '8',
+ 'name' => 'buddylist_add',
+ 'family' => '19'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'mods'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '9',
+ 'name' => 'buddylist_modify',
+ 'family' => '19'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'mods'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '10',
+ 'name' => 'buddylist_delete',
+ 'family' => '19'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'mods'
+ }
+ ]
+ ],
+ 0,
+ '
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'buddylist_change'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'changes'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'buddylist_modification'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '17',
+ 'name' => 'start_buddylist_modifications',
+ 'family' => '19'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '18',
+ 'name' => 'end_buddylist_modifications',
+ 'family' => '19'
+ }
+ ],
+ 0,
+ '
+
+
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '21',
+ 'name' => 'get_info',
+ 'family' => '2'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '1'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '21',
+ 'name' => 'get_away',
+ 'family' => '2'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '3'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '6',
+ 'name' => 'incoming_profile',
+ 'family' => '2'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'userinfo'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'profile'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '4'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'awaymsg'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '4',
+ 'name' => 'set_info',
+ 'family' => '2'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'profile_mimetype'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'profile'
+ }
+ ]
+ ],
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '3'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'awaymsg_mimetype'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '4'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'awaymsg'
+ }
+ ]
+ ],
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '5'
+ },
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'length' => '16',
+ 'name' => 'capabilities'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '6'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 'tlv',
+ [
+ {
+ 'type' => '4'
+ },
+ 'word',
+ [
+ {},
+ 0,
+ '2'
+ ]
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '17',
+ 'name' => 'set_idle',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'duration'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '20',
+ 'name' => 'typing_notification',
+ 'family' => '4'
+ },
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '1'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'typing_status'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '33',
+ 'name' => 'incoming_extended_information',
+ 'family' => '1'
+ },
+ 0,
+ '
+
+
+ ',
+ 'tlvchain',
+ [
+ {
+ 'subtyped' => 'yes'
+ },
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'subtype' => '65',
+ 'type' => '0'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'upload_checksum'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'subtype' => '65',
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'upload_checksum'
+ }
+ ]
+ ],
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'subtype' => '129',
+ 'type' => '0'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'resend_checksum'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'subtype' => '129',
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'resend_checksum'
+ }
+ ]
+ ],
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'subtype' => '-1',
+ 'type' => '2'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'status_message',
+ 'length_prefix' => 'word'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '30',
+ 'name' => 'set_extended_status',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'name' => 'status_message',
+ 'type' => '29'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '2'
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {},
+ 0,
+ '4'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'length_prefix' => 'byte'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'message',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'name' => 'stealth',
+ 'type' => '6'
+ },
+ 0,
+ '
+
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'state'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'icon_upload',
+ 'family' => '16'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'icon'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '11',
+ 'name' => 'buddy_status_update',
+ 'family' => '3'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'userinfo'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '12',
+ 'name' => 'buddy_signoff',
+ 'family' => '3'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'standard_IM_header'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'length' => '8',
+ 'name' => 'cookie'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'channel'
+ },
+ 0,
+ '1'
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'standard_IM_footer'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1281'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '257'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '257'
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '257'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'message'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'name' => 'is_automatic',
+ 'type' => '4'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'name' => 'request_server_confirmation',
+ 'type' => '3'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'name' => 'supports_typing_status',
+ 'type' => '11'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'name' => 'icon_data',
+ 'type' => '8'
+ },
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'icon_length'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '1'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'icon_checksum'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'icon_timestamp'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'rendezvous_IM'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '5'
+ },
+ 0,
+ '
+ ',
+ 'enum',
+ [
+ {
+ 'name' => 'status',
+ 'type' => 'word'
+ },
+ 0,
+ '
+ ',
+ 'edef',
+ [
+ {
+ 'value' => '0',
+ 'name' => 'propose'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'edef',
+ [
+ {
+ 'value' => '1',
+ 'name' => 'cancel'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'edef',
+ [
+ {
+ 'value' => '2',
+ 'name' => 'accept'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'data',
+ [
+ {
+ 'length' => '8',
+ 'name' => 'cookie'
+ }
+ ],
+ 0,
+ '
+
+
+ ',
+ 'data',
+ [
+ {
+ 'length' => '16',
+ 'name' => 'capability'
+ }
+ ],
+ 0,
+ '
+
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '10'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'push_pull'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '11'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'error'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'default_generate' => 'yes',
+ 'type' => '15'
+ }
+ ],
+ 0,
+ '
+
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'dword',
+ [
+ {
+ 'name' => 'client_1_ip'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '3'
+ },
+ 'dword',
+ [
+ {
+ 'name' => 'client_2_ip'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '4'
+ },
+ 'dword',
+ [
+ {
+ 'name' => 'client_external_ip'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '5'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'port'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '22'
+ },
+ 'dword',
+ [
+ {
+ 'name' => 'proxy_ip'
+ }
+ ]
+ ],
+ 0,
+ '
+
+
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '12'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'invitation_msg'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '13'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'charset'
+ },
+ 0,
+ 'us-ascii'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '14'
+ },
+ 'byte',
+ [
+ {
+ 'name' => 'language'
+ },
+ 0,
+ '48'
+ ]
+ ],
+ 0,
+ '
+
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '10001'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'svcdata'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '10002'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'svcdata_charset'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '7',
+ 'name' => 'incoming_IM',
+ 'family' => '4'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'standard_IM_header'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'userinfo'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'message_body'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '6',
+ 'name' => 'outgoing_IM',
+ 'family' => '4'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'standard_IM_header'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'message_body'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '12',
+ 'name' => 'IM_acknowledgement',
+ 'family' => '4'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'length' => '8',
+ 'name' => 'cookie'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'channel'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '4',
+ 'name' => 'chat_invitation_accept',
+ 'family' => '13'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'exchange'
+ },
+ 0,
+ '4'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'url',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {},
+ 0,
+ '2'
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '11',
+ 'name' => 'chat_invitation_decline',
+ 'family' => '4'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'length' => '8',
+ 'name' => 'cookie'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'channel'
+ },
+ 0,
+ '2'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '3'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'code'
+ },
+ 0,
+ '1'
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'chat_navigator_rights_request',
+ 'family' => '13'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '8',
+ 'name' => 'chat_navigator_room_create',
+ 'family' => '13'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'chat_room_info'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'chat_data'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {
+ 'count_prefix' => 'word'
+ },
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '106'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'name'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '111'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'occupant_count'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'occupants',
+ 'type' => '115'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'userinfo'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '209'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'max_msg_len'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '211'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'name'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '214'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'charset'
+ },
+ 0,
+ 'us-ascii'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'default_generate' => 'yes',
+ 'type' => '215'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'language'
+ },
+ 0,
+ 'en'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '219'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'encoding'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'chat_room_info'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'exchange'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'url',
+ 'length_prefix' => 'byte'
+ },
+ 0,
+ 'create'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'instance'
+ },
+ 0,
+ '65535'
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'detail_level'
+ },
+ 0,
+ '1'
+ ],
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'chat_data'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {}
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'length_prefix' => 'byte'
+ },
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {}
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'name'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {}
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'detail_level'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {
+ 'count_prefix' => 'word'
+ },
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '111'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'occupant_count'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '115'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'occupants'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'userinfo'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '9',
+ 'name' => 'chat_navigator_response',
+ 'family' => '13'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'byte',
+ [
+ {
+ 'name' => 'max_concurrent_rooms'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'exchange',
+ 'type' => '3'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'exchange'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'chat_data'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+ ',
+ 'tlv',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'room',
+ 'type' => '4'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'chat_room_info'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'chat_room_status',
+ 'family' => '14'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'chat_room_info'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '3',
+ 'name' => 'chat_buddy_arrival',
+ 'family' => '14'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'arrivals'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'userinfo'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '4',
+ 'name' => 'chat_buddy_departure',
+ 'family' => '14'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'departures',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'chat_IM'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'length' => '8',
+ 'name' => 'cookie'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '3'
+ ],
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'default_generate' => 'yes',
+ 'type' => '1'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '3'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'sender',
+ 'length_prefix' => 'byte'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'name' => 'reflect',
+ 'type' => '6'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'name' => 'is_automatic',
+ 'type' => '7'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '5'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '4'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'type'
+ },
+ 0,
+ 'text/x-aolrtf'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'charset'
+ },
+ 0,
+ 'us-ascii'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '3'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'language'
+ },
+ 0,
+ 'en'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '5'
+ },
+ 'data',
+ [
+ {},
+ 0,
+ 'binary'
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'message'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '5',
+ 'name' => 'outgoing_chat_IM',
+ 'family' => '14'
+ },
+ 'ref',
+ [
+ {
+ 'name' => 'chat_IM'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '6',
+ 'name' => 'incoming_chat_IM',
+ 'family' => '14'
+ },
+ 'ref',
+ [
+ {
+ 'name' => 'chat_IM'
+ }
+ ]
+ ],
+ 0,
+ '
+
+
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '5',
+ 'name' => 'admin_request_response',
+ 'family' => '7'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'request_type'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {
+ 'count_prefix' => 'word'
+ },
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'new_screenname'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '17'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'new_email'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '8'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'error_code'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '4'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'error_url'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '3'
+ },
+ 'word',
+ [
+ {
+ 'name' => 'subrequest'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '3',
+ 'name' => 'buddy_icon_uploaded',
+ 'family' => '16'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '4',
+ 'name' => 'buddy_icon_download',
+ 'family' => '16'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {},
+ 0,
+ '1'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '1'
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {},
+ 0,
+ '1'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'md5sum',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '5',
+ 'name' => 'buddy_icon_downloaded',
+ 'family' => '16'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'flags'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'number'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'checksum',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'icon',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '6',
+ 'name' => 'confirm_account_request',
+ 'family' => '7'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '7',
+ 'name' => 'confirm_account_response',
+ 'family' => '7'
+ },
+ 0,
+ '
+
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'status'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '4',
+ 'name' => 'change_account_info',
+ 'family' => '7'
+ },
+ 0,
+ '
+
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'new_screenname'
+ }
+ ]
+ ],
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '17'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'new_email'
+ }
+ ]
+ ],
+ 0,
+ '
+
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '2'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'newpass'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '18'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'oldpass'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_meta'
+ },
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'prefix_order' => 'vax',
+ 'length_prefix' => 'word'
+ },
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'our_uin'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'type'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'seqno'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'typedata'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '2',
+ 'name' => 'ICQ_meta_request',
+ 'family' => '21'
+ },
+ 'ref',
+ [
+ {
+ 'name' => 'ICQ_meta'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '3',
+ 'name' => 'ICQ_meta_response',
+ 'family' => '21'
+ },
+ 'ref',
+ [
+ {
+ 'name' => 'ICQ_meta'
+ }
+ ]
+ ],
+ 0,
+ '
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_meta_info_request'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'subtype'
+ },
+ 0,
+ '1202'
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'uin'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_meta_info_response'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'subtype'
+ }
+ ],
+ 0,
+ '
+
+
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'status'
+ }
+ ],
+ 0,
+ '
+
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'response_data'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_meta_info_response:_basic'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'nickname',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'firstname',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'lastname',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'email',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'home'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'city',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'state',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'phone_num',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'fax_num',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'address',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'cell_phone_num',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'zip_code',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'country_code'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'gmt_offset'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'authorization'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'web_aware'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'direct_connect_permissions'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'publish_primary_email'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_meta_info_response:_office'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'city',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'state',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'phone_num',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'fax_num',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'address',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'zip_code',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'country_code'
+ }
+ ],
+ 0,
+ '
+
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'company',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'department',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'position',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'occupation'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'office_website',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_meta_info_response:_background'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'age'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'gender'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'homepage',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'birth_year'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'birth_month'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'bith_day'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'language_1'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'language_2'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'language_3'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {}
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'origin_city',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'origin_state',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'origin_country'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'marital_status'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_meta_info_response:_notes'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'notes',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_meta_info_response:_email'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count_prefix' => 'byte',
+ 'name' => 'addresses'
+ },
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'publish'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'address',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_meta_info_response:_interests'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count_prefix' => 'byte',
+ 'name' => 'interests'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'category'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'interest',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_meta_info_response:_affiliations'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count_prefix' => 'byte',
+ 'name' => 'past_affiliations'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'category'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'keyword',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count_prefix' => 'byte',
+ 'name' => 'affiliations'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'category'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'keyword',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'ICQ_meta_info_response:_homepage'
+ },
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'enabled'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'order' => 'vax',
+ 'name' => 'category'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'null_terminated' => 'yes',
+ 'prefix_order' => 'vax',
+ 'name' => 'keywords',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {}
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'chat_invite_rendezvous_data'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'exchange'
+ },
+ 0,
+ '4'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'url',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'file_transfer_rendezvous_data'
+ },
+ 0,
+ '
+
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'file_count_status'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'file_count'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'size'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'null_terminated' => 'yes',
+ 'name' => 'files'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'buddy_list_transfer_rendezvous_data'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'group'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'name',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'count_prefix' => 'word',
+ 'name' => 'buddies'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'name',
+ 'length_prefix' => 'word'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'file_transfer_header'
+ },
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'length' => '4'
+ },
+ 0,
+ 'OFT2'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'header_length'
+ },
+ 0,
+ '256'
+ ],
+ 0,
+ '
+
+
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'type'
+ }
+ ],
+ 0,
+ '
+
+ ',
+ 'data',
+ [
+ {
+ 'length' => '8',
+ 'name' => 'cookie'
+ }
+ ],
+ 0,
+ '
+
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'encrypt'
+ },
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'compress'
+ },
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'file_count'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'files_left'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'part_count'
+ },
+ 0,
+ '1'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'parts_left'
+ },
+ 0,
+ '1'
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'byte_count'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'bytes_left'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'mtime'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'checksum'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'received_initial_checksum'
+ },
+ 0,
+ '4294901760'
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'received_size'
+ },
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'ctime'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'initial_checksum'
+ },
+ 0,
+ '4294901760'
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'bytes_received'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'received_checksum'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'pad' => '0',
+ 'length' => '32',
+ 'name' => 'client_id'
+ },
+ 0,
+ 'Cool FileXfer'
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'flags'
+ },
+ 0,
+ '32'
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'name_offset'
+ },
+ 0,
+ '28'
+ ],
+ 0,
+ '
+ ',
+ 'byte',
+ [
+ {
+ 'name' => 'size_offset'
+ },
+ 0,
+ '17'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'pad' => '0',
+ 'length' => '69'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'pad' => '0',
+ 'length' => '16',
+ 'name' => 'mac_file_info'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'encoding'
+ },
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'language'
+ },
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'pad' => '0',
+ 'length' => '64',
+ 'name' => 'filename'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '11',
+ 'name' => 'pause',
+ 'family' => '1'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '12',
+ 'name' => 'pause_ack',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'count' => '-1',
+ 'name' => 'families'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '13',
+ 'name' => 'unpause',
+ 'family' => '1'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'subtype' => '18',
+ 'name' => 'migrate',
+ 'family' => '1'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'count_prefix' => 'word',
+ 'name' => 'families'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '5'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'peer'
+ }
+ ]
+ ],
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '6'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'cookie'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+
+
+
+
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'direct_connect_proxy_hdr'
+ },
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'magic'
+ },
+ 0,
+ '1098'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'msg_type'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'data'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'direct_connect_proxy_init'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'direct_connect_proxy_hdr'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '0'
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'name' => 'screenname',
+ 'length_prefix' => 'byte'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'data',
+ [
+ {
+ 'length' => '8',
+ 'name' => 'cookie'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'tlvchain',
+ [
+ {},
+ 0,
+ '
+ ',
+ 'tlv',
+ [
+ {
+ 'type' => '1'
+ },
+ 'data',
+ [
+ {
+ 'name' => 'capability'
+ }
+ ]
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+ ',
+ 'define',
+ [
+ {
+ 'name' => 'direct_connect_proxy_reply'
+ },
+ 0,
+ '
+ ',
+ 'ref',
+ [
+ {
+ 'name' => 'direct_connect_proxy_hdr'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {},
+ 0,
+ '544'
+ ],
+ 0,
+ '
+ ',
+ 'word',
+ [
+ {
+ 'name' => 'port'
+ }
+ ],
+ 0,
+ '
+ ',
+ 'dword',
+ [
+ {
+ 'name' => 'ip'
+ }
+ ],
+ 0,
+ '
+ '
+ ],
+ 0,
+ '
+'
+ ]
+ ];
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.xml
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.xml (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Protocol.xml 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,928 @@
+<?xml version="1.0"?>
+<!DOCTYPE oscar SYSTEM "Protocol.dtd">
+
+<oscar>
+
+ <!-- OSCAR primitives -->
+
+ <define name="flap">
+ <byte>42</byte> <!-- FLAP packet start indicator -->
+ <byte name="channel">2</byte>
+ <word name="seqno" />
+ <data length_prefix="word" name="msg" />
+ </define>
+
+ <define name="snac">
+ <word name="family" />
+ <word name="subtype" />
+ <byte name="flags1" />
+ <byte name="flags2" />
+ <dword name="reqid" />
+ <data name="data" />
+ </define>
+
+ <define name="TLV">
+ <word name="type" />
+ <data length_prefix="word" name="data" />
+ </define>
+ <define name="subtyped_TLV">
+ <word name="type" />
+ <byte name="subtype" />
+ <data length_prefix="byte" name="data" />
+ </define>
+
+
+ <define name="userinfo">
+ <data name="screenname" length_prefix="byte" />
+ <word name="evil" />
+ <tlvchain count_prefix="word">
+ <tlv type="1"><word name="flags" /></tlv>
+ <tlv type="2"><dword name="membersince" /></tlv>
+ <tlv type="3"><dword name="onsince" /></tlv>
+ <tlv type="4"><word name="idle" /></tlv>
+ <tlv type="13"><data length="16" count="-1" name="capabilities" /></tlv>
+ <tlv type="25"><data length="2" count="-1" name="shortcaps" /></tlv>
+ <tlv type="29">
+ <tlvchain subtyped="yes">
+ <tlv type="1" subtype="1"><data name="icon_md5sum" /></tlv>
+ <tlv type="2" subtype="-1"><data length_prefix="word" name="extended_status" /></tlv>
+ </tlvchain>
+ </tlv>
+
+ <tlv type="5"> <!-- Only found in channel 3 IMs, why is it in this structure??? -->
+ <tlvchain>
+ <tlv type="12"><data name="invitation_message" /></tlv>
+ <tlv type="10001">
+ <word />
+ <data length_prefix="byte" name="chat_url" />
+ </tlv>
+ </tlvchain>
+ </tlv>
+
+
+ <!-- Self-info only -->
+ <tlv type="15"><dword name="session_length" /></tlv>
+ <tlv type="10"><dword name="ip" /></tlv>
+
+ <!-- This contains a second copy of this structure - why?! -->
+ <tlv type="512" name="sub_info" />
+ </tlvchain>
+ </define>
+
+
+ <!-- Random protocol crap -->
+
+ <define name="service_request" family="1" subtype="4">
+ <word name="type" />
+
+ <!-- Chat extra -->
+ <tlvchain>
+ <tlv type="1" name="chat">
+ <word name="exchange" />
+ <data length_prefix="byte" name="url" />
+ <word>0</word>
+ </tlv>
+ </tlvchain>
+ </define>
+ <define name="error" family="-1" subtype="1">
+ <word name="errno" />
+ <tlvchain>
+ <tlv type="4"><data name="error_details" /></tlv>
+ </tlvchain>
+ </define>
+ <define name="service_redirect_response" family="1" subtype="5">
+ <tlvchain>
+ <tlv type="13"><word name="service_type" /></tlv>
+ <tlv type="6"><data name="auth_cookie" /></tlv>
+ <tlv type="5"><data name="server_ip" /></tlv>
+ </tlvchain>
+ </define>
+
+
+ <!-- Signing on -->
+
+ <define name="BOS_signon" family="0" subtype="1" channel="1" flags2="6">
+ <data name="cookie" />
+ </define>
+
+ <define name="signon" family="23" subtype="2">
+ <tlvchain>
+ <tlv type="1"><data name="screenname" /></tlv>
+
+ <!-- For AIM-style signons -->
+ <tlv type="37"><data name="auth_response" /></tlv>
+ <!--
+ Set this if the password was hashed before putting
+ it into the auth_response
+ -->
+ <tlv type="76"><data name="pass_is_hashed" /></tlv>
+
+ <!-- For ICQ-style signons -->
+ <tlv type="2"><data name="password" /></tlv>
+
+ <tlv type="3"><data name="clistr" /></tlv>
+ <tlv type="22"><word name="supermajor" /></tlv>
+ <tlv type="23"><word name="major" /></tlv>
+ <tlv type="24"><word name="minor" /></tlv>
+ <tlv type="25"><word name="subminor" /></tlv>
+ <tlv type="26"><word name="build" /></tlv>
+ <tlv type="20"><dword name="subbuild" /></tlv>
+ <tlv type="15"><data>en</data></tlv>
+ <tlv type="14"><data>us</data></tlv>
+ <tlv type="74"><byte>1</byte></tlv>
+ </tlvchain>
+ </define>
+ <define name="ICQ_signon_request" channel="1">
+ <dword>1</dword>
+ <ref name="signon" />
+ </define>
+
+ <define name="initial_signon_request" family="23" subtype="6">
+ <tlvchain>
+ <tlv type="1"><data name="screenname" /></tlv>
+ <tlv type="75" default_generate="yes" />
+ <tlv type="90" default_generate="yes" />
+ </tlvchain>
+ </define>
+
+ <!-- How server sends challenge for challenge/response authentication to client -->
+ <define name="authentication_key" family="23" subtype="7">
+ <data name="key" length_prefix="word" />
+ </define>
+
+ <!-- Random crap that's part of signon, protocol negotiation -->
+ <define name="authorization_response" family="23" subtype="3">
+ <tlvchain>
+ <!-- If there's an error -->
+ <tlv type="8"><word name="error" /></tlv>
+ <tlv type="4"><data name="error_details" /></tlv>
+
+ <!-- Basic info -->
+ <tlv type="1"><data name="screenname" /></tlv>
+ <tlv type="17"><data name="email" /></tlv>
+ <tlv type="6"><data name="auth_cookie" /></tlv>
+ <tlv type="5"><data name="server_ip" /></tlv>
+
+ <!-- Other stuff -->
+ <tlv type="19"><word name="registration_status" /></tlv>
+ <tlv type="84"><data name="password_change_url" /></tlv>
+ </tlvchain>
+ </define>
+ <define name="rate_class_info">
+ <word name="class_id" />
+ <dword name="window_size" />
+ <data name="levels">
+ <dword name="clear" />
+ <dword name="alert" />
+ <dword name="limit" />
+ <dword name="disconnect" />
+ <dword name="current" />
+ <dword name="max" />
+ </data>
+ <dword name="last_time" />
+ <byte name="current_state" />
+ </define>
+ <define name="rate_info_response" family="1" subtype="7">
+ <data count_prefix="word" name="classes">
+ <ref name="rate_class_info" />
+ </data>
+ <data count="-1" name="classmembers">
+ <word name="class_id" />
+ <data count_prefix="word" name="snacs">
+ <word name="family" />
+ <word name="subtype" />
+ </data>
+ </data>
+ </define>
+ <define name="rate_acknowledgement" family="1" subtype="8">
+ <word count="-1" name="classes" />
+ </define>
+ <define name="personal_info_request" family="1" subtype="14" />
+ <define name="buddylist_rights_request" family="19" subtype="2" />
+ <define name="buddylist_request" family="19" subtype="4" />
+
+ <define name="locate_rights_request" family="2" subtype="2" />
+ <define name="locate_rights_response" family="2" subtype="3">
+ <tlvchain>
+ <tlv type="1"><word name="max_profile_len">1024</word></tlv>
+ <tlv type="2"><word name="max_capabilities">16</word></tlv>
+ <tlv type="3"><word>10</word></tlv>
+ <tlv type="4"><word>4096</word></tlv>
+ </tlvchain>
+ </define>
+
+ <define name="buddy_rights_request" family="3" subtype="2" />
+ <define name="buddy_rights_response" family="3" subtype="3">
+ <tlvchain>
+ <tlv type="1"><word name="maxbuddies">600</word></tlv>
+ <tlv type="2"><word name="maxwatchers">750</word></tlv>
+ <tlv type="3"><word name="maxnotifies">512</word></tlv>
+ </tlvchain>
+ </define>
+
+ <define name="IM_parameters">
+ <word name="channel">0</word>
+ <dword name="flags">3</dword>
+ <word name="max_size">8000</word>
+ <word name="max_send_warn">999</word>
+ <word name="max_recv_warn">999</word>
+ <word name="min_msg_interval">0</word>
+ <word>0</word>
+ </define>
+ <define name="add_IM_parameters" family="4" subtype="2"><ref name="IM_parameters" /></define>
+ <define name="IM_parameter_request" family="4" subtype="4"><ref name="IM_parameters" /></define>
+ <define name="IM_parameter_response" family="4" subtype="5"><ref name="IM_parameters" /></define>
+
+ <define name="BOS_rights_request" family="9" subtype="2" />
+ <define name="BOS_rights_response" family="9" subtype="3">
+ <tlvchain>
+ <tlv type="1"><word name="max_permits">200</word></tlv>
+ <tlv type="2"><word name="max_denies">200</word></tlv>
+ </tlvchain>
+ </define>
+
+ <define name="self_information" family="1" subtype="15"><ref name="userinfo" /></define>
+ <define name="minimum_report_interval" family="11" subtype="2" />
+ <define name="MOTD" family="1" subtype="19" />
+ <define name="server_ready" family="1" subtype="3">
+ <word count="-1" name="families" />
+ </define>
+ <define name="set_service_versions" family="1" subtype="23">
+ <data count="-1" name="service">
+ <word name="service_id" />
+ <word name="service_version" />
+ </data>
+ </define>
+ <define name="set_tool_versions" family="1" subtype="2">
+ <data count="-1" name="service">
+ <word name="service_id" />
+ <word name="service_version" />
+ <word name="tool_id" />
+ <word name="tool_version" />
+ </data>
+ </define>
+ <define name="rate_info_request" family="1" subtype="6" />
+ <define name="rate_change" family="1" subtype="10">
+ <enum type="word" name="message_type">
+ <edef name="change" value="1" />
+ <edef name="warning" value="2" />
+ <edef name="alert" value="3" />
+ <edef name="clear" value="4" />
+ </enum>
+ <ref name="rate_class_info" />
+ </define>
+ <define name="outgoing_warning" family="4" subtype="8">
+ <word name="is_anonymous" />
+ <data name="screenname" length_prefix="byte" />
+ </define>
+ <define name="incoming_warning" family="1" subtype="16">
+ <word name="new_level" />
+ <ref name="userinfo" />
+ </define>
+ <define name="memory_request" family="1" subtype="31" /> <!-- This was an attempt to block third-party clients by requesting MD5s of portions of the AIM.EXE binary; it is no longer used, huzzah -->
+ <define name="host_versions" family="1" subtype="24">
+ <data count="-1" name="server">
+ <word name="service_id" />
+ <word name="service_version" />
+ </data>
+ </define>
+ <define name="buddylist_done" family="19" subtype="7" />
+
+
+
+ <!-- Buddylist stuff -->
+
+ <define name="buddylist_3_response" family="19" subtype="3">
+ <tlvchain>
+ <tlv type="4"><word count="-1" name="maximums" /></tlv>
+ <tlv type="2"><word>254</word></tlv>
+ <tlv type="3"><word>508</word></tlv>
+ <tlv type="5"><word>0</word></tlv>
+ <tlv type="6"><word>97</word></tlv>
+ <tlv type="7"><word>10</word></tlv>
+ </tlvchain>
+ </define>
+ <define name="buddylist" family="19" subtype="6"> <!-- This is supremely weird and fucked up, no bloody way we'll be able to get it in the XML; notably, it is split across multiple SNACs, but not on any sort of coherent boundary, and you have to slice random bits off the front and back... See OSCAR/Callbacks.pm handler for this protobit. -->
+ <data name="data" />
+ </define>
+ <define name="buddylist_modification_acknowledgement" family="19" subtype="14">
+ <word name="error" count="-1" />
+ </define>
+ <define name="buddylist_error" family="19" subtype="15">
+ <data name="data" />
+ </define>
+
+ <!-- Packets are limited to 8k in size, which we could exceed if we try to put too many
+ modifications into one packet. Since we need to flatten one modification at a time
+ and stop when we hit the size cap, this stuff is a bit peculiar. -->
+ <define name="buddylist_modification">
+ <data name="entry_name" length_prefix="word" />
+ <word name="group_id" />
+ <word name="buddy_id" />
+ <word name="entry_type" />
+ <data name="entry_data" length_prefix="word" />
+ </define>
+ <define name="buddylist_add" family="19" subtype="8"><data name="mods" /></define>
+ <define name="buddylist_modify" family="19" subtype="9"><data name="mods" /></define>
+ <define name="buddylist_delete" family="19" subtype="10"><data name="mods" /></define>
+
+ <!-- We also provide this more regular version for use in parsing changes sent by the server -->
+ <define name="buddylist_change">
+ <data name="changes" count="-1">
+ <ref name="buddylist_modification" />
+ </data>
+ </define>
+
+ <define name="start_buddylist_modifications" family="19" subtype="17" />
+ <define name="end_buddylist_modifications" family="19" subtype="18" />
+
+
+
+ <!-- User information -->
+
+ <define name="get_info" family="2" subtype="21">
+ <word>0</word>
+ <word>1</word>
+ <data length_prefix="byte" name="screenname" />
+ </define>
+ <define name="get_away" family="2" subtype="21">
+ <word>0</word>
+ <word>3</word>
+ <data length_prefix="byte" name="screenname" />
+ </define>
+ <define name="incoming_profile" family="2" subtype="6">
+ <ref name="userinfo" />
+ <tlvchain>
+ <tlv type="2"><data name="profile" /></tlv>
+ <tlv type="4"><data name="awaymsg" /></tlv>
+ </tlvchain>
+ </define>
+
+ <define name="set_info" family="2" subtype="4">
+ <tlvchain>
+ <tlv type="1"><data name="profile_mimetype" /></tlv>
+ <tlv type="2"><data name="profile" /></tlv>
+
+ <tlv type="3"><data name="awaymsg_mimetype" /></tlv>
+ <tlv type="4"><data name="awaymsg" /></tlv>
+
+ <tlv type="5"><data name="capabilities" length="16" count="-1" /></tlv>
+ <tlv type="6">
+ <tlvchain><tlv type="4"><word>2</word></tlv></tlvchain>
+ </tlv>
+ </tlvchain>
+ </define>
+
+ <define name="set_idle" family="1" subtype="17">
+ <dword name="duration" />
+ </define>
+
+ <!-- Extended information -->
+
+ <define name="typing_notification" family="4" subtype="20">
+ <dword>0</dword>
+ <dword>0</dword>
+ <word>1</word>
+ <data length_prefix="byte" name="screenname" />
+ <word name="typing_status" />
+ </define>
+
+ <define name="incoming_extended_information" family="1" subtype="33">
+ <!-- Gee, thank you for this wonderful structure, AOL... Love you too. -->
+ <!-- Only one item in the TLV chain will be present, client should key off of which one -->
+ <tlvchain subtyped="yes">
+ <tlv type="0" subtype="65"><data name="upload_checksum" /></tlv>
+ <tlv type="1" subtype="65"><data name="upload_checksum" /></tlv>
+
+ <tlv type="0" subtype="129"><data name="resend_checksum" /></tlv>
+ <tlv type="1" subtype="129"><data name="resend_checksum" /></tlv>
+
+ <tlv type="2" subtype="-1"><data length_prefix="word" name="status_message" /></tlv>
+ </tlvchain>
+ </define>
+
+ <define name="set_extended_status" family="1" subtype="30">
+ <tlvchain>
+ <tlv type="29" name="status_message">
+ <word>2</word>
+ <byte>4</byte>
+ <data length_prefix="byte">
+ <data length_prefix="word" name="message" />
+ <word>0</word>
+ </data>
+ </tlv>
+ <tlv type="6" name="stealth">
+ <!--
+ 0x100 is the 'stealth' flag
+ Presumably there are other things that can go here...
+ -->
+ <dword name="state" />
+ </tlv>
+ </tlvchain>
+ </define>
+
+ <define name="icon_upload" family="16" subtype="2">
+ <tlvchain>
+ <tlv type="1"><data name="icon" /></tlv>
+ </tlvchain>
+ </define>
+
+
+
+ <!-- Buddylist -->
+
+ <define name="buddy_status_update" family="3" subtype="11">
+ <ref name="userinfo" />
+ </define>
+ <define name="buddy_signoff" family="3" subtype="12">
+ <data length_prefix="byte" name="screenname" />
+ </define>
+
+
+ <!-- IMs -->
+
+ <define name="standard_IM_header">
+ <data length="8" name="cookie" />
+ <word name="channel">1</word>
+ </define>
+ <define name="standard_IM_footer">
+ <tlvchain>
+ <tlv type="2">
+ <tlvchain>
+ <tlv type="1281">
+ <word>257</word>
+ <word>257</word>
+ </tlv>
+ <tlv type="257">
+ <word>0</word>
+ <word>0</word>
+ <data name="message" />
+ </tlv>
+ </tlvchain>
+ </tlv>
+ <tlv type="4" name="is_automatic" />
+ <tlv type="3" name="request_server_confirmation" />
+ <tlv type="11" name="supports_typing_status" />
+ <tlv type="8" name="icon_data">
+ <dword name="icon_length" />
+ <word>1</word>
+ <word name="icon_checksum" />
+ <dword name="icon_timestamp" />
+ </tlv>
+ </tlvchain>
+ </define>
+ <define name="rendezvous_IM">
+ <tlvchain>
+ <tlv type="5">
+ <enum type="word" name="status">
+ <edef name="propose" value="0" />
+ <edef name="cancel" value="1" />
+ <edef name="accept" value="2" />
+ </enum>
+
+ <data length="8" name="cookie" />
+
+ <!-- Indicates request type -->
+ <data length="16" name="capability" />
+
+ <tlvchain>
+ <!-- 1 == push, 2 == pull -->
+ <tlv type="10"><word name="push_pull" /></tlv>
+ <tlv type="11"><word name="error" /></tlv>
+ <tlv type="15" default_generate="yes" />
+
+ <!-- File transfer stuff -->
+ <tlv type="2"><dword name="client_1_ip" /></tlv>
+ <tlv type="3"><dword name="client_2_ip" /></tlv>
+ <tlv type="4"><dword name="client_external_ip" /></tlv>
+ <tlv type="5"><word name="port" /></tlv>
+ <tlv type="22"><dword name="proxy_ip" /></tlv>
+
+
+ <!-- Proposal message -->
+ <tlv type="12"><data name="invitation_msg" /></tlv>
+ <tlv type="13"><data name="charset">us-ascii</data></tlv>
+ <tlv type="14"><byte name="language">48</byte></tlv>
+
+ <!-- See 'rendezvous service-specific data' -->
+ <tlv type="10001"><data name="svcdata" /></tlv>
+ <tlv type="10002"><data name="svcdata_charset" /></tlv>
+ </tlvchain>
+ </tlv>
+ </tlvchain>
+ </define>
+
+ <define name="incoming_IM" family="4" subtype="7">
+ <ref name="standard_IM_header" />
+ <ref name="userinfo" />
+ <data name="message_body" />
+ </define>
+ <define name="outgoing_IM" family="4" subtype="6">
+ <ref name="standard_IM_header" />
+ <data name="screenname" length_prefix="byte" />
+ <data name="message_body" />
+ </define>
+
+ <define name="IM_acknowledgement" family="4" subtype="12">
+ <data length="8" name="cookie" />
+ <word name="channel" />
+ <data length_prefix="byte" name="screenname" />
+ </define>
+
+
+
+ <!-- Chat -->
+
+ <define name="chat_invitation_accept" family="13" subtype="4">
+ <word name="exchange">4</word>
+ <data length_prefix="byte" name="url" />
+ <word>0</word>
+ <byte>2</byte>
+ </define>
+ <define name="chat_invitation_decline" family="4" subtype="11">
+ <data length="8" name="cookie" />
+ <word name="channel">2</word>
+ <data length_prefix="byte" name="screenname" />
+ <tlvchain>
+ <!-- 0=not supported, 1=declined, 2=client is not accepting transfers -->
+ <tlv type="3"><word name="code">1</word></tlv>
+ </tlvchain>
+ </define>
+
+ <define name="chat_navigator_rights_request" family="13" subtype="2" />
+ <define name="chat_navigator_room_create" family="13" subtype="8">
+ <ref name="chat_room_info" />
+ </define>
+
+ <define name="chat_data">
+ <tlvchain count_prefix="word">
+ <tlv type="106"><data name="name" /></tlv>
+ <tlv type="111"><word name="occupant_count" /></tlv>
+ <tlv type="115" name="occupants" count="-1">
+ <ref name="userinfo" />
+ </tlv>
+
+ <tlv type="209"><word name="max_msg_len" /></tlv>
+ <tlv type="211"><data name="name" /></tlv>
+ <tlv type="214"><data name="charset">us-ascii</data></tlv>
+ <tlv type="215" default_generate="yes"><data name="language">en</data></tlv>
+ <tlv type="219"><data name="encoding" /></tlv>
+ </tlvchain>
+ </define>
+ <define name="chat_room_info">
+ <word name="exchange" />
+ <data length_prefix="byte" name="url">create</data>
+ <word name="instance">65535</word>
+ <byte name="detail_level">1</byte>
+ <ref name="chat_data" />
+ </define>
+ <word />
+ <data length_prefix="byte">
+ <byte />
+ <data name="name" />
+ </data>
+ <word />
+ <byte name="detail_level" />
+ <tlvchain count_prefix="word">
+ <tlv type="111"><word name="occupant_count" /></tlv>
+ <tlv type="115">
+ <data name="occupants" count="-1">
+ <ref name="userinfo" />
+ </data>
+ </tlv>
+ </tlvchain>
+
+
+ <define name="chat_navigator_response" family="13" subtype="9">
+ <tlvchain>
+ <!-- These two come from the 'chat navigator rights request' -->
+ <tlv type="2"><byte name="max_concurrent_rooms" /></tlv>
+ <tlv type="3" count="-1" name="exchange">
+ <word name="exchange" />
+ <ref name="chat_data" />
+ </tlv>
+
+ <!-- These two come from the create room request -->
+ <tlv type="4" count="-1" name="room">
+ <ref name="chat_room_info" />
+ </tlv>
+ </tlvchain>
+ </define>
+
+
+ <define name="chat_room_status" family="14" subtype="2">
+ <ref name="chat_room_info" />
+ </define>
+ <define name="chat_buddy_arrival" family="14" subtype="3">
+ <data name="arrivals" count="-1">
+ <ref name="userinfo" />
+ </data>
+ </define>
+ <define name="chat_buddy_departure" family="14" subtype="4">
+ <data name="departures" count="-1" length_prefix="byte" />
+ </define>
+
+
+ <define name="chat_IM">
+ <data length="8" name="cookie" />
+ <word>3</word> <!-- channel -->
+ <tlvchain>
+ <tlv type="1" default_generate="yes" />
+ <tlv type="3"><data name="sender" length_prefix="byte" /></tlv>
+ <tlv type="6" name="reflect" />
+ <tlv type="7" name="is_automatic" />
+ <tlv type="5">
+ <tlvchain>
+ <tlv type="4"><data name="type">text/x-aolrtf</data></tlv>
+ <tlv type="2"><data name="charset">us-ascii</data></tlv>
+ <tlv type="3"><data name="language">en</data></tlv>
+ <tlv type="5"><data>binary</data></tlv>
+ <tlv type="1"><data name="message" /></tlv>
+ </tlvchain>
+ </tlv>
+ </tlvchain>
+ </define>
+ <define name="outgoing_chat_IM" family="14" subtype="5"><ref name="chat_IM" /></define>
+ <define name="incoming_chat_IM" family="14" subtype="6"><ref name="chat_IM" /></define>
+
+
+
+ <!-- Administrative services -->
+
+ <define name="admin_request_response" family="7" subtype="5">
+ <word name="request_type" />
+ <tlvchain count_prefix="word">
+ <tlv type="1"><data name="new_screenname" /></tlv>
+ <tlv type="17"><data name="new_email" /></tlv>
+ <tlv type="8"><word name="error_code" /></tlv>
+ <tlv type="4"><data name="error_url" /></tlv>
+ <tlv type="3"><word name="subrequest" /></tlv>
+ </tlvchain>
+ </define>
+ <define name="buddy_icon_uploaded" family="16" subtype="3" />
+ <define name="buddy_icon_download" family="16" subtype="4">
+ <data name="screenname" length_prefix="byte" />
+ <byte>1</byte>
+ <word>1</word>
+ <byte>1</byte>
+ <data name="md5sum" length_prefix="byte" />
+ </define>
+ <define name="buddy_icon_downloaded" family="16" subtype="5">
+ <data name="screenname" length_prefix="byte" />
+ <word name="flags" />
+ <byte name="number" />
+ <data name="checksum" length_prefix="byte" />
+ <data name="icon" length_prefix="word" />
+ </define>
+
+ <define name="confirm_account_request" family="7" subtype="6" />
+ <define name="confirm_account_response" family="7" subtype="7">
+ <!-- If present and 19, indicates error, otherwise success -->
+ <word name="status" />
+ </define>
+
+ <define name="change_account_info" family="7" subtype="4">
+ <!-- Not all of these need to be present. -->
+ <tlvchain>
+ <tlv type="1"><data name="new_screenname" /></tlv>
+
+ <tlv type="17"><data name="new_email" /></tlv>
+
+ <tlv type="2"><data name="newpass" /></tlv>
+ <tlv type="18"><data name="oldpass" /></tlv>
+ </tlvchain>
+ </define>
+
+
+ <!-- ICQ -->
+
+ <define name="ICQ_meta">
+ <tlvchain>
+ <tlv type="1">
+ <data length_prefix="word" prefix_order="vax" >
+ <dword name="our_uin" order="vax" />
+ <word name="type" order="vax" />
+ <word name="seqno" order="vax" />
+ <data name="typedata" />
+ </data>
+ </tlv>
+ </tlvchain>
+ </define>
+ <define name="ICQ_meta_request" family="21" subtype="2"><ref name="ICQ_meta" /></define>
+ <define name="ICQ_meta_response" family="21" subtype="3"><ref name="ICQ_meta" /></define>
+
+ <!-- Type 2000 -->
+ <define name="ICQ_meta_info_request">
+ <word name="subtype" order="vax">1202</word>
+ <dword name="uin" order="vax" />
+ </define>
+
+
+ <!-- Type 2010 -->
+ <define name="ICQ_meta_info_response">
+ <word name="subtype" order="vax" />
+
+ <!-- 10 == success -->
+ <byte name="status" />
+
+ <data name="response_data" />
+ </define>
+
+ <!-- Type 2010 subtypes -->
+
+ <!-- 200 -->
+ <define name="ICQ_meta_info_response:_basic">
+ <data name="nickname" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="firstname" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="lastname" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="email" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+
+ <data name="home">
+ <data name="city" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="state" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="phone_num" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="fax_num" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="address" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="cell_phone_num" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="zip_code" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <word name="country_code" order="vax" />
+ </data>
+
+ <byte name="gmt_offset" />
+ <byte name="authorization" />
+ <byte name="web_aware" />
+ <byte name="direct_connect_permissions" />
+ <byte name="publish_primary_email" />
+ </define>
+ <!-- 210 -->
+ <define name="ICQ_meta_info_response:_office">
+ <data name="city" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="state" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="phone_num" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="fax_num" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="address" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="zip_code" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <word name="country_code" order="vax" />
+
+ <data name="company" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="department" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="position" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <word name="occupation" order="vax" />
+ <data name="office_website" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ </define>
+ <!-- 220 -->
+ <define name="ICQ_meta_info_response:_background">
+ <word name="age" order="vax" />
+ <byte name="gender" />
+ <data name="homepage" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <word name="birth_year" order="vax" />
+ <byte name="birth_month" />
+ <byte name="bith_day" />
+ <byte name="language_1" />
+ <byte name="language_2" />
+ <byte name="language_3" />
+ <word />
+ <data name="origin_city" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <data name="origin_state" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <word name="origin_country" order="vax" />
+ <byte name="marital_status" />
+ </define>
+ <!-- 230 -->
+ <define name="ICQ_meta_info_response:_notes">
+ <data name="notes" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ </define>
+ <!-- 235 -->
+ <define name="ICQ_meta_info_response:_email">
+ <data count_prefix="byte" name="addresses">
+ <byte name="publish" />
+ <data name="address" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ </data>
+ </define>
+ <!-- 240 -->
+ <define name="ICQ_meta_info_response:_interests">
+ <data count_prefix="byte" name="interests">
+ <word name="category" order="vax" />
+ <data name="interest" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ </data>
+ </define>
+ <!-- 250 -->
+ <define name="ICQ_meta_info_response:_affiliations">
+ <data count_prefix="byte" name="past_affiliations">
+ <word name="category" order="vax" />
+ <data name="keyword" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ </data>
+ <data count_prefix="byte" name="affiliations">
+ <word name="category" order="vax" />
+ <data name="keyword" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ </data>
+ </define>
+ <!-- 270 -->
+ <define name="ICQ_meta_info_response:_homepage">
+ <byte name="enabled" />
+ <word name="category" order="vax" />
+ <data name="keywords" length_prefix="word" prefix_order="vax" null_terminated="yes" />
+ <byte />
+ </define>
+
+
+ <!-- Rendezvous service-specific data -->
+ <define name="chat_invite_rendezvous_data">
+ <word name="exchange">4</word>
+ <data length_prefix="byte" name="url" />
+ <word>0</word>
+ </define>
+ <define name="file_transfer_rendezvous_data">
+ <!-- 1 if only sending a single file, otherwise 2 -->
+ <word name="file_count_status" />
+ <word name="file_count" />
+ <dword name="size" />
+ <data count="-1" null_terminated="yes" name="files" />
+ </define>
+ <define name="buddy_list_transfer_rendezvous_data">
+ <data count="-1" name="group">
+ <data length_prefix="word" name="name" />
+ <data count_prefix="word" name="buddies">
+ <data length_prefix="word" name="name" />
+ </data>
+ </data>
+ </define>
+
+
+ <!-- Direct-connect and file transfer stuff -->
+ <define name="file_transfer_header">
+ <data length="4">OFT2</data>
+ <word name="header_length">256</word>
+
+ <!-- 0x0101 for syn, 0x0202 for ack, 0x0204 for fin -->
+ <word name="type" />
+
+ <data length="8" name="cookie" />
+
+ <word name="encrypt">0</word>
+ <word name="compress">0</word>
+ <word name="file_count" />
+ <word name="files_left" />
+ <word name="part_count">1</word>
+ <word name="parts_left">1</word>
+ <dword name="byte_count" />
+ <dword name="bytes_left" />
+ <dword name="mtime" />
+ <dword name="checksum" />
+ <dword name="received_initial_checksum">4294901760</dword>
+ <dword name="received_size">0</dword>
+ <dword name="ctime" />
+ <dword name="initial_checksum">4294901760</dword>
+ <dword name="bytes_received" />
+ <dword name="received_checksum" />
+ <data length="32" pad="0" name="client_id">Cool FileXfer</data>
+ <byte name="flags">32</byte>
+ <byte name="name_offset">28</byte>
+ <byte name="size_offset">17</byte>
+ <data length="69" pad="0" />
+ <data length="16" pad="0" name="mac_file_info" />
+ <word name="encoding">0</word>
+ <word name="language">0</word>
+ <data length="64" pad="0" name="filename" />
+ </define>
+
+
+ <!-- Migration: See http://iserverd1.khstu.ru/oscar/sequences.html#migration -->
+ <define name="pause" family="1" subtype="11" />
+ <define name="pause_ack" family="1" subtype="12">
+ <word count="-1" name="families" />
+ </define>
+ <define name="unpause" family="1" subtype="13" />
+ <define name="migrate" family="1" subtype="18">
+ <word count_prefix="word" name="families" />
+ <tlvchain>
+ <tlv type="5"><data name="peer" /></tlv>
+ <tlv type="6"><data name="cookie" /></tlv>
+ </tlvchain>
+ </define>
+
+
+ <!-- Direct connect proxy -->
+ <!-- In front of any of these is a 16-bit network order length -->
+ <define name="direct_connect_proxy_hdr">
+ <word name="magic">1098</word>
+ <word name="msg_type" />
+ <dword>0</dword>
+ <data name="data" />
+ </define>
+ <define name="direct_connect_proxy_init"> <!-- msg_type 2 -->
+ <ref name="direct_connect_proxy_hdr" />
+ <word>0</word>
+ <data length_prefix="byte" name="screenname" />
+ <data length="8" name="cookie" />
+ <tlvchain>
+ <tlv type="1"><data name="capability" /></tlv>
+ </tlvchain>
+ </define>
+ <define name="direct_connect_proxy_reply"> <!-- msg_type 3 -->
+ <ref name="direct_connect_proxy_hdr" />
+ <word>544</word>
+ <word name="port" />
+ <dword name="ip" />
+ </define>
+</oscar>
+
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Template.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Template.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/XML/Template.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,485 @@
+# These objects, initialized with an "OSCAR protocol template" from Net::OSCAR::XML::protoparse,
+# pack and unpack data according to the specification of that template.
+
+package Net::OSCAR::XML::Template;
+
+use strict;
+use warnings;
+
+use Net::OSCAR::XML;
+use Net::OSCAR::Common qw(:loglevels);
+use Net::OSCAR::Utility qw(hexdump);
+use Net::OSCAR::TLV;
+use Data::Dumper;
+use Carp;
+
+sub new($@) {
+ my $class = shift;
+ my $package = ref($class) || $class || "Net::OSCAR::XML::Template";
+ my $self = {template => $_[0]};
+ $self->{oscar} = $class->{oscar} if ref($class) and $class->{oscar};
+ bless $self, $package;
+ return $self;
+}
+
+# Net::OSCAR::XML caches Template objects that don't have an associated OSCAR,
+# so that the same Template can be reused with multiple OSCAR objects.
+# Before returning a Template to the user, it calls set_oscar, so here we clone
+# ourself with the new OSCAR.
+#
+sub set_oscar($$) {
+ my($self, $oscar) = @_;
+ my $clone = $self->new($self->{template});
+ $clone->{oscar} = $oscar;
+ return $clone;
+}
+
+
+# If given a scalar ref instead of a scalar as the second argument,
+# we will modify the packet in-place.
+sub unpack($$) {
+ my ($self, $x_packet) = @_;
+ my $oscar = $self->{oscar};
+ my $template = $self->{template};
+ my $packet = ref($x_packet) ? $$x_packet : $x_packet;
+
+ my %data = ();
+
+ $oscar->log_print_cond(OSCAR_DBG_XML, sub { "Decoding:\n", hexdump($packet), "\n according to: ", Data::Dumper::Dumper($template) });
+
+ assert(ref($template) eq "ARRAY");
+ foreach my $datum (@$template) {
+ # In TLV chains, count refers to number of TLVs, not number of repetitions of the datum, so it defaults to infinite.
+ my $count = $datum->{count} || ($datum->{type} eq "tlvchain" ? -1 : 1);
+ my @results;
+
+
+ ## Figure out how much input data this datum is dealing with
+
+ if($datum->{prefix} and $datum->{prefix} eq "count") {
+ ($count) = unpack($datum->{prefix_packlet}, substr($packet, 0, $datum->{prefix_len}, "")) || 0;
+ }
+
+ my $size = undef;
+ if($datum->{type} eq "num") {
+ if($count != -1) {
+ $size = $datum->{len} * $count;
+ } else {
+ $size = length($packet);
+ }
+ } else {
+ if($datum->{prefix} and $datum->{prefix} eq "length") {
+ ($size) = unpack($datum->{prefix_packlet}, substr($packet, 0, $datum->{prefix_len}, ""));
+ } elsif(exists($datum->{len})) {
+ # In TLV chains, count is the number of TLVs, not a repeat
+ # count for the datum.
+ if($datum->{type} eq "tlvchain") {
+ $size = $datum->{len};
+ } else {
+ if($count == -1) {
+ $size = length($packet);
+ } else {
+ $size = $datum->{len} * $count;
+ }
+ }
+ }
+ }
+
+ my $input;
+ if(defined($size)) {
+ $input = substr($packet, 0, $size, "");
+ } else {
+ $input = $packet;
+ }
+
+
+ ## Okay, we have our input data -- act on it
+
+ if($datum->{type} eq "num") {
+ for(my $i = 0; ($input ne "") and ($count == -1 or $i < $count); $i++) {
+ push @results, unpack($datum->{packlet}, substr($input, 0, $datum->{len}, ""));
+
+ if(exists($datum->{enum_byval}) and exists($datum->{enum_byval}->{$results[-1]})) {
+ $results[-1] = $datum->{enum_byval}->{$results[-1]};
+ }
+ }
+ } elsif($datum->{type} eq "data" or $datum->{type} eq "ref") {
+ # If we just have simple, no preset length, no subitems, raw data, it can't have a repeat count, since the first repetition will gobble up everything
+ assert($datum->{type} ne "data" or ($datum->{items} and @{$datum->{items}}) or defined($size) or $count == 1 or $datum->{null_terminated});
+
+ # We want:
+ # <data length_prefix="num" />
+ # to be empty string, not undefined, when length==0.
+ if(!$input and $count == 1 and defined($size)) {
+ push @results, "";
+ }
+
+ for(my $i = 0; $input and ($count == -1 or $i < $count); $i++) {
+ # So, consider the structure:
+ # <data name="foo">
+ # <word />
+ # <word />
+ # </data>
+ # We don't know the size of 'foo' in advance.
+ # Thus, we pass a reference to the actual packet into protopack.
+ # subpacket will be modified to be the packet minus the bits that the contents of the data consumed.
+
+ my %tmp;
+ if($datum->{type} eq "data") {
+ my $subinput;
+ if($datum->{len}) {
+ $subinput = substr($input, 0, $datum->{len}, "");
+ } elsif($datum->{null_terminated}) {
+ $input =~ s/^(.*?)\0//;
+ $subinput = $1;
+ } else {
+ $subinput = $input;
+ $input = "";
+ }
+
+ if(exists($datum->{pad})) {
+ my $pad = chr($datum->{pad});
+ $subinput =~ s/$pad*$//;
+ }
+
+ if($datum->{items} and @{$datum->{items}}) {
+ assert(!$datum->{null_terminated});
+ (%tmp) = $self->new($datum->{items})->unpack(\$subinput);
+ $input = $subinput unless $datum->{len};
+ } else {
+ $subinput =~ s/\0$// if $datum->{null_terminated};
+
+ # The simple case -- raw <data />
+ push @results, $subinput if $datum->{name};
+ }
+ } elsif($datum->{type} eq "ref") {
+ (%tmp) = protoparse($oscar, $datum->{name})->unpack(\$input);
+ }
+
+ push @results, \%tmp if %tmp;
+ }
+ } elsif($datum->{type} eq "tlvchain") {
+ my @unknown;
+
+ ## First set up a hash to store the data for each TLV, grouped by (sub)type
+ ##
+ my $tlvmap = tlv();
+ if($datum->{subtyped}) {
+ foreach (@{$datum->{items}}) {
+ $tlvmap->{$_->{num}} ||= tlv();
+ $tlvmap->{$_->{num}}->{$_->{subtype} || -1} = {%$_};
+ }
+ } else {
+ $tlvmap->{$_->{num}} = {%$_} foreach (@{$datum->{items}});
+ }
+
+ ## Now, go through the chain and split the data into TLVs.
+ ##
+ for(my $i = 0; $input and ($count == -1 or $i < $count); $i++) {
+ my %tlv;
+ if($datum->{subtyped}) {
+ (%tlv) = protoparse($oscar, "subtyped_TLV")->unpack(\$input);
+ } else {
+ (%tlv) = protoparse($oscar, "TLV")->unpack(\$input);
+ }
+
+ my $unknown = 0;
+ if(!exists($tlvmap->{$tlv{type}})) {
+ $tlvmap->{$tlv{type}} = $datum->{subtyped} ? tlv() : {};
+ $unknown = 1;
+ }
+
+ assert(!exists($tlv{name})) if exists($tlv{count});
+ if($datum->{subtyped}) {
+ assert(exists($tlv{subtype}));
+
+ if(!exists($tlvmap->{$tlv{type}}->{$tlv{subtype}})) {
+ if(exists($tlvmap->{$tlv{type}}->{-1})) {
+ $tlv{subtype} = -1;
+ } else {
+ $tlvmap->{$tlv{type}}->{$tlv{subtype}} = {};
+ $unknown = 1;
+ }
+ }
+
+ if(!$unknown) {
+ my $type = $tlv{type};
+ my $subtype = $tlv{subtype};
+ $tlvmap->{$type}->{$subtype}->{data} ||= [];
+ $tlvmap->{$type}->{$subtype}->{outdata} ||= [];
+
+ $tlv{data} = "" if !defined($tlv{data});
+ push @{$tlvmap->{$type}->{$subtype}->{data}}, $tlv{data};
+ } else {
+ push @unknown, {
+ type => $tlv{type},
+ subtype => $tlv{subtype},
+ data => $tlv{data}
+ };
+ }
+ } else {
+ if(!$unknown) {
+ my $type = $tlv{type};
+ $tlvmap->{$type}->{data} ||= [];
+ $tlvmap->{$type}->{outdata} ||= [];
+
+ $tlv{data} = "" if !defined($tlv{data});
+ push @{$tlvmap->{$tlv{type}}->{data}}, $tlv{data};
+ } else {
+ push @unknown, {
+ type => $tlv{type},
+ data => $tlv{data}
+ };
+ }
+ }
+ }
+
+ ## Almost done! Go back through the hash we made earlier, which now has the
+ ## data in it, and figure out which TLVs we want to emit.
+ ##
+ my @outvals;
+ while(my($num, $val) = each %$tlvmap) {
+ if($datum->{subtyped}) {
+ while(my($subtype, $subval) = each %$val) {
+ push @outvals, $subval if exists($subval->{data});
+ }
+ } else {
+ push @outvals, $val if exists($val->{data});
+ }
+ }
+
+
+ ## Okay, now take the TLVs to emit, and structure the output correctly
+ ## for each thing-to-emit. We'll need to do one last phase of postprocessing
+ ## so that we can group counted TLVs correctly.
+ ##
+ foreach my $val (@outvals) {
+ foreach (@{$val->{data}}) {
+ next unless exists($val->{items});
+ my(%tmp) = $self->new($val->{items})->unpack($_);
+ # We want:
+ # <tlv type="1"><data name="x" /></tlv>
+ # to give x => "" when TLV 1 is present but empty,
+ # not x => undef.
+ if(@{$val->{items}} == 1 and $val->{items}->[0]->{name}) {
+ my $name = $val->{items}->[0]->{name};
+ $tmp{$name} = "" if !defined($tmp{$name});
+ }
+
+ if(@{$val->{items}}) {
+ push @{$val->{outdata}}, \%tmp;
+ } else {
+ push @{$val->{outdata}}, "";
+ }
+ }
+ }
+
+
+ ## Okay, we've stashed the output (formatted data structures) for each TLV.
+ ## Now we need to merge these into results.
+ ## This is normally just pushing everything out to results, as a hashref
+ ## under the TLVs name for named TLVs, but counted TLVs also need to
+ ## be layered into an array.
+ ##
+ foreach my $val (@outvals) {
+ if(exists($val->{count})) {
+ if(exists($val->{name})) {
+ push @results, {
+ $val->{name} => $val->{outdata}
+ };
+ } else {
+ push @results, $val->{outdata}->[0];
+ }
+ } else {
+ if(exists($val->{name})) {
+ push @results, {
+ $val->{name} => $val->{outdata}->[0]
+ };
+ } else {
+ push @results, $val->{outdata}->[0];
+ }
+ }
+ }
+
+ push @results, {__UNKNOWN => [@unknown]} if @unknown;
+ }
+
+
+ # If we didn't know the length of the datum in advance,
+ # we've been modifying the entire packet in-place.
+ $packet = $input if !defined($size);
+
+
+ ## Okay, we have the results from this datum, store them away.
+
+ if($datum->{name}) {
+ if($datum->{count} or ($datum->{prefix} and $datum->{prefix} eq "count")) {
+ $data{$datum->{name}} = \@results;
+ } elsif(
+ $datum->{type} eq "ref" or
+ (ref($datum->{items}) and @{$datum->{items}})
+ ) {
+ $data{$_} = $results[0]->{$_} foreach keys %{$results[0]};
+ } else {
+ $data{$datum->{name}} = $results[0];
+ }
+ } elsif(@results) {
+ foreach my $result(@results) {
+ next unless ref($result);
+ $data{$_} = $result->{$_} foreach keys %$result;
+ }
+ }
+ }
+
+ $oscar->log_print_cond(OSCAR_DBG_XML, sub { "Decoded:\n", join("\n", map { "\t$_ => ".(defined($data{$_}) ? hexdump($data{$_}) : 'undef') } keys %data) });
+
+ # Remember, passing in a ref to packet in place of actual packet data == in-place editing...
+ $$x_packet = $packet if ref($x_packet);
+
+ return %data;
+}
+
+
+sub pack($%) {
+ my($self, %data) = @_;
+ my $packet = "";
+ my $oscar = $self->{oscar};
+ my $template = $self->{template};
+
+ $oscar->log_print_cond(OSCAR_DBG_XML, sub { "Encoding:\n", join("\n", map { "\t$_ => ".(defined($data{$_}) ? hexdump($data{$_}) : 'undef') } keys %data), "\n according to: ", Data::Dumper::Dumper($template) });
+
+ assert(ref($template) eq "ARRAY");
+ foreach my $datum (@$template) {
+ my $output = undef;
+
+ ## Figure out what we're packing
+ my $value = undef;
+ $value = $data{$datum->{name}} if $datum->{name};
+ $value = $datum->{value} if !defined($value);
+ my @valarray = ref($value) eq "ARRAY" ? @$value : ($value); # Don't modify $value in-place!
+
+ $datum->{count} = @valarray if $datum->{prefix} and $datum->{prefix} eq "count";
+ my $max_count = exists($datum->{count}) ? $datum->{count} : 1;
+ my $count = 0;
+
+ assert($max_count == -1 or @valarray <= $max_count);
+
+
+ ## Pack it
+ if($datum->{type} eq "num") {
+ next unless defined($value);
+
+ for($count = 0; ($max_count == -1 or $count < $max_count) and @valarray; $count++) {
+ my $val = shift @valarray;
+ if(exists($datum->{enum_byname}) and exists($datum->{enum_byname}->{$val})) {
+ $val = $datum->{enum_byname}->{$val};
+ }
+
+ $output .= pack($datum->{packlet}, $val);
+ }
+ } elsif($datum->{type} eq "data" or $datum->{type} eq "ref") {
+ for($count = 0; ($max_count == -1 or $count < $max_count) and @valarray; $count++) {
+ my $val = shift @valarray;
+
+ if($datum->{items} and @{$datum->{items}}) {
+ $output .= $self->new($datum->{items})->pack(ref($val) ? %$val : %data);
+ } elsif($datum->{type} eq "ref") {
+ assert($max_count == 1 or (ref($val) and ref($val) eq "HASH"));
+ $output .= protoparse($oscar, $datum->{name})->pack(ref($val) ? %$val : %data);
+ } else {
+ $output .= $val if defined($val);
+ }
+
+ $output .= chr(0) if $datum->{null_terminated};
+ if(exists($datum->{pad})) {
+ assert(exists($datum->{len}) and exists($datum->{pad}));
+
+ my $outlen = defined($output) ? length($output) : 0;
+ my $pad_needed = $datum->{len} - $outlen;
+ $output .= chr($datum->{pad}) x $pad_needed if $pad_needed;
+ }
+ }
+ } elsif($datum->{type} eq "tlvchain") {
+ foreach my $tlv (@{$datum->{items}}) {
+ my $tlvdata = undef;
+
+ if(exists($tlv->{name})) {
+ if(exists($data{$tlv->{name}})) {
+ if(@{$tlv->{items}}) {
+ assert(ref($data{$tlv->{name}}) eq "HASH" or ref($data{$tlv->{name}}) eq "ARRAY");
+ if(ref($data{$tlv->{name}}) eq "ARRAY") {
+ $tlvdata = [];
+ push @$tlvdata, $self->new($tlv->{items})->pack(%$_) foreach @{$data{$tlv->{name}}};
+ } else {
+ $tlvdata = [$self->new($tlv->{items})->pack(%{$data{$tlv->{name}}})];
+ }
+ } else {
+ $tlvdata = [""] if defined($data{$tlv->{name}});
+ }
+ } elsif(exists($tlv->{value}) and !@{$tlv->{items}}) {
+ $tlvdata = [$tlv->{value}];
+ }
+ } else {
+ my $tmp = $self->new($tlv->{items})->pack(%data);
+
+ # If TLV has no name and only one element, do special handling for "present but empty" value.
+ if($tmp ne "") {
+ $tlvdata = [$tmp];
+ } elsif(@{$tlv->{items}} == 1 and $tlv->{items}->[0]->{name} and exists($data{$tlv->{items}->[0]->{name}})) {
+ $tlvdata = [""];
+ } elsif(!@{$tlv->{items}} and exists($tlv->{value})) {
+ $tlvdata = [$tlv->{value}];
+ }
+ }
+
+ assert($tlv->{num});
+ next unless defined($tlvdata);
+
+ $count++;
+ if($datum->{subtyped}) {
+ my $subtype = 0;
+ assert(exists($tlv->{subtype}));
+ $subtype = $tlv->{subtype} if $tlv->{subtype} != -1;
+
+ $output .= protoparse($oscar, "subtyped_TLV")->pack(
+ type => $tlv->{num},
+ subtype => $subtype,
+ data => $_
+ ) foreach @$tlvdata;
+ } else {
+ $output .= protoparse($oscar, "TLV")->pack(
+ type => $tlv->{num},
+ data => $_
+ ) foreach @$tlvdata;
+ }
+ }
+ }
+
+
+ ## Handle any prefixes
+ if($datum->{prefix} and defined($output)) {
+ if($datum->{prefix} eq "count") {
+ $packet .= pack($datum->{prefix_packlet}, $count);
+ } else {
+ $packet .= pack($datum->{prefix_packlet}, length($output));
+ }
+ }
+
+ $packet .= $output if defined($output);
+ }
+
+ $oscar->log_print_cond(OSCAR_DBG_XML, sub { "Encoded:\n", hexdump($packet) });
+ return $packet;
+}
+
+
+sub assert($) {
+ my $test = shift;
+ return if $test;
+ confess("Net::OSCAR internal error");
+}
+
+# Why isn't this imported properly??
+sub protoparse { Net::OSCAR::XML::protoparse(@_); }
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/_BLInternal.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/_BLInternal.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR/_BLInternal.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,557 @@
+=pod
+
+Net::OSCAR::_BLInternal -- internal buddylist stuff
+
+This handles conversion of Net::OSCAR to "OSCAR buddylist format",
+and the sending of buddylist changes to the OSCAR server.
+
+=cut
+
+package Net::OSCAR::_BLInternal;
+
+use strict;
+use Net::OSCAR::Common qw(:all);
+use Net::OSCAR::Constants;
+use Net::OSCAR::Utility;
+use Net::OSCAR::TLV;
+use Net::OSCAR::XML;
+
+use vars qw($VERSION $REVISION);
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.56 $';
+
+sub init_entry($$$$) {
+ my($blinternal, $type, $gid, $bid) = @_;
+
+ $blinternal->{$type} ||= tlv();
+ $blinternal->{$type}->{$gid} ||= tlv();
+ $blinternal->{$type}->{$gid}->{$bid} ||= {};
+ $blinternal->{$type}->{$gid}->{$bid}->{name} ||= "";
+ $blinternal->{$type}->{$gid}->{$bid}->{data} ||= tlv();
+ $blinternal->{$type}->{$gid}->{$bid}->{__BLI_DIRTY} = 1;
+ $blinternal->{$type}->{$gid}->{$bid}->{__BLI_DELETED} = 0;
+}
+
+sub blentry_clear($%) {
+ my($session, %data) = @_;
+
+ if(chain_exists($session->{blinternal}, $data{entry_type}, $data{group_id}, $data{buddy_id})) {
+ $session->{blinternal}->{$data{entry_type}}->{$data{group_id}}->{$data{buddy_id}}->{__BLI_DELETED} = 1;
+ }
+}
+
+sub blentry_set($%) {
+ my($session, %data) = @_;
+
+ init_entry($session->{blinternal}, $data{entry_type}, $data{group_id}, $data{buddy_id});
+ my $typedata = tlv_decode($data{entry_data});
+
+ $session->{blinternal}->{$data{entry_type}}->{$data{group_id}}->{$data{buddy_id}}->{name} = $data{entry_name} if $data{entry_name};
+ while(my($key, $value) = each %$typedata) {
+ $session->{blinternal}->{$data{entry_type}}->{$data{group_id}}->{$data{buddy_id}}->{data}->{$key} = $value;
+ }
+ $session->log_printf_cond(OSCAR_DBG_DEBUG, sub { "Got BLI entry %s 0x%04X/0x%04X/0x%04X with %d bytes of data:%s", $data{entry_name}, $data{entry_type}, $data{group_id}, $data{buddy_id}, length($typedata), hexdump($data{entry_data}) });
+}
+
+sub blparse($$) {
+ my($session, $data) = @_;
+
+ $session->{visibility} = VISMODE_PERMITALL; # If we don't have p/d data, this is default.
+
+ delete $session->{blinternal};
+ $session->{blinternal} = tlv();
+
+ while(length($data) > 4) {
+ my($name) = unpack("n/a*", $data);
+ substr($data, 0, 2+length($name)) = "";
+ my($gid, $bid, $type, $sublen) = unpack("n4", substr($data, 0, 8, ""));
+ my $typedata = substr($data, 0, $sublen, "");
+ blentry_set($session,
+ entry_type => $type,
+ group_id => $gid,
+ buddy_id => $bid,
+ entry_name => $name,
+ entry_data => $typedata
+ );
+ }
+
+ BLI_to_NO($session);
+}
+
+# Buddylist-Internal -> Net::OSCAR
+# Sets various $session hashkeys from blinternal.
+# That's what Brian Bli-to-no'd do. ;)
+sub BLI_to_NO($) {
+ my($session) = @_;
+ my $bli = $session->{blinternal};
+
+ delete $session->{blinternal_visbid};
+ delete $session->{blinternal_iconbid};
+
+ $session->{buddies} ||= bltie(1);
+ $session->{buddies}->{__BLI_DIRTY} = 0;
+
+ $session->{permit} ||= bltie;
+ $session->{deny} ||= bltie;
+
+
+ foreach my $type ([2, "permit"], [3, "deny"]) {
+ my($num, $name) = @$type;
+
+ if(exists $bli->{$num}) {
+ foreach my $bid(keys(%{$bli->{$num}->{0}})) {
+ my $item = $bli->{$num}->{0}->{$bid};
+
+ if($item->{__BLI_DELETED}) {
+ delete $session->{$name}->{$item->{name}};
+ delete $bli->{$num}->{0}->{$bid};
+ } elsif($item->{__BLI_DIRTY}) {
+ $session->{$name}->{$item->{name}} = {buddyid => $bid};
+ $item->{__BLI_DIRTY} = 0;
+ }
+ }
+ }
+ }
+
+
+ foreach my $type (4, 5, 0x14) {
+ delete $bli->{$type}->{0}->{$_} foreach grep { $bli->{$type}->{0}->{$_}->{__BLI_DELETED} } keys %{$bli->{$type}->{0}};
+ }
+
+ if(exists $bli->{4} and exists $bli->{4}->{0} and (my($visbid) = grep {exists($bli->{4}->{0}->{$_}->{data}->{0xCB})} keys %{$bli->{4}->{0}})) {
+ $session->{blinternal_visbid} = $visbid;
+ my $typedata = $bli->{4}->{0}->{$visbid}->{data};
+ if($bli->{4}->{0}->{$visbid}->{__BLI_DIRTY}) {
+ ($session->{visibility}) = unpack("C", $typedata->{0xCA}) if $typedata->{0xCA};
+
+ my $groupperms = $typedata->{0xCB};
+ ($session->{groupperms}) = unpack("N", $groupperms) if $groupperms;
+ $session->{profile} = $typedata->{0x0100} if exists($typedata->{0x0100});
+ ($session->{icon_checksum}) = unpack("n", $typedata->{0x0101}) if exists($typedata->{0x0101});
+ ($session->{icon_timestamp}) = unpack("N", $typedata->{0x0102}) if exists($typedata->{0x0102});
+ ($session->{icon_length}) = unpack("N", $typedata->{0x0103}) if exists($typedata->{0x0103});
+
+ $session->{appdata} = $typedata;
+
+ $session->set_info($session->{profile}) if exists($session->{profile});
+
+ $bli->{4}->{0}->{$visbid}->{__BLI_DIRTY} = 0;
+ }
+ } else {
+ # No permit info - we permit everyone
+ $session->{visibility} = VISMODE_PERMITALL;
+ $session->{groupperms} = 0xFFFFFFFF;
+ }
+
+ if(exists $bli->{0x14} and exists $bli->{0x14}->{0} and (my($iconbid) = grep {exists($bli->{0x14}->{0}->{$_}->{data}->{0xD5})} keys %{$bli->{0x14}->{0}})) {
+ $session->{blinternal_iconbid} = $iconbid;
+ my $typedata = $bli->{0x14}->{0}->{$iconbid}->{data};
+ $session->{icon_md5sum} = $typedata->{0xD5};
+ }
+
+
+ my @ret;
+
+ foreach my $gid (keys %{$bli->{1}}) {
+ next unless exists $bli->{1}->{$gid}->{0};
+ my $item = $bli->{1}->{$gid}->{0};
+
+ if($item->{__BLI_DELETED}) {
+ delete $bli->{1}->{$gid}->{0};
+ next if $gid == 0 or !$item->{name};
+
+ delete $session->{buddies}->{$item->{name}};
+ push @ret, {type => MODBL_WHAT_GROUP, action => MODBL_ACTION_DEL, group => $item->{name}};
+ } elsif($item->{__BLI_DIRTY}) {
+ $item->{__BLI_DIRTY} = 0;
+ next if $gid == 0 or !$item->{name};
+
+ $session->{buddies}->{$item->{name}} ||= {};
+ my $entry = $session->{buddies}->{$item->{name}};
+
+ $entry->{__BLI_DIRTY} = 0;
+ $entry->{__BLI_DELETED} = 0;
+ $entry->{groupid} = $gid;
+ $entry->{members} = bltie unless $entry->{members};
+ $entry->{data} = $item->{data};
+
+ push @ret, {type => MODBL_WHAT_GROUP, action => MODBL_ACTION_ADD, group => $item->{name}};
+ }
+ }
+
+ foreach my $gid (keys %{$bli->{0}}) {
+ foreach my $bid (keys %{$bli->{0}->{$gid}}) {
+ my $item = $bli->{0}->{$gid}->{$bid};
+ my $group = "";
+ $group = $bli->{1}->{$gid}->{0}->{name} if chain_exists($bli, 1, $gid, 0);
+
+ if($item->{__BLI_DELETED}) {
+ delete $bli->{0}->{$gid}->{$bid};
+ next if $gid == 0 or !$group;
+
+ delete $session->{buddies}->{$group}->{members}->{$item->{name}} if $group;
+ push @ret, {type => MODBL_WHAT_BUDDY, action => MODBL_ACTION_DEL, group => $group, buddy => $item->{name}};
+ } elsif($item->{__BLI_DIRTY}) {
+ $item->{__BLI_DIRTY} = 0;
+ next if $gid == 0 or !$group;
+
+ my $comment = undef;
+ $comment = $item->{data}->{0x13C} if exists($item->{data}->{0x13C});
+
+ my $alias = undef;
+ $alias = $item->{data}->{0x131} if exists($item->{data}->{0x131});
+
+ $session->{buddies}->{$group}->{members}->{$item->{name}} ||= {};
+ my $entry = $session->{buddies}->{$group}->{members}->{$item->{name}};
+ $entry->{__BLI_DIRTY} = 0;
+ $entry->{__BLI_DELETED} = 0;
+ $entry->{buddyid} = $bid;
+ $entry->{online} = 0 unless exists($entry->{online});
+ $entry->{comment} = $comment;
+ $entry->{alias} = $alias;
+ $entry->{data} = $item->{data};
+ $entry->{screenname} = Net::OSCAR::Screenname->new($item->{name});
+
+ push @ret, {type => MODBL_WHAT_BUDDY, action => MODBL_ACTION_ADD, group => $group, buddy => $item->{name}};
+ }
+ }
+ }
+
+ return @ret;
+}
+
+# Gee, guess what this does? Hint: see sub BLI_to_NO.
+sub NO_to_BLI($) {
+ my $session = shift;
+
+ my $bli = tlv();
+ my $oldbli = $session->{blinternal};
+
+ # Copy old data
+ my $visbid = $session->{blinternal_visbid} || int(rand(30000)) + 1;
+ my $iconbid = $session->{blinternal_iconbid} || 0x51F4;
+ foreach my $type (keys %$oldbli) {
+ next if $type == 2 or $type == 3;
+ foreach my $gid (keys %{$oldbli->{$type}}) {
+ foreach my $bid (keys %{$oldbli->{$type}->{$gid}}) {
+ next if $type == 4 and $bid == $visbid;
+ next if $type == 0x14 and $bid == $iconbid;
+
+ init_entry($bli, $type, $gid, $bid);
+ $bli->{$type}->{$gid}->{$bid}->{name} = $oldbli->{$type}->{$gid}->{$bid}->{name};
+ foreach my $data (keys %{$oldbli->{$type}->{$gid}->{$bid}->{data}}) {
+ $bli->{$type}->{$gid}->{$bid}->{data}->{$data} = $oldbli->{$type}->{$gid}->{$bid}->{data}->{$data};
+ }
+ }
+ }
+ }
+
+
+ foreach my $permit (keys %{$session->{permit}}) {
+ init_entry($bli, 2, 0, $session->{permit}->{$permit}->{buddyid});
+ $bli->{2}->{0}->{$session->{permit}->{$permit}->{buddyid}}->{name} = $permit;
+ }
+
+ foreach my $deny (keys %{$session->{deny}}) {
+ init_entry($bli, 3, 0, $session->{deny}->{$deny}->{buddyid});
+ $bli->{3}->{0}->{$session->{deny}->{$deny}->{buddyid}}->{name} = $deny;
+ }
+
+ init_entry($bli, 4, 0, $visbid);
+ $bli->{4}->{0}->{$visbid}->{data}->{0xCA} = pack("C", $session->{visibility} || VISMODE_PERMITALL);
+ $bli->{4}->{0}->{$visbid}->{data}->{0xCB} = pack("N", $session->{groupperms} || 0xFFFFFFFF);
+
+ #Net::OSCAR protocol extensions
+ $bli->{4}->{0}->{$visbid}->{data}->{0x0100} = $session->{profile} if $session->{profile};
+ $bli->{4}->{0}->{$visbid}->{data}->{0x0101} = pack("n", $session->{icon_checksum}) if $session->{icon_checksum};
+ $bli->{4}->{0}->{$visbid}->{data}->{0x0102} = pack("N", $session->{icon_timestamp}) if $session->{icon_timestamp};
+ $bli->{4}->{0}->{$visbid}->{data}->{0x0103} = pack("N", $session->{icon_length}) if $session->{icon_length};
+
+ foreach my $appdata(keys %{$session->{appdata}}) {
+ $bli->{4}->{0}->{$visbid}->{data}->{$appdata} = $session->{appdata}->{$appdata};
+ }
+
+ if(exists($session->{icon_md5sum}) || chain_exists($oldbli, 0x14, 0, $iconbid)) {
+ init_entry($bli, 0x14, 0, $iconbid);
+
+ if(chain_exists($oldbli, 0x14, 0, $iconbid)) {
+ $bli->{0x14}->{0}->{$iconbid}->{name} = $oldbli->{0x14}->{0}->{$iconbid}->{name};
+
+ $bli->{0x14}->{0}->{$iconbid}->{data}->{$_} = $oldbli->{0x14}->{0}->{$iconbid}->{data}->{$_}
+ foreach grep { $_ != 0xD5 } keys %{$oldbli->{0x14}->{0}->{$iconbid}->{data}};
+ } else {
+ $bli->{0x14}->{0}->{$iconbid}->{name} = "1";
+ }
+
+ if(exists($session->{icon_md5sum})) {
+ $bli->{0x14}->{0}->{$iconbid}->{data}->{0xD5} = $session->{icon_md5sum};
+ }
+ }
+
+ init_entry($bli, 1, 0, 0);
+ if($session->{buddies}->{__BLI_DIRTY}) {
+ $bli->{1}->{0}->{0}->{data}->{0xC8} = pack("n*", map { $_->{groupid} } grep { ref($_) } values %{$session->{buddies}});
+ $session->{buddies}->{__BLI_DIRTY} = 0;
+ } else {
+ $bli->{1}->{0}->{0}->{__BLI_SKIP} = 1;
+ $oldbli->{1}->{0}->{0}->{__BLI_SKIP} = 1;
+ }
+
+ while(my($grpname, $grp) = each(%{$session->{buddies}})) {
+ next if $grpname eq "__BLI_DIRTY";
+
+ my $gid = $grp->{groupid};
+
+ if($grp->{__BLI_DELETED}) {
+ delete $session->{buddies}->{$grpname};
+ delete $bli->{1}->{$gid}->{0};
+ next;
+ }
+
+ if(not $grp->{__BLI_DIRTY}) {
+ $bli->{1}->{$gid}->{0}->{__BLI_SKIP} = 1;
+ $oldbli->{1}->{$gid}->{0}->{__BLI_SKIP} = 1;
+ next;
+ } else {
+ $grp->{__BLI_DIRTY} = 0;
+ }
+
+ init_entry($bli, 1, $gid, 0);
+ my $bligrp = $bli->{1}->{$gid}->{0};
+ $bligrp->{name} = $grpname;
+
+
+ # Clear out data, since the user may have deleted keys.
+ $bli->{1}->{$gid}->{0}->{data} = tlv();
+
+ # It seems that WinAIM can now have groups without 0xC8 data, and gets pissed if we create such data where it doesn't exist.
+ if(!exists($oldbli->{1}->{$gid}) or chain_exists($oldbli, 1, $gid, 0, "data", 0xC8)) {
+ $bligrp->{data}->{0xC8} = pack("n*",
+ map { $_->{buddyid} }
+ grep { not $_->{__BLI_DELETED} }
+ values %{$grp->{members}});
+ }
+
+ if(chain_exists($oldbli, 1, $gid, 0)) {
+ $bli->{1}->{$gid}->{0}->{data}->{$_} = $oldbli->{1}->{$gid}->{0}->{data}->{$_}
+ foreach grep { $_ != 0xC8 } keys %{$oldbli->{1}->{$gid}->{0}->{data}};
+ }
+
+
+ while(my($buddy, $bud) = each(%{$grp->{members}})) {
+ my $bid = $bud->{buddyid};
+
+ if($bud->{__BLI_DELETED}) {
+ delete $grp->{members}->{$buddy};
+ delete $bli->{0}->{$gid}->{$bid};
+ next;
+ }
+
+ if(not $bud->{__BLI_DIRTY}) {
+ $bli->{0}->{$gid}->{$bid}->{__BLI_SKIP} = 1;
+ $oldbli->{0}->{$gid}->{$bid}->{__BLI_SKIP} = 1;
+ next;
+ } else {
+ $bud->{__BLI_DIRTY} = 0;
+ }
+
+ next unless $bid;
+ init_entry($bli, 0, $gid, $bid);
+ my $blibud = $bli->{0}->{$gid}->{$bid};
+ $blibud->{name} = "$buddy"; # Make sure to get strinfied version of Screenname
+
+ $blibud->{data} = tlv();
+ while(my ($key, $value) = each(%{$bud->{data}})) {
+ $blibud->{data}->{$key} = $value;
+ }
+ $blibud->{data}->{0x13C} = $bud->{comment} if defined $bud->{comment};
+ $blibud->{data}->{0x131} = $bud->{alias} if defined $bud->{alias};
+ }
+ }
+
+ BLI_to_OSCAR($session, $bli);
+}
+
+# Send changes to BLI over to OSCAR
+sub BLI_to_OSCAR($$) {
+ my($session, $newbli) = @_;
+ my $oldbli = $session->{blinternal};
+ my (@adds, @modifies, @deletes);
+ $session->crapout($session->{services}->{0+CONNTYPE_BOS}, "You must wait for a buddylist_ok or buddylist_error callback before calling commit_buddylist again.") if $session->{budmods};
+ $session->{budmods} = [];
+
+ my %budmods;
+ $budmods{add} = [];
+ $budmods{modify} = [];
+ $budmods{delete} = [];
+
+ # First, delete stuff that we no longer use and modify everything else
+ foreach my $type(keys %$oldbli) {
+
+ my $budtype = (BUDTYPES)[$type] || "unknown type $type";
+
+ foreach my $gid(keys %{$oldbli->{$type}}) {
+ foreach my $bid(keys %{$oldbli->{$type}->{$gid}}) {
+ my $oldentry = $oldbli->{$type}->{$gid}->{$bid};
+ if($oldentry->{__BLI_SKIP}) {
+ delete $oldentry->{__BLI_SKIP};
+ next;
+ }
+
+ my $olddata = tlv_encode($oldentry->{data});
+ $session->log_printf_cond(OSCAR_DBG_DEBUG, sub { "Old BLI entry %s 0x%04X/0x%04X/0x%04X with %d bytes of data:%s", $oldentry->{name}, $type, $gid, $bid, length($olddata), hexdump($olddata) });
+ my $delete = 0;
+ if(exists($newbli->{$type}) and exists($newbli->{$type}->{$gid}) and exists($newbli->{$type}->{$gid}->{$bid})) {
+ my $newentry = $newbli->{$type}->{$gid}->{$bid};
+ my $newdata = tlv_encode($newentry->{data});
+ $session->log_printf_cond(OSCAR_DBG_DEBUG, sub { "New BLI entry %s 0x%04X/0x%04X/0x%04X with %d bytes of data:%s", $newentry->{name}, $type, $gid, $bid, length($newdata), hexdump($newdata) });
+
+ next if
+ $newentry->{name} eq $oldentry->{name}
+ and $newdata eq $olddata;
+
+ # Apparently, we can't modify the name of a buddylist entry?
+ if($newentry->{name} ne $oldentry->{name}) {
+ $delete = 1;
+ } else {
+ $session->log_print(OSCAR_DBG_DEBUG, "Modifying.");
+
+ push @{$budmods{modify}}, {
+ reqdata => {desc => "modifying $budtype $newentry->{name}", type => $type, gid => $gid, bid => $bid},
+ protodata => {
+ entry_name => $newentry->{name},
+ group_id => $gid,
+ buddy_id => $bid,
+ entry_type => $type,
+ entry_data => $newdata
+ }
+ };
+ }
+ } else {
+ $delete = 1;
+ }
+
+ if($delete) {
+ $session->log_print(OSCAR_DBG_DEBUG, "Deleting.");
+
+ push @{$budmods{delete}}, {
+ reqdata => {desc => "deleting $budtype $oldentry->{name}", type => $type, gid => $gid, bid => $bid},
+ protodata => {
+ entry_name => $oldentry->{name},
+ group_id => $gid,
+ buddy_id => $bid,
+ entry_type => $type,
+ entry_data => $olddata
+ }
+ };
+ }
+ }
+ }
+ }
+
+ # Now, add the new stuff
+ foreach my $type(keys %$newbli) {
+
+ my $budtype = (BUDTYPES)[$type] || "unknown type $type";
+
+ foreach my $gid(keys %{$newbli->{$type}}) {
+ foreach my $bid(keys %{$newbli->{$type}->{$gid}}) {
+ my $entry = $newbli->{$type}->{$gid}->{$bid};
+ if($entry->{__BLI_SKIP}) {
+ delete $entry->{__BLI_SKIP};
+ next;
+ }
+
+ next if exists($oldbli->{$type}) and exists($oldbli->{$type}->{$gid}) and exists($oldbli->{$type}->{$gid}->{$bid}) and $oldbli->{$type}->{$gid}->{$bid}->{name} eq $newbli->{$type}->{$gid}->{$bid}->{name};
+
+ my $data = tlv_encode($entry->{data});
+
+ $session->log_printf_cond(OSCAR_DBG_DEBUG, sub { "New BLI entry %s 0x%04X/0x%04X/0x%04X with %d bytes of data:%s", $entry->{name}, $type, $gid, $bid, length($data), hexdump($data) });
+
+ push @{$budmods{add}}, {
+ reqdata => {desc => "adding $budtype $entry->{name}", type => $type, gid => $gid, bid => $bid},
+ protodata => {
+ entry_name => $entry->{name},
+ group_id => $gid,
+ buddy_id => $bid,
+ entry_type => $type,
+ entry_data => $data
+ }
+ };
+ }
+ }
+ }
+
+ # Actually send the changes. Don't send more than 7K in a single SNAC.
+ # FLAP size limit is 8K, but that includes headers - good to have a safety margin
+ foreach my $type (qw(add modify delete)) {
+ my $changelist = $budmods{$type};
+
+ my(@reqdata, @packets);
+ my $packet = "";
+ foreach my $change(@$changelist) {
+ $packet .= protoparse($session, "buddylist_modification")->pack(%{$change->{protodata}});
+ push @reqdata, $change->{reqdata};
+
+ if(length($packet) > 7*1024) {
+ #$session->log_print(OSCAR_DBG_INFO, "Adding to blmod queue (max packet size reached): type $type, payload size ", scalar(@reqdata));
+ push @packets, {
+ type => $type,
+ data => $packet,
+ reqdata => [@reqdata],
+ };
+ $packet = "";
+ @reqdata = ();
+ }
+ }
+ if($packet) {
+ #$session->log_print(OSCAR_DBG_INFO, "Adding to blmod queue (no more changes): type $type, payload size ", scalar(@reqdata));
+ push @packets, {
+ type => $type,
+ data => $packet,
+ reqdata => [@reqdata],
+ };
+ }
+
+ push @{$session->{budmods}}, map {
+ {
+ protobit => "buddylist_" . $_->{type},
+ reqdata => $_->{reqdata},
+ protodata => {mods => $_->{data}}
+ };
+ } @packets;
+ }
+
+ push @{$session->{budmods}}, {protobit => "end_buddylist_modifications"}; # End BL mods
+ #$session->log_print(OSCAR_DBG_INFO, "Adding terminator to blmod queue.");
+
+ $session->{blold} = $oldbli;
+ $session->{blinternal} = $newbli;
+
+ if(@{$session->{budmods}} <= 1) { # We only have the start/end modification packets, no actual changes
+ #$session->log_print(OSCAR_DBG_INFO, "Empty blmod queue - calling buddylist_ok.");
+ delete $session->{budmods};
+ $session->callback_buddylist_ok();
+ } else {
+ #$session->log_print(OSCAR_DBG_INFO, "Non-empty blmod queue - sending initiator and first change packet.");
+ $session->svcdo(CONNTYPE_BOS, protobit => "start_buddylist_modifications");
+ $session->svcdo(CONNTYPE_BOS, %{shift @{$session->{budmods}}}); # Send the first modification
+ }
+}
+
+sub chain_exists($@) {
+ my($tlv, @refs) = @_;
+
+ while(@refs) {
+ my $ref = shift @refs;
+ if(exists($tlv->{$ref})) {
+ $tlv = $tlv->{$ref};
+ } else {
+ return 0;
+ }
+ }
+
+ return defined($tlv) ? 1 : 0;
+}
+
+1;
Added: branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR.pm
===================================================================
--- branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR.pm (rev 0)
+++ branches/barnowl_perlaim/owl/perl/modules/AIM/lib/Net/OSCAR.pm 2008-06-01 07:51:40 UTC (rev 1074)
@@ -0,0 +1,4500 @@
+package Net::OSCAR;
+
+$VERSION = '1.925';
+$REVISION = '$Revision: 1.221 $';
+
+=pod
+
+=head1 NAME
+
+Net::OSCAR - Implementation of AOL's OSCAR protocol for instant messaging (for interacting with AIM a.k.a. AOL IM a.k.a. AOL Instant Messenger - and ICQ, too!)
+
+=head1 SYNOPSIS
+
+ use Net::OSCAR qw(:standard);
+
+ sub im_in {
+ my($oscar, $sender, $message, $is_away) = @_;
+ print "[AWAY] " if $is_away;
+ print "$sender: $message\n";
+ }
+
+ $oscar = Net::OSCAR->new();
+ $oscar->set_callback_im_in(\&im_in);
+ $oscar->signon($screenname, $password);
+ while(1) {
+ $oscar->do_one_loop();
+ # Do stuff
+ }
+
+=head1 INSTALLATION
+
+=head2 HOW TO INSTALL
+
+ perl Build.PL
+ perl Build
+ perl Build test
+ perl Build install
+
+See C<perldoc Module::Build> for details.
+Note that this requires that you have the perl module Module::Build installed.
+If you don't, the traditional C<perl Makefile.PL ; make ; make test ; make install>
+should still work.
+
+=head2 DEPENDENCIES
+
+This modules requires C<Digest::MD5> and C<Scalar::Util>. C<Test::More> is needed
+to run the test suite, and C<XML::Parser> is needed to generate the XML parse tree
+which is shipped with released versions.
+
+=head1 INTRODUCTION
+
+=head2 ABSTRACT
+
+C<Net::OSCAR> implements the OSCAR protocol which is used by AOL's AOL Instant
+Messenger service. To use the module, you create a C<Net::OSCAR> object,
+register some functions as handlers for various events by using the module's
+callback mechanism, and then continually make calls to the module's event
+processing methods.
+
+You probably want to use the C<:standard> parameter when importing this module
+in order to have a few important constants added to your namespace. See
+L<"CONSTANTS"> below for a list of the constants exported by the C<:standard> tag.
+
+No official documentation exists for the OSCAR protocol, so it had to be figured
+out by analyzing traffic generated by AOL's official AOL Instant Messenger client.
+Source code from the Gaim client, the protocol analysis provided by the Ethereal
+network sniffer, and the Alexander Shutko's website
+E<lt>http://iserverd1.khstu.ru/oscar/E<gt> were also used as references.
+
+This module strives to be as compatible with C<Net::AIM> as possible at the API level, but some
+protocol-level differences prevent total compatibility. The TOC protocol implemented
+by C<Net::AIM> is simpler than OSCAR and has official reference documentation from AOL,
+but it only provides a small subset of the full C<OSCAR> functionality.
+See the section on L<Net::AIM Compatibility> for more information.
+
+=head2 EVENT PROCESSING OVERVIEW
+
+Event processing is the implementation of C<Net::OSCAR> within the framework of your
+program, so that your program can respond to things happening on the OSCAR servers while
+still doing everything else that you need it to do, such as accepting user input. There are three main ways for the module to handle event processing. The simplest is to
+call the L<do_one_loop> method, which performs a C<select> call on all the object's
+sockets and reads incoming commands from the OSCAR server on any connections which
+have them. The C<select> call has a default timeout of 0.01 seconds which can
+be adjusted using the L<timeout> method. This means that every time you call L<do_one_loop>,
+it will pause for that interval if there are no messages from the OSCAR server.
+If you need lower overhead, want better performance, or need to handle many Net::OSCAR objects and/or other files and sockets
+at once, see L<HIGH-PERFORMANCE EVENT PROCESSING> below.
+
+=head2 FUNCTIONALITY
+
+C<Net::OSCAR> pretends to be WinAIM 5.5.3595. It supports remote buddylists
+including permit and deny settings. It also supports chat, buddy icons,
+and extended status messages. At the present time, setting and retrieving of
+directory information is not supported; nor are email privacy settings,
+voice chat, stock ticker, file transfer, direct IM, and many other of the
+official AOL Instant Messenger client's features.
+
+=head2 TERMINOLOGY
+
+When you sign on with the OSCAR service, you are establishing an OSCAR session.
+
+=head2 CALLBACKS
+
+C<Net::OSCAR> uses a callback mechanism to notify you about different events.
+A callback is a function provided by you which C<Net::OSCAR> will call
+when a certain event occurs. To register a callback, calling the C<set_callback_callbackname> method
+with a code reference as a parameter. For instance, you might call
+C<$oscar-E<gt>set_callback_error(\&got_error);>. Your callback function will
+be passed parameters which are different for each callback type (and are
+documented below). The first parameter to each callback function will be
+the C<Net::OSCAR> object which generated the callback. This is useful
+when using multiple C<Net::OSCAR> objects.
+
+=head1 REFERENCE
+
+=cut
+
+use 5.006_001;
+use strict;
+use vars qw($VERSION $REVISION @ISA @EXPORT_OK %EXPORT_TAGS $NODESTROY);
+use Carp;
+use Scalar::Util qw(weaken);
+use Digest::MD5 qw(md5);
+use Socket;
+use Net::OSCAR::Common qw(:all);
+use Net::OSCAR::Constants;
+use Net::OSCAR::Utility;
+use Net::OSCAR::Connection;
+use Net::OSCAR::Callbacks;
+use Net::OSCAR::TLV;
+use Net::OSCAR::Buddylist;
+use Net::OSCAR::Screenname;
+use Net::OSCAR::_BLInternal;
+use Net::OSCAR::XML;
+
+$NODESTROY = 0;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = @Net::OSCAR::Common::EXPORT_OK;
+%EXPORT_TAGS = %Net::OSCAR::Common::EXPORT_TAGS;
+
+Net::OSCAR::XML::load_xml();
+
+=pod
+
+=head2 BASIC FUNCTIONALITY
+
+=head3 METHODS
+
+=over 4
+
+=item new ([capabilities =E<gt> CAPABILITIES], [rate_manage =E<gt> RATE_MANAGE_MODE])
+
+Creates a new C<Net::OSCAR> object. You may optionally
+pass a hash to set some parameters for the object.
+
+=over 4
+
+=item capabilities
+
+A listref of optional features that your client supports.
+Valid capabilities are:
+
+=over 4
+
+=item extended_status
+
+iChat-style extended status messages
+
+=item buddy_icons
+
+=item file_transfer
+
+=item file_sharing
+
+=item typing_status
+
+Typing status notification
+
+=item buddy_list_transfer
+
+=back
+
+=item rate_manage
+
+Which mechanism will your application be using to deal with
+the sending rates which the server enforces on the client?
+See L<"RATE LIMIT OVERVIEW"> for more information on the subject.
+
+=over 4
+
+=item OSCAR_RATE_MANAGE_NONE
+
+=item OSCAR_RATE_MANAGE_AUTO
+
+=item OSCAR_RATE_MANAGE_MANUAL
+
+=back
+
+=back
+
+ $oscar = Net::OSCAR->new(capabilities => [qw(extended_status typing_status)], rate_manage => OSCAR_RATE_MANAGE_AUTO);
+
+=cut
+
+sub new($) {
+ my $class = ref($_[0]) || $_[0] || "Net::OSCAR";
+ shift;
+
+ my $self = {
+ options => {},
+ _parameters => [@_]
+ };
+ bless $self, $class;
+
+ my(%parameters) = @_;
+ if(my($badparam) = grep { $_ ne "capabilities" and $_ ne "rate_manage" } keys %parameters) {
+ croak "Invalid parameter '$badparam' passed to Net::OSCAR::new.";
+ }
+ if($parameters{capabilities}) {
+ if(my($badcap) = grep { $_ ne "extended_status" and $_ ne "buddy_icons" and $_ ne "file_transfer" and $_ ne "file_sharing" and $_ ne "typing_status" and $_ ne "file_transfer" and $_ ne "buddy_list_transfer" } @{$parameters{capabilities}}) {
+ croak "Invalid capability '$badcap' passed to Net::OSCAR::new.";
+ }
+ }
+ if($parameters{rate_manage}) {
+ if($parameters{rate_manage} < OSCAR_RATE_MANAGE_NONE or $parameters{rate_manage} > OSCAR_RATE_MANAGE_MANUAL) {
+ croak "Invalid rate_manage value '$parameters{rate_manage}' passed to Net::OSCAR::new.";
+ } elsif($parameters{rate_manage} == OSCAR_RATE_MANAGE_AUTO) {
+ croak "OSCAR_RATE_MANAGE_AUTO hasn't been implemented yet!";
+ } else {
+ $self->{rate_manage_mode} = $parameters{rate_manage};
+ if($self->{rate_manage_mode} != OSCAR_RATE_MANAGE_NONE) {
+ require Net::OSCAR::MethodInfo;
+ }
+ }
+ } else {
+ $self->{rate_manage_mode} = OSCAR_RATE_MANAGE_NONE;
+ }
+
+ $self->{LOGLEVEL} = OSCAR_DBG_WARN;
+ $self->{SNDEBUG} = 0;
+ $self->{__BLI_locked} = 0;
+ $self->{__BLI_commit_later} = 0;
+
+ $self->{description} = "OSCAR session";
+ $self->{userinfo} = bltie;
+ $self->{services} = tlv;
+ $self->{svcqueues} = tlv;
+ $self->{listener} = undef;
+ $self->{rv_proposals} = {};
+ $self->{pass_is_hashed} = 0;
+ $self->{stealth} = 0;
+ $self->{icq_meta_info_cache} = {};
+ $self->{ip} = 0;
+
+ $self->{ft_ip} = undef;
+ $self->{rv_neg_mode} = OSCAR_RV_AUTO;
+ $self->{bl_limits} = {
+ buddies => 0,
+ groups => 0,
+ permits => 0,
+ denies => 0
+ };
+
+ $self->{timeout} = 0.01;
+ $self->{capabilities} = {};
+
+ if($parameters{capabilities}) {
+ $self->{capabilities}->{$_} = 1 foreach @{$parameters{capabilities}};
+ }
+
+ # Set default callbacks
+ $self->set_callback_snac_unknown(\&Net::OSCAR::Callbacks::default_snac_unknown);
+
+ return $self;
+}
+
+=pod
+
+=item signon (HASH)
+
+=item signon (SCREENNAME, PASSWORD[, HOST, PORT]
+
+Sign on to the OSCAR service. You can specify an
+alternate host/port to connect to. The default is
+login.oscar.aol.com port 5190.
+
+The non-hash form of C<signon> is obsolete and is only provided for compatibility with C<Net::AIM>.
+If you use a hash to pass parameters to this function, here are the valid keys:
+
+=over 4
+
+=item screenname
+
+=item password
+
+Screenname and password are mandatory. The other keys are optional.
+In the special case of password being present but undefined, the
+auth_challenge callback will be used - see L<"auth_challenge"> for details.
+
+=item stealth
+
+Use this to sign on with stealth mode activated. Using this, as opposed
+to signon on without this setting and then calling L<"set_stealth">, will prevent
+the user from showing as online for a brief interval after signon. See L<"set_stealth">
+for information about stealth mode.
+
+=item pass_is_hashed
+
+If you want to give Net::OSCAR the MD5 hash of the password instead of the password
+itself, use the MD5'd password in the password key and also set this key. The
+benefit of this is that, if your application saves user passwords, you can save
+them in hashed form and don't need to store the plaintext.
+
+=item local_ip
+
+If you have more than one IP address with a route to the internet, this
+parameter can be used to specify which to use as the source IP for outgoing
+connections.
+
+=item local_port
+
+This controls which port Net::OSCAR will listen on for incoming direct connections.
+If not specified, a random port will be selected.
+
+=item host
+
+=item port
+
+=item proxy_type
+
+Either "SOCKS4", "SOCKS5", "HTTP", or HTTPS. This and C<proxy_host> must be specified if you wish to use a proxy.
+C<proxy_port>, C<proxy_username>, C<proxy_password> are optional. Note that proxy support
+is considered experimental. You will need to have the C<Net::SOCKS> module installed for
+SOCKS proxying or the C<LWP::UserAgent> module installed for HTTP proxying.
+
+=item proxy_host
+
+=item proxy_port
+
+=item proxy_username
+
+=item proxy_password
+
+=back
+
+If the screenname is all-numeric, it will automatically be treated
+as an ICQ UIN instead of an AIM screenname.
+
+=cut
+
+sub signon($@) {
+ my($self, $password, $host, %args);
+ $self = shift;
+
+ # Determine whether caller is using hash-method or old method of passing parms.
+ # Note that this breaks if caller passes in both a host and a port using the old way.
+ # But hey, that's why it's deprecated!
+ if(@_ < 3) {
+ $args{screenname} = shift @_ or return $self->crapout($self->{services}->{0+CONNTYPE_BOS}, "You must specify a username to sign on with!");
+ $args{password} = shift @_ or return $self->crapout($self->{services}->{0+CONNTYPE_BOS}, "You must specify a password to sign on with!");;
+ $args{host} = shift @_ if @_;
+ $args{port} = shift @_ if @_;
+ } else {
+ %args = @_;
+ return $self->crapout($self->{services}->{0+CONNTYPE_BOS}, "You must specify a username and password to sign on with!") unless $args{screenname} and exists($args{password});
+ }
+
+ my %defaults = OSCAR_SVC_AIM;
+ %defaults = OSCAR_SVC_ICQ if $args{screenname} =~ /^\d+$/;
+ foreach my $key(keys %defaults) {
+ $args{$key} ||= $defaults{$key};
+ }
+ return $self->crapout($self->{services}->{0+CONNTYPE_BOS}, "MD5 authentication not available for this service (you must define a password.)") if !defined($args{password}) and $args{hashlogin};
+ $self->{screenname} = Net::OSCAR::Screenname->new(\$args{screenname});
+
+ # We set BOS to the login connection so that our error handlers pick up errors on this connection as fatal.
+ $args{host} ||= "login.oscar.aol.com";
+ $args{port} ||= 5190;
+
+
+ ($self->{screenname}, $password, $host, $self->{port},
+ $self->{proxy_type}, $self->{proxy_host}, $self->{proxy_port},
+ $self->{proxy_username}, $self->{proxy_password}, $self->{local_ip},
+ $self->{local_port}, $self->{pass_is_hashed}, $self->{stealth}) =
+ delete @args{qw(screenname password host port proxy_type proxy_host proxy_port proxy_username proxy_password local_ip local_port pass_is_hashed stealth)};
+
+ $self->{svcdata} = \%args;
+
+ if(defined($self->{proxy_type})) {
+ $self->{proxy_type} = uc($self->{proxy_type});
+ die "You must specify proxy_host if proxy_type is specified!\n" unless $self->{proxy_host};
+ if($self->{proxy_type} eq "HTTP" or $self->{proxy_type} eq "HTTPS") {
+ $self->{http_proxy} = LWP::UserAgent->new(
+ agent => "Mozilla/4.08 [en] (WinNT; U ;Nav)",
+ keep_alive => 1,
+ timeout => 30,
+ );
+ die "HTTPS not supported by your LWP::UserAgent\n" if $self->{proxy_type} eq "HTTPS" and !$self->{http_proxy}->is_protocol_supported("https");
+
+ my $proxyurl = lc($self->{proxy_type}) . "://$self->{proxy_host}";
+ $proxyurl .= ":$self->{proxy_port}" if $self->{proxy_port};
+ $proxyurl .= "/";
+ $self->{http_proxy}->proxy('http', $proxyurl);
+ }
+ }
+
+ $self->{services}->{0+CONNTYPE_BOS} = $self->addconn(auth => $password, conntype => CONNTYPE_LOGIN, description => "login", peer => $host);
+}
+
+=pod
+
+=item signoff
+
+Sign off from the OSCAR service.
+
+=cut
+
+sub signoff($) {
+ my $self = shift;
+ foreach my $connection(@{$self->{connections}}) {
+ $self->delconn($connection);
+ }
+ my $screenname = $self->{screenname};
+ %$self = ();
+ $self->{screename} = $screenname; # Useful for post-mortem processing in multiconnection apps
+}
+
+=pod
+
+=back
+
+=head3 CALLBACKS
+
+=over 4
+
+=item signon_done (OSCAR)
+
+Called when the user is completely signed on to the service.
+
+=back
+
+=head2 BUDDIES AND BUDDYLISTS
+
+See also L<"OTHER USERS"> for methods which pertain to any other user, regardless of
+whether they're on the buddylist or not.
+
+=head3 METHODS
+
+=over 4
+
+=item findbuddy (BUDDY)
+
+In scalar context, returns the name of the group that BUDDY is in, or undef if
+BUDDY could not be found in any group. If BUDDY is in multiple
+groups, will return the first one we find.
+
+In list context, returns a two-element list consisting of the group
+name followed by the group hashref (or the empty list of the buddy
+is not found.)
+
+=cut
+
+sub findbuddy($$) {
+ my($self, $buddy) = @_;
+
+ while(my($grpname, $group) = each(%{$self->{buddies}})) {
+ next if
+ $grpname eq "__BLI_DIRTY" or
+ !$group or
+ not $group->{members}->{$buddy} or
+ $group->{members}->{$buddy}->{__BLI_DELETED};
+
+ hash_iter_reset(\%{$self->{buddies}}); # Reset the iterator
+ return wantarray ? ($grpname, $group) : $grpname;
+ }
+ return;
+}
+
+=pod
+
+=item commit_buddylist
+
+Sends your modified buddylist to the OSCAR server. Changes to the buddylist
+won't actually take effect until this method is called. Methods that change
+the buddylist have a warning about needing to call this method in their
+documentation. After calling this method, your program B<MUST> not call
+it again until either the L<buddylist_ok> or L<buddylist_error> callbacks
+are received.
+
+=item rollback_buddylist
+
+Revert changes you've made to the buddylist, assuming you haven't called
+L<"commit_buddylist"> since making them.
+
+=item reorder_groups (GROUPS)
+
+Changes the ordering of the groups in your buddylist. Call L<"commit_buddylist"> to
+save the
+new order on the OSCAR server.
+
+=item reorder_buddies (GROUP, BUDDIES)
+
+Changes the ordering of the buddies in a group on your buddylist.
+Call L<"commit_buddylist"> to save the new order on the OSCAR server.
+
+=cut
+
+sub commit_buddylist($) {
+ my($self) = shift;
+ return must_be_on($self) unless $self->{is_on};
+
+ if($self->{__BLI_locked}) {
+ # If the server is modifying the buddylist,
+ # wait until its done to do the commit.
+ $self->{__BLI_commit_later} = 1;
+ return;
+ }
+
+ Net::OSCAR::_BLInternal::NO_to_BLI($self);
+
+ # If user set icon to same as old icon, server won't request an upload.
+ # Send a buddy_icon_uploaded callback anyway.
+ if($self->{icon_md5sum_old} and $self->{icon_md5sum} eq $self->{icon_md5sum_old}) {
+ $self->callback_buddy_icon_uploaded();
+ }
+
+ delete $self->{icon_md5sum_old};
+}
+
+sub rollback_buddylist($) {
+ my($self) = shift;
+ return must_be_on($self) unless $self->{is_on};
+ Net::OSCAR::_BLInternal::BLI_to_NO($self);
+}
+
+sub reorder_groups($@) {
+ my $self = shift;
+ return must_be_on($self) unless $self->{is_on};
+ my @groups = @_;
+ tied(%{$self->{buddies}})->setorder(@groups);
+ $self->{buddies}->{__BLI_DIRTY} = 1;
+}
+
+sub reorder_buddies($$@) {
+ my $self = shift;
+ return must_be_on($self) unless $self->{is_on};
+ my $group = shift;
+ my @buddies = @_;
+ tied(%{$self->{buddies}->{$group}->{members}})->setorder(@buddies);
+ $self->{buddies}->{$group}->{__BLI_DIRTY} = 1;
+}
+
+=pod
+
+=item rename_group (OLDNAME, NEWNAME)
+
+Renames a group. Call L<"commit_buddylist"> for the change to take effect.
+
+=item add_buddy (GROUP, BUDDIES)
+
+Adds buddies to the given group on your buddylist. If the group does not exist,
+it will be created. Call L<"commit_buddylist"> for the change to take effect.
+
+=item remove_buddy (GROUP, BUDDIES)
+
+See L<add_buddy>.
+
+=item add_group (GROUP)
+
+Creates a new, empty group. Call L<"commit_buddylist"> for the change to take effect.
+
+=item remove_group (GROUP)
+
+See L<add_group>. Any buddies in the group will be removed from the group first.
+
+=cut
+
+sub rename_group($$$) {
+ my($self, $oldgroup, $newgroup) = @_;
+ return must_be_on($self) unless $self->{is_on};
+ return send_error($self, $self->{services}->{0+CONNTYPE_BOS}, 0, "That group does not exist", 0) unless exists $self->{buddies}->{$oldgroup};
+
+ $self->{buddies}->{$newgroup} = $self->{buddies}->{$oldgroup};
+ $self->{buddies}->{$newgroup}->{__BLI_DIRTY} = 1;
+ delete $self->{buddies}->{$oldgroup};
+}
+
+sub add_buddy($$@) {
+ my($self, $group, @buddies) = @_;
+ $self->mod_buddylist(MODBL_ACTION_ADD, MODBL_WHAT_BUDDY, $group, @buddies);
+}
+
+sub remove_buddy($$@) {
+ my($self, $group, @buddies) = @_;
+ $self->mod_buddylist(MODBL_ACTION_DEL, MODBL_WHAT_BUDDY, $group, @buddies);
+}
+
+sub add_group($$) {
+ my($self, $group) = @_;
+ $self->mod_buddylist(MODBL_ACTION_ADD, MODBL_WHAT_GROUP, $group);
+}
+
+sub remove_group($$) {
+ my($self, $group) = @_;
+ return send_error($self, $self->{services}->{0+CONNTYPE_BOS}, 0, "That group does not exist", 0) unless exists $self->{buddies}->{$group};
+ $self->remove_buddy($group, $self->buddies($group)) if $self->buddies($group);
+ $self->mod_buddylist(MODBL_ACTION_DEL, MODBL_WHAT_GROUP, $group);
+}
+
+
+=item groups
+
+Returns a list of groups in the user's buddylist.
+
+=item buddies (GROUP)
+
+Returns the names of the buddies in the specified group in the user's buddylist.
+The names may not be formatted - that is, they may have spaces and capitalization
+removed. The names are C<Net::OSCAR::Screenname> objects, so you don't have to
+worry that they're case and whitespace insensitive when using them for comparison.
+
+=item buddy (BUDDY[, GROUP])
+
+Returns information about a buddy on the user's buddylist. This information is
+a hashref as per L<USER INFORMATION> below.
+
+=cut
+
+sub groups($) { return grep {$_ and $_ ne "__BLI_DIRTY"} keys %{shift->{buddies}}; }
+sub buddies($;$) {
+ my($self, $group) = @_;
+
+ if($group) {
+ my $grp = $self->{buddies}->{$group};
+
+ return grep {
+ not $grp->{members}->{$_}->{__BLI_DELETED}
+ } keys %{$grp->{members}};
+ }
+
+ my @buddies;
+ while(my($grpname, $group) = each(%{$self->{buddies}})) {
+ next if !$grpname or $grpname eq "__BLI_DIRTY";
+ push @buddies, grep { not $group->{members}->{$_}->{__BLI_DELETED} } keys %{$group->{members}};
+ }
+ return @buddies;
+}
+sub buddy($$;$) {
+ my($self, $buddy, $grpname) = @_;
+ my $group;
+
+ if(!$grpname) {
+ ($grpname, $group) = $self->findbuddy($buddy) or return;
+ } else {
+ $group = $self->{buddies}->{$grpname} or return;
+ }
+
+ my $ret = $group->{members}->{$buddy};
+ return $ret->{__BLI_DELETED} ? undef : $ret;
+
+ return $self->{userinfo}->{$buddy} || undef;
+}
+
+=pod
+
+=item set_buddy_comment (GROUP, BUDDY[, COMMENT])
+
+Set a brief comment about a buddy. You must call L<"commit_buddylist"> to save
+the comment to the server. If COMMENT is undefined, the comment is
+deleted.
+
+=item set_buddy_alias (GROUP, BUDDY[, ALIAS])
+
+Set an alias for a buddy. You must call L<"commit_buddylist"> to save
+the comment to the server. If ALIAS is undefined, the alias is
+deleted.
+
+=cut
+
+sub set_buddy_comment($$$;$) {
+ my($self, $group, $buddy, $comment) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ my $bud = $self->{buddies}->{$group}->{members}->{$buddy};
+ $bud->{comment} = $comment;
+ $bud->{__BLI_DIRTY} = 1;
+}
+
+sub set_buddy_alias($$$;$) {
+ my($self, $group, $buddy, $alias) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ my $bud = $self->{buddies}->{$group}->{members}->{$buddy};
+ $bud->{alias} = $alias;
+ $bud->{__BLI_DIRTY} = 1;
+}
+
+=pod
+
+=item buddylist_limits
+
+Returns a hash containing the maximum number of buddylist entries
+of various types. The keys in the hash are:
+
+=over 4
+
+=item *
+
+buddies
+
+=item *
+
+groups
+
+=item *
+
+permits
+
+=item *
+
+denies
+
+=back
+
+So, the maximum number of buddies allowed on a buddylist is stored in the C<buddies> key.
+Please note that buddylist storage has some overhead, so the actual number of items you
+can have on a buddylist may be slightly less than advertised.
+
+If the OSCAR server did not inform us of the limits, values of 0 will be used.
+
+=cut
+
+sub buddylist_limits($) { return %{shift->{bl_limits}}; }
+
+=pod
+
+=back
+
+=head3 CALLBACKS
+
+=over 4
+
+=item buddy_in (OSCAR, SCREENNAME, GROUP, BUDDY DATA)
+
+SCREENNAME (in buddy group GROUP) has signed on, or their information has
+changed. BUDDY DATA is the same as that returned by the L<buddy> method.
+
+=item buddy_out (OSCAR, SCREENNAME, GROUP)
+
+Called when a buddy has signed off (or added us to their deny list.)
+
+=item buddylist_error (OSCAR, ERROR, WHAT)
+
+This is called when there is an error commiting changes to the buddylist.
+C<ERROR> is the error number. C<WHAT> is a string describing which buddylist
+change failed. C<Net::OSCAR> will revert the failed change to
+its state before C<commit_buddylist> was called. Note that the
+buddylist contains information other than the user's buddies - see
+any method which says you need to call C<commit_buddylist> to have its
+changes take effect.
+
+=item buddylist_ok (OSCAR)
+
+This is called when your changes to the buddylist have been successfully commited.
+
+=item buddylist_changed (OSCAR, CHANGES)
+
+This is called when your buddylist is changed by the server.
+The most common reason for this to happen is if the screenname you are signed
+on with is also signed on somewhere else, and the buddylist is changed in
+the other session.
+
+Currently, only changes to buddies and groups will be listed in C<CHANGES>.
+Changes to privacy settings and any other portions of the buddylist will
+not be included in the list in the current version of C<Net::OSCAR>.
+
+C<CHANGES> is a list of hash references, one for each change to the buddylist,
+with the following keys:
+
+=over 4
+
+=item *
+
+type: Either C<MODBL_WHAT_BUDDY> or C<MODBL_WHAT_GROUP>. This indicates
+if the change was to a buddy or a group.
+
+=item *
+
+action: Either C<MODBL_ACTION_DEL> or C<MODBL_ACTION_ADD>. This indicates
+whether the change was an addition/modification or a deletion.
+
+=item *
+
+group: The name of the group which the modification took place in. For
+C<MODBL_WHAT_BUDDY>, this will be the name of the group which the
+changed buddy was changed in; for C<MODBL_WHAT_GROUP>, this will
+be the name of the group which was changed.
+
+=item *
+
+buddy: This key is only present for C<MODBL_WHAT_BUDDY>. It's the name
+of the buddy which was changed.
+
+=back
+
+The C<MODBL_*> constants come from C<Net::OSCAR::Common>, and
+are included in the C<:standard> export list.
+
+=back
+
+=head2 PRIVACY
+
+C<Net::OSCAR> supports privacy controls. Our visibility setting, along
+with the contents of the permit and deny lists, determines who can
+contact us. Visibility can be set to permit or deny everyone, permit only
+those on the permit list, deny only those on the deny list, or permit
+everyone on our buddylist.
+
+=head3 METHODS
+
+=over 4
+
+=item add_permit (BUDDIES)
+
+Add buddies to your permit list. Call L<"commit_buddylist"> for the
+change to take effect.
+
+=item add_deny (BUDDIES)
+
+See L<add_permit>.
+
+=item remove_permit (BUDDIES)
+
+See L<add_permit>.
+
+=item remove_deny (BUDDIES)
+
+See L<add_permit>.
+
+=item get_permitlist
+
+Returns a list of all members of the permit list.
+
+=item get_denylist
+
+Returns a list of all members of the deny list.
+
+=item visibility
+
+Returns the user's current visibility setting. See L<set_visibility>.
+
+=cut
+
+sub add_permit($@) { shift->mod_permit(MODBL_ACTION_ADD, "permit", @_); }
+sub add_deny($@) { shift->mod_permit(MODBL_ACTION_ADD, "deny", @_); }
+sub remove_permit($@) { shift->mod_permit(MODBL_ACTION_DEL, "permit", @_); }
+sub remove_deny($@) { shift->mod_permit(MODBL_ACTION_DEL, "deny", @_); }
+sub get_permitlist($) { return keys %{shift->{permit}}; }
+sub get_denylist(@) { return keys %{shift->{deny}}; }
+sub visibility($) { return shift->{visibility}; }
+
+
+=pod
+
+=item set_visibility (MODE)
+
+Sets the visibility mode, which determines how the permit and deny lists
+are interpreted. Note that if you're looking for the feature which will prevent
+a user from showing up as online on any buddy list while not affecting anything else,
+the droids you're looking for are L<"is_stealth">/L<"set_stealth">.
+
+The visibility mode may be:
+
+=over 4
+
+=item *
+
+VISMODE_PERMITALL: Permit everybody.
+
+=item *
+
+VISMODE_DENYALL: Deny everybody.
+
+=item *
+
+VISMODE_PERMITSOME: Permit only those on your permit list.
+
+=item *
+
+VISMODE_DENYSOME: Deny only those on your deny list.
+
+=item *
+
+VISMODE_PERMITBUDS: Same as VISMODE_PERMITSOME, but your permit list is made to be
+the same as the buddies from all the various groups in your
+buddylist (except the deny group!) Adding and removing buddies
+maintains this relationship. You shouldn't manually alter the
+permit or deny groups when using this visibility mode.
+
+=back
+
+These constants are contained in the C<Net::OSCAR::Common> package,
+and will be imported into your namespace if you import C<Net::OSCAR>
+with the C<:standard> parameter.
+
+When someone is permitted, they can see when you are online and
+send you messages. When someone is denied, they can't see when
+you are online or send you messages. You cannot see them or
+send them messages. You can talk to them if you are in the same
+chatroom, although neither of you can invite the other one into
+a chatroom.
+
+Call L<"commit_buddylist"> for the change to take effect.
+
+=cut
+
+sub set_visibility($$) {
+ my($self, $vismode) = @_;
+
+ return must_be_on($self) unless $self->{is_on};
+ $self->{visibility} = $vismode;
+}
+
+=pod
+
+=item is_stealth
+
+=item set_stealth STEALTH_STATUS
+
+These methods deal with "stealth mode". When the user is in stealth mode, she won't
+show up as online on anyone's buddylist. However, for all other purposes, she will be online
+as usual. Any restrictions, imposed by the visibility mode (see L<"set_visibility">),
+on who can communicate with her will remain in effect.
+
+Stealth state can be changed by another signon of the user's
+screenname. So, if you want your application to be aware of the stealth state,
+C<is_stealth> won't cut it; there's a L<"stealth_changed"> callback which will serve
+nicely.
+
+=cut
+
+sub is_stealth($) { return shift->{stealth}; }
+sub set_stealth($$) {
+ my($self, $new_state) = @_;
+ $self->svcdo(CONNTYPE_BOS, protobit => "set_extended_status", protodata => {
+ stealth => {state => $new_state ? 0x100 : 0}
+ });
+}
+
+=pod
+
+=item set_group_permissions (NEWPERMS)
+
+Set group permissions. This lets you block any OSCAR users or any AOL users.
+C<NEWPERMS> should be a list of zero or more of the following constants:
+
+=over 4
+
+=item GROUPPERM_OSCAR
+
+Permit AOL Instant Messenger users to contact you.
+
+=item GROUPPERM_AOL
+
+Permit AOL subscribers to contact you.
+
+=back
+
+Call L<"commit_buddylist"> for the change to take effect.
+
+=cut
+
+sub set_group_permissions($@) {
+ my($self, @perms) = @_;
+ my $perms = 0xFFFFFF00;
+
+ return must_be_on($self) unless $self->{is_on};
+ foreach my $perm (@perms) { $perms |= $perm; }
+ $self->{groupperms} = $perms;
+}
+
+=pod
+
+=item group_permissions
+
+Returns current group permissions. The return value is a list like the one
+that L<"set_group_permissions"> wants.
+
+=cut
+
+sub group_permissions($) {
+ my $self = shift;
+ my @retval = ();
+
+ foreach my $perm (GROUPPERM_OSCAR, GROUPPERM_AOL) {
+ push @retval, $perm if $self->{groupperms} & $perm;
+ }
+ return @retval;
+}
+
+=pod
+
+=back
+
+=head2 OTHER USERS
+
+See also L<"BUDDIES AND BUDDYLISTS">.
+
+=head3 METHODS
+
+=over 4
+
+=item get_info (WHO)
+
+Requests a user's information, which includes their profile and idle time.
+See the L<buddy_info> callback for more information.
+
+=item get_away (WHO)
+
+Similar to L<get_info>, except requests the user's away message instead of
+their profile.
+
+=cut
+
+sub get_info($$) {
+ my($self, $screenname) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ $self->svcdo(CONNTYPE_BOS, reqdata => $screenname, protobit => "get_info", protodata => {screenname => $screenname});
+}
+sub get_away($$) {
+ my($self, $screenname) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ $self->svcdo(CONNTYPE_BOS, reqdata => $screenname, protobit => "get_away", protodata => {screenname => $screenname});
+}
+
+
+=pod
+
+=item send_im (WHO, MESSAGE[, AWAY])
+
+Sends someone an instant message. If the message is an automated reply generated,
+perhaps, because you have an away message set, give the AWAY parameter a non-zero
+value. Note that C<Net::OSCAR> will not handle sending away messages to people who
+contact you when you are away - you must perform this yourself if you want it done.
+
+Returns a "request ID" that you can use in the C<im_ok> callback to identify the message.
+If the message was too long to send, returns zero.
+
+=cut
+
+sub send_im($$$;$) {
+ my($self, $to, $msg, $away) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ if(!$self->{svcdata}->{hashlogin}) {
+ return 0 if length($msg) >= 7987;
+ } else {
+ return 0 if length($msg) > 2000;
+ }
+
+ my %protodata;
+ $protodata{message} = $msg;
+
+ if($away) {
+ $protodata{is_automatic} = {};
+ } else {
+ $protodata{request_server_confirmation} = {};
+ }
+
+ if($self->{capabilities}->{buddy_icons} and $self->{icon_checksum} and $self->{icon_timestamp} and
+ (!exists($self->{userinfo}->{$to}) or
+ !exists($self->{userinfo}->{to}->{icon_timestamp_received}) or
+ $self->{icon_timestamp} > $self->{userinfo}->{$to}->{icon_timestamp_received})
+ ) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Informing $to about our buddy icon.");
+ $self->{userinfo}->{$to} ||= {};
+ $self->{userinfo}->{$to}->{icon_timestamp_received} = $self->{icon_timestamp};
+
+ $protodata{icon_data}->{"icon_".$_} = $self->{"icon_".$_} foreach qw(length checksum timestamp);
+ }
+
+ my $flags2 = 0;
+ if($self->{capabilities}->{typing_status}) {
+ $flags2 = 0xB;
+ }
+
+ my($req_id) = $self->send_message($to, 1, protoparse($self, "standard_IM_footer")->pack(%protodata), $flags2);
+ return $req_id;
+}
+
+=pod
+
+=item send_typing_status (RECIPIENT, STATUS)
+
+Send a typing status change to another user. Send these messages
+to implement typing status notification. Valid values for C<STATUS> are:
+
+=over 4
+
+=item *
+
+TYPINGSTATUS_STARTED: The user has started typing to the recipient.
+This indicates that typing is actively taking place.
+
+=item *
+
+TYPINGSTATUS_TYPING: The user is typing to the recipient. This
+indicates that there is text in the message input area, but
+typing is not actively taking place at the moment.
+
+=item *
+
+TYPINGSTATUS_FINISHED: The user has finished typing to the recipient.
+This should be sent when the user starts to compose a message, but
+then erases all of the text in the message input area.
+
+=back
+
+=cut
+
+sub send_typing_status($$$) {
+ my($self, $recipient, $status) = @_;
+
+ croak "This client does not support typing status notifications." unless $self->{capabilities}->{typing_status};
+ return unless exists $self->{userinfo}->{$recipient} and $self->{userinfo}->{$recipient}->{typing_status};
+
+ $self->svcdo(CONNTYPE_BOS, protobit => "typing_notification", protodata => {
+ screenname => $recipient,
+ typing_status => $status
+ });
+}
+
+
+=pod
+
+=item evil (WHO[, ANONYMOUSLY])
+
+C<Evils>, or C<warns>, a user. Evilling a user increases their evil level,
+which makes them look bad and decreases the rate at which they can send
+messages. Evil level gradually decreases over time. If the second
+parameter is non-zero, the evil will be done anonymously, which does
+not increase the user's evil level by as much as a standard evil.
+
+You can't always evil someone. You can only do it when they do something
+like send you an instant message.
+
+=cut
+
+sub evil($$;$) {
+ my($self, $who, $anon) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ $self->svcdo(CONNTYPE_BOS, reqdata => $who, protobit => "outgoing_warning", protodata => {
+ is_anonymous => $anon ? 1 : 0,
+ screenname => $who
+ });
+}
+
+=pod
+
+=item get_icon (SCREENNAME, MD5SUM)
+
+Gets a user's buddy icon. See L<set_icon> for details. To make
+sure this method isn't called excessively, please check the
+C<icon_checksum> and C<icon_timestamp> data, which are available
+via the L<buddy> method (even for people not on the user's buddy
+list.) The MD5 checksum of a user's icon will be in the
+C<icon_md5sum> key returned by L<buddy>.
+
+You should receive a L<buddy_icon_downloaded> callback in
+response to this method.
+
+=cut
+
+sub get_icon($$$) {
+ my($self, $screenname, $md5sum) = @_;
+
+ carp "This client does not support buddy icons!" unless $self->{capabilities}->{buddy_icons};
+
+ $self->svcdo(CONNTYPE_ICON, protobit => "buddy_icon_download", protodata => {
+ screenname => $screenname,
+ md5sum => $md5sum
+ });
+}
+
+=pod
+
+=back
+
+=head3 CALLBACKS
+
+=over 4
+
+=item new_buddy_icon (OSCAR, SCREENNAME, BUDDY DATA)
+
+This is called when someone, either someone the user is talking with or someone on
+their buddylist, has a potentially new buddy icon. The buddy data is guaranteed
+to have at least C<icon_checksum> available; C<icon_timestamp> and C<icon_length>
+may not be. Specifically, if C<Net::OSCAR> found out about the buddy icon
+through a buddy status update (the sort that triggers a L<buddy_in> callback),
+these data will B<not> be available; if C<Net::OSCAR> found out about the
+icon via an incoming IM from the person, these data B<will> be available.
+
+Upon receiving this callback, an application should use the C<icon_checksum>
+to search for the icon in its cache, and call L<get_icon> if it can't find it.
+If the C<icon_md5sum>, which is what needs to get passed to L<get_icon>, is not present
+in the buddy data, use L<get_info> to request the information for the user,
+and then call L<get_icon> from the L<buddy_info> callback.
+
+=item buddy_icon_downloaded (OSCAR, SCREENNAME, ICONDATA)
+
+This is called when a user's buddy icon is successfully downloaded from the server.
+
+=item typing_status (OSCAR, SCREENNAME, STATUS)
+
+Called when someone has sent us a typing status notification message.
+See L<send_typing_status> for a description of the different statuses.
+
+=item im_ok (OSCAR, TO, REQID)
+
+Called when an IM to C<TO> is successfully sent.
+REQID is the request ID of the IM as returned by C<send_im>.
+
+=item im_in (OSCAR, FROM, MESSAGE[, AWAY])
+
+Called when someone sends you an instant message. If the AWAY parameter
+is non-zero, the message was generated as an automatic reply, perhaps because
+you sent that person a message and they had an away message set.
+
+=item buddylist_in (OSCAR, FROM, BUDDYLIST)
+
+Called when someone sends you a buddylist. You must set the L<"buddy_list_transfer">
+capability for buddylists to be sent to you. The buddylist will be a C<Net::OSCAR::Buddylist>
+hashref whose keys are the groups and whose values are listrefs of C<Net::OSCAR::Screenname>
+strings for the buddies in the group.
+
+=item buddy_info (OSCAR, SCREENNAME, BUDDY DATA)
+
+Called in response to a L<get_info> or L<get_away> request.
+BUDDY DATA is the same as that returned by the L<buddy> method,
+except that one of two additional keys, C<profile> and C<awaymsg>,
+may be present.
+
+=back
+
+=head2 THE SIGNED-ON USER
+
+These methods deal with the user who is currently signed on using a particular
+C<Net::OSCAR> object.
+
+=head3 METHODS
+
+=over 4
+
+=item email
+
+Returns the email address currently assigned to the user's account.
+
+=item screenname
+
+Returns the user's current screenname, including all capitalization and spacing.
+
+=item is_on
+
+Returns true if the user is signed on to the OSCAR service. Otherwise,
+returns false.
+
+=cut
+
+sub email($) { return shift->{email}; }
+sub screenname($) { return shift->{screenname}; }
+sub is_on($) { return shift->{is_on}; }
+
+=item profile
+
+Returns your current profile.
+
+=cut
+
+sub profile($) { return shift->{profile}; }
+
+=pod
+
+=item set_away (MESSAGE)
+
+Sets the user's away message, also marking them as being away.
+If the message is undef or the empty string, the user will be
+marked as no longer being away. See also L<"get_away">.
+
+=cut
+
+sub set_away($$) {
+ my($self, $awaymsg) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ # Because we use !defined(awaymsg) to indicate
+ # that we just want to set the profile, force
+ # it to be defined.
+ $awaymsg = "" unless defined($awaymsg);
+
+ shift->set_info(undef, $awaymsg);
+}
+
+=pod
+
+=item set_extended_status (MESSAGE)
+
+Sets the user's extended status message. This requires the
+C<Net::OSCAR> object to have been created with the C<extended_status>
+capability. Currently, the only clients which support extended
+status messages are Net::OSCAR, Gaim, and iChat. If the message
+is undef or the empty string, the user's extended status
+message will be cleared. Use L<"get_info"> to get another
+user's extended status.
+
+=cut
+
+sub set_extended_status($$) {
+ my($self, $status) = @_;
+ croak "This client does not support extended status messages." unless $self->{capabilities}->{extended_status};
+
+ $status ||= "";
+
+ $self->log_print(OSCAR_DBG_NOTICE, "Setting extended status.");
+ $self->svcdo(CONNTYPE_BOS, protobit => "set_extended_status", protodata => {
+ status_message => {message => $status}
+ });
+}
+
+=pod
+
+=item set_info (PROFILE)
+
+Sets the user's profile. Call L<"commit_buddylist"> to have
+the new profile saved into the buddylist, so that it will be
+set the next time the screenname is signed on. (This is a
+Net::OSCAR-specific feature, so other clients will not pick
+up the profile from the buddylist.)
+
+Note that Net::OSCAR stores the user's profile in the server-side buddylist, so
+if L<"commit_buddylist"> is called after setting the profile with this method,
+the user will automatically get that same profile set whenever they sign on
+through Net::OSCAR. See the file C<PROTOCOL>, included with the C<Net::OSCAR> distribution,
+for details of how we're storing this data.
+
+Use L<"get_info"> to retrieve another user's profile.
+
+=cut
+
+sub set_info($$;$) {
+ my($self, $profile, $awaymsg) = @_;
+
+ return must_be_on($self) unless $self->{services}->{0+CONNTYPE_BOS};
+ $self->log_print(OSCAR_DBG_NOTICE, "Setting user information.");
+
+ my %protodata;
+ $protodata{capabilities} = $self->capabilities();
+
+ if(defined($profile)) {
+ $protodata{profile_mimetype} = 'text/aolrtf; charset="us-ascii"';
+ $protodata{profile} = $profile;
+ $self->{profile} = $profile;
+ }
+
+ if(defined($awaymsg)) {
+ $protodata{awaymsg_mimetype} = 'text/aolrtf; charset="us-ascii"';
+ $protodata{awaymsg} = $awaymsg;
+ }
+
+ $self->svcdo(CONNTYPE_BOS, protobit => "set_info", protodata => \%protodata);
+}
+
+=pod
+
+=item set_icon (ICONDATA)
+
+Sets the user's buddy icon. The C<Net::OSCAR> object must have been created
+with the C<buddy_icons> capability to use this. C<ICONDATA> must be less
+than 4kb, should be 48x48 pixels, and should be BMP, GIF, or JPEG image data.
+You must call L<commit_buddylist> for this change to take effect. If
+C<ICONDATA> is the empty string, the user's buddy icon will be removed.
+
+When reading the icon data from a file, make sure to call C<binmode>
+on the file handle.
+
+Note that if the user's buddy icon was previously set with Net::OSCAR,
+enough data will be stored in the server-side buddylist that this will
+not have to be called every time the user signs on. However, other clients
+do not store the extra data in the buddylist, so if the user previously
+set a buddy icon with a non-Net::OSCAR-based client, this method will
+need to be called in order for the user's buddy icon to be set properly.
+
+See the file C<PROTOCOL>, included with the C<Net::OSCAR> distribution,
+for details of how we're storing this data.
+
+You should receive a L<buddy_icon_uploaded> callback in response to this
+method.
+
+Use L<"get_icon"> to retrieve another user's icon.
+
+=cut
+
+sub set_icon($$) {
+ my($self, $icon) = @_;
+
+ carp "This client does not support buddy icons!" unless $self->{capabilities}->{buddy_icons};
+
+ if($icon) {
+ $self->{icon} = $icon;
+ $self->{icon_md5sum_old} = $self->{icon_md5sum} || "";
+ $self->{icon_md5sum} = pack("n", 0x10) . md5($icon);
+ $self->{icon_checksum} = $self->icon_checksum($icon);
+ $self->{icon_timestamp} = time;
+ $self->{icon_length} = length($icon);
+ } else {
+ delete $self->{icon};
+ delete $self->{icon_md5sum};
+ delete $self->{icon_checksum};
+ delete $self->{icon_timestamp};
+ delete $self->{icon_length};
+ }
+}
+
+
+=pod
+
+=pod
+
+=item change_password (CURRENT PASSWORD, NEW PASSWORD)
+
+Changes the user's password.
+
+=cut
+
+sub change_password($$$) {
+ my($self, $currpass, $newpass) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ if($self->{adminreq}->{0+ADMIN_TYPE_PASSWORD_CHANGE}) {
+ $self->callback_admin_error(ADMIN_TYPE_PASSWORD_CHANGE, ADMIN_ERROR_REQPENDING);
+ return;
+ } else {
+ $self->{adminreq}->{0+ADMIN_TYPE_PASSWORD_CHANGE}++;
+ }
+
+ $self->svcdo(CONNTYPE_ADMIN, protobit => "change_account_info", protodata => {
+ newpass => $newpass,
+ oldpass => $currpass
+ });
+}
+
+=pod
+
+=item confirm_account
+
+Confirms the user's account. This can be used when the user's account is in the trial state,
+as determined by the presence of the C<trial> key in the information given when the user's
+information is requested.
+
+=cut
+
+sub confirm_account($) {
+ my($self) = shift;
+ return must_be_on($self) unless $self->{is_on};
+
+ if($self->{adminreq}->{0+ADMIN_TYPE_ACCOUNT_CONFIRM}) {
+ $self->callback_admin_error(ADMIN_TYPE_ACCOUNT_CONFIRM, ADMIN_ERROR_REQPENDING);
+ return;
+ } else {
+ $self->{adminreq}->{0+ADMIN_TYPE_ACCOUNT_CONFIRM}++;
+ }
+
+ $self->svcdo(CONNTYPE_ADMIN, protobit => "confirm_account_request");
+}
+
+=pod
+
+=item change_email (NEW EMAIL)
+
+Requests that the email address registered to the user's account be changed.
+This causes the OSCAR server to send an email to both the new address and the
+old address. To complete the change, the user must follow instructions contained
+in the email sent to the new address. The email sent to the old address contains
+instructions which allow the user to cancel the change within three days of the
+change request. It is important that the user's current email address be
+known to the OSCAR server so that it may email the account password if the
+user forgets it.
+
+=cut
+
+sub change_email($$) {
+ my($self, $newmail) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ if($self->{adminreq}->{0+ADMIN_TYPE_EMAIL_CHANGE}) {
+ $self->callback_admin_error(ADMIN_TYPE_EMAIL_CHANGE, ADMIN_ERROR_REQPENDING);
+ return;
+ } else {
+ $self->{adminreq}->{0+ADMIN_TYPE_EMAIL_CHANGE}++;
+ }
+
+ $self->svcdo(CONNTYPE_ADMIN, protobit => "change_account_info", protodata => {
+ new_email => $newmail
+ });
+}
+
+=pod
+
+=item format_screenname (NEW FORMAT)
+
+Allows the capitalization and spacing of the user's screenname to be changed.
+The new format must be the same as the user's current screenname, except that
+case may be changed and spaces may be inserted or deleted.
+
+=cut
+
+sub format_screenname($$) {
+ my($self, $newname) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ if($self->{adminreq}->{0+ADMIN_TYPE_SCREENNAME_FORMAT}) {
+ $self->callback_admin_error(ADMIN_TYPE_SCREENNAME_FORMAT, ADMIN_ERROR_REQPENDING);
+ return;
+ } else {
+ $self->{adminreq}->{0+ADMIN_TYPE_SCREENNAME_FORMAT}++;
+ }
+
+ $self->svcdo(CONNTYPE_ADMIN, protobit => "change_account_info", protodata => {
+ new_screenname => $newname
+ });
+}
+
+=pod
+
+=item set_idle (TIME)
+
+Sets the user's idle time in seconds. Set to zero to mark the user as
+not being idle. Set to non-zero once the user becomes idle. The OSCAR
+server will automatically increment the user's idle time once you mark
+the user as being idle.
+
+=cut
+
+sub set_idle($$) {
+ my($self, $time) = @_;
+ return must_be_on($self) unless $self->{is_on};
+ $self->svcdo(CONNTYPE_BOS, protobit => "set_idle", protodata => {duration => $time});
+}
+
+=pod
+
+=back
+
+=head3 CALLBACKS
+
+=over 4
+
+=item admin_error (OSCAR, REQTYPE, ERROR, ERRURL)
+
+This is called when there is an error performing an administrative function - changing
+your password, formatting your screenname, changing your email address, or confirming your
+account. REQTYPE is a string describing the type of request which generated the error.
+ERROR is an error message. ERRURL is an http URL which the user may visit for more
+information about the error.
+
+=item admin_ok (OSCAR, REQTYPE)
+
+This is called when an administrative function succeeds. See L<admin_error> for more info.
+
+=item buddy_icon_uploaded (OSCAR)
+
+This is called when the user's buddy icon is successfully uploaded to the server.
+
+=item stealth_changed (OSCAR, NEW_STEALTH_STATE)
+
+This is called when the user's stealth state changes. See L<"is_stealth"> and L<"set_stealth">
+for information on stealth.
+
+=item extended_status (OSCAR, STATUS)
+
+Called when the user's extended status changes. This will normally
+be sent in response to a successful L<set_extended_status> call.
+
+=item evil (OSCAR, NEWEVIL[, FROM])
+
+Called when your evil level changes. NEWEVIL is your new evil level,
+as a percentage (accurate to tenths of a percent.) ENEMY is undef
+if the evil was anonymous (or if the message was triggered because
+your evil level naturally decreased), otherwise it is the screenname
+of the person who sent us the evil. See the L<"evil"> method for
+more information on evils.
+
+=back
+
+=head2 FILE TRANSFER AND DIRECT CONNECTIONS
+
+=over 4
+
+=item file_send SCREENNAME MESSAGE FILEREFS
+
+C<FILEDATA> can be undef to have Net::OSCAR read the file,
+a file handle, or the data to send.
+
+=cut
+
+sub file_send($$@) {
+ my($self, $screenname, $message, @filerefs) = @_;
+
+ my $connection = $self->addconn(conntype => CONNTYPE_DIRECT_IN);
+ my($port) = sockaddr_in(getsockname($connection->{socket}));
+
+ my $size = 0;
+ $size += length($_->{data}) foreach @filerefs;
+
+ my %svcdata = (
+ file_count_status => (@filerefs > 1 ? 2 : 1),
+ file_count => scalar(@filerefs),
+ size => $size,
+ files => [map {$_->{name}} @filerefs]
+ );
+
+ my $cookie = randchars(8);
+ my($ip) = unpack("N", inet_aton($self->{services}->{CONNTYPE_BOS()}->local_ip()));
+ my %protodata = (
+ capability => OSCAR_CAPS()->{filexfer}->{value},
+ charset => "us-ascii",
+ cookie => $cookie,
+ invitation_msg => $message,
+ language => 101,
+ push_pull => 1,
+ status => "propose",
+ client_1_ip => $ip,
+ client_2_ip => $ip,
+ port => $port,
+ proxy_ip => unpack("N", inet_aton("63.87.248.248")), # TODO: What's this really supposed to be?
+ svcdata_charset => "us-ascii",
+ svcdata => protoparse($self, "file_transfer_rendezvous_data")->pack(%svcdata)
+ );
+
+ my($req_id) = $self->send_message($screenname, 2, pack("nn", 3, 0) . protoparse($self, "rendezvous_IM")->pack(%protodata), 0, $cookie);
+
+ $self->{rv_proposals}->{$cookie} = $connection->{rv} = {
+ cookie => $cookie,
+ sender => $self->{screenname},
+ recipient => $screenname,
+ peer => $screenname,
+ type => "filexfer",
+ connection => $connection,
+ ft_state => "listening",
+ direction => "send",
+ accepted => 0,
+ filenames => [map {$_->{name}} @filerefs],
+ data => [map {$_->{data}} @filerefs],
+ using_proxy => 0,
+ tried_proxy => 0,
+ tried_listen => 1,
+ tried_connect => 0,
+ total_size => $size,
+ file_count => scalar(@filerefs)
+ };
+
+ return ($req_id, $cookie);
+}
+
+=pod
+
+=back
+
+=head2 EVENT PROCESSING
+
+=head3 METHODS
+
+=over 4
+
+=item do_one_loop
+
+Processes incoming data from our connections to the various
+OSCAR services. This method reads one command from any
+connections which have data to be read. See the
+L<timeout> method to set the timeout interval used
+by this method.
+
+=cut
+
+sub do_one_loop($) {
+ my $self = shift;
+ my $timeout = $self->{timeout};
+
+ undef $timeout if defined($timeout) and $timeout == -1;
+
+ my($rin, $win, $ein) = ('', '', '');
+
+ foreach my $connection(@{$self->{connections}}) {
+ next unless exists($connection->{socket});
+ if($connection->{connected}) {
+ vec($rin, fileno $connection->{socket}, 1) = 1;
+ } elsif(!$connection->{connected} or $connection->{outbuff}) {
+ vec($win, fileno $connection->{socket}, 1) = 1;
+ }
+ }
+ $ein = $rin | $win;
+
+ return unless $ein;
+ my $nfound = select($rin, $win, $ein, $timeout);
+ $self->process_connections(\$rin, \$win, \$ein) if $nfound and $nfound != -1;
+}
+
+=pod
+
+=item process_connections (READERSREF, WRITERSREF, ERRORSREF)
+
+Use this method when you want to implement your own C<select>
+statement for event processing instead of using C<Net::OSCAR>'s
+L<do_one_loop> method. The parameters are references to the
+readers, writers, and errors parameters used by the select
+statement. The method will ignore all connections which
+are not C<Net::OSCAR::Connection> objects or which are
+C<Net::OSCAR::Connection> objects from a different C<Net::OSCAR>
+object. It modifies its arguments so that its connections
+are removed from the connection lists. This makes it very
+convenient for use with multiple C<Net::OSCAR> objects or
+use with a C<select>-based event loop that you are also
+using for other purposes.
+
+See the L<selector_filenos> method for a way to get the necessary
+bit vectors to use in your C<select>.
+
+=cut
+
+sub process_connections($\$\$\$) {
+ my($self, $readers, $writers, $errors) = @_;
+
+ # Filter out our connections and remove them from the to-do list
+ foreach my $connection(@{$self->{connections}}) {
+ my($read, $write) = (0, 0);
+ next unless $connection->fileno;
+ if($connection->{connected}) {
+ next unless vec($$readers | $$errors, $connection->fileno, 1);
+ vec($$readers, $connection->fileno, 1) = 0;
+ $read = 1;
+ }
+ if(!$connection->{connected} or $connection->{outbuff}) {
+ next unless vec($$writers | $$errors, $connection->fileno, 1);
+ vec($$writers, $connection->fileno, 1) = 0;
+ $write = 1;
+ }
+ if(vec($$errors, $connection->fileno, 1)) {
+ vec($$errors, $connection->fileno, 1) = 0;
+ $connection->{sockerr} = 1;
+ $connection->disconnect();
+ } else {
+ $connection->process_one($read, $write);
+ }
+ }
+}
+
+=pod
+
+=back
+
+=head3 CALLBACKS
+
+=over 4
+
+=item connection_changed (OSCAR, CONNECTION, STATUS)
+
+Called when the status of a connection changes. The status is "read" if we
+should call L<"process_one"> on the connection when C<select> indicates that
+the connection is ready for reading, "write" if we should call
+L<"process_one"> when the connection is ready for writing, "readwrite" if L<"process_one">
+should be called in both cases, or "deleted" if the connection has been deleted.
+
+C<CONNECTION> is a C<Net::OSCAR::Connection> object.
+
+Users of this callback may also be interested in the L<"get_filehandle">
+method of C<Net::OSCAR::Connection>.
+
+=back
+
+=head2 CHATS
+
+=head3 METHODS
+
+=over 4
+
+=item chat_join (NAME[, EXCHANGE])
+
+Creates (or joins?) a chatroom. The exchange parameter should probably not be
+specified unless you know what you're doing. Do not use this method
+to accept invitations to join a chatroom - use the L<"chat_accept"> method
+for that.
+
+=cut
+
+sub chat_join($$;$) {
+ my($self, $name, $exchange) = @_;
+ return must_be_on($self) unless $self->{is_on};
+ $exchange ||= 4;
+
+ my $reqid = (8<<16) | (unpack("n", randchars(2)))[0];
+ $self->{chats}->{pack("N", $reqid)} = $name;
+ $self->svcdo(CONNTYPE_CHATNAV, reqid => $reqid, protobit => "chat_navigator_room_create", protodata => {
+ exchange => $exchange,
+ name => $name
+ });
+}
+
+=pod
+
+=item chat_accept (CHATURL)
+
+Use this to accept an invitation to join a chatroom.
+
+=item chat_decline (CHATURL)
+
+Use this to decline an invitation to join a chatroom.
+
+=cut
+
+sub chat_accept($$) {
+ my($self, $url) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ $self->log_print(OSCAR_DBG_NOTICE, "Accepting chat invite for $url.");
+ my($rv) = grep { $_->{chat_url} eq $url } values %{$self->{rv_proposals}};
+ return unless $rv;
+
+ $self->svcdo(CONNTYPE_CHATNAV, protobit => "chat_invitation_accept", protodata => {
+ exchange => $rv->{exchange},
+ url => $url
+ });
+
+
+ my $reqid = pack("n", 4);
+ $reqid .= randchars(2);
+ ($reqid) = unpack("N", $reqid);
+
+ $self->{chats}->{$reqid} = $rv;
+ $self->svcdo(CONNTYPE_BOS, protobit => "service_request", reqid => $reqid, protodata => {
+ type => CONNTYPE_CHAT,
+ chat => {
+ exchange => $rv->{exchange},
+ url => $url
+ }
+ });
+}
+
+sub chat_decline($$) {
+ my($self, $url) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ $self->log_print(OSCAR_DBG_NOTICE, "Declining chat invite for $url.");
+ my($rv) = grep { $_->{chat_url} eq $url } values %{$self->{rv_proposals}};
+ return unless $rv;
+
+ $self->svcdo(CONNTYPE_BOS, protobit => "chat_invitation_decline", protodata => {
+ cookie => $rv->{cookie},
+ screenname => $rv->{sender},
+ });
+
+ delete $self->{rv_proposals}->{$rv->{cookie}};
+}
+
+=pod
+
+=back
+
+=head3 CALLBACKS
+
+=over 4
+
+=item chat_buddy_in (OSCAR, SCREENNAME, CHAT, BUDDY DATA)
+
+SCREENNAME has entered CHAT. BUDDY DATA is the same as that returned by
+the L<buddy> method.
+
+=item chat_buddy_out (OSCAR, SCREENNAME, CHAT)
+
+Called when someone leaves a chatroom.
+
+=item chat_im_in (OSCAR, FROM, CHAT, MESSAGE)
+
+Called when someone says something in a chatroom. Note that you
+receive your own messages in chatrooms unless you specify the
+NOREFLECT parameter in L<chat_send>.
+
+=item chat_invite (OSCAR, WHO, MESSAGE, CHAT, CHATURL)
+
+Called when someone invites us into a chatroom. MESSAGE is the message
+that they specified on the invitation. CHAT is the name of the chatroom.
+CHATURL is a chat URL and not a C<Net::OSCAR::Connection::Chat> object. CHATURL can
+be passed to the L<chat_accept> method to accept the invitation.
+
+=item chat_joined (OSCAR, CHATNAME, CHAT)
+
+Called when you enter a chatroom. CHAT is the C<Net::OSCAR::Connection::Chat>
+object for the chatroom.
+
+=item chat_closed (OSCAR, CHAT, ERROR)
+
+Your connection to CHAT (a C<Net::OSCAR::Connection::Chat> object) was severed due to ERROR.
+
+=back
+
+=head2 RATE LIMITS
+
+See L<"RATE LIMIT OVERVIEW"> for more information on rate limits.
+
+=head3 METHODS
+
+=over 4
+
+=item rate_level (OSCAR, METHODNAME[, CHAT])
+
+Returns the rate level (one of C<RATE_CLEAR>, C<RATE_ALERT>, C<RATE_LIMIT>, C<RATE_DISCONNECT>)
+which the OSCAR session is currently at for the C<Net::OSCAR> (or C<Net::OSCAR::Connection::Chat>) method named
+C<METHODNAME> right now. This only makes sense for methods which send information to the OSCAR
+server, such as C<send_im>, but if you pass in a method name which doesn't make sense (or isn't
+actually a C<Net::OSCAR> method, or which isn't rate-limited), we'll gladly an empty list. B<This method is
+not available if your application is using L<"OSCAR_RATE_MANAGE_NONE">.>
+
+If C<METHODNAME> is C<chat_send>, you should also pass the C<Net::OSCAR::Connection::Chat>
+object to get rate information on (as the C<CHAT> parameter.)
+
+=cut
+
+sub _rate_level($$$) {
+ my($oscar, $level, $levels) = @_;
+
+ if($level <= $levels->{disconnect}) {
+ return RATE_DISCONNECT;
+ } elsif($level <= $levels->{limit}) {
+ return RATE_LIMIT;
+ } elsif($level <= $levels->{alert}) {
+ return RATE_ALERT;
+ } else {
+ return RATE_CLEAR;
+ }
+}
+
+sub _rate_lookup($$;$) {
+ my($oscar, $method, $chat) = @_;
+ croak "Rate methods not supported when using OSCAR_RATE_MANAGE_NONE!" if $oscar->{rate_manage_mode} == OSCAR_RATE_MANAGE_NONE;
+
+ print "rate_lookup $method\n";
+ my $key = $Net::OSCAR::MethodInfo::methods{$method} or return;
+ print "\tFound key\n";
+ my $conn = $chat || $oscar->connection_for_family(unpack("n", $key));
+ print "\tFound connection\n";
+ my $class = $conn->{rate_limits}->{classmap}->{$key} or return;
+ print "\tFound class\n";
+ return $conn->{rate_limits}->{$class};
+}
+
+sub rate_level($$;$) {
+ my($oscar, $method, $chat) = @_;
+ my $rinfo = $oscar->_rate_lookup($method, $chat) or return;
+
+ return $oscar->_rate_level($rinfo->{current_state}, $rinfo->{levels});
+}
+
+=pod
+
+=item rate_limits (OSCAR, METHODNAME[, CHAT])
+
+Similar to L<"rate_level">. This returns the boundaries of the different rate level
+categories for the given method name, in the form of a hash with the following keys
+(this won't make sense if you don't know how the current level is calculated; see below):
+
+=over 4
+
+=item window_size
+
+=item levels
+
+A hashref with keys for each of the levels. Each key is the name of a level,
+and the value for that key is the threshold for that level.
+
+=over 4
+
+=item clear
+
+=item alert
+
+=item limit
+
+=item disconnect
+
+=back
+
+=item last_time
+
+The time at which the last command to affect this rate level was sent.
+
+=item current_state
+
+The session's current rate level.
+
+=back
+
+Every time a command is sent to the OSCAR server, the level is recalculated according to the formula
+(from Alexandr Shutko's OSCAR documentation, L<http://iserverd.khstu.ru/oscar/>:
+
+ NewLevel = (Window - 1)/Window * OldLevel + 1/Window * CurrentTimeDiff
+
+C<CurrentTimeDiff> is the difference between the current system time and C<last_time>.
+
+=cut
+
+sub rate_limits($$;$) {
+ my($oscar, $method, $chat) = @_;
+ return $oscar->_rate_lookup($method, $chat);
+}
+
+=pod
+
+=item would_make_rate_level (OSCAR, METHODNAME[, CHAT])
+
+Returns the rate level which your session would be at if C<METHODNAME> were sent right now.
+See L<"rate_level"> for more information.
+
+=cut
+
+sub _compute_rate($$) {
+ my($oscar, $rinfo) = @_;
+
+ my $level = $rinfo->{current_state};
+ my $window = $rinfo->{window_size};
+ my $timediff = (millitime() - $rinfo->{time_offset}) - $rinfo->{last_time};
+ return ($window - 1)/$window * $level + 1/$window * $timediff;
+}
+
+sub would_make_rate_level($$;$) {
+ my($oscar, $method, $chat) = @_;
+ my $rinfo = $oscar->_rate_lookup($method, $chat) or return;
+
+ return $oscar->_rate_level($oscar->_compute_rate($rinfo), $rinfo->{levels});
+}
+
+=cut
+
+=back
+
+=head3 CALLBACKS
+
+=over 4
+
+=item rate_alert (OSCAR, LEVEL, CLEAR, WINDOW, WORRISOME, VIRTUAL)
+
+This is called when you are sending commands to OSCAR too quickly.
+
+C<LEVEL> is one of C<RATE_CLEAR>, C<RATE_ALERT>, C<RATE_LIMIT>, or C<RATE_DISCONNECT> from the C<Net::OSCAR::Common>
+package (they are imported into your namespace if you import C<Net::OSCAR> with the C<:standard>
+parameter.) C<RATE_CLEAR> means that you're okay. C<RATE_ALERT> means you should slow down. C<RATE_LIMIT>
+means that the server is ignoring messages from you until you slow down. C<RATE_DISCONNECT> means you're
+about to be disconnected.
+
+C<CLEAR> and C<WINDOW> tell you the maximum speed you can send in order to maintain C<RATE_CLEAR> standing.
+You must send no more than C<WINDOW> commands in C<CLEAR> milliseconds. If you just want to keep it
+simple, you can just not send any commands for C<CLEAR> milliseconds and you'll be fine.
+
+C<WORRISOME> is nonzero if C<Net::OSCAR> thinks that the alert is anything worth
+worrying about. Otherwise it is zero. This is very rough, but it's a good way
+for the lazy to determine whether or not to bother passing the alert on to
+their users.
+
+A C<VIRTUAL> rate limit is one which your application would have incurred,
+but you're using L<automatic rate management|"OSCAR_RATE_MANAGE_AUTO">, so we
+stopped something from being sent out.
+
+=back
+
+=head2 MISCELLANEOUS
+
+=head3 METHODS
+
+=over 4
+
+=item timeout ([NEW TIMEOUT])
+
+Gets or sets the timeout value used by the L<do_one_loop> method.
+The default timeout is 0.01 seconds.
+
+=cut
+
+sub timeout($;$) {
+ my($self, $timeout) = @_;
+ return $self->{timeout} unless $timeout;
+ $self->{timeout} = $timeout;
+}
+
+=pod
+
+=item loglevel ([LOGLEVEL[, SCREENNAME DEBUG]])
+
+Gets or sets the level of logging verbosity. If this is non-zero, varing amounts of information will be printed
+to standard error (unless you have a L<"log"> callback defined). Higher loglevels will give you more information.
+If the optional screenname debug parameter is non-zero,
+debug messages will be prepended with the screenname of the OSCAR session which is generating
+the message (but only if you don't have a L<"log"> callback defined). This is useful when you have multiple C<Net::OSCAR> objects.
+
+See the L<"log"> callback for more information.
+
+=cut
+
+sub loglevel($;$$) {
+ my $self = shift;
+ return $self->{LOGLEVEL} unless @_;
+ $self->{LOGLEVEL} = shift;
+ $self->{SNDEBUG} = shift if @_;
+}
+
+=pod
+
+=item auth_response (MD5_DIGEST[, PASS_IS_HASHED])
+
+Provide a response to an authentication challenge - see the L<"auth_challenge">
+callback for details.
+
+=cut
+
+sub auth_response($$$) {
+ my($self, $digest, $pass_is_hashed) = @_;
+
+ if($pass_is_hashed) {
+ $self->{pass_is_hashed} = 1;
+ } else {
+ $self->{pass_is_hashed} = 0;
+ }
+
+ $self->log_print(OSCAR_DBG_SIGNON, "Got authentication response - proceeding with signon");
+ $self->{auth_response} = $digest;
+ my %data = signon_tlv($self);
+ $self->svcdo(CONNTYPE_BOS, protobit => "signon", protodata => {%data});
+}
+
+=pod
+
+=item clone
+
+Clones the object. This creates a new C<Net::OSCAR> object whose callbacks,
+loglevel, screenname debugging, and timeout are the same as those of the
+current object. This is provided as a convenience when using multiple
+C<Net::OSCAR> objects in order to allow you to set those parameters once
+and then call the L<signon> method on the object returned by clone.
+
+=cut
+
+sub clone($) {
+ my $self = shift;
+ my $clone = $self->new(@{$self->{_parameters}}); # Born in a science lab late one night
+ # Without a mother or a father
+ # Just a test tube and womb with a view...
+
+ # Okay, now we don't want to just copy the reference.
+ # If we did that, changing ourself would change the clone.
+ $clone->{callbacks} = { %{$self->{callbacks}} };
+
+ $clone->{LOGLEVEL} = $self->{LOGLEVEL};
+ $clone->{SNDEBUG} = $self->{SNDEBUG};
+ $clone->{timeout} = $self->{timeout};
+
+ foreach my $c (@{$clone->{connections}}) {
+ $c->{buffer} = \"";
+ }
+
+ return $clone;
+}
+
+=pod
+
+=item buddyhash
+
+Returns a reference to a tied hash which automatically normalizes its keys upon a fetch.
+Use this for hashes whose keys are AIM screennames since AIM screennames with different
+capitalization and spacing are considered equivalent.
+
+The keys of the hash as returned by the C<keys> and C<each> functions will be
+C<Net::OSCAR::Screenname> objects, so you they will automagically be compared
+without regards to case and whitespace.
+
+=cut
+
+sub buddyhash($) { bltie; }
+
+=pod
+
+=item findconn (FILENO)
+
+Finds the connection that is using the specified file number, or undef
+if the connection could not be found. Returns a C<Net::OSCAR::Connection>
+object.
+
+=cut
+
+sub findconn($$) {
+ my($self, $target) = @_;
+ my($conn) = grep { fileno($_->{socket}) == $target } @{$self->{connections}};
+ return $conn;
+}
+
+=pod
+
+=item selector_filenos
+
+Returns a list whose first element is a vec of all filehandles that we care
+about reading from and whose second element is a vec of all filehandles that
+we care about writing to. See the L<"process_connections"> method for details.
+
+=cut
+
+sub selector_filenos($) {
+ my $self = shift;
+ my($rin, $win) = ('', '');
+
+ foreach my $connection(@{$self->{connections}}) {
+ next unless $connection->{socket};
+ if($connection->{connected}) {
+ my $n = fileno($connection->{socket});
+ vec($rin, $n, 1) = 1;
+ }
+ if(!$connection->{connected} or $connection->{outbuff}) {
+ my $n = fileno($connection->{socket});
+ vec($win, $n, 1) = 1;
+ }
+ }
+ return ($rin, $win);
+}
+
+=item icon_checksum (ICONDATA)
+
+Returns a checksum of the buddy icon. Use this in conjunction with the
+C<icon_checksum> buddy info key to cache buddy icons.
+
+=cut
+
+sub icon_checksum($$) {
+ my($self, $icon) = @_;
+
+ my $sum = 0;
+ my $i = 0;
+ for($i = 0; $i+1 < length($icon); $i += 2) {
+ $sum += (ord(substr($icon, $i+1, 1)) << 8) + ord(substr($icon, $i, 1));
+ }
+
+ $sum += ord(substr($icon, $i, 1)) if $i < length($icon);
+
+ $sum = (($sum & 0xFFFF0000) >> 16) + ($sum & 0x0000FFFF);
+
+ return $sum;
+}
+
+=pod
+
+=item get_app_data ([GROUP[, BUDDY]])
+
+Gets application-specific data. Returns a hashref whose keys are app-data IDs.
+IDs with high-order byte 0x0001 are reserved for non-application-specific usage
+and must be registered with the C<libfaim-aim-protocol@lists.sourceforge.net> list.
+If you wish to set application-specific data, you should reserve a high-order
+byte for your application by emailing C<libfaim-aim-protocol@lists.sourceforge.net>.
+This data is stored in your server-side buddylist and so will be persistent,
+even across machines.
+
+If C<GROUP> is present, a hashref for accessing data specific to that group
+is returned.
+
+If C<BUDDY> is present, a hashref for accessing data specific to that buddy
+is returned.
+
+Call L<"commit_buddylist"> to have the new data saved on the OSCAR server.
+
+=cut
+
+sub get_app_data($;$$) {
+ my($self, $group, $buddy) = @_;
+
+ # We don't track changes to the contents of these hashes,
+ # so mark as dirty and let BLI figure out whether anything really changed.
+ if($group and $buddy) {
+ my $bud = $self->{buddies}->{$group}->{members}->{$buddy};
+ $bud->{__BLI_DIRTY} = 1;
+ return $bud->{data};
+ } elsif($group) {
+ my $grp = $self->{buddies}->{$group};
+ $grp->{__BLI_DIRTY} = 1;
+ return $grp->{data};
+ } else {
+ return $self->{appdata};
+ }
+}
+
+=pod
+
+=item chat_invite (CHAT, MESSAGE, WHO)
+
+Deprecated. Provided for compatibility with C<Net::AIM>.
+Use the appropriate method of the C<Net::OSCAR::Connection::Chat> object
+instead.
+
+=cut
+
+sub chat_invite($$$@) {
+ my($self, $chat, $msg, @who) = @_;
+ return must_be_on($self) unless $self->{is_on};
+ foreach my $who(@who) { $chat->{connection}->invite($who, $msg); }
+}
+
+=pod
+
+=item chat_leave (CHAT)
+
+Deprecated. Provided for compatibility with C<Net::AIM>.
+Use the appropriate method of the C<Net::OSCAR::Connection::Chat> object
+instead.
+
+=item chat_send (CHAT, MESSAGE)
+
+Deprecated. Provided for compatibility with C<Net::AIM>.
+Use the appropriate method of the C<Net::OSCAR::Connection::Chat> object
+instead.
+
+=cut
+
+sub chat_leave($$) { $_[1]->part(); }
+sub chat_send($$$) { $_[1]->chat_send($_[2]); }
+
+=pod
+
+=back
+
+=head3 CALLBACKS
+
+=over 4
+
+=item auth_challenge (OSCAR, CHALLENGE, HASHSTR)
+
+B<New for Net::OSCAR 2.0>: AOL Instant Messenger has changed their encryption
+mechanisms; instead of using the password in the hash, you B<may> now use
+the MD5 hash of the password. This allows your application to save the user's
+password in hashed form instead of plaintext if you're saving passwords.
+You must pass an extra parameter to C<auth_response> indicating that you are
+using the new encryption scheme. See below for an example.
+
+OSCAR uses an MD5-based challenge/response system for authentication so that the
+password is never sent in plaintext over the network. When a user wishes to sign on,
+the OSCAR server sends an arbitrary number as a challenge. The client must respond
+with the MD5 digest of the concatenation of, in this order, the challenge, the password,
+and an additional hashing string (currently always the string
+"AOL Instant Messenger (SM)", but it is possible that this might change in the future.)
+
+If password is undefined in L<"signon">, this callback will be triggered when the
+server sends a challenge during the signon process. The client must reply with
+the MD5 digest of CHALLENGE . MD5(password) . HASHSTR. For instance, using the
+L<MD5::Digest> module:
+
+ my($oscar, $challenge, $hashstr) = @_;
+ my $md5 = Digest::MD5->new;
+ $md5->add($challenge);
+ $md5->add(md5("password"));
+ $md5->add($hashstr);
+ $oscar->auth_response($md5->digest, 1);
+
+Note that this functionality is only available for certain services. It is
+available for AIM but not ICQ. Note also that the MD5 digest must be in binary
+form, not the more common hex or base64 forms.
+
+=item log (OSCAR, LEVEL, MESSAGE)
+
+Use this callback if you don't want the log_print methods to just print to STDERR.
+It is called when even C<MESSAGE> of level C<LEVEL> is called. The levels are,
+in order of increasing importance:
+
+=over 4
+
+=item OSCAR_DBG_NONE
+
+Really only useful for setting in the L<"loglevel"> method. No information will
+be logged. The default loglevel.
+
+=item OSCAR_DBG_PACKETS
+
+Hex dumps of all incoming/outgoing packets.
+
+=item OSCAR_DBG_DEBUG
+
+Information useful for debugging C<Net::OSCAR>, and precious little else.
+
+=item OSCAR_DBG_SIGNON
+
+Like C<OSCAR_DBG_NOTICE>, but only for the signon process; this is where
+problems are most likely to occur, so we provide this for the common case of
+people who only want a lot of information during signon. This may be deprecated
+some-day and be replaced by a more flexible facility/level system, ala syslog.
+
+=item OSCAR_DBG_NOTICE
+
+=item OSCAR_DBG_INFO
+
+=item OSCAR_DBG_WARN
+
+=back
+
+Note that these symbols are imported into your namespace if and only if you use
+the C<:loglevels> or C<:all> tags when importing the module (e.g. C<use Net::OSCAR qw(:standard :loglevels)>.)
+
+Also note that this callback is only triggered for events whose level is greater
+than or equal to the loglevel for the OSCAR session. The L<"loglevel"> method
+allows you to get or set the loglevel.
+
+=back
+
+=head2 ERROR HANDLING
+
+=head3 CALLBACKS
+
+=over 4
+
+=item error (OSCAR, CONNECTION, ERROR, DESCRIPTION, FATAL)
+
+Called when any sort of error occurs (except see L<admin_error> below and
+L<buddylist_error> in L<BUDDIES AND BUDDYLISTS>.)
+
+C<CONNECTION> is the particular connection which generated the error - the C<log_print> method of
+C<Net::OSCAR::Connection> may be useful, as may be getting C<$connection-E<gt>{description}>.
+C<DESCRIPTION> is a nicely formatted description of the error. C<ERROR> is an error number.
+
+If C<FATAL> is non-zero, the error was fatal and the connection to OSCAR has been
+closed.
+
+=item snac_unknown (OSCAR, CONNECTION, SNAC, DATA)
+
+Called when Net::OSCAR receives a message from the OSCAR server which
+it doesn't known how to handle. The default handler for this callback
+will print out the unknown SNAC.
+
+C<CONNECTION> is the C<Net::OSCAR::Connection> object on which the unknkown
+message was received. C<SNAC> is a hashref with keys such as C<family>, C<subtype>, C<flags1>, and
+C<flags2>.
+
+=back
+
+=cut
+
+sub do_callback($@) {
+ my $callback = shift;
+ return unless $_[0]->{callbacks}->{$callback};
+ &{$_[0]->{callbacks}->{$callback}}(@_);
+}
+sub set_callback { $_[1]->{callbacks}->{$_[0]} = $_[2]; }
+
+sub callback_error(@) { do_callback("error", @_); }
+sub callback_buddy_in(@) { do_callback("buddy_in", @_); }
+sub callback_buddy_out(@) { do_callback("buddy_out", @_); }
+sub callback_im_in(@) { do_callback("im_in", @_); }
+sub callback_chat_joined(@) { do_callback("chat_joined", @_); }
+sub callback_chat_buddy_in(@) { do_callback("chat_buddy_in", @_); }
+sub callback_chat_buddy_out(@) { do_callback("chat_buddy_out", @_); }
+sub callback_chat_im_in(@) { do_callback("chat_im_in", @_); }
+sub callback_chat_invite(@) { do_callback("chat_invite", @_); }
+sub callback_buddy_info(@) { do_callback("buddy_info", @_); }
+sub callback_evil(@) { do_callback("evil", @_); }
+sub callback_chat_closed(@) { do_callback("chat_closed", @_); }
+sub callback_buddylist_error(@) { do_callback("buddylist_error", @_); }
+sub callback_buddylist_ok(@) { do_callback("buddylist_ok", @_); }
+sub callback_buddylist_changed(@) { do_callback("buddylist_changed", @_); }
+sub callback_admin_error(@) { do_callback("admin_error", @_); }
+sub callback_admin_ok(@) { do_callback("admin_ok", @_); }
+sub callback_new_buddy_icon(@) { do_callback("new_buddy_icon", @_); }
+sub callback_buddy_icon_uploaded(@) { do_callback("buddy_icon_uploaded", @_); }
+sub callback_buddy_icon_downloaded(@) { do_callback("buddy_icon_downloaded", @_); }
+sub callback_rate_alert(@) { do_callback("rate_alert", @_); }
+sub callback_signon_done(@) { do_callback("signon_done", @_); }
+sub callback_log(@) { do_callback("log", @_); }
+sub callback_typing_status(@) { do_callback("typing_status", @_); }
+sub callback_extended_status(@) { do_callback("extended_status", @_); }
+sub callback_im_ok(@) { do_callback("im_ok", @_); }
+sub callback_connection_changed(@) { do_callback("connection_changed", @_); }
+sub callback_auth_challenge(@) { do_callback("auth_challenge", @_); }
+sub callback_stealth_changed(@) { do_callback("stealth_changed", @_); }
+sub callback_snac_unknown(@) { do_callback("snac_unknown", @_); }
+sub callback_rendezvous_reject(@) { do_callback("rendezvous_reject", @_); }
+sub callback_rendezvous_accept(@) { do_callback("rendezvous_accept", @_); }
+sub callback_buddylist_in(@) { do_callback("buddylist_in", @_); }
+
+sub set_callback_error($\&) { set_callback("error", @_); }
+sub set_callback_buddy_in($\&) { set_callback("buddy_in", @_); }
+sub set_callback_buddy_out($\&) { set_callback("buddy_out", @_); }
+sub set_callback_im_in($\&) { set_callback("im_in", @_); }
+sub set_callback_chat_joined($\&) { set_callback("chat_joined", @_); }
+sub set_callback_chat_buddy_in($\&) { set_callback("chat_buddy_in", @_); }
+sub set_callback_chat_buddy_out($\&) { set_callback("chat_buddy_out", @_); }
+sub set_callback_chat_im_in($\&) { set_callback("chat_im_in", @_); }
+sub set_callback_chat_invite($\&) { set_callback("chat_invite", @_); }
+sub set_callback_buddy_info($\&) { set_callback("buddy_info", @_); }
+sub set_callback_evil($\&) { set_callback("evil", @_); }
+sub set_callback_chat_closed($\&) { set_callback("chat_closed", @_); }
+sub set_callback_buddylist_error($\&) { set_callback("buddylist_error", @_); }
+sub set_callback_buddylist_ok($\&) { set_callback("buddylist_ok", @_); }
+sub set_callback_buddylist_changed($\&) { set_callback("buddylist_changed", @_); }
+sub set_callback_admin_error($\&) { set_callback("admin_error", @_); }
+sub set_callback_admin_ok($\&) { set_callback("admin_ok", @_); }
+sub set_callback_new_buddy_icon($\&) {
+ croak "This client does not support buddy icons." unless $_[0]->{capabilities}->{buddy_icons};
+ set_callback("new_buddy_icon", @_);
+}
+sub set_callback_buddy_icon_uploaded($\&) {
+ croak "This client does not support buddy icons." unless $_[0]->{capabilities}->{buddy_icons};
+ set_callback("buddy_icon_uploaded", @_);
+}
+sub set_callback_buddy_icon_downloaded($\&) {
+ croak "This client does not support buddy icons." unless $_[0]->{capabilities}->{buddy_icons};
+ set_callback("buddy_icon_downloaded", @_);
+}
+sub set_callback_rate_alert($\&) { set_callback("rate_alert", @_); }
+sub set_callback_signon_done($\&) { set_callback("signon_done", @_); }
+sub set_callback_log($\&) { set_callback("log", @_); }
+sub set_callback_typing_status($\&) {
+ croak "This client does not support typing status notification." unless $_[0]->{capabilities}->{typing_status};
+ set_callback("typing_status", @_);
+}
+sub set_callback_extended_status($\&) {
+ croak "This client does not support extended status messages." unless $_[0]->{capabilities}->{extended_status};
+ set_callback("extended_status", @_);
+}
+sub set_callback_im_ok($\&) { set_callback("im_ok", @_); }
+sub set_callback_connection_changed($\&) { set_callback("connection_changed", @_); }
+sub set_callback_auth_challenge($\&) { set_callback("auth_challenge", @_); }
+sub set_callback_stealth_changed($\&) { set_callback("stealth_changed", @_); }
+sub set_callback_snac_unknown($\&) { set_callback("snac_unknown", @_); }
+sub set_callback_rendezvous_reject($\&) { set_callback("snac_rendezvous_reject", @_); }
+sub set_callback_rendezvous_accept($\&) { set_callback("snac_rendezvous_accept", @_); }
+sub set_callback_buddylist_in($\&) {
+ croak "This client does not support buddy list transfer." unless $_[0]->{capabilities}->{buddy_list_transfer};
+ set_callback("buddylist_in", @_);
+}
+
+=pod
+
+=head1 CHAT CONNECTIONS
+
+Aside from the methods listed here, there are a couple of methods of the
+C<Net::OSCAR::Connection::Chat> object that are important for implementing chat
+functionality. C<Net::OSCAR::Connection::Chat> is a descendent of C<Net::OSCAR::Connection>.
+
+=over 4
+
+=item invite (WHO, MESSAGE)
+
+Invite somebody into the chatroom.
+
+=item chat_send (MESSAGE[, NOREFLECT[, AWAY]])
+
+Sends a message to the chatroom. If the NOREFLECT parameter is
+present, you will not receive the message as an incoming message
+from the chatroom. If AWAY is present, the message was generated
+as an automatic reply, perhaps because you have an away message set.
+
+=item part
+
+Leave the chatroom.
+
+=item url
+
+Returns the URL for the chatroom. Use this to associate a chat invitation
+with the chat_joined that C<Net::OSCAR> sends when you've join the chatroom.
+
+=item name
+
+Returns the name of the chatroom.
+
+=item exchange
+
+Returns the exchange of the chatroom.
+This is normally 4 but can be 5 for certain chatrooms.
+
+=back
+
+=head1 RATE LIMIT OVERVIEW
+
+The OSCAR server has the ability to specify restrictions on the rate at which
+the client, your application, can send it commands. These constraints can be independently
+set and tracked for different classes of command, so there might be one limit on how
+fast you can send IMs and another on how fast you can request away messages.
+If your application exceeds these limits, the OSCAR server may start ignoring it or
+may even disconnect your session.
+
+See also the reference section on L<rate limits|"RATE LIMITS">.
+
+=head2 RATE MANAGEMENT MODES
+
+C<Net::OSCAR> supports three different schemes for managing these limits. Pass the
+scheme you want to use as the value of the C<rate_manage> key when you invoke the
+L<"new"> method.
+
+=head3 OSCAR_RATE_MANAGE_NONE
+
+The default. C<Net::OSCAR> will not keep track of what the limits are,
+much less how close you're coming to reaching them. If the OSCAR server complains
+that you are sending too fast, your L<"rate_alert"> callback will be triggered.
+
+=head3 OSCAR_RATE_MANAGE_AUTO
+
+In this mode, C<Net::OSCAR> will prevent your application from exceeding the limits.
+If you try to send a command which would cause the limits to be exceeded, your
+command will be queued. You will be notified when this happens via the L<"rate_alert">
+callback. B<This mode is only available if your application implements C<Net::OSCAR>'s
+L<time-delayed event system|"TIME-DELAYED EVENTS">.>
+
+=head3 OSCAR_RATE_MANAGE_MANUAL
+
+In this mode, C<Net::OSCAR> will track what the limits are and how close you're
+coming to reaching them, but won't do anything about it. Your application should use the
+L<"rate_level">, L<"rate_limits">, and L<"would_make_rate_level"> methods to
+control its own rate.
+
+=head1 TIME-DELAYED EVENTS
+
+=head1 CONSTANTS
+
+The following constants are defined when C<Net::OSCAR> is imported with the
+C<:standard> tag. Unless indicated otherwise, the constants are magical
+scalars - they return different values in string and numeric contexts (for
+instance, an error message and an error number.)
+
+=over 4
+
+=item ADMIN_TYPE_PASSWORD_CHANGE
+
+=item ADMIN_TYPE_EMAIL_CHANGE
+
+=item ADMIN_TYPE_SCREENNAME_FORMAT
+
+=item ADMIN_TYPE_ACCOUNT_CONFIRM
+
+=item ADMIN_ERROR_UNKNOWN
+
+=item ADMIN_ERROR_BADPASS
+
+=item ADMIN_ERROR_BADINPUT
+
+=item ADMIN_ERROR_BADLENGTH
+
+=item ADMIN_ERROR_TRYLATER
+
+=item ADMIN_ERROR_REQPENDING
+
+=item ADMIN_ERROR_CONNREF
+
+=item VISMODE_PERMITALL
+
+=item VISMODE_DENYALL
+
+=item VISMODE_PERMITSOME
+
+=item VISMODE_DENYSOME
+
+=item VISMODE_PERMITBUDS
+
+=item RATE_CLEAR
+
+=item RATE_ALERT
+
+=item RATE_LIMIT
+
+=item RATE_DISCONNECT
+
+=item OSCAR_RATE_MANAGE_NONE
+
+=item OSCAR_RATE_MANAGE_AUTO
+
+=item OSCAR_RATE_MANAGE_MANUAL
+
+=item GROUPPERM_OSCAR
+
+=item GROUPPERM_AOL
+
+=item TYPINGSTATUS_STARTED
+
+=item TYPINGSTATUS_TYPING
+
+=item TYPINGSTATUS_FINISHED
+
+=back
+
+=head1 Net::AIM Compatibility
+
+Here are the major differences between the C<Net::OSCAR> interface
+and the C<Net::AIM> interface:
+
+=over 4
+
+=item *
+
+No get/set method.
+
+=item *
+
+No newconn/getconn method.
+
+=item *
+
+No group parameter for add_permit or add_deny.
+
+=item *
+
+Many differences in chat handling.
+
+=item *
+
+No chat_whisper.
+
+=item *
+
+No encode method - it isn't needed.
+
+=item *
+
+No send_config method - it isn't needed.
+
+=item *
+
+No send_buddies method - we don't keep a separate local buddylist.
+
+=item *
+
+No normalize method - it isn't needed. Okay, there is a normalize
+function in C<Net::OSCAR::Utility>, but I can't think of any reason
+why it would need to be used outside of the module internals. C<Net::OSCAR>
+provides the same functionality through the C<Net::OSCAR::Screenname> class.
+
+=item *
+
+Different callbacks with different parameters.
+
+=back
+
+=head1 MISCELLANEOUS INFO
+
+There are two programs included with the C<Net::OSCAR> distribution.
+C<oscartest> is half a reference implementation of a C<Net::OSCAR> client
+and half a tool for testing this library. C<snacsnatcher> is a tool designed
+for analyzing the OSCAR protocol from libpcap-format packet captures, but
+it isn't particularly well-maintained; the Ethereal sniffer does a good
+job at this nowadays.
+
+There is a class C<Net::OSCAR::Screenname>. OSCAR screennames
+are case and whitespace insensitive, and if you do something like
+C<$buddy = new Net::OSCAR::Screenname "Matt Sachs"> instead of
+C<$buddy = "Matt Sachs">, this will be taken care of for you when
+you use the string comparison operators (eq, ne, cmp, etc.)
+
+C<Net::OSCAR::Connection>, the class used for connection objects,
+has some methods that may or may not be useful to you.
+
+=over 4
+
+=item get_filehandle
+
+Returns the filehandle used for the connection. Note that this is a method
+of C<Net::OSCAR::Connection>, not C<Net::OSCAR>.
+
+=item process_one (CAN_READ, CAN_WRITE, HAS_ERROR)
+
+Call this when a C<Net::OSCAR::Connection> is ready for reading and/or
+writing. You might call this yourself instead of using L<"process_connections">
+when, for instance, using the L<"connection_changed"> callback in conjunction with
+C<IO::Poll> instead of C<select>. The C<CAN_READ> and C<CAN_WRITE> parameters
+should be non-zero if the connection is ready for the respective operations to be
+performed and zero otherwise. If and only if there was a socket error with the
+connection, set C<HAS_ERROR> to non-zero.
+
+=item session
+
+Returns the C<Net::OSCAR> object associated with this C<Net::OSCAR::Connection>.
+
+=back
+
+=head1 USER INFORMATION
+
+Methods which return information about a user, such as L<"buddy">, will return
+the information in the form of a hash. The keys of the hash are the following --
+note that any of these may be absent.
+
+=over 4
+
+=item online
+
+The user is signed on. If this key is not present, all of the other keys may not
+be present.
+
+=item screenname
+
+The formatted version of the user's screenname. This includes all spacing and
+capitalization. This is a C<Net::OSCAR::Screenname> object, so you don't have to
+worry about the fact that it's case and whitespace insensitive when comparing it.
+
+=item comment
+
+A user-defined comment associated with the buddy. See L<"set_buddy_comment">.
+Note that this key will be present but undefined if there is no comment.
+
+=item alias
+
+A user-defined alias for the buddy. See L<"set_buddy_alias">.
+Note that this key will be present but undefined if there is no alias.
+
+=item extended_status
+
+The user's extended status message, if one is set, will be in this key.
+This requires that you set the C<extended_status> capability when
+creating the C<Net::OSCAR> object.
+
+=item trial
+
+The user's account has trial status.
+
+=item aol
+
+The user is accessing the AOL Instant Messenger service from America OnLine.
+
+=item free
+
+Opposite of aol.
+
+=item away
+
+The user is away.
+
+=item admin
+
+The user is an administrator.
+
+=item mobile
+
+The user is using a mobile device.
+
+=item typing_status
+
+The user is known to support typing status notification. We only find this out if they send us an IM.
+
+=item capabilities
+
+The user's capabilities. This is a reference to a hash whose keys are the user's capabilities, and
+whose values are descriptions of their respective capabilities.
+
+=item icon
+
+The user's buddy icon, if available.
+
+=item icon_checksum
+
+The checksum time of the user's buddy icon, if available. Use this, in conjunction with
+the L<icon_checksum> method, to cache buddy icons.
+
+=item icon_timestamp
+
+The modification timestamp of the user's buddy icon, if available.
+
+=item icon_length
+
+The length of the user's buddy icon, if available.
+
+=item membersince
+
+Time that the user's account was created, in the same format as the C<time> function.
+
+=item onsince
+
+Time that the user signed on to the service, in the same format as the C<time> function.
+
+=item idle_since
+
+Time, in seconds since Jan 1st 1970, since which the user has been idle. This will only
+be present if the user is idle. To figure out how long the user has been idle for,
+subtract this value from C<time()> .
+
+=item evil
+
+Evil (warning) level for the user.
+
+=back
+
+Some keys; namely, C<typing_status> and C<icon_checksum>, may be available for people
+who the user has communicated with but who are not on the user's buddylist.
+
+=cut
+
+
+=pod
+
+=head1 ICQ-SPECIFIC INFORMATION
+
+ICQ support isn't nearly as well-tested as AIM support, and ICQ-specific
+features aren't being particularly actively developed. Patches for ICQ-isms
+are welcome. The initial patch enabling us to sign on to ICQ was provided by Sam Wong.
+
+=head2 ICQ METHODS
+
+=over 4
+
+=item get_icq_info (UIN)
+
+Requests ICQ-specific information. See also the L<"buddy_icq_info"> callback.
+
+=cut
+
+sub get_icq_info($$) {
+ my($self, $uin) = @_;
+
+ $self->svcdo(CONNTYPE_BOS, protobit => "ICQ_meta_request", protodata => {
+ our_uin => $self->{screenname},
+ type => 2000,
+ seqno => ++$self->{bos}->{icq_seqno},
+ typedata => protoparse($self, "ICQ_meta_info_request")->pack(uin => $uin)
+ });
+}
+
+=pod
+
+=back
+
+=head2 ICQ CALLBACKS
+
+=over 4
+
+=item buddy_icq_info (OSCAR, UIN, ICQ DATA)
+
+The result of a L<"get_icq_info"> call. Data is a hashref with the following keys, the value
+of each key is a either a hashref or undefined:
+
+=over 4
+
+=item basic
+
+=over 4
+
+=item nickname
+
+=item firstname
+
+=item lastname
+
+=item email
+
+=item gmt_offset
+
+=item authorization
+
+=item web_aware
+
+=item direct_connect_permissions
+
+=item publish_primary_email
+
+=back
+
+=item home
+
+=over 4
+
+=item city
+
+=item state
+
+=item phone_num
+
+=item fax_num
+
+=item address
+
+=item cell_phone_num
+
+=item zip_code
+
+=item country_code
+
+=back
+
+=item office
+
+=over 4
+
+=item city
+
+=item state
+
+=item phone_num
+
+=item fax_num
+
+=item address
+
+=item zip_code
+
+=item country_code
+
+=item company
+
+=item department
+
+=item position
+
+=item occupation
+
+=item office_website
+
+=back
+
+=item background
+
+=over 4
+
+=item age
+
+=item gender
+
+=item homepage
+
+=item birth_year
+
+=item birth_month
+
+=item birth_day
+
+=item spoken_languages
+
+This key is a listref containing the langauges the user speaks.
+
+=item origin_city
+
+=item origin_state
+
+=item origin_country
+
+=item marital_status
+
+=back
+
+=item notes
+
+This key is a simple scalar.
+
+=item email_addresses
+
+This key is a listref, each element of which is a hashref with the following keys:
+
+=over 4
+
+=item publish
+
+=item address
+
+=back
+
+=item interests
+
+This key is a listref, each element of which is a hashref with the following keys:
+
+=over 4
+
+=item category
+
+=item interest
+
+=back
+
+=item past_affiliations
+
+This key is a listref, each element of which is a hashref with the following keys:
+
+=over 4
+
+=item category
+
+=item affiliation
+
+=back
+
+=item present_affiliations
+
+As per above.
+
+=item homepage
+
+=over 4
+
+=item category
+
+=item keywords
+
+=back
+
+=back
+
+=back
+
+=cut
+
+sub callback_buddy_icq_info(@) { do_callback("buddy_icq_info", @_); }
+sub set_callback_buddy_icq_info($\&) { set_callback("buddy_icq_info", @_); }
+
+
+=pod
+
+=head1 HIGH-PERFORMANCE EVENT PROCESSING
+
+A second way of doing event processing is designed to make it easy to integrate C<Net::OSCAR> into
+an existing C<select>-based event loop, especially one where you have many C<Net::OSCAR> objects.
+Simply call the L<"process_connections"> method with references to the lists of readers, writers,
+and errors given to you by C<select>. Connections that don't belong to the object will be ignored,
+and connections that do belong to the object will be removed from the C<select> lists so that you
+can use the lists for your own purposes.
+Here is an example that demonstrates how to use this method with multiple C<Net::OSCAR> objects:
+
+ my $ein = $rin | $win;
+ select($rin, $win, $ein, 0.01);
+ foreach my $oscar(@oscars) {
+ $oscar->process_connections(\$rin, \$win, \$ein);
+ }
+
+ # Now $rin, $win, and $ein only have the file descriptors not
+ # associated with any of the OSCAR objects in them - we can
+ # process our events.
+
+The third way of doing connection processing uses the L<"connection_changed">
+callback in conjunction with C<Net::OSCAR::Connection>'s L<"process_one"> method.
+This method, in conjunction with C<IO::Poll>, probably offers the highest performance
+in situations where you have a long-lived application which creates and destroys many
+C<Net::OSCAR> sessions; that is, an application whose list of file descriptors to
+monitor will likely be sparse. However, this method is the most complicated.
+What you need to do is call C<IO::Poll::mask> inside of the L<"connection_changed">
+callback. That part's simple. The tricky bit is figuring out which
+C<Net::OSCAR::Connection::process_one>'s to call and how to call them. My recommendation
+for doing this is to use a hashmap whose keys are the file descriptors of everything
+you're monitoring in the C<IO::Poll> - the FDs can be retrieved by doing
+C<fileno($connection-E<gt>get_filehandle)> inside of the L<"connection_changed"> -
+and then calling C<@handles = $poll-E<gt>handles(POLLIN | POLLOUT | POLLERR | POLLHUP)>
+and walking through the handles.
+
+For optimum performance, use the L<"connection_changed"> callback.
+
+=head1 HISTORY
+
+=over 4
+
+=item *
+
+1.925, 2006-02-06
+
+=over 4
+
+=item *
+
+Many buddylist performance enhancements and bug fixes.
+
+=item *
+
+Added support for receiving dynamic buddylist changes from the server
+(C<callback_buddylist_changed>.)
+
+=item *
+
+Add support buddylist transfer (C<set_callback_buddylist_in>.)
+
+=item *
+
+Miscellaneous performance and scalability enhancements.
+
+=item *
+
+Added experimental migration support.
+
+=item *
+
+Added advanced rate limit management API.
+
+=item *
+
+Added C<oscarserv> server for testing.
+
+=item *
+
+Audited screennames exposed to application to verify that they are
+C<Net::OSCAR::Screenname> objects everywhere.
+
+=item *
+
+Began work on file transfer.
+
+=item *
+
+Connection status fix for compatibility with POE.
+
+=back
+
+=item *
+
+1.907, 2004-09-22
+
+=over 4
+
+=item *
+
+Fixed assert failure on certain invalid input ("Buddy Trikill" crash)
+
+=back
+
+=item *
+
+1.906, 2004-08-28
+
+=over 4
+
+=item *
+
+Reorganized documentation
+
+=back
+
+=item *
+
+1.904, 2004-08-26
+
+=over 4
+
+=item *
+
+Add $Net::OSCAR::XML::NO_XML_CACHE to prevent use of cached XML parse tree,
+and skip tests if we can't load Test::More or XML::Parser.
+
+=back
+
+=item *
+
+1.903, 2004-08-26
+
+=over 4
+
+=item *
+
+Generate XML parse tree at module build time so that users don't need to have
+XML::Parser and expat installed.
+
+=back
+
+=item *
+
+1.902, 2004-08-26
+
+=over 4
+
+=item *
+
+Fixes to buddy icon upload and chat invitation decline
+
+=item *
+
+Increase performance by doing lazy generation of certain debugging info
+
+=back
+
+=item *
+
+1.901, 2004-08-24
+
+=over 4
+
+=item *
+
+Lots of buddylist-handling bug fixes; should fix intermittent buddylist modification errors
+and errors only seen when modifying certain screennames; Roy C. rocks.
+
+=item *
+
+We now require Perl 5.6.1.
+
+=item *
+
+Workaround for bug in Perl pre-5.8.4 which manifested as a "'basic OSCAR services' isn't numeric"
+warning followed by the program freezing.
+
+=item *
+
+C<add_group> and C<remove_group> methods added.
+
+=item *
+
+Fixed a potential memory leak which could impact programs which create many transient Net::OSCAR
+objects.
+
+=back
+
+=item *
+
+1.900, 2004-08-17
+
+=over 4
+
+=item *
+
+Wrote new XML-based protocol back-end with reasonably comprehensive test-suite.
+Numerous protocol changes; we now emulate AOL's version 5.5 client.
+
+=item *
+
+Rewrote snacsnatcher, an OSCAR protocol analysis tool
+
+=item *
+
+Reorganized documentation
+
+=item *
+
+ICQ meta-info support: get_icq_info method, buddy_icq_info callback
+
+=item *
+
+Stealth mode support: is_stealth and set_stealth methods, stealth_changed callback, stealth signon key
+
+=item *
+
+More flexible unknown SNAC handling: snac_unknown callback
+
+=item *
+
+Application can give Net::OSCAR the MD5-hashed password instead of the cleartext password
+(pass_is_hashed signon key). This is useful if your application is storing user passwords.
+
+=item *
+
+Inability to set blocking on Win32 is no longer fatal. Silly platform.
+
+=item *
+
+Fixed chat functionality.
+
+=back
+
+=item *
+
+1.11, 2004-02-13
+
+=over 4
+
+=item *
+
+Fixed presence-related problems modifying some buddylists
+
+=back
+
+=item *
+
+1.10, 2004-02-10
+
+=over 4
+
+=item *
+
+Fixed idle time handling; user info hashes now have an 'idle_since' key,
+which you should use instead of the old 'idle' key. Subtract C<idle_since>
+from C<time()> to get the length of time for which the user has been idle.
+
+=item *
+
+Fixed buddylist type 5 handling; this fixes problems modifying the buddylists
+of recently-created screennames.
+
+=back
+
+=item *
+
+1.01, 2004-01-06
+
+=over 4
+
+=item *
+
+Fixed buddy ID generation (problems adding buddies)
+
+=back
+
+=item *
+
+1.00, 2004-01-03
+
+=over 4
+
+=item *
+
+Documented requirement to wait for buddylist_foo callback between calls to commit_buddylist
+
+=item *
+
+Fixed handling of idle time (zoyboy22)
+
+=item *
+
+More flexible signon method
+
+=item *
+
+Added buddy alias support
+
+=item *
+
+Buddy icon support
+
+=item *
+
+Typing notification support
+
+=item *
+
+mac.com screenname support
+
+=item *
+
+Support for communicating with ICQ users from AIM
+
+=item *
+
+iChat extended status message support
+
+=item *
+
+We now emulate AOL Instant Messenger for Windows 5.2
+
+=item *
+
+We now parse the capabilities of other users
+
+=item *
+
+Attempts at Win32 (non-cygwin) support
+
+=back
+
+=item *
+
+0.62, 2002-02-25
+
+=over 4
+
+=item *
+
+Error handling slightly improved; error 29 is no longer unknown.
+
+=item *
+
+A minor internal buddylist enhancement
+
+=item *
+
+snacsnatcher fixes
+
+=back
+
+=item *
+
+0.61, 2002-02-17
+
+=over 4
+
+=item *
+
+Fixed connection handling
+
+=back
+
+=item *
+
+0.60, 2002-02-17
+
+=over 4
+
+=item *
+
+Various connection_changed fixes, including the new readwrite status.
+
+=item *
+
+Added Net::OSCAR::Connection::session method
+
+=item *
+
+Improved Net::OSCAR::Connection::process_one, documented it, and documented using it
+
+=back
+
+=item *
+
+0.59, 2002-02-15
+
+=over 4
+
+=item *
+
+Protocol fixes - solves problem with AOL calling us an unauthorized client
+
+=item *
+
+Better handling of socket errors, especially when writing
+
+=item *
+
+Minor POD fixes
+
+=back
+
+=item *
+
+0.58, 2002-01-20
+
+=over 4
+
+=item *
+
+Send buddylist deletions before adds - needed for complex BL mods (loadbuddies)
+
+=item *
+
+Added hooks to allow client do MD5 digestion for authentication (auth_challenge
+callback, Net::OSCAR::auth_response method)
+
+=back
+
+=item *
+
+0.57, 2002-01-16
+
+=over 4
+
+=item *
+
+Send callback_chat_joined correctly when joining an existing chat
+
+=item *
+
+Don't activate OldPerl fixes for perl 5.6.0
+
+=item *
+
+Ignore chats that we're already in
+
+=back
+
+=item *
+
+0.56, 2002-01-16
+
+=over 4
+
+=item *
+
+Fixed rate handling
+
+=item *
+
+Send multiple buddylist modifications per SNAC
+
+=item *
+
+Detect when someone else signs on with your screenname
+
+=item *
+
+Corrected attribution of ICQ support
+
+=back
+
+=item *
+
+0.55, 2001-12-29
+
+=over 4
+
+=item *
+
+Preliminary ICQ support, courtesy of SDiZ Chen (actually, Sam Wong).
+
+=item *
+
+Restored support for pre-5.6 perls - reverted from C<IO::Socket> to C<Socket>.
+
+=item *
+
+Corrected removal of buddylist entries and other buddylist-handling improvements
+
+=item *
+
+Improved rate handling - new C<worrisome> parameter to rate_alert callback
+
+=item *
+
+Removed remaining C<croak> from C<OSCAR::Connection>
+
+=item *
+
+Added is_on method
+
+=back
+
+=item *
+
+0.50, 2001-12-23
+
+=over 4
+
+=item *
+
+Fixes for the "crap out on 'connection reset by peer'" and "get stuck and slow down in Perl_sv_2bool" bugs!
+
+=item *
+
+Correct handling of very large (over 100 items) buddylists.
+
+=item *
+
+We can now join exchange 5 chats.
+
+=item *
+
+Fixes in modifying permit mode.
+
+=item *
+
+Updated copyright notice courtesy of AOL's lawyers.
+
+=item *
+
+Switch to IO::Socket for portability in set_blocking.
+
+=back
+
+=item *
+
+0.25, 2001-11-26
+
+=over 4
+
+=item *
+
+Net::OSCAR is now in beta!
+
+=item *
+
+We now work with perl 5.005 and even 5.004
+
+=item *
+
+Try to prevent weird Net::OSCAR::Screenname bug where perl gets stuck in Perl_sv_2bool
+
+=item *
+
+Fixed problems with setting visibility mode and adding to deny list (thanks, Philip)
+
+=item *
+
+Added some methods to allow us to be POE-ified
+
+=item *
+
+Added guards around a number of methods to prevent the user from trying to do stuff before s/he's finished signing on.
+
+=item *
+
+Fix *incredibly* stupid error in NO_to_BLI that ate group names
+
+=item *
+
+Fixed bad bug in log_printf
+
+=item *
+
+Buddylist error handling changes
+
+=item *
+
+Added chat_decline command
+
+=item *
+
+Signon, signoff fixes
+
+=item *
+
+Allow AOL screennames to sign on
+
+=item *
+
+flap_get crash fixes
+
+=back
+
+=item *
+
+0.09, 2001-10-01
+
+=over 4
+
+=item *
+
+Crash and undefined value fixes
+
+=item *
+
+New method: im_ok
+
+=item *
+
+New method: rename_group, should fix "Couldn't get group name" error.
+
+=item *
+
+Fix for buddy_in callback and data
+
+=item *
+
+Better error handling when we can't resolve a host
+
+=item *
+
+Vastly improved logging infrastructure - debug_print(f) replaced with log_print(f). debug_print callback is now called log and has an extra parameter.
+
+=item *
+
+Fixed MANIFEST - we don't actually use Changes (and we do use Screenname.pm)
+
+=item *
+
+blinternal now automagically enforces the proper structure (the right things become Net::OSCAR::TLV tied hashes and the name and data keys are automatically created) upon vivification. So, you can do $bli-E<gt>{0}-E<gt>{1}-E<gt>{2}-E<gt>{data}-E<gt>{0x3} = "foo" without worrying if 0, 1, 2, or data have been tied. Should close bug #47.
+
+=back
+
+=item *
+
+0.08, 2001-09-07
+
+=over 4
+
+=item *
+
+Totally rewritten buddylist handling. It is now much cleaner, bug-resistant,
+and featureful.
+
+=item *
+
+Many, many internal changes that I don't feel like enumerating.
+Hey, there's a reason that I haven't declared the interface stable yet! ;)
+
+=item *
+
+New convenience object: Net::OSCAR::Screenname
+
+=item *
+
+Makefile.PL: Fixed perl version test and compatibility with BSD make
+
+=back
+
+=item *
+
+0.07, 2001-08-13
+
+=over 4
+
+=item *
+
+A bunch of Makefile.PL fixes
+
+=item *
+
+Fixed spurious admin_error callback and prevent user from having multiple
+pending requests of the same type. (closes #39)
+
+=item *
+
+Head off some potential problems with set_visibility. (closes #34)
+
+=item *
+
+Removed connections method, added selector_filenos
+
+=item *
+
+Added error number 29 (too many recent signons from your site) to Net::OSCAR::Common.
+
+=item *
+
+We now explicitly perl 5.6.0 or newer.
+
+=back
+
+=item *
+
+0.06, 2001-08-12
+
+=over 4
+
+=item *
+
+Prevent sending duplicate signon_done messages
+
+=item *
+
+Don't addconn after crapping out!
+
+=item *
+
+Don't try to delconn unless we have connections.
+
+=item *
+
+delete returns the correct value now in Net::OSCAR::Buddylist.
+
+=item *
+
+Don't use warnings if $] E<lt>= 5.005
+
+=item *
+
+evil is a method, not a manpage (doc fix)
+
+=item *
+
+Added buddyhash method.
+
+=item *
+
+Added a debug_print callback.
+
+=item *
+
+Clarified process_connections method in documentation
+
+=item *
+
+You can now specify an alternate host/port in signon
+
+=item *
+
+Added name method to Chat.
+
+=item *
+
+permit list and deny list are no longer part of buddylist
+
+=item *
+
+Rewrote buddylist parsing (again!)
+
+=item *
+
+No more default profile.
+
+=item *
+
+Fix bug when storing into an already-existing key in Net::OSCAR::Buddylist.
+
+=item *
+
+snacsnatcher: Remove spurious include of Net::OSCAR::Common
+
+=item *
+
+We don't need to handle VISMODE_PERMITBUDS ourself - the server takes care of it.
+Thanks, VB!
+
+=item *
+
+Makefile.PL: Lots of way cool enhancements to make dist:
+
+=over 4
+
+=item -
+
+It modifies the version number for us
+
+=item -
+
+It does a CVS rtag
+
+=item -
+
+It updates the HTML documentation on zevils and the README.
+
+=back
+
+=item *
+
+Added HISTORY and INSTALLATION section to POD.
+
+=back
+
+=item *
+
+0.05, 2001-08-08
+
+=over 4
+
+=item *
+
+Don't send signon_done until after we get buddylist.
+
+=item *
+
+Added signoff method.
+
+=item *
+
+Fixed typo in documentation
+
+=item *
+
+Fixed chat_invite parm count
+
+=item *
+
+Added Scalar::Utils::dualvar variables, especially to Common.pm.
+dualvar variables return different values in numeric and string context.
+
+=item *
+
+Added url method for Net::OSCAR::Chat (closes #31)
+
+=item *
+
+Divide evil by 10 in extract_userinfo (closes #30)
+
+=item *
+
+chat_invite now exposes chatname (closes #32)
+
+=item *
+
+Removed unnecessary and warning-generating session length from extract_userinfo
+
+=back
+
+=item *
+
+0.01, 2001-08-02
+
+=over 4
+
+=item *
+
+Initial release.
+
+=back
+
+=back
+
+=head1 SUPPORT
+
+See http://www.zevils.com/programs/net-oscar/ for support, including
+a mailing list and bug-tracking system.
+
+=head1 AUTHOR
+
+Matthew Sachs E<lt>matthewg@zevils.comE<gt>.
+
+=head1 CREDITS
+
+AOL, for creating the AOL Instant Messenger service, even though they aren't terribly helpful to
+developers of third-party clients.
+
+Apple Computer for help with mac.com support.
+
+The users of IMIRC for being reasonably patient while this module was developed. E<lt>http://www.zevils.com/programs/imirc/E<gt>
+
+Bill Atkins for typing status notification and mobile user support. E<lt>http://www.milkbone.org/E<gt>
+
+Jayson Baker for some last-minute debugging help.
+
+Roy Camp for loads of bug reports and ideas and helping with user support.
+
+Rocco Caputo for helping to work out the hooks that let use be used with
+POE. E<lt>http://poe.perl.org/E<gt>
+
+Mark Doliner for help with remote buddylists. E<lt>http://kingant.net/libfaim/ReadThis.htmlE<gt>
+
+Adam Fritzler and the libfaim team for their documentation and an OSCAR implementation that
+was used to help figure out a lot of the protocol details. E<lt>http://www.zigamorph.net/faim/protocol/E<gt>
+
+The gaim team - the source to their libfaim client was also very helpful. E<lt>http://gaim.sourceforge.net/E<gt>
+
+Nick Gray for sponsoring scalability work.
+
+John "VBScript" for a lot of technical assistance, including the explanation of rates.
+
+Jonathon Wodnicki for additional help with typing status notification.
+
+Sam Wong E<lt>sam@uhome.netE<gt> for a patch implementing ICQ2000 support.
+
+=head1 LEGAL
+
+Copyright (c) 2001 Matthew Sachs. All rights reserved.
+This program is free software; you can redistribute it and/or modify it under the
+same terms as Perl itself. B<AOL> and B<AMERICA ONLINE> are registered trademarks
+owned by America Online, Inc. The B<INSTANT MESSENGER> mark is owned by America
+Online, Inc. B<ICQ> is a trademark and/or servicemark of ICQ. C<Net::OSCAR> is not
+endorsed by, or affiliated with, America Online, Inc or ICQ. B<iChat> and B<Apple Computer>
+are registered trademarks of Apple Computer, Inc. C<Net::OSCAR> is not endorsed by,
+or affiliated with, Apple Computer, Inc or iChat.
+
+=cut
+
+
+
+### Private methods
+
+sub addconn($@) {
+ my $self = shift;
+ my %data = @_;
+
+ $data{session} = $self;
+ weaken($data{session});
+
+ my $connection;
+ my $conntype = $data{conntype};
+ $data{description} ||= $conntype;
+
+ if($conntype == CONNTYPE_CHAT) {
+ require Net::OSCAR::Connection::Chat;
+ $connection = Net::OSCAR::Connection::Chat->new(%data);
+ } elsif($conntype == CONNTYPE_DIRECT_IN) {
+ require Net::OSCAR::Connection::Direct;
+ $connection = Net::OSCAR::Connection::Direct->new(%data);
+ $connection->listen();
+ } elsif($conntype == CONNTYPE_DIRECT_OUT) {
+ require Net::OSCAR::Connection::Direct;
+ $connection = Net::OSCAR::Connection::Direct->new(%data);
+ } elsif($conntype == CONNTYPE_SERVER) {
+ require Net::OSCAR::Connection::Server;
+ $connection = Net::OSCAR::Connection::Server->new(%data);
+ } else {
+ $connection = Net::OSCAR::Connection->new(%data);
+ # We set the connection to 1 to indicate that it is in progress but not ready for SNAC-sending yet.
+ $self->{services}->{$conntype} = 1 unless $conntype == CONNTYPE_CHAT;
+ }
+
+ if($conntype == CONNTYPE_BOS) {
+ $self->{services}->{$conntype} = $connection;
+ }
+
+ push @{$self->{connections}}, $connection;
+ $self->callback_connection_changed($connection, $connection->{state});
+ return $connection;
+}
+
+sub delconn($$) {
+ my($self, $connection) = @_;
+
+ return unless $self->{connections};
+ $self->callback_connection_changed($connection, "deleted") if $connection->{socket};
+ for(my $i = scalar @{$self->{connections}} - 1; $i >= 0; $i--) {
+ next unless $self->{connections}->[$i] == $connection;
+ $connection->log_print(OSCAR_DBG_NOTICE, "Closing.");
+ splice @{$self->{connections}}, $i, 1;
+ if(!$connection->{sockerr}) {
+ eval {
+ if($connection->{socket} and $connection->{conntype} != CONNTYPE_DIRECT_IN and $connection->{conntype} != CONNTYPE_DIRECT_OUT) {
+ $connection->flap_put("", FLAP_CHAN_CLOSE);
+ }
+ close $connection->{socket} if $connection->{socket};
+ };
+ } else {
+ delete $self->{services}->{$connection->{conntype}} unless $connection->{conntype} == CONNTYPE_CHAT;
+
+ if($connection->{conntype} == CONNTYPE_BOS or ($connection->{conntype} == CONNTYPE_LOGIN and !$connection->{closing})) {
+ delete $connection->{socket};
+ return $self->crapout($connection, "Lost connection to BOS");
+ } elsif($connection->{conntype} == CONNTYPE_ADMIN) {
+ $self->callback_admin_error("all", ADMIN_ERROR_CONNREF, undef) if scalar(keys(%{$self->{adminreq}}));
+ } elsif($connection->{conntype} == CONNTYPE_CHAT) {
+ $self->callback_chat_closed($connection, "Lost connection to chat");
+ } else {
+ $self->log_print(OSCAR_DBG_NOTICE, "Closing connection ", $connection->{conntype});
+ }
+ }
+ delete $connection->{socket};
+ return 1;
+ }
+ return 0;
+}
+
+sub DESTROY {
+ my $self = shift;
+ return if $Net::OSCAR::NODESTROY;
+
+ foreach my $connection(@{$self->{connections}}) {
+ next unless $connection->{socket} and not $connection->{sockerr};
+ $connection->flap_put("", FLAP_CHAN_CLOSE);
+ close $connection->{socket} if $connection->{socket};
+ }
+}
+
+sub findgroup($$) {
+ my($self, $groupid) = @_;
+ my($group, $currgroup, $currid);
+
+ my $thegroup = undef;
+
+ while(($group, $currgroup) = each(%{$self->{buddies}})) {
+ next if $group eq "__BLI_DIRTY";
+ next unless exists($currgroup->{groupid}) and $groupid == $currgroup->{groupid};
+ next if $currgroup->{__BLI_DELETED};
+ $thegroup = $group;
+ hash_iter_reset(\%{$self->{buddies}}); # Reset the iterator
+ last;
+ }
+ return $thegroup;
+}
+
+sub findbuddy_byid($$$) {
+ my($self, $buddies, $bid) = @_;
+
+ while(my($buddy, $value) = each(%$buddies)) {
+ if($value->{buddyid} == $bid and !$value->{__BLI_DELETED}) {
+ hash_iter_reset(\%$buddies); # reset the iterator
+ return $buddy;
+ }
+ }
+ return undef;
+}
+
+sub newid($;$) {
+ my($self, $group) = @_;
+ my $id = 4;
+ my %ids = ();
+
+ if($group) {
+ %ids = map { $_->{buddyid} => 1 } values %$group;
+ do { ++$id; } while($ids{$id}) or $id < 4;
+ } else {
+ do { $id = ++$self->{nextid}->{__GROUPID__}; } while($self->findgroup($id));
+ }
+ return $id;
+}
+
+sub capabilities($) {
+ my $self = shift;
+
+ my @caps;
+
+ push @caps, OSCAR_CAPS()->{chat}->{value}, OSCAR_CAPS()->{interoperate}->{value};
+ push @caps, OSCAR_CAPS()->{extstatus}->{value} if $self->{capabilities}->{extended_status};
+ push @caps, OSCAR_CAPS()->{buddyicon}->{value} if $self->{capabilities}->{buddy_icons};
+ push @caps, OSCAR_CAPS()->{filexfer}->{value} if $self->{capabilities}->{file_transfer};
+ push @caps, OSCAR_CAPS()->{fileshare}->{value} if $self->{capabilities}->{file_sharing};
+ push @caps, OSCAR_CAPS()->{sendlist}->{value} if $self->{capabilities}->{buddy_list_transfer};
+
+ return \@caps;
+}
+
+sub mod_permit($$$@) {
+ my($self, $action, $group, @buddies) = @_;
+
+ return must_be_on($self) unless $self->{is_on};
+ if($action == MODBL_ACTION_ADD) {
+ foreach my $buddy(@buddies) {
+ next if exists($self->{$group}->{$buddy});
+ $self->{$group}->{$buddy}->{buddyid} = $self->newid($self->{$group});
+ }
+ } else {
+ foreach my $buddy(@buddies) {
+ delete $self->{$group}->{$buddy};
+ }
+ }
+}
+
+sub mod_buddylist($$$$;@) {
+ my($self, $action, $what, $group, @buddies) = @_;
+ return must_be_on($self) unless $self->{is_on};
+
+ if($group eq "__BLI_DIRTY") {
+ send_error($self, $self->{bos}, "Invalid group name", "__BLI_DIRTY is a reserved group name.", 0);
+ return;
+ }
+
+ @buddies = ($group) if $what == MODBL_WHAT_GROUP;
+
+ if($what == MODBL_WHAT_GROUP and $action == MODBL_ACTION_ADD) {
+ return if exists $self->{buddies}->{$group} and !$self->{buddies}->{$group}->{__BLI_DELETED};
+
+ $self->{buddies}->{__BLI_DIRTY} = 1;
+
+ # Maybe group was deleted and then recreated
+ if(exists $self->{buddies}->{$group}) {
+ my $grp = $self->{buddies}->{$group};
+ $grp->{__BLI_DIRTY} = 1;
+ $grp->{__BLI_DELETED} = 0;
+ $grp->{data} = tlv();
+ $_->{__BLI_DELETED} = 1 foreach values %{$grp->{members}};
+ } else {
+ $self->{buddies}->{$group} = {
+ groupid => $self->newid(),
+ members => bltie(),
+ data => tlv(),
+ __BLI_DIRTY => 1,
+ __BLI_DELETED => 0,
+ };
+ }
+ } elsif($what == MODBL_WHAT_GROUP and $action == MODBL_ACTION_DEL) {
+ return unless exists $self->{buddies}->{$group};
+ $self->{buddies}->{__BLI_DIRTY} = 1;
+ $self->{buddies}->{$group}->{__BLI_DELETED} = 1;
+ } elsif($what == MODBL_WHAT_BUDDY and $action == MODBL_ACTION_ADD) {
+
+ $self->mod_buddylist(MODBL_ACTION_ADD, MODBL_WHAT_GROUP, $group) unless
+ exists $self->{buddies}->{$group} and
+ not $self->{buddies}->{$group}->{__BLI_DELETED};
+
+ my $grp = $self->{buddies}->{$group};
+ @buddies = grep {
+ not (
+ exists $grp->{members}->{$_} and
+ not $grp->{members}->{$_}->{__BLI_DELETED}
+ )
+ } @buddies;
+ return unless @buddies;
+
+ $grp->{__BLI_DIRTY} = 1;
+
+ foreach my $buddy(@buddies) {
+ # Buddy may have been deleted and recreated
+ if(exists($grp->{members}->{$buddy})) {
+ my $bud = $grp->{members}->{$buddy};
+ $bud->{__BLI_DIRTY} = 1;
+ $bud->{__BLI_DELETED} = 0;
+ $bud->{data} = tlv();
+ $bud->{comment} = undef;
+ $bud->{alias} = undef;
+ } else {
+ $grp->{members}->{$buddy} = {
+ buddyid => $self->newid($grp->{members}),
+ screenname => Net::OSCAR::Screenname->new($buddy),
+ data => tlv(),
+ online => 0,
+ comment => undef,
+ alias => undef,
+ __BLI_DIRTY => 1,
+ __BLI_DELETED => 0,
+ };
+ }
+ }
+ } elsif($what == MODBL_WHAT_BUDDY and $action == MODBL_ACTION_DEL) {
+ return unless exists $self->{buddies}->{$group};
+
+ my $grp = $self->{buddies}->{$group};
+ @buddies = grep {
+ exists $grp->{members}->{$_} and
+ not $grp->{members}->{$_}->{__BLI_DELETED}
+ } @buddies;
+ return unless @buddies;
+
+ $grp->{__BLI_DIRTY} = 1;
+
+ foreach my $buddy(@buddies) {
+ $grp->{members}->{$buddy}->{__BLI_DELETED} = 1;
+ }
+ $self->mod_buddylist(MODBL_ACTION_DEL, MODBL_WHAT_GROUP, $group) unless scalar
+ grep { not $grp->{members}->{$_}->{__BLI_DELETED} }
+ keys %{$grp->{members}};
+ }
+}
+
+sub postprocess_userinfo($$) {
+ my($self, $userinfo) = @_;
+
+ Net::OSCAR::Screenname->new(\$userinfo->{screenname});
+
+ if($userinfo->{idle}) {
+ $userinfo->{idle} *= 60;
+ $userinfo->{idle_since} = time() - $userinfo->{idle};
+ }
+ $userinfo->{evil} /= 10 if exists($userinfo->{evil});
+ if(exists($userinfo->{flags})) {
+ my $flags = $userinfo->{flags};
+ $userinfo->{trial} = $flags & 0x1;
+ $userinfo->{admin} = $flags & 0x2;
+ $userinfo->{aol} = $flags & 0x4;
+ $userinfo->{pay} = $flags & 0x8;
+ $userinfo->{free} = $flags & 0x10;
+ $userinfo->{away} = $flags & 0x20;
+ $userinfo->{mobile} = $flags & 0x80;
+ }
+
+ if(exists($userinfo->{capabilities})) {
+ my $capabilities = delete $userinfo->{capabilities};
+ foreach my $capability (@$capabilities) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Got a capability.");
+ if(OSCAR_CAPS_INVERSE()->{$capability}) {
+ my $capname = OSCAR_CAPS_INVERSE()->{$capability};
+ $self->log_print(OSCAR_DBG_DEBUG, "Got capability $capname.");
+ $userinfo->{capabilities}->{$capname} = OSCAR_CAPS()->{$capname}->{description};
+ } else {
+ $self->log_print_cond(OSCAR_DBG_INFO, sub { "Unknown capability: ", hexdump($capability) });
+ }
+ }
+ }
+
+ if(exists($userinfo->{icon_md5sum})) {
+ if(!exists($self->{userinfo}->{$userinfo->{screenname}})
+ or !exists($self->{userinfo}->{$userinfo->{screenname}}->{icon_md5sum})
+ or $self->{userinfo}->{$userinfo->{screenname}}->{icon_md5sum} ne $userinfo->{icon_md5sum}) {
+ $self->callback_new_buddy_icon($userinfo->{screenname}, $userinfo);
+ }
+ }
+}
+
+sub send_message($$$$;$$) {
+ my($self, $recipient, $channel, $body, $flags2, $cookie) = @_;
+ $flags2 ||= 0;
+
+ my $reqid = (8<<16) | (unpack("n", randchars(2)))[0];
+ my %protodata = (
+ cookie => $cookie ? $cookie : randchars(8),
+ channel => $channel,
+ screenname => $recipient,
+ message_body => $body,
+ );
+ $self->svcdo(CONNTYPE_BOS, reqdata => $recipient, reqid => $reqid, protobit => "outgoing_IM", protodata => \%protodata, flags2 => $flags2);
+
+ return ($reqid, $protodata{cookie});
+}
+
+sub rendezvous_revise($$;$) {
+ my($self, $cookie, $ip) = @_;
+ return unless exists($self->{rv_proposals}->{$cookie});
+ my $proposal = $self->{rv_proposals}->{$cookie};
+
+ if($proposal->{connection}) {
+ $self->delconn($proposal->{connection});
+ delete $proposal->{connection};
+ }
+
+ if(!$ip) {
+ croak "OSCAR server FT proxy not yet supported!";
+ }
+
+ my $connection = $self->addconn(conntype => CONNTYPE_DIRECT_IN);
+ my($port) = sockaddr_in(getsockname($connection->{socket}));
+
+ my %protodata = (
+ capability => OSCAR_CAPS()->{filexfer}->{value},
+ cookie => $proposal->{cookie},
+ status => "propose",
+ client_1_ip => $self->{ip},
+ client_2_ip => $self->{ip},
+ port => $port,
+ );
+ $proposal->{connection} = $connection;
+ $proposal->{ft_state} = "listening";
+ $proposal->{accepted} = 0;
+ $proposal->{tried_listen} = 1;
+
+ my($req_id) = $self->send_message($proposal->{peer}, 2, protoparse($self, "rendezvous_IM")->pack(%protodata), 0, $cookie);
+}
+
+sub rendezvous_proxy_host($) {
+ return "ars.oscar.aol.com";
+}
+
+sub rendezvous_negotiate($$) {
+ my($self, $cookie) = @_;
+ return unless exists($self->{rv_proposals}->{$cookie});
+ my $proposal = $self->{rv_proposals}->{$cookie};
+
+ if($proposal->{tried_connect} or !$proposal->{ip} or $proposal->{ip} eq "0.0.0.0" or $proposal->{ip} eq "255.255.255.255") {
+ $self->log_print(OSCAR_DBG_DEBUG, "Negotiating rendezvous.");
+
+ # If we haven't tried hosting the connection and it
+ # doesn't look like we're behind NAT, or we have
+ # a designated file transfer IP, try hosting.
+ # Otherwise, use the proxy.
+ #
+ if(!$proposal->{tried_listen} and
+ $self->{ft_ip} or ($self->{ip} and $self->{bos}->local_ip eq $self->{ip})
+ ) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Hosting.");
+ $self->rendezvous_revise($cookie, $self->{ft_ip} || $self->{ip});
+ $proposal->{using_proxy} = 0;
+ $proposal->{tried_listen} = 1;
+ $proposal->{ft_state} = "listening";
+ return;
+ } elsif(!$proposal->{tried_proxy}) {
+ $self->log_print(OSCAR_DBG_DEBUG, "Using proxy.");
+ $proposal->{using_proxy} = 1;
+ $proposal->{tried_proxy} = 1;
+ $proposal->{ft_state} = "proxy_connect";
+ $proposal->{ip} = $self->rendezvous_proxy_host();
+ } else {
+ $self->rendezvous_reject($cookie);
+ $self->log_printf(OSCAR_DBG_WARN, "Couldn't figure out how to connect for file transfer (%s, %s).", $proposal->{ip}, $proposal->{proxy});
+ return;
+ }
+ } else {
+ $proposal->{using_proxy} = 0;
+ $proposal->{tried_connect} = 1;
+ $proposal->{ft_state} = "connecting";
+ }
+
+ return 1;
+}
+
+sub rendezvous_accept($$) {
+ my($self, $cookie) = @_;
+ return unless exists($self->{rv_proposals}->{$cookie});
+ my $proposal = $self->{rv_proposals}->{$cookie};
+
+ return unless $self->rendezvous_negotiate($cookie);
+
+ $self->log_printf(OSCAR_DBG_INFO, "Establishing rendezvous connection to %s:%d", $proposal->{ip}, $proposal->{port});
+ $proposal->{ip} .= ":" . $proposal->{port} if $proposal->{port};
+ my $newconn = $self->addconn(
+ conntype => CONNTYPE_DIRECT_OUT,
+ peer => $proposal->{ip},
+ description => "transfer of files: " . join(", ", @{$proposal->{filenames}}),
+ rv => $proposal,
+ );
+ $proposal->{connection} = $newconn;
+}
+
+sub rendezvous_reject($$) {
+ my($self, $cookie) = @_;
+
+ return unless exists($self->{rv_proposals}->{$cookie});
+ my $proposal = delete $self->{rv_proposals}->{$cookie};
+
+ my %protodata;
+ $protodata{status} = "cancel";
+ $protodata{cookie} = $cookie;
+ $protodata{capability} = OSCAR_CAPS()->{$proposal->{type}} ? OSCAR_CAPS()->{$proposal->{type}}->{value} : $proposal->{type};
+
+ return $self->send_message($proposal->{sender}, 2, protoparse($self, "rendezvous_IM")->pack(%protodata));
+}
+
+sub svcdo($$%) {
+ my($self, $service, %data) = @_;
+
+ if($self->{services}->{$service} and ref($self->{services}->{$service})) {
+ $self->{services}->{$service}->proto_send(%data);
+ } else {
+ push @{$self->{svcqueues}->{$service}}, \%data;
+ $self->svcreq($service) unless $self->{services}->{$service};
+ }
+}
+
+sub svcreq($$;@) {
+ my($self, $svctype, @extradata) = @_;
+
+ $self->log_print(OSCAR_DBG_INFO, "Sending service request for servicetype $svctype.");
+ $self->svcdo(CONNTYPE_BOS, protobit => "service_request", protodata => {type => $svctype, @extradata});
+}
+
+sub crapout($$$;$) {
+ my($self, $connection, $reason, $errno) = @_;
+ send_error($self, $connection, $errno || 0, $reason, 1);
+ $self->signoff();
+}
+
+sub must_be_on($) {
+ my $self = shift;
+ send_error($self, $self->{services}->{0+CONNTYPE_BOS}, 0, "You have not finished signing on.", 0);
+}
+
+
+sub server($%) {
+ my $self = shift;
+ my %data = @_;
+ $self->{$_} = $data{$_} foreach keys %data;
+ $self->addconn(conntype => CONNTYPE_SERVER);
+}
+
+sub connection_for_family($$) {
+ my($self, $family) = @_;
+
+ my $bos = $self->{services}->{0+CONNTYPE_BOS};
+ if($bos->{families}->{$family}) {
+ return $bos;
+ }
+
+ foreach my $connection (@{$self->{session}->{connections}}) {
+ next unless $connection->{families}->{$family};
+ $connection->log_print(OSCAR_DBG_WARN, "Found connection for unsupported SNAC.");
+ return $connection;
+ }
+
+ return;
+}
+
+1;
+
