Author: dylan
Date: 2004-10-22 19:11:22 -0400 (Fri, 22 Oct 2004)
New Revision: 402
Added:
branches/haver-server-cleanup/lib/Haver/Server/Broadcaster.pm
branches/haver-server-cleanup/lib/Haver/Server/Commands/
branches/haver-server-cleanup/lib/Haver/Server/Connection.pm
branches/haver-server-cleanup/lib/Haver/Server/Listener.pm
Removed:
branches/haver-server-cleanup/lib/Haver/Server/Object/Hammer.pm
branches/haver-server-cleanup/lib/Haver/Server/POE.pm
branches/haver-server-cleanup/lib/Haver/Server/POE/Broadcaster.pm
branches/haver-server-cleanup/lib/Haver/Server/POE/Connection.pm
branches/haver-server-cleanup/lib/Haver/Server/POE/Listener.pm
Log:
whole bunch of renames.
Copied: branches/haver-server-cleanup/lib/Haver/Server/Broadcaster.pm (from rev
401, branches/haver-server-cleanup/lib/Haver/Server/POE/Broadcaster.pm)
Copied: branches/haver-server-cleanup/lib/Haver/Server/Connection.pm (from rev
401, branches/haver-server-cleanup/lib/Haver/Server/POE/Connection.pm)
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/POE/Connection.pm
2004-10-22 15:38:41 UTC (rev 401)
+++ branches/haver-server-cleanup/lib/Haver/Server/Connection.pm
2004-10-22 23:11:22 UTC (rev 402)
@@ -0,0 +1,283 @@
+# 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;
Copied: branches/haver-server-cleanup/lib/Haver/Server/Listener.pm (from rev
401, branches/haver-server-cleanup/lib/Haver/Server/POE/Listener.pm)
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/POE/Listener.pm
2004-10-22 15:38:41 UTC (rev 401)
+++ branches/haver-server-cleanup/lib/Haver/Server/Listener.pm 2004-10-22
23:11:22 UTC (rev 402)
@@ -0,0 +1,151 @@
+# Haver::Server::POE::Listener,
+# this creates a session that listens for connections,
+# and when something connects, it spawns
+# a Haver::Server::Connection session.
+#
+# 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::Listener;
+use strict;
+use warnings;
+use Carp;
+use POE qw(
+ Wheel::SocketFactory
+);
+
+use Haver::Preprocessor;
+use Haver::Server::Connection;
+
+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 => [qw(
+ _start
+ _stop
+ socket_birth
+ socket_fail
+ listen
+ shutdown
+ )],
+ ],
+ heap => $opts,
+ );
+}
+
+sub _start {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+
+ # DEBUG(session): "Listener starts.";
+ $heap->{wheels} = {};
+ $heap->{info} = {};
+ $heap->{kids} = {};
+ $kernel->alias_set('Listener');
+
+ my $ifaces = $heap->{interfaces};
+ return unless $ifaces;
+
+ foreach my $i (@$ifaces) {
+ $kernel->yield('listen', $i);
+ }
+
+}
+
+sub _stop {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+ # DEBUG(session): "Listener stops.";
+}
+
+sub _child {
+ my ($kernel, $heap, $type, $kid) = @_[KERNEL, HEAP, ARG0, ARG1];
+
+ if ($type eq 'create' or $type eq 'gain') {
+ $heap->{kids}{$kid->ID} = 1;
+ } elsif ($type eq 'lose') {
+ delete $heap->{kids}{$kid->ID};
+ } else {
+ die "I don't know how I got here!\n";
+ }
+}
+
+sub listen {
+ my ($kernel, $heap, $iface) = @_[KERNEL, HEAP, ARG0, ARG1];
+
+ my $s = '';
+ if ($iface->{ssl}) {
+ $s = ' (ssl!)';
+ }
+
+ $kernel->post('Logger', 'note', "Listening on port $iface->{port}.$s");
+
+ my $wheel = POE::Wheel::SocketFactory->new(
+ BindPort => $iface->{port},
+ Reuse => 1,
+ SuccessEvent => 'socket_birth',
+ FailureEvent => 'socket_fail',
+ );
+ $heap->{wheels}{$wheel->ID} = $wheel;
+ $heap->{info}{$wheel->ID} = $iface;
+}
+
+
+
+sub socket_birth {
+ my ($kernel, $heap, $socket, $address, $port, $wid) =
+ @_[KERNEL, HEAP, ARG0, ARG1, ARG2, ARG3];
+ my $info = $heap->{info}{$wid};
+ my $wheel = $heap->{wheels}{$wid};
+
+
+ if ($info->{ssl}) {
+ # SSL is postponed until POE::Wrapper::SSL is written.
+ croak "SSL not available";
+ }
+
+ Haver::Server::Connection->create(
+ sock => $socket,
+ address => Socket::inet_ntoa($address),
+ port => $port,
+ iface => $info,
+ );
+}
+
+sub socket_fail {
+ my ($kernel, $heap, $operation, $errnum, $errstr, $wheel_id) =
@_[KERNEL, HEAP, ARG0..ARG3];
+ delete $heap->{info}{$wheel_id};
+ delete $heap->{wheels}{$wheel_id};
+
+ $kernel->post('Logger', 'error', "Operation '$operation' failed:
$errstr ($errnum)");
+}
+
+sub shutdown {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ $kernel->alias_remove('Listener');
+
+ foreach my $kid (keys %{ $heap->{kids} }) {
+ $kernel->post($kid, 'shutdown');
+ }
+ %$heap = ();
+}
+
+1;
Deleted: branches/haver-server-cleanup/lib/Haver/Server/Object/Hammer.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/Object/Hammer.pm
2004-10-22 15:38:41 UTC (rev 401)
+++ branches/haver-server-cleanup/lib/Haver/Server/Object/Hammer.pm
2004-10-22 23:11:22 UTC (rev 402)
@@ -1,117 +0,0 @@
-# Haver::Server::Object::Hammer - OO Hammer object thing.
-#
-# 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::Object::Hammer;
-use strict;
-use warnings;
-use Carp;
-
-
-use Haver::Server::Object;
-use base qw( Haver::Server::Object::Grantable );
-
-our $VERSION = '0.04';
-our $AUTOLOAD;
-
-
-sub namespace { 'hammer' }
-
-sub initialize {
- my ($me) = shift;
-
- $me->SUPER::initialize(@_);
- $me->{user} or croak "Need user object!";
-
- $me->{home} ||= 'object/limbo';
- $me->{owner} ||= 'object/nobody';
-}
-
-sub has {
- my ($me, @keys) = @_;
-
- return $me->SUPER::has(@keys) || $me->{user}->has(@keys);
-}
-
-sub get {
- my ($me, @keys) = @_;
- my @values;
-
- foreach my $k (@keys) {
- push(@values, $me->SUPER::get($k) || $me->{user}->get($k));
- }
-
- return @values;
-}
-
-
-BEGIN {
- no strict 'refs';
- foreach my $sub (qw( home owner user )) {
- *{$sub} = sub {
- my ($me, $val) = @_;
- if (@_ == 2) {
- return $me->{$sub} = $val;
- } else {
- return $me->{$sub};
- }
- };
- }
-}
-
-
-
-#sub AUTOLOAD {
-# my $me = shift;
-# my $method = (split("::", $AUTOLOAD))[-1];
-#
-# $me->{user}->$method(@_);
-#}
-
-1;
-__END__
-=head1 NAME
-
-Haver::Server::Object::Hammer - Object representation of a user.
-
-=head1 SYNOPSIS
-
- use Haver::Server::Object::Hammer;
- my %opts = (); # No options at this time...
- my $uid = 'rob';
- a
- my $user = new Haver::Server::Object::Hammer($uid, %opts);
-
- $user->uid eq $uid; # True
- $user->set(nick => "Roberto");
- $user->set(away => "Roberto isn't here.");
- $user->get('nick') eq 'Roberto'; # True
- my ($nick, $away) = $user->get('nick', 'away'); # Obvious...
- my $array_ref = $user->get('nick', 'away'); # Like above, but a arrayref.
-
- $user->unset('nick', 'away'); # unset one or more items.
-
- my @fields = $user->keys; # Returns all fields.
-
- $user->add_cid($cid);
- $user->remove_cid($cid);
-
-=head1 DESCRIPTION
-
-This module is a representation of a user. It's rather pointless, but it gives
-you a warm fuzzy feeling. In the future, it might store the users in a
database or something.
-
-
Deleted: branches/haver-server-cleanup/lib/Haver/Server/POE/Broadcaster.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/POE/Broadcaster.pm
2004-10-22 15:38:41 UTC (rev 401)
+++ branches/haver-server-cleanup/lib/Haver/Server/POE/Broadcaster.pm
2004-10-22 23:11:22 UTC (rev 402)
@@ -1,71 +0,0 @@
-# vim: set ft=perl ts=4 sw=4:
-# Haver::Server::POE::Broadcaster - 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::POE::Broadcaster;
-use strict;
-use warnings;
-use POE;
-
-our $VERSION = 0.01;
-use Haver::Preprocessor;
-use Haver::Server::Registry qw( $Registry );
-
-use constant CHUNK => 10;
-
-sub create {
- my ($this) = @_;
-
- POE::Session->create(
- package_states => [
- $this => [qw(
- _start
- _stop
- send
- )],
- ],
- );
-}
-
-sub _start {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- $kernel->alias_set('Broadcaster');
-}
-
-sub send {
- my ($kernel, $heap, $target, $msg) = @_[KERNEL, HEAP, ARG0, ARG1];
- # ASSERT: ref($target) eq 'ARRAY' and ref($msg) eq 'ARRAY';
- my $n = @$target;
- my $end = $n > CHUNK ? CHUNK : $n;
- my @targ = splice(@$target, 0, $end);
-
- foreach my $t (@targ) {
- my $u = ref $t ? $t : $Registry->fetch('user', $t);
- eval { $u->wheel->put($msg) };
- warn $@ if $@;
- }
-
- if (@$target) {
- $kernel->yield('send', $target, $msg);
- }
-}
-
-sub _stop { }
-
-1;
-
Deleted: branches/haver-server-cleanup/lib/Haver/Server/POE/Connection.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/POE/Connection.pm
2004-10-22 15:38:41 UTC (rev 401)
+++ branches/haver-server-cleanup/lib/Haver/Server/POE/Connection.pm
2004-10-22 23:11:22 UTC (rev 402)
@@ -1,366 +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::Protocol;
-use Haver::Server::POE::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] : { @_ };
-
- my $commands = 'Haver::Server::POE::Commands';
-
- 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',
- close => 'on_close',
- },
- $commands => $commands->commands,
- ],
- heap => {},
- args => [ $opts ],
- );
-}
-
-sub _start {
- my ($heap, $session, $kernel, $opt) = @_[ HEAP, SESSION, KERNEL,
ARG0];
- my ($address, $socket, $port) = ($opt->{address}, $opt->{sock},
$opt->{port});
- $address = Socket::inet_ntoa($address);
-
- $kernel->post('Logger', 'note', 'Socket Birth');
- $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 = (
- address => $address,
- port => $port,
- timer => $timer,
- client => $client,
- sock => $socket,
- shutdown => 0,
- plonk => 0,
- want => undef,
- want_data => undef, # called if CANT $WANT...
- user => undef,
- uid => undef,
- );
-}
-sub _stop {
- my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
-
- my ($address, $port) = @$heap{qw(address port)};
- $kernel->call('Logger', 'note', 'Socket Death');
- $kernel->call('Logger', 'note', "Lost connection from
${address}:$port");
-}
-sub _default {
- my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
-
-
- if ($event =~ s/^cmd_//) {
- my $cmd = "cmd_$event";
- if (my $code = Haver::Server::POE::Commands->can($cmd)) {
- $kernel->state($cmd, 'Haver::Server::POE::Commands');
- @_[ARG0 .. $#_] = @{ $_[ARG1] };
- goto &$code;
- } else {
- $kernel->call($_[SESSION], 'unknown_cmd', $event,
$_[ARG1][0]);
- }
- }
- $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;
- }
- 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;
-
- if ($heap->{want} and $cmd ne 'CANT') {
- if ($cmd eq $heap->{want}) {
- $want = 1;
- $heap->{want} = undef;
- } else {
- $kernel->yield('oops', 'WANT', [$heap->{want}, $cmd]);
- return;
- }
- }
-
- if ($heap->{user} or $want or $cmd eq 'CANT' or $cmd eq 'HAVER') {
- $heap->{scope} = {};
- $kernel->yield("cmd_$cmd", $args);
- } else {
- $heap->{client} = undef;
- $kernel->yield('cleanup', 'SPEEDY');
- }
-}
-
-sub socket_flush {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- if ($heap->{shutdown}) {
- $kernel->yield('close');
- }
-}
-
-
-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('close');
- $kernel->yield('cleanup', 'DISCON');
-}
-
-sub on_close {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- $kernel->post('Logger', 'note', "Closing client connection: "
- . fileno($heap->{client}[0]));
- $kernel->post('Logger', 'note', "Socket: $heap->{sock}");
-
- my $sock = delete $heap->{sock};
- #close $sock;
- #untie $sock;
- $heap->{client} = undef;
- #close $sock if $t;
- #untie *$sock;
-}
-
-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};
-
- eval { $heap->{client}->put(['BYE', @args]) };
- $heap->{shutdown} = 1;
- $kernel->yield('cleanup', @args);
-}
-
-sub on_want {
- my ($kernel, $heap, $want, %opts) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
- #$want =~ s/\W//g;
- #$want = uc $want;
-
- $kernel->post('Logger', 'note', "Want: $want");
- unless ($heap->{client}) {
- my ($file, $line) = @_[CALLER_FILE,CALLER_LINE];
- $kernel->post('Logger', 'error', "on_want called with undefined
socket at $file line $line!");
- return;
- }
- $heap->{want} = $want;
-
- foreach my $key (keys %opts) {
- $heap->{want_data}{$key} = $opts{$key};
- }
-
- my @args = $opts{args} ? @{$opts{args}} : ();
- $heap->{client}->put(['WANT', $want, @args]);
-}
-
-sub on_cleanup {
- my ($kernel, $heap, @args) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
- if (!$heap->{cleanup}) {
- $kernel->call('Logger', 'note', 'Shutting down client
session.');
- my $user = $heap->{user};
- my $uid = $heap->{uid};
- $heap->{cleanup} = 1;
- $heap->{plonk} = 1;
- $heap->{user} = undef;
- $heap->{uid} = undef;
-
- $kernel->alarm_remove_all();
- if ($uid) {
- $Registry->remove('user', $uid);
- my @users = ();
- foreach my $chan ($user->list_vals('channel')) {
- $user->remove($chan);
- $chan->remove($user);
- push(@users, $chan->list_ids('user'));
- }
- my %users = map { ($_ => $_) } @users;
- delete $users{$uid};
- my $msg = ['QUIT', $uid, @args];
- $kernel->post('Broadcaster', 'send', [ keys %users ],
$msg);
- }
- if ($user) {
- $user->save if $user->has('_reg');
- }
- } else {
- $kernel->post('Logger', 'error', "Trying to run cleanup more
than once! @args");
- }
-}
-
-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 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 {
- format_duration(time - $login_time);
- },
- _last => time,
- Idle => sub {
- my ($u) = @_;
- format_duration(time - $u->get('_last'));
- },
- '.IP' => $heap->{address},
- );
- delete $heap->{want_data};
- $heap->{login} = 1;
- $heap->{client}->put(['ACCEPT', $uid]);
-}
-
-sub on_auth {
- my ($kernel, $heap, $uid, $user) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- $kernel->yield('want', 'AUTH',
- args => ['PASS', 'FAKE'],
- uid => $uid,
- user => $user,
- );
-}
-
-1;
Deleted: branches/haver-server-cleanup/lib/Haver/Server/POE/Listener.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/POE/Listener.pm
2004-10-22 15:38:41 UTC (rev 401)
+++ branches/haver-server-cleanup/lib/Haver/Server/POE/Listener.pm
2004-10-22 23:11:22 UTC (rev 402)
@@ -1,166 +0,0 @@
-# Haver::Server::POE::Listener,
-# this creates a session that listens for connections,
-# and when something connects, it spawns
-# a Haver::Server::Connection session.
-#
-# 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::Listener;
-use strict;
-use warnings;
-use Carp;
-use POE qw(
- Wheel::SocketFactory
-);
-
-use Haver::Preprocessor;
-use Haver::Server::POE::Connection;
-
-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 => [qw(
- _start
- _stop
- socket_birth
- socket_fail
- listen
- shutdown
- )],
- ],
- heap => $opts,
- );
-}
-
-sub _start {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
-
- # DEBUG(session): "Listener starts.";
- $heap->{conn} = {};
- $heap->{kids} = {};
- $kernel->alias_set('Listener');
-
- my $ifaces = $heap->{interfaces};
- return unless $ifaces;
-
- foreach my $i (@$ifaces) {
- $kernel->yield('listen', $i);
- }
-
-}
-
-sub _stop {
- my ($kernel, $heap) = @_[KERNEL,HEAP];
- delete $heap->{listener};
- delete $heap->{session};
- #DEBUG(session): "Listener stops.";
-}
-
-sub _child {
- my ($kernel, $heap, $type, $kid) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- if ($type eq 'create' or $type eq 'gain') {
- $heap->{kids}{$kid->ID} = 1;
- } elsif ($type eq 'lose') {
- delete $heap->{kids}{$kid->ID};
- } else {
- die "I don't know how I got here!\n";
- }
-}
-
-sub listen {
- my ($kernel, $heap, $iface) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- my $s = '';
- if ($iface->{ssl}) {
- $s = ' (ssl!)';
- }
-
- $kernel->post('Logger', 'note', "Listening on port $iface->{port}.$s");
-
- my $wheel = POE::Wheel::SocketFactory->new(
- BindPort => $iface->{port},
- Reuse => 1,
- SuccessEvent => 'socket_birth',
- FailureEvent => 'socket_fail',
- );
- $heap->{conn}{$wheel->ID} = {
- wheel => $wheel,
- host => $iface->{host},
- port => $iface->{port},
- ssl => $iface->{ssl},
- };
-}
-
-
-
-sub socket_birth {
- my ($kernel, $heap, $socket, $address, $port, $wid) =
- @_[KERNEL, HEAP, ARG0, ARG1, ARG2, ARG3];
-
-
-
- if ($heap->{conn}{$wid}{ssl}) {
- # DEBUG: "Doing ssl";
- # BEGIN MAKE SSL
- use Symbol qw(gensym);
- use SslServer;
-
- my $old_socket = $socket;
- $socket = gensym();
- tie( *$socket,
- "SslServer",
- $old_socket,
- "./plain-rsa.pem",
- "./plain-cert.pem",
- ) or die $!;
- # CEASE MAKE SSL
- print "Filenos: ", $old_socket, ", ", tied(*$socket), "\n";
- $socket = \*$socket;
- }
-
- Haver::Server::POE::Connection->create(
- sock => $socket,
- address => $address,
- port => $port,
- );
-}
-
-sub socket_fail {
- my ($kernel, $heap, $operation, $errnum, $errstr, $wheel_id) =
@_[KERNEL, HEAP, ARG0..ARG3];
- delete $heap->{conn}{$wheel_id};
- $kernel->post('Logger', 'error', "Operation '$operation' failed:
$errstr ($errnum)");
-}
-
-sub shutdown {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
- $kernel->alias_remove('Listener');
-
- foreach my $kid (keys %{ $heap->{kids} }) {
- $kernel->post($kid, 'shutdown');
- }
- %$heap = ();
-}
-
-1;
Deleted: branches/haver-server-cleanup/lib/Haver/Server/POE.pm
===================================================================
--- branches/haver-server-cleanup/lib/Haver/Server/POE.pm 2004-10-22
15:38:41 UTC (rev 401)
+++ branches/haver-server-cleanup/lib/Haver/Server/POE.pm 2004-10-22
23:11:22 UTC (rev 402)
@@ -1,205 +0,0 @@
-# Haver::Server::POE - Haver server POE component
-#
-# Copyright (C) 2003-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::POE;
-use strict;
-use open ":utf8";
-
-
-use Data::Dumper;
-#use IO::Poll;
-use POE;
-
-use Haver::Preprocessor;
-use Haver::Config;
-
-use Haver::Server::POE::Listener;
-use Haver::Server::POE::Broadcaster;
-use Haver::Server::Registry;
-use Haver::Server::Object::Channel;
-use Haver::Server::Object::User;
-use Haver::Server::Object::POE;
-use Haver::Server::Object::Index;
-use Haver::Util::Logger;
-use Haver::Util::Reload;
-
-
-our $VERSION = 0.07;
-
-my %Default = (
- logger => {
- levels => {},
- },
- listener => {
- interfaces => [
- {
- port => 7070,
- },
- {
- port => 7072,
- ssl => 1,
- },
- ]
- },
- broadcaster => { },
- path => {
- storage => "./store",
- },
- channels => [qw(
- main
- lobby
- attic
- basement
- kitchen
- Creatures
- )],
-);
-
-sub boot {
- my ($this, $file) = @_;
-
- # ASSERT: defined $file;
- # DEBUG(session): "Booting ", __PACKAGE__;
-
- my $cfg = new Haver::Config (
- file => $file,
- default => \%Default,
- );
- $cfg->save;
-
- init Haver::Util::Reload;
- my $reg = instance Haver::Server::Registry;
-
- my @cids = (Haver::Server::Object::Channel->saved_ids, @{
$cfg->{channels} });
- foreach my $cid (@cids) {
- DEBUG: $cid;
- my $chan = Haver::Server::Object::Channel->new(id => $cid);
- $chan->load;
- $reg->add($chan);
- }
-
- if ($cfg->{path}{storage}) {
- $Haver::Server::Object::StorageDir = $cfg->{path}{storage};
- }
-
- $this->create(cfg => $cfg);
-}
-
-sub create {
- my ($class, %opt) = @_;
-
- POE::Session->create(
- package_states => [
- $class => [
- '_start',
- '_stop',
- 'interrupt',
- 'die',
- 'shutdown',
- ]
- ],
- heap => {
- cfg => $opt{cfg}
- },
- );
-}
-
-sub _start {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
-
- # DEBUG(session): "Server starts.";
-
- create Haver::Util::Logger $heap->{cfg}{logger};
- create Haver::Server::POE::Listener $heap->{cfg}{listener};
- create Haver::Server::POE::Broadcaster $heap->{cfg}{broadcaster};
-
-
-
- $kernel->sig('INT' => 'intterrupt');
- $kernel->sig('DIE' => 'die');
-}
-sub _stop {
- # DEBUG(session): "Server stops.";
-}
-
-sub die {
- # DEBUG(session): "Got die!";
-}
-
-sub interrupt {
- print "Got INT\n";
- return 0;
-}
-sub shutdown {
-}
-
-
-1;
-__END__
-# Below is stub documentation for your module. You'd better edit it!
-
-=head1 NAME
-
-Haver::Server::POE - Haver chat server.
-
-=head1 SYNOPSIS
-
- use Haver::Server::POE;
-
-=head1 DESCRIPTION
-
- WRITEME
-
-=head2 EXPORT
-
-None by default.
-
-=head1 SEE ALSO
-
-Mention other useful documentation such as the documentation of
-related modules or operating system documentation (such as man pages
-in UNIX), or any relevant external documentation such as RFCs or
-standards.
-
-If you have a mailing list set up for your module, mention it here.
-
-If you have a web site set up for your module, mention it here.
-
-=head1 AUTHOR
-
-Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2003-2004 by 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
-
-=cut
