Author: bdonlan
Date: 2004-05-27 17:57:10 -0400 (Thu, 27 May 2004)
New Revision: 175
Modified:
trunk/poe-client/lib/POE/Component/Client/Haver.pm
Log:
Added basic authentication support, made USERS more efficient
Modified: trunk/poe-client/lib/POE/Component/Client/Haver.pm
===================================================================
--- trunk/poe-client/lib/POE/Component/Client/Haver.pm 2004-05-27 21:27:33 UTC
(rev 174)
+++ trunk/poe-client/lib/POE/Component/Client/Haver.pm 2004-05-27 21:57:10 UTC
(rev 175)
@@ -96,6 +96,7 @@
register
unregister
dispatch
+ dispatch_ref
connect
connected
@@ -230,20 +231,29 @@
}
}
-sub dispatch {
- my ($kernel, $heap, $event, @args) = @_[KERNEL,HEAP,ARG0..$#_];
+sub dispatch_ref {
+ my ($kernel, $heap, $event, $args) = @_[KERNEL,HEAP,ARG0,ARG1];
my %targets = (map { $_ => 1 }
(keys(%{$heap->{registrations}->{$event}}),
keys(%{$heap->{registrations}->{all}})));
- $kernel->post($_, "haver_$event", [EMAIL PROTECTED], $heap->{scope})
for keys %targets;
+ $kernel->post($_, "haver_$event", $args, $heap->{scope}) for keys
%targets;
}
+sub dispatch {
+ my @pre = @_[0..ARG0];
+ my $payload = [EMAIL PROTECTED];
+ @_ = (@pre, $payload);
+ goto &dispatch_ref;
+}
+
### SESSION MANAGEMENT
=head2 B<connect(Host => $Z<>host, [Port => $Z<>port, UID => $Z<>uid, Password
=> $Z<>password])
Connects to the haver server. The Host option is mandatory, all others are
optional.
-If it is already connected, it will disconnect, then connect with the new
parameters
+If it is already connected, it will disconnect, then connect with the new
parameters.
+Password is deprecated, and will be removed some time after SSL is supported.
+
=cut
sub connect {
@@ -257,6 +267,7 @@
}
$heap->{UID} = $args{UID};
$heap->{PASS} = $args{Password};
+ $heap->{Host} = $args{Host};
$args{Port} ||= 7070;
$heap->{connect_wheel} =
POE::Wheel::SocketFactory->new(
@@ -386,6 +397,25 @@
IDENT => sub {
$kernel->yield('send', 'IDENT', $heap->{UID}, 'user',
$heap->{version});
},
+ AUTH => sub {
+ # XXX: More extensible AUTH system later too
+ my @methods = split ',', $arg[0];
+ # XXX: only pass for now
+ unless(grep { $_ eq 'pass' } @methods) {
+ $kernel->yield('send', 'CANT', 'AUTH');
+ return;
+ }
+ $kernel->yield('send', 'AUTH', 'pass');
+ $heap->{auth} = 'pass';
+ },
+ 'AUTH:PASS' => sub {
+ # XXX: Better support for namespaces
+ if($heap->{PASS}) {
+ $kernel->yield('login', $heap->{PASS});
+ return;
+ }
+ $kernel->yield('dispatch', 'login_request');
+ },
);
if (exists $wants{$wanted}) {
$wants{$wanted}->();
@@ -470,8 +500,7 @@
sub event_USERS {
my ($kernel, $heap, @who) = @_[KERNEL,HEAP,ARG0..$#_];
- # XXX probably we should pass [EMAIL PROTECTED] instead of @who. (dylan)
- _call('dispatch', 'users', @who);
+ _call('dispatch_ref', 'users', [EMAIL PROTECTED]);
}
sub event_BYE {
@@ -519,36 +548,23 @@
### CLIENT EVENTS
-=head2 login($Z<>uid [, $Z<>pass])
+=head2 login($Z<>pass)
-Specify a UID and password to use for the next login. If already logged in,
this takes effect on the next connection
+Specify a password to use for the next login. If already logged in, this takes
effect on the next connection
unless overridden by connect(). If the server is waiting for a login, takes
effect immediately.
=cut
sub login {
- my ($kernel, $heap, $uid, $pass) = @_[KERNEL,HEAP,ARG0,ARG1];
- $heap->{UID} = $uid;
- $heap->{PASS} = $pass;
- if ($heap->{want}) {
- if ($heap->{want} eq 'UID') {
- if (!defined $uid) {
- # oops...
- delete $heap->{UID};
- delete $heap->{PASS};
- _call('dispatch', 'login_fail', 'UNDEF_UID', 'Undefined
UID',
- 'Internal client error: UID is
undefined');
- return;
- }
- $kernel->yield('send', 'UID', $heap->{UID});
- } elsif ($heap->{want} eq 'PASS') {
- if (defined $pass) {
- $kernel->yield('send', 'PASS', $pass);
+ my ($kernel, $heap, $pass) = @_[KERNEL,HEAP,ARG0,ARG1];
+ $heap->{PASS} = $pass if $pass;
+ if ($heap->{want} eq 'AUTH:PASS') {
+ if (defined $heap->{PASS}) {
+ $kernel->yield('send', 'AUTH:PASS',
sha1_base64($heap->{UID} . $heap->{PASS} . $heap->{Host}));
} else {
- $kernel->yield('send', 'CANT', 'PASS');
+ $kernel->yield('send', 'CANT', 'AUTH:PASS');
}
}
- }
}
=head2 join($Z<>channel)
@@ -744,7 +760,7 @@
=head2 haver_login_request(Z<>)
The server is asking for a login, and one was not provided in connect(). The
connection will not proceed until
-login() is sent with the UID and (optionally) password.
+login() is sent with the password.
=head2 haver_login(Z<>)
