source: perl/modules/AIM/lib/Net/OSCAR/ServerCallbacks/23/signon.pm @ 3dcccba

barnowl_perlaim
Last change on this file since 3dcccba was 7a1c90d, checked in by Geoffrey Thomas <geofft@mit.edu>, 14 years ago
Skeleton AIM module, and Net::OSCAR 1.925
  • Property mode set to 100644
File size: 1.3 KB
Line 
1package Net::OSCAR::ServerCallbacks;
2use strict;
3use warnings;
4use Net::OSCAR::Constants;
5use vars qw($SESSIONS $SCREENNAMES %COOKIES $screenname $connection $snac $conntype $family $subtype $data $reqid $reqdata $session $protobit %data);
6sub {
7
8my $hash;
9($screenname, $hash) = ($data{screenname}, $data{auth_response});
10
11if(!$SCREENNAMES->{$screenname}) {
12        $connection->proto_send(protobit => "authorization_response", protodata => {error => 1});
13}
14
15my @valid_hashes = map {
16        [$_, encode_password($session, exists($data{pass_is_hashed}) ? md5($SCREENNAMES->{$screenname}->{pw}) : $SCREENNAMES->{$screenname}->{pw}, $_)];
17} keys %{$SESSIONS->{$screenname}->{keys}};
18
19my $valid = 0;
20foreach (@valid_hashes) {
21        next unless $_->[1] eq $hash;
22        $valid = 1;
23        delete $SCREENNAMES->{$screenname}->{keys}->{$_->[0]};
24        last;
25}
26
27if($valid) {
28        my $key = randchars(256);
29        $connection->proto_send(protobit => "authorization_response", protodata => {
30                screenname => $SCREENNAMES->{$screenname}->{sn},
31                email => $SCREENNAMES->{$screenname}->{email},
32                auth_cookie => $key,
33                server_ip => "127.0.0.1"
34        });
35        $session->delconn($connection);
36
37        $COOKIES{$key} = {sn => $screenname, conntype => CONNTYPE_BOS};
38} else {
39        $connection->proto_send(protobit => "authorization_response", protodata => {error => 5});
40        $session->delconn($connection);
41}
42
43};
44
Note: See TracBrowser for help on using the repository browser.