Author: dylan
Date: 2005-06-25 19:20:08 -0400 (Sat, 25 Jun 2005)
New Revision: 824
Added:
trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm
Modified:
trunk/
trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm
trunk/perl/server/lib/Haver/Server/Talker.pm
trunk/perl/server/lib/Haver/Server/Wheel.pm
trunk/perl/server/lib/Haver/Server/Wheel/Login.pm
Log:
[EMAIL PROTECTED]: dylan | 2005-06-25 19:19:59 -0400
Added support for auth extension.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1193
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/havercurs-objc:43089
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:1195
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Modified: trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm 2005-06-25 23:16:31 UTC
(rev 823)
+++ trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm 2005-06-25 23:20:08 UTC
(rev 824)
@@ -10,8 +10,8 @@
field -weak => 'wheel';
field _access => {};
+field password => undef;
-
sub put {
my ($self, $msg) = @_;
@@ -26,7 +26,8 @@
sub dump {
my ($self) = @_;
my $data = super;
- $data->{access} = $self->_access;
+ $data->{access} = $self->_access;
+ $data->{password} = $self->password;
return $data;
}
@@ -34,6 +35,7 @@
my ($this, $data) = @_;
my $self = super($data);
$self->_access($data->{access});
+ $self->password($data->{password});
return $self;
}
Modified: trunk/perl/server/lib/Haver/Server/Talker.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Talker.pm 2005-06-25 23:16:31 UTC
(rev 823)
+++ trunk/perl/server/lib/Haver/Server/Talker.pm 2005-06-25 23:20:08 UTC
(rev 824)
@@ -84,7 +84,6 @@
my $cmd = shift @$args;
my $event = 'msg_' . $cmd;
- $event =~ s/:/_/g;
Log('info', "Command: '$cmd'");
$heap->{cmd} = $cmd;
Added: trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm 2005-06-25 23:16:31 UTC
(rev 823)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm 2005-06-25 23:20:08 UTC
(rev 824)
@@ -0,0 +1,139 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
+package Haver::Server::Wheel::Auth;
+use strict;
+use warnings;
+
+use Haver::Server::Wheel -base;
+use Digest::SHA1 ();
+use Digest::MD5 ();
+
+my %Algos = (
+ md5 => 'Digest::MD5',
+ sha1 => 'Digest::SHA1',
+);
+
+sub setup {
+ my $self = shift;
+ $self->msg(
+ qw(
+ AUTH:TYPE
+ AUTH:BASIC
+ )
+ );
+
+ $self->provide('auth_ok', 'on_auth_ok');
+}
+
+sub on_auth_ok {
+ my ($kernel, $heap, $user) = @_[KERNEL, HEAP, ARG0];
+ Log('notice', "client is authorized as $heap->{name}");
+ $heap->{loader}->unload_wheel(__PACKAGE__);
+ $kernel->yield('accept', delete $heap->{name}, $user);
+}
+
+sub msg_AUTH_TYPE {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $type = $args->[0];
+ if ($type eq 'basic') {
+ $heap->{nonce} = rand_word();
+ $heap->{client}->put(['AUTH:BASIC', $heap->{nonce}, join(',',
keys %Algos)]);
+ }
+}
+
+sub msg_AUTH_BASIC {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($algo, $resp) = @$args;
+ my $store = $heap->{store};
+ my $name = $heap->{name};
+ my $user = $store->fetch(user => $name);
+
+ unless (exists $Algos{$algo}) {
+ $kernel->yield('fail', 'unknown.hash');
+ return;
+ }
+ my $class = $Algos{$algo};
+ my $hasher = $class->new;
+ $hasher->add($heap->{nonce});
+ $hasher->add($user->password);
+ my $need = $hasher->b64digest;
+
+ if ($need eq $resp) {
+ $kernel->yield('auth_ok', $user);
+ } else {
+ $kernel->yield('fail', 'auth.fail', $name, $algo);
+ }
+}
+
+sub rand_char { chr(int(rand(93)) + 33) }
+sub rand_word {
+ my $len = 26;
+ my @char;
+ for (1 .. $len) {
+ push @char, rand_char();
+ }
+ join('', @char);
+}
+
+1;
+__END__
+=head1 NAME
+
+Haver::Server::Wheel::Message - description
+
+=head1 SYNOPSIS
+
+ use Haver::Server::Wheel::Message;
+ # Small code example.
+
+=head1 DESCRIPTION
+
+FIXME
+
+=head1 INHERITENCE
+
+Haver::Server::Wheel::Message extends blaa blaa blaa
+
+=head1 CONSTRUCTOR
+
+List required parameters for new().
+
+=head1 METHODS
+
+This class implements the following methods:
+
+=head2 method1(Z<>)
+
+...
+
+=head1 BUGS
+
+None known. Bug reports are welcome. Please use our bug tracker at
+L<http://gna.org/bugs/?func=additem&group=haver>.
+
+=head1 AUTHOR
+
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 SEE ALSO
+
+L<http://www.haverdev.org/>.
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (C) 2005 by Dylan William Hardison. All Rights Reserved.
+
+This module is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This module is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Modified: trunk/perl/server/lib/Haver/Server/Wheel/Login.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Login.pm 2005-06-25 23:16:31 UTC
(rev 823)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Login.pm 2005-06-25 23:20:08 UTC
(rev 824)
@@ -5,6 +5,7 @@
use warnings;
use Haver::Server::Wheel -base;
+use Haver::Server::Wheel::Auth;
use Haver::Util qw( :name );
our $VERSION = 0.02;
@@ -12,23 +13,32 @@
sub setup {
my $self = shift;
$self->msg('HAVER');
+ $self->provide('accept', 'on_accept');
}
sub msg_HAVER {
my ($self, $kernel, $heap, $args) = @_[OBJECT, KERNEL, HEAP, ARG0];
- my ($version) = @$args;
+ my ($version, $ext) = @$args;
Log('notice', 'Client is ' . $version);
$heap->{client}->put(
['HAVER', $heap->{info}{host},
"Haver::Server/$Haver::Server::VERSION"]);
$heap->{version} = $version;
+ my %ext;
+ if ($ext) {
+ foreach my $n (split(/,/, $ext)) {
+ $ext{$n} = 1;
+ }
+ }
+ $heap->{extensions} = \%ext;
$self->define('msg_IDENT', 'msg_IDENT');
}
sub msg_IDENT {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
my ($name) = @$args;
- my $lobby = $_[HEAP]{lobby};
+ my $lobby = $heap->{lobby};
+ my $store = $heap->{store};
my $ns = 'user';
if ($lobby->contains($ns, $name)) {
@@ -37,20 +47,37 @@
$kernel->yield('fail', "invalid.name", $name);
} elsif ($ns eq 'user' and is_reserved_name($name)) {
$kernel->yield('fail', "reserved.$ns", $name);
+ } elsif ($store->exists($ns, $name)) {
+ $heap->{name} = $name;
+ if (exists $heap->{extensions}{auth}) {
+ $heap->{client}->put(['AUTH:TYPES', 'basic']);
+
$heap->{loader}->load_wheel('Haver::Server::Wheel::Auth');
+ } else {
+ $kernel->yield('fail', 'auth.impossible');
+ }
} else {
my $user = new Haver::Server::Entity::User (
name => $name,
- wheel => $heap->{client}, # weak reference!
);
- $lobby->add($user);
- $heap->{user} = $user;
- $heap->{client}->put(['HELLO', $name]);
- $heap->{loader}->unload_wheel(__PACKAGE__);
- $heap->{loader}->load_wheel('Haver::Server::Wheel::Main');
+ $kernel->yield('accept', $name, $user);
}
}
+sub on_accept {
+ my ($kernel, $heap, $name, $user) = @_[KERNEL, HEAP, ARG0, ARG1];
+ my $lobby = $heap->{lobby};
+
+ $user->wheel($heap->{client});
+ $lobby->add($user);
+ $heap->{user} = $user;
+ $heap->{client}->put(['HELLO', $name]);
+ $heap->{loader}->unload_wheel(__PACKAGE__);
+ $heap->{loader}->load_wheel('Haver::Server::Wheel::Main');
+}
+
+
+
1;
__END__
=head1 NAME
Modified: trunk/perl/server/lib/Haver/Server/Wheel.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel.pm 2005-06-25 23:16:31 UTC (rev
823)
+++ trunk/perl/server/lib/Haver/Server/Wheel.pm 2005-06-25 23:20:08 UTC (rev
824)
@@ -13,7 +13,9 @@
my $self = shift;
foreach my $word (@_) {
- $self->provide("msg_$word", "msg_$word");
+ my $method = "msg_$word";
+ $method =~ s/\W/_/g;
+ $self->provide("msg_$word", $method);
}
}
