Author: dylan
Date: 2004-10-25 16:49:58 -0400 (Mon, 25 Oct 2004)
New Revision: 403
Added:
branches/haver-server-cleanup/lib/Haver/Server/Avatar.pm
Removed:
branches/haver-server-cleanup/lib/Haver/Server/Connection.pm
Modified:
branches/haver-server-cleanup/lib/Haver/Server/Listener.pm
branches/haver-server-cleanup/lib/Haver/Server/Registry.pm
Log:
The redesign continues. Adding loadable modules
of server commands.
Copied: branches/haver-server-cleanup/lib/Haver/Server/Avatar.pm (from rev 402,
branches/haver-server-cleanup/lib/Haver/Server/Connection.pm)
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/Connection.pm
2004-10-22 23:11:22 UTC (rev 402)
+++ branches/haver-server-cleanup/lib/Haver/Server/Avatar.pm 2004-10-25
20:49:58 UTC (rev 403)
@@ -0,0 +1,225 @@
+# Haver::Server::Avatar,
+# this creates a session, which represents the user...
+#
+# Copyright (C) 2003 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
+
+# TODO, write POD. Soon.
+package Haver::Server::Avatar;
+use strict;
+use Carp qw(croak confess carp cluck);
+
+use POE qw(
+ Wheel::ReadWrite
+ Driver::SysRW
+ Preprocessor
+ Filter::Haver
+);
+
+use Haver::Server::Commands;
+use Haver::Server::Registry qw( $Registry );
+
+our $RELOAD = 1;
+
+sub create {
+ my ($class) = shift;
+ # ASSERT: (@_ == 1 and ref($_[0]) eq 'HASH') or ((@_ % 2) == 0);
+ my $opts = @_ == 1 ? $_[0] : { @_ };
+
+
+ POE::Session->create(
+ package_states => [
+ $class => {
+ # POE states
+ _start => '_start',
+ _stop => '_stop',
+ _default => '_default',
+
+
+ # Wheel states
+ input => 'on_input',
+ error => 'on_error',
+ flush => 'on_flush',
+
+ # Utility states
+ cleanup => 'on_cleanup',
+ 'shutdown' => 'on_shutdown',
+ 'fail' => 'on_fail',
+ 'oops' => 'on_oops',
+ },
+ ],
+ heap => {},
+ args => [ $opts ],
+ );
+}
+
+sub _start {
+ my ($heap, $session, $kernel, $opt) = @_[ HEAP, SESSION, KERNEL,
ARG0];
+ my ($address, $socket, $port) = ($opt->{address}, delete $opt->{sock},
$opt->{port});
+
+ $kernel->post('Logger', 'note', "Connection from ${address}:$port");
+
+
+ ## breaks ssl.
+ #binmode $socket, ":utf8";
+ my $client = new POE::Wheel::ReadWrite(
+ Handle => $socket,
+ Driver => new POE::Driver::SysRW,
+ Filter => new POE::Filter::Haver,
+ InputEvent => 'input',
+ FlushedEvent => 'flush',
+ ErrorEvent => 'error',
+ );
+
+ %$heap = (
+ %$opt,
+ client => $client,
+ shutdown => 0,
+ plonk => 0,
+ plugin => new Haver::Server::Plugin::Loader,
+ );
+
+ $heap->{plugin}->load('Haver::Server::Commands::Connection');
+ $kernel->call($session, 'init');
+}
+
+
+sub _stop {
+ my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
+
+ my ($address, $port) = @$heap{qw(address port)};
+ $kernel->call('Logger', 'note', "Lost connection from
${address}:$port");
+}
+
+
+sub on_ready {
+ my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
+
+ $heap->{plugin}->unload('Haver::Server::Commands::Connection');
+ $heap->{plugin}->load('Haver::Server::Commands::Channel');
+}
+
+sub _default {
+ my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
+
+ my $cmd = $event;
+ if ($event =~ s/^cmd_//) {
+ $kernel->call($_[SESSION], 'unknown_cmd', $event, $_[ARG1][0],
$cmd);
+ }
+ $kernel->post('Logger', 'error', "Unknown event: $event");
+
+ return 0;
+}
+
+sub on_input {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+
+ my @copy = @$args;
+ foreach (@copy) {
+ next unless defined;
+ #my @foo = split(//, $_);
+ #foreach my $c (@foo) {
+ #$c = ord($c);
+ #$c = "[$c]";
+ #}
+ #$_ = join('', @foo);
+ s/\e/<ESC>/g;
+ s/\r/<CR>/g;
+ s/\n/<LF>/g;
+ s/\t/<TAB>/g;
+ p
+ }
+ my $raw = join("\t", map { defined $_ ? $_ : '' } @copy);
+ $kernel->post('Logger', 'raw', $raw);
+
+ return if $heap->{plonk};
+ return if $heap->{shutdown};
+
+ my $want = 0;
+ my $cmd = shift @$args;
+ my $event = 'cmd_' . $cmd;
+
+ $kernel->yield($event, $args, $cmd);
+
+}
+
+sub on_flush {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ if ($heap->{shutdown}) {
+ delete $heap->{client};
+ }
+}
+
+
+sub on_error {
+ my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
+
+ $kernel->post('Logger', 'error',
+ "Socket generated $operation error ${errnum}: $errstr");
+
+
+ $kernel->yield('shutdown', 'DISCON');
+}
+
+
+sub on_shutdown {
+ my ($kernel, $heap, $session, @args) = @_[KERNEL, HEAP, SESSION, ARG0
.. $#_];
+ return if $heap->{shutdown};
+
+ $kernel->call('Logger', 'note', 'Shutting down client session.');
+ eval { $heap->{client}->put(['BYE', @args]) };
+ $heap->{shutdown} = 1;
+ $kernel->alarm_remove_all();
+
+ $kernel->yield('cleanup', @args);
+}
+
+sub on_cleanup {
+ my ($kernel, $heap, @args) = @_[KERNEL, HEAP, ARG0 .. $#_];
+
+}
+
+sub on_oops {
+ my ($kernel, $heap, $err, $data) = @_[KERNEL, HEAP, ARG0 .. $#_];
+
+ if (not defined $data) {
+ $data = [];
+ }
+
+ if (not ref $data) {
+ $data = [$data];
+ }
+
+ eval { $heap->{client}->put(['OOPS', $err, @$data]) };
+ $kernel->yield('shutdown', 'OOPS');
+}
+sub on_fail {
+ my ($kernel, $heap, $cmd, $err, $data) = @_[KERNEL, HEAP, ARG0 .. $#_];
+
+ if (not defined $data) {
+ $data = [];
+ }
+
+ if (not ref $data) {
+ $data = [$data];
+ }
+
+ $kernel->post('Logger', 'fail', "failing $heap->{uid} with $cmd -
$err");
+ eval { $heap->{client}->put(['FAIL', $cmd, $err, @$data]) };
+}
+
+1;
Deleted: branches/haver-server-cleanup/lib/Haver/Server/Connection.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/Connection.pm
2004-10-22 23:11:22 UTC (rev 402)
+++ branches/haver-server-cleanup/lib/Haver/Server/Connection.pm
2004-10-25 20:49:58 UTC (rev 403)
@@ -1,283 +0,0 @@
-# Haver::Server::POE::Connection,
-# this creates a session, which represents the user...
-#
-# Copyright (C) 2003 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
-
-# TODO, write POD. Soon.
-package Haver::Server::POE::Connection;
-use strict;
-use Carp qw(croak confess carp cluck);
-
-use POE qw(
- Wheel::ReadWrite
- Driver::SysRW
- Preprocessor
- Filter::Haver
-);
-
-use Haver::Server::Commands;
-use Haver::Server::Registry qw( $Registry );
-use Haver::Formats qw( :duration );
-
-use Scalar::Util ();
-use Digest::SHA1 qw( sha1_base64 );
-our $RELOAD = 1;
-
-sub create {
- my ($class) = shift;
- # ASSERT: (@_ == 1 and ref($_[0]) eq 'HASH') or ((@_ % 2) == 0);
- my $opts = @_ == 1 ? $_[0] : { @_ };
-
-
- POE::Session->create(
- package_states => [
- $class => {
- # POE states
- _start => '_start',
- _stop => '_stop',
- _default => '_default',
-
-
- # Wheel states
- socket_input => 'socket_input',
- socket_error => 'socket_error',
- socket_flush => 'socket_flush',
-
- # Utility states
- want => 'on_want',
- cleanup => 'on_cleanup',
- 'shutdown' => 'on_shutdown',
- 'fail' => 'on_fail',
- 'oops' => 'on_oops',
- 'accept' => 'on_accept',
- auth => 'on_auth',
- unknown_cmd => 'on_unknown_cmd',
- },
- ],
- heap => {},
- args => [ $opts ],
- );
-}
-
-sub _start {
- my ($heap, $session, $kernel, $opt) = @_[ HEAP, SESSION, KERNEL,
ARG0];
- my ($address, $socket, $port) = ($opt->{address}, delete $opt->{sock},
$opt->{port});
-
- $kernel->post('Logger', 'note', "Connection from ${address}:$port");
-
-
- ## breaks ssl.
- #binmode $socket, ":utf8";
- my $client = new POE::Wheel::ReadWrite(
- Handle => $socket,
- Driver => new POE::Driver::SysRW,
- Filter => new POE::Filter::Haver,
- InputEvent => 'socket_input',
- FlushedEvent => 'socket_flush',
- ErrorEvent => 'socket_error',
- );
-
-
- my $timer = $kernel->alarm_set(
- 'shutdown',
- time + 60 * 60,
- 'TIMEOUT',
- );
-
- %$heap = (
- %$opt,
- timer => $timer,
- client => $client,
- shutdown => 0,
- plonk => 0,
- user => undef,
- uid => undef,
- prefix => 'wcmd',
- );
-}
-sub _stop {
- my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
-
- my ($address, $port) = @$heap{qw(address port)};
- $kernel->call('Logger', 'note', "Lost connection from
${address}:$port");
-}
-
-sub _default {
- my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
-
-
- if ($event =~ s/^cmd_//) {
- $kernel->call($_[SESSION], 'unknown_cmd', $event, $_[ARG1][0]);
- } elsif ($event =~ s/^wcmd_//) {
-
- }
- $kernel->post('Logger', 'error', "Unknown event: $event");
-
- return 0;
-}
-
-sub socket_input {
- my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
-
- my @copy = @$args;
- foreach (@copy) {
- next unless defined;
- #my @foo = split(//, $_);
- #foreach my $c (@foo) {
- #$c = ord($c);
- #$c = "[$c]";
- #}
- #$_ = join('', @foo);
- s/\e/<ESC>/g;
- s/\r/<CR>/g;
- s/\n/<LF>/g;
- s/\t/<TAB>/g;
- p
- }
- my $raw = join("\t", map { defined $_ ? $_ : '' } @copy);
- $kernel->post('Logger', 'raw', $raw);
-
- return if $heap->{plonk};
- return if $heap->{shutdown};
-
- my $want = 0;
- my $cmd = shift @$args;
- my $event = $heap->{prefix} . '_' . $cmd;
-
- $kernel->yield($event, $args, $cmd);
-
-}
-
-sub socket_flush {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- if ($heap->{shutdown}) {
- delete $heap->{client};
- }
-}
-
-
-sub socket_error {
- my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
-
- $kernel->post('Logger', 'error',
- "Socket generated $operation error ${errnum}: $errstr");
-
-
- $kernel->yield('shutdown', 'DISCON');
-}
-
-sub on_unknown_cmd {
- my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
-
-
- $heap->{client}->put(['FAIL', $event, 'unknown.command']);
-}
-
-sub on_shutdown {
- my ($kernel, $heap, $session, @args) = @_[KERNEL, HEAP, SESSION, ARG0
.. $#_];
- return if $heap->{shutdown};
-
- $kernel->call('Logger', 'note', 'Shutting down client session.');
- eval { $heap->{client}->put(['BYE', @args]) };
- $heap->{shutdown} = 1;
- $kernel->alarm_remove_all();
-
- $kernel->yield('cleanup', @args);
-}
-
-sub on_cleanup {
- my ($kernel, $heap, @args) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
-}
-
-sub on_oops {
- my ($kernel, $heap, $err, $data) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
- if (not defined $data) {
- $data = [];
- }
-
- if (not ref $data) {
- $data = [$data];
- }
-
- eval { $heap->{client}->put(['OOPS', $err, @$data]) };
- $kernel->yield('shutdown', 'OOPS');
-}
-sub on_fail {
- my ($kernel, $heap, $cmd, $err, $data) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
- if (not defined $data) {
- $data = [];
- }
-
- if (not ref $data) {
- $data = [$data];
- }
-
- $kernel->post('Logger', 'fail', "failing $heap->{uid} with $cmd -
$err");
- eval { $heap->{client}->put(['FAIL', $cmd, $err, @$data]) };
-}
-
-sub since {
- my ($then, $now) = @_;
-
- $now ||= time;
- format_duration($now - $then);
-}
-
-sub on_accept {
- my ($kernel, $heap, $uid, $user) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- $kernel->alarm_remove(delete $heap->{timer});
-
-
- $Registry->add($user);
- $heap->{user} = $user;
- $heap->{uid} = $uid;
-
- my $addr = join('.', (split(/\./, $heap->{address}))[0,1,2]) . '.*';
- my $login_time = time;
-
- $user->set(
- IP => $addr,
- Login => sub {
- since($login_time);
- },
- _last => time,
- Idle => sub {
- my ($u) = @_;
- since($u->get('_last'));
- },
- '.IP' => $heap->{address},
- );
-
- $heap->{prefix} = 'cmd';
- $heap->{login} = 1;
- $heap->{client}->put(['ACCEPT', $uid]);
-}
-
-sub on_auth {
- my ($kernel, $heap, $uid, $user) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- $heap->{uid} = $uid;
- $heap->{user} = $user;
-
-}
-
-1;
Modified: branches/haver-server-cleanup/lib/Haver/Server/Listener.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/Listener.pm 2004-10-22
23:11:22 UTC (rev 402)
+++ branches/haver-server-cleanup/lib/Haver/Server/Listener.pm 2004-10-25
20:49:58 UTC (rev 403)
@@ -20,7 +20,7 @@
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# TODO, write POD. Soon.
-package Haver::Server::POE::Listener;
+package Haver::Server::Listener;
use strict;
use warnings;
use Carp;
@@ -29,7 +29,6 @@
);
use Haver::Preprocessor;
-use Haver::Server::Connection;
sub create {
my $class = shift;
@@ -122,12 +121,12 @@
croak "SSL not available";
}
- Haver::Server::Connection->create(
+ create Haver::Server::Avatar {
sock => $socket,
address => Socket::inet_ntoa($address),
port => $port,
iface => $info,
- );
+ };
}
sub socket_fail {
Modified: branches/haver-server-cleanup/lib/Haver/Server/Registry.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/Registry.pm 2004-10-22
23:11:22 UTC (rev 402)
+++ branches/haver-server-cleanup/lib/Haver/Server/Registry.pm 2004-10-25
20:49:58 UTC (rev 403)
@@ -26,19 +26,20 @@
use POE;
use Carp;
-our $VERSION = 0.04;
-our $RELOAD = 1;
+our $VERSION = 0.04;
+our $RELOAD = 1;
+our @EXPORT_OK = qw( $Registry );
our $Registry;
-our @EXPORT_OK = qw( $Registry );
sub instance {
my $class = shift;
# don't warn about redefining a function.
- do {
+ {
no warnings;
- *instance = \&self;
- };
+ *old_instance = \&instance;
+ *instance = \&self;
+ }
return $Registry = $class->SUPER::new(@_);
}
