Author: dylan
Date: 2005-07-05 19:28:39 -0400 (Tue, 05 Jul 2005)
New Revision: 837
Added:
trunk/perl/server/lib/Haver/Server/Wheel/AuthReg.pm
Modified:
trunk/
trunk/perl/server/TODO
trunk/perl/server/lib/Haver/Server/Entity.pm
trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm
trunk/perl/server/lib/Haver/Server/Entity/Channel.pm
trunk/perl/server/lib/Haver/Server/Talker.pm
trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm
trunk/perl/server/lib/Haver/Server/Wheel/Login.pm
trunk/perl/server/lib/Haver/Server/Wheel/Main.pm
Log:
[EMAIL PROTECTED]: dylan | 2005-07-05 19:27:15 -0400
INFO support.
AUTH:REGISTER
Added more parameters to errors.
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:1212
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:1213
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Modified: trunk/perl/server/TODO
===================================================================
--- trunk/perl/server/TODO 2005-07-05 23:28:36 UTC (rev 836)
+++ trunk/perl/server/TODO 2005-07-05 23:28:39 UTC (rev 837)
@@ -1,8 +1,3 @@
-* Have persistent channels and users.
-** I envision some type of Saver object to do this.
-** The contents of containers will not be saved;
-*** Except for all the channels defined in &lobby?
-*** Hmm, perhaps have another object, &store or something, to hold offline
users and channels?
* Integrate the config file stuff. Everything that can be configured should be.
* Add an unlisten state to the Listener.
* Implement AUTH.
Modified: trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm 2005-07-05 23:28:36 UTC
(rev 836)
+++ trunk/perl/server/lib/Haver/Server/Entity/Avatar.pm 2005-07-05 23:28:39 UTC
(rev 837)
@@ -8,9 +8,12 @@
our $VERSION = 0.08;
-field -weak => 'wheel';
-field _access => {};
-field password => undef;
+field -weak => 'wheel';
+field _access => {};
+field passcode => undef;
+field keep => 0;
+field address => '0.0.0.*';
+field version => 'unknown';
sub put {
my ($self, $msg) = @_;
@@ -23,11 +26,19 @@
}
}
+sub info {
+ my ($self) = @_;
+ return (
+ address => $self->address,
+ version => $self->version,
+ );
+}
+
sub dump {
my ($self) = @_;
my $data = super;
$data->{access} = $self->_access;
- $data->{password} = $self->password;
+ $data->{passcode} = $self->passcode;
return $data;
}
@@ -35,7 +46,8 @@
my ($this, $data) = @_;
my $self = super($data);
$self->_access($data->{access});
- $self->password($data->{password});
+ $self->passcode($data->{passcode});
+ $self->keep(1);
return $self;
}
Modified: trunk/perl/server/lib/Haver/Server/Entity/Channel.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity/Channel.pm 2005-07-05
23:28:36 UTC (rev 836)
+++ trunk/perl/server/lib/Haver/Server/Entity/Channel.pm 2005-07-05
23:28:39 UTC (rev 837)
@@ -7,14 +7,39 @@
our $VERSION = 0.22;
-const namespace => 'channel';
+const namespace => 'channel';
field _contents => {};
+field creator => '&root';
+
+sub dump {
+ my ($self, $store) = @_;
+ my $dump = super($store);
+ $dump->{creator} = $self->creator;
+
+ return $dump;
+}
+
+sub load {
+ my ($this, $data, $store) = @_;
+ my $self = super($data, $store);
+ $self->creator($data->{creator});
+
+ return $self;
+}
+
sub can_contain {
my ($self, $object) = @_;
$object->namespace eq 'user';
}
+sub info {
+ my $self = shift;
+ return (
+ creator => $self->creator,
+ );
+}
+
sub put {
my ($self, $msg) = @_;
Modified: trunk/perl/server/lib/Haver/Server/Entity.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Entity.pm 2005-07-05 23:28:36 UTC
(rev 836)
+++ trunk/perl/server/lib/Haver/Server/Entity.pm 2005-07-05 23:28:39 UTC
(rev 837)
@@ -9,6 +9,7 @@
field attr => {};
stub 'namespace';
stub 'put';
+stub 'info';
sub initialize {
my ($self) = @_;
Modified: trunk/perl/server/lib/Haver/Server/Talker.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Talker.pm 2005-07-05 23:28:36 UTC
(rev 836)
+++ trunk/perl/server/lib/Haver/Server/Talker.pm 2005-07-05 23:28:39 UTC
(rev 837)
@@ -119,6 +119,7 @@
sub shutdown {
my ($kernel, $heap, $session, @why) = @_[KERNEL, HEAP, SESSION, ARG0 ..
$#_];
my $lobby = $heap->{lobby};
+ my $store = $heap->{store};
if ($heap->{shutdown}) {
Log('critical', 'Race condition: shutdown called more than
once!');
@@ -129,6 +130,7 @@
if (@why) {
if ($heap->{user}) {
my $user = delete $heap->{user};
+ $store->insert($user) if $user->keep;
$lobby->remove($user->namespace, $user->name);
my %seen;
foreach my $name ($user->channels) {
Modified: trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm 2005-07-05 23:28:36 UTC
(rev 836)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Auth.pm 2005-07-05 23:28:39 UTC
(rev 837)
@@ -55,7 +55,7 @@
}
my $hasher = Digest->new($digests->{$digest});
$hasher->add($heap->{nonce});
- $hasher->add($user->password);
+ $hasher->add($user->passcode);
my $need = $hasher->b64digest;
if ($need eq $resp) {
Added: trunk/perl/server/lib/Haver/Server/Wheel/AuthReg.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/AuthReg.pm 2005-07-05 23:28:36 UTC
(rev 836)
+++ trunk/perl/server/lib/Haver/Server/Wheel/AuthReg.pm 2005-07-05 23:28:39 UTC
(rev 837)
@@ -0,0 +1,37 @@
+# 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::AuthReg;
+use strict;
+use warnings;
+
+use Haver::Server::Wheel -base;
+use Digest;
+
+sub setup {
+ my $self = shift;
+ $self->msg(
+ qw(
+ AUTH:REGISTER
+ )
+ );
+}
+
+sub msg_AUTH_REGISTER {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($email, $passcode) = @$args;
+ my $store = $heap->{store};
+ my $user = $heap->{user};
+
+ unless ($email =~ /[EMAIL PROTECTED]/) {
+ $kernel->yield('fail', 'invalid.email', $email);
+ return;
+ }
+
+ $user->keep(1);
+ $user->passcode($passcode);
+ $store->insert($user);
+ $heap->{client}->put(['AUTH:REGISTER', $user->name, $email]);
+}
+
+
+1;
Modified: trunk/perl/server/lib/Haver/Server/Wheel/Login.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Login.pm 2005-07-05 23:28:36 UTC
(rev 836)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Login.pm 2005-07-05 23:28:39 UTC
(rev 837)
@@ -6,6 +6,7 @@
use Haver::Server::Wheel -base;
use Haver::Server::Wheel::Auth;
+use Haver::Server::Wheel::AuthReg;
use Haver::Util qw( :name );
our $VERSION = 0.02;
@@ -70,11 +71,14 @@
$user->wheel($heap->{client});
+ $user->version(delete $heap->{version});
+ $user->address($heap->{address});
$lobby->add($user);
$heap->{user} = $user;
$heap->{client}->put(['HELLO', $name]);
$heap->{loader}->unload_wheel(__PACKAGE__);
$heap->{loader}->load_wheel('Haver::Server::Wheel::Main');
+ $heap->{loader}->load_wheel('Haver::Server::Wheel::AuthReg');
}
Modified: trunk/perl/server/lib/Haver/Server/Wheel/Main.pm
===================================================================
--- trunk/perl/server/lib/Haver/Server/Wheel/Main.pm 2005-07-05 23:28:36 UTC
(rev 836)
+++ trunk/perl/server/lib/Haver/Server/Wheel/Main.pm 2005-07-05 23:28:39 UTC
(rev 837)
@@ -5,7 +5,7 @@
use warnings;
use Haver::Server::Wheel -base;
-use Haver::Util 'is_valid_name';
+use Haver::Util ':all';
use constant PING_TIME => 4 * 60;
sub setup {
@@ -14,6 +14,7 @@
qw(
TO IN BYE POKE PONG
JOIN OPEN PART LIST
+ INFO
)
);
@@ -56,11 +57,11 @@
return;
}
unless ($chan) {
- $kernel->yield('fail', 'unknown.channel');
+ $kernel->yield('fail', 'unknown.channel', $name);
return;
}
if ($chan->contains('user', $user->name)) {
- $kernel->yield('fail', 'already.joined');
+ $kernel->yield('fail', 'already.joined', $name);
return;
}
@@ -84,7 +85,8 @@
$lobby->add(
new Haver::Server::Entity::Channel (
- name => $name
+ name => $name,
+ creator => 'bob',
)
);
$heap->{client}->put(['OPEN', $name]);
@@ -104,11 +106,11 @@
return;
}
unless ($chan) {
- $kernel->yield('fail', 'unknown.channel');
+ $kernel->yield('fail', 'unknown.channel', $name);
return;
}
unless ($chan->contains('user', $user->name)) {
- $kernel->yield('fail', 'already.parted');
+ $kernel->yield('fail', 'already.parted', $name);
return;
}
@@ -130,7 +132,7 @@
return;
}
unless ($targ) {
- $kernel->yield('fail', 'unknown.user');
+ $kernel->yield('fail', 'unknown.user', $name);
return;
}
unless (defined $type) {
@@ -155,7 +157,7 @@
return;
}
unless ($chan) {
- $kernel->yield('fail', 'unknown.channel');
+ $kernel->yield('fail', 'unknown.channel', $name);
return;
}
unless (defined $type) {
@@ -176,10 +178,10 @@
return;
}
unless ($lobby->contains('channel', $name)) {
- $kernel->yield('fail', 'unknown.channel');
+ $kernel->yield('fail', 'unknown.channel', $name);
return;
}
- unless ($ns and ($ns eq 'user' or $ns eq 'channel' or $ns eq
'service')) {
+ unless (is_known_namespace($ns)) {
$kernel->yield('fail', 'unknown.namespace', $ns);
return;
}
@@ -188,6 +190,30 @@
$heap->{client}->put(['LIST', $name, $ns, map { $_->name } @items]);
}
+sub msg_INFO {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($ns, $name) = @$args;
+ my $lobby = $heap->{lobby};
+
+ unless (is_valid_name($name)) {
+ $kernel->yield('fail', "invalid.name", $name);
+ return;
+ }
+ unless ($lobby->contains($ns, $name)) {
+ $kernel->yield('fail', "unknown.$ns", $name);
+ return;
+ }
+ unless (is_known_namespace($ns)) {
+ $kernel->yield('fail', 'unknown.namespace', $ns);
+ return;
+ }
+
+ my $entity = $lobby->get($ns, $name);
+ $heap->{client}->put(['INFO', $ns, $name, $entity->info]);
+
+
+}
+
sub msg_POKE {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
$heap->{client}->put(['OUCH', $args->[0]]);
