Author: dylan
Date: 2004-10-25 16:52:37 -0400 (Mon, 25 Oct 2004)
New Revision: 404
Added:
branches/haver-server-cleanup/lib/Haver/Server/Commands.pm
branches/haver-server-cleanup/lib/Haver/Server/Commands/Connection.pm
branches/haver-server-cleanup/lib/Haver/Server/Plugin.pm
branches/haver-server-cleanup/lib/Haver/Server/Plugin/
branches/haver-server-cleanup/lib/Haver/Server/Plugin/Loader.pm
Log:
Haver::Server::Plugin is a generic module
for loading state handlers into an active session,
sort of like a POE::Wheel.
Haver::Server::Commands is a subclass of this,
which provides some Command specific stuff.
Haver::Server::Commands::Connection are the commands and
needed when a client first connects.
Haver::Server::Plugin::Loader is a container
that loads and unloads plugins.
Added: branches/haver-server-cleanup/lib/Haver/Server/Commands/Connection.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/Commands/Connection.pm
2004-10-25 20:49:58 UTC (rev 403)
+++ branches/haver-server-cleanup/lib/Haver/Server/Commands/Connection.pm
2004-10-25 20:52:37 UTC (rev 404)
@@ -0,0 +1,217 @@
+# vim: set ft=perl ts=4 sw=4:
+# Commands::Basic - description
+#
+# Copyright (C) 2004 Dylan William Hardison.
+#
+# 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
+package Haver::Server::Commands::Connection;
+use strict;
+use warnings;
+
+use Haver::Formats qw( :duration );
+use Digest::SHA1 qw( sha1_base64 );
+use Haver::Server::Registry qw( $Registry );
+
+use base 'Haver::Server::Commands';
+
+our $VERSION = '0.01';
+
+sub setup {
+ my $me = shift;
+
+ $me->SUPER::setup();
+
+ foreach my $state (qw(want accept auth reject unknown_cmd init
timeout)) {
+ $me->provide($state, "on_$state");
+ }
+
+}
+
+sub commands {
+ qw(
+ HAVER IDENT CANT AUTH AUTH:PASS
+ );
+}
+
+sub cmd_HAVER {
+ my ($me, $kernel, $heap, $args) = @_[OBJECT, KERNEL, HEAP, ARG0];
+ my $client = $args->[0];
+
+ if (exists $me->{version}) {
+ $kernel->yield('oops', 'repeat', ['HAVER']);
+ return;
+ }
+
+ eval {
+ $heap->{client}->put(['HAVER',
+ "Haver::Server/$Haver::Server::VERSION",
+ ]);
+ };
+ $me->{version} = $client;
+ $kernel->yield('want', 'IDENT');
+}
+
+sub cmd_IDENT {
+ my ($me, $kernel, $heap, $args) = @_[OBJECT, KERNEL, HEAP, ARG0];
+ my ($id, $ns) = @$args;
+
+ $ns ||= 'user';
+
+ # This may only be called once.
+ if ($me->{did}{IDENT}++) {
+ $kernel->yield('oops', "repeat", ['IDENT']);
+ return;
+ }
+
+ # We don't support other types of clients right now.
+ if ($ns ne 'user') {
+ $kernel->yield('fail', 'IDENT', 'unsupported.ns', [$ns]);
+ $kernel->yield('want', 'IDENT');
+ return;
+ }
+
+ # Make sure it's a valid id.
+ if (not Haver::Server::Object->is_valid_id($id)) {
+ $kernel->yield('fail', 'IDENT', 'syntax.id', [$id]);
+ $kernel->yield('want', 'IDENT');
+ return;
+ }
+
+ # users arn't allowed to have names that begin with
+ # & or @ in them.
+ if ($ns eq 'user' and ($id =~ /^&/ or $id =~ /@/)) {
+ $kernel->yield('fail', 'IDENT', 'reserved.id', [$id]);
+ $kernel->yield('want', 'IDENT');
+ return;
+ }
+
+ if ($Registry->contains('user', $id)) {
+ $kernel->yield('fail', 'IDENT', 'used.id', [$id]);
+ $kernel->yield('want', 'IDENT');
+ return;
+ }
+
+ my $user = new Haver::Server::Object::User (
+ id => $id,
+ wheel => $heap->{client},
+ sid => $_[SESSION]->ID,
+ );
+ $user->set (
+ Client => $heap->{version},
+ Rank => 0,
+ Role => 'User',
+ _info => [qw( Rank Role Client IP Login Idle )],
+ );
+
+ $kernel->yield('accept', $id, $user);
+}
+
+sub cmd_AUTH {
+ my ($me, $kernel, $heap, $args) = @_[OBJECT, KERNEL, HEAP, ARG0];
+ my $method = $args->[0];
+
+ if ($me->{did}{AUTH}++) {
+ $kernel->yield('oops', 'repeat', ['AUTH']);
+ return;
+ }
+
+ if ($method eq 'pass') {
+ $kernel->yield('want', 'AUTH:PASS');
+ } else {
+ $kernel->yield('fail', 'AUTH', 'unknown.method', [$method]);
+ $kernel->yield('want', 'IDENT');
+ }
+
+}
+
+sub cmd_AUTH_PASS {
+ my ($me, $kernel, $heap, $args) = @_[OBJECT, KERNEL, HEAP, ARG0];
+ my ($pass) = @$args;
+ my $user = delete $heap->{user};
+ my $id = delete $heap->{uid};
+
+ if ($heap->{did}{'AUTH:PASS'}++) {
+ $kernel->yield('oops', 'repeat', ['AUTH:PASS']);
+ return;
+ }
+
+ if ($pass eq $user->get('.password')) {
+ $kernel->yield('accept');
+ } else {
+ $kernel->yield('fail', 'AUTH:PASS', 'nomatch.passhash', []);
+ $kernel->yield('bye', 'monkeys');
+ }
+}
+
+#-------------------------------- Events
--------------------------------------#
+
+sub on_init {
+ my ($me, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
+
+ $me->{timeout} = $kernel->alarm_set('timeout', time + (60 * 3));
+}
+
+sub on_timeout {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ delete $heap->{client};
+ $kernel->yield('shutdown');
+}
+
+sub on_want {
+ my ($kernel, $heap, $want) = @_[KERNEL, HEAP, ARG0];
+
+ delete $me->{did}{$want};
+ $heap->{client}->put(['WANT', $want]);
+}
+
+sub since {
+ my ($then, $now) = @_;
+
+ $now ||= time;
+ format_duration($now - $then);
+}
+
+sub on_accept {
+ my ($me, $kernel, $heap, $uid, $user) = @_[OBJECT, KERNEL, HEAP, ARG0,
ARG1];
+
+ $kernel->alarm_remove(delete $me->{timeout});
+
+ $Registry->add($user);
+ my $addr = join('.', (split(/\./, $heap->{address}))[0,1,2]) .
'.*';
+ my $login_time = time;
+
+ $user->set(
+ IP => $addr,
+ Login => sub {
+ since($login_time);
+ },
+ _lastmsg => time,
+ Idle => sub {
+ my ($u) = @_;
+ since($u->get('_lastmsg'));
+ },
+ '.IP' => $heap->{address},
+ );
+
+ $kernel->call($_[SESSION], 'ready', $uid, $user);
+ $heap->{client}->put(['ACCEPT', $uid]);
+}
+
+
+
+
+
+1;
Added: branches/haver-server-cleanup/lib/Haver/Server/Commands.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/Commands.pm 2004-10-25
20:49:58 UTC (rev 403)
+++ branches/haver-server-cleanup/lib/Haver/Server/Commands.pm 2004-10-25
20:52:37 UTC (rev 404)
@@ -0,0 +1,38 @@
+# vim: set ft=perl ts=4 sw=4:
+# Commands - description
+#
+# Copyright (C) 2004 Dylan William Hardison.
+#
+# 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
+package Haver::Server::Commands;
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+sub setup {
+ my $me = shift;
+
+ foreach my $cmd ($me->commands) {
+ my $method = $cmd;
+ $method =~ s/:/_/g;
+ $me->provide("cmd_$cmd", "cmd_$method");
+ }
+}
+
+
+
+1;
+
Added: branches/haver-server-cleanup/lib/Haver/Server/Plugin/Loader.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/Plugin/Loader.pm
2004-10-25 20:49:58 UTC (rev 403)
+++ branches/haver-server-cleanup/lib/Haver/Server/Plugin/Loader.pm
2004-10-25 20:52:37 UTC (rev 404)
@@ -0,0 +1,51 @@
+# vim: set ft=perl ts=4 sw=4:
+# Plugin::Loader - description
+#
+# Copyright (C) 2004 Dylan William Hardison.
+#
+# 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
+package Haver::Server::Plugin::Loader;
+use strict;
+use warnings;
+use Carp;
+use base 'Haver::Base';
+
+our $VERSION = '0.01';
+
+sub initialize {
+ my $me = shift;
+
+ $me->{plugins} = {};
+}
+
+
+sub load {
+ my ($me, $class) = @_;
+
+ croak "$class is not a Haver::Plugin!" unless
$class->isa('Haver::Plugin');
+
+ $me->{plugins}{$class} = $class->new(load => 1);
+}
+
+sub unload {
+ my ($me, $class) = @_;
+
+ croak "$class is not a Haver::Plugin!" unless
$class->isa('Haver::Plugin');
+ croak "I never loaded a $class!" unless exists $me->{plugins}{$class};
+
+ delete $me->{plugins}{$class};
+}
+
+1;
Added: branches/haver-server-cleanup/lib/Haver/Server/Plugin.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/Plugin.pm 2004-10-25
20:49:58 UTC (rev 403)
+++ branches/haver-server-cleanup/lib/Haver/Server/Plugin.pm 2004-10-25
20:52:37 UTC (rev 404)
@@ -0,0 +1,117 @@
+# vim: set ft=perl ts=4 sw=4:
+# Haver::Server::Commands - description
+#
+# Copyright (C) 2004 Dylan William Hardison.
+#
+# 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
+package Haver::Server::Plugin;
+use strict;
+use warnings;
+use base 'Haver::Base';
+
+our $VERSION = '0.01';
+my $Kernel = $POE::Kernel::poe_kernel;
+
+sub initialize {
+ my ($me) = @_;
+
+ $me->{provides} = [];
+ $me->{states} = {};
+
+ $me->setup();
+
+ if ($me->{load}) {
+ $me->load();
+ }
+}
+
+
+sub provide {
+ my ($me, $state, $method) = @_;
+
+ foreach my $state (@states) {
+ push @{ $me->{provides} }, [ $state, $method ];
+ }
+
+ return $me;
+}
+
+sub load {
+ my ($me) = @_;
+
+ # $p = ['state', 'method']
+ # OR $p = ['state']
+ foreach my $p ($me->provided) {
+ $me->register(@$p);
+ }
+}
+
+sub unload {
+ my ($me) = @_;
+
+ foreach my $state ($me->registered) {
+ $me->unregister($state);
+ }
+}
+
+
+sub register {
+ my ($me, $state, $method) = @_;
+
+ if (exists $me->{states}{$state}) {
+ croak "Can't register $state, already registered!";
+ }
+
+ $me->{states}{$state} = 1;
+ $Kernel->state(
+ $state,
+ not($me->{package}) ? $me : ref($me),
+ $method,
+ );
+}
+
+sub unregister {
+ my ($this, $state) = @_;
+
+ if (not exists $me->{states}{$state}) {
+ croak "Can't unregister $state, it is not registered!";
+ }
+
+ delete $me->{states}{$state};
+ $Kernel->state($state);
+}
+
+sub registered {
+ my ($me) = @_;
+
+ return keys %{ $me->{states} };
+}
+
+# Returns: List of arrays.
+# Example:
+# (['state'], ['state', 'method']);
+sub provided {
+ my ($me) = @_;
+
+ return @{ $me->{provides} };
+}
+
+sub finalize {
+ my ($me) = @_;
+
+ $me->unload();
+}
+
+1;
