Author: dylan
Date: 2004-06-09 17:07:13 -0400 (Wed, 09 Jun 2004)
New Revision: 234
Added:
trunk/main/server/lib/Haver/Server/POE.pm
trunk/main/server/lib/Haver/Server/POE/
trunk/main/server/lib/Haver/Server/POE/Commands.pm
trunk/main/server/lib/Haver/Server/POE/Connection.pm
trunk/main/server/lib/Haver/Server/POE/Listener.pm
Removed:
trunk/main/server/lib/Haver/Server.pm
trunk/main/server/lib/Haver/Server/Connection.pm
trunk/main/server/lib/Haver/Server/Connection/
trunk/main/server/lib/Haver/Server/Globals.pm
trunk/main/server/lib/Haver/Server/Listener.pm
trunk/main/server/lib/Haver/Server/Remote.pm
Modified:
trunk/main/server/lib/Haver/Server/Object/User.pm
Log:
Continuing moving POE things into a sub-namespace.
Also we no longer use any global variables.
Deleted: trunk/main/server/lib/Haver/Server/Connection.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Connection.pm 2004-06-09 01:59:54 UTC
(rev 233)
+++ trunk/main/server/lib/Haver/Server/Connection.pm 2004-06-09 21:07:13 UTC
(rev 234)
@@ -1,368 +0,0 @@
-# Haver::Server::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::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::Globals qw( $Registry $Config );
-use Haver::Server::Connection::Commands;
-use Digest::SHA1 qw( sha1_base64 );
-
-our $RELOAD = 1;
-
-sub create {
- my ($class, @args) = @_;
- my $C = "Haver::Server::Connection::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',
- 'warn' => 'on_warn',
- 'die' => 'on_die',
- 'accept' => 'on_accept',
- 'auth' => 'on_auth',
- 'send_ping' => 'on_send_ping',
-# 'broadcast' => 'on_broadcast',
-
- },
- $C => $C->commands,
- ],
- heap => {
- },
- args => [EMAIL PROTECTED],
- );
-}
-
-sub _start {
- my ($heap, $session, $kernel, $socket, $address, $port ) =
- @_[ HEAP, SESSION, KERNEL, ARG0, ARG1, ARG2];
- $address = Socket::inet_ntoa($address);
-
- $kernel->post('Logger', 'note', 'Socket Birth');
- $kernel->post('Logger', 'note', "Connection from ${address}:$port");
-
-
- binmode $socket, ":utf8";
- my $sock = 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 + 20,
- 'TIMEOUT',
- );
-
- %$heap = (
- timer => $timer,
- ping => undef,
- ping_time => undef,
- socket => $sock,
- shutdown => 0,
- plonk => 0,
- want => undef,
- want_data => undef, # called if CANT $WANT...
- user => undef,
- uid => undef,
- );
-
- $sock->put(['HAVER', 3, "line=$Config->{Server}{LineLimit}"]);
- $kernel->yield('want', 'IDENT',
- address => $address,
- port => $port,
- );
-
-}
-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::Commands->can($cmd)) {
- $kernel->state($cmd, 'Haver::Server::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};
- if ($heap->{ping} && !$heap->{ping_time}) {
- $kernel->alarm_remove($heap->{ping});
- $heap->{ping} = $kernel->alarm_set(
- 'send_ping',
- time + $Config->{Server}{PingTime});
- }
-
- 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('die', 'WANT', [$heap->{want}, $cmd]);
- return;
- }
- }
-
- if ($heap->{user} or $want or $cmd eq 'CANT') {
- $heap->{scope} = {
- };
- $kernel->yield("cmd_$cmd", $args);
- } else {
- $kernel->yield('die', 'SPEEDY');
- }
-}
-sub socket_flush {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- if ($heap->{shutdown}) {
- $heap->{socket} = undef;
- }
-}
-sub socket_error {
- my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
-
- $kernel->post('Logger', 'error',
- "Socket generated $operation error ${errnum}: $errstr");
-
- $heap->{socket} = undef;
- $kernel->yield('cleanup', 'DISCON');
-}
-
-
-sub on_shutdown {
- my ($kernel, $heap, $session, @args) = @_[KERNEL, HEAP, SESSION, ARG0
.. $#_];
- return if $heap->{shutdown};
-
- $heap->{socket}->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->{socket}) {
- 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->{socket}->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_vals('user'));
- }
- my %users = map { ($_ => $_) } @users;
- my $msg = ['QUIT', $uid, @args];
- foreach my $u (values %users) {
- eval { $u->send($msg) };
- }
- }
- if ($user) {
- ($heap->{port}, $heap->{address}) = $user->get('.port',
'.address');
- $user->save if $user->has('reg');
- }
- } else {
- $kernel->post('Logger', 'error', "Trying to run cleanup more
than once! @args");
- }
-}
-
-sub on_die {
- my ($kernel, $heap, $err, $data, $in) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
- if (not defined $data) {
- $data = [];
- }
-
- if (not ref $data) {
- $data = [$data];
- }
-
- my @p = $in ? (IN => $in) : ();
- eval { $heap->{socket}->put([EMAIL PROTECTED], 'DIE', $err, @$data]) };
- $kernel->yield('shutdown', 'DIE');
-}
-sub on_warn {
- my ($kernel, $heap, $err, $data, $in) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
- if (not defined $data) {
- $data = [];
- }
-
- if (not ref $data) {
- $data = [$data];
- }
-
- my @p = $in ? (IN => $in) : ();
- $kernel->post('Logger', 'warn', "Warning $heap->{uid}: $err");
- eval { $heap->{socket}->put([EMAIL PROTECTED], 'WARN', $err, @$data]) };
-}
-
-sub on_accept {
- my ($kernel, $heap, $uid, $user) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- $kernel->alarm_remove(delete $heap->{timer});
- $heap->{ping} = $kernel->alarm_set(
- 'send_ping',
- time + $Config->{Server}{PingTime});
- $heap->{ping_time} = undef;
-
-
-
- $Registry->add($user);
- $heap->{user} = $user;
- $heap->{uid} = $uid;
- my $addr = join('.', (split(/\./, $heap->{want_data}{address}))[0,1,2])
. '.*';
- $user->set(
- address => $addr,
- '.address' => delete $heap->{want_data}{address},
- '.port' => delete $heap->{want_data}{port},
- );
- delete $heap->{want_data};
- $user->set_flags('address', 'li');
- $user->set_flags('.address', 'l');
- $user->set_flags('.port', 'l');
-
- $heap->{login} = 1;
- $heap->{socket}->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,
- );
-}
-
-sub on_send_ping {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- my $time = time;
- $heap->{socket}->put(['PING', $time]);
-
- $heap->{ping} = $kernel->alarm_set(
- 'shutdown', time + $Config->{Server}{PingTime}, 'PING');
- $heap->{ping_time} = $time;
-
- $kernel->post('Logger', 'note', "Sending PING: $time");
-}
-
-
-
-1;
Deleted: trunk/main/server/lib/Haver/Server/Globals.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Globals.pm 2004-06-09 01:59:54 UTC
(rev 233)
+++ trunk/main/server/lib/Haver/Server/Globals.pm 2004-06-09 21:07:13 UTC
(rev 234)
@@ -1,120 +0,0 @@
-# Haver::Server::Globals - The Server class.
-#
-# 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::Globals;
-use strict;
-use open ":utf8";
-
-our %Feature;
-our $Store;
-our $Config;
-our $Roles;
-our $Registry;
-our $VERSION = 0.055;
-
-BEGIN {
- use Exporter;
- use base 'Exporter';
-
- our $RELOAD = 1;
- our @EXPORT = ();
- our @EXPORT_OK = qw( $Registry $Config %Feature $Store);
-}
-
-use Haver::Server::Registry;
-use Haver::Config;
-
-
-sub init {
- my ($class, %opts) = @_;
-
- return if $Config || $Store || $Registry;
-
- $Registry = $opts{Registry};
- $Config = $opts{Config};
- $Store = $opts{Store};
- %Feature = $opts{Feature} ? %{ $opts{Feature} } : () ;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-Haver::Server::Globals - Export of global variables.
-
-=head1 SYNOPSIS
-
- use Haver::Server::Globals qw( $Config $Registry %Features );
-
-=head1 DESCRIPTION
-
-Haver::Server::Globals exports a few variables
-that are needed everywhere. These variables are:
-
-$Config -- the data from the global config file.
-
-$Registry -- the object registry, a database of users and
-and channels,and hammers...
-
-$Store -- global storage for bits and bobs.
-
-%Features -- a hash for the lookup of what features are available.
-
-
-=head2 EXPORT
-
-None by default.
-
-$Store, $Config, $Registry, %Features.
-
-
-=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
Deleted: trunk/main/server/lib/Haver/Server/Listener.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Listener.pm 2004-06-09 01:59:54 UTC
(rev 233)
+++ trunk/main/server/lib/Haver/Server/Listener.pm 2004-06-09 21:07:13 UTC
(rev 234)
@@ -1,92 +0,0 @@
-# Haver::Server::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::Listener;
-use strict;
-use warnings;
-use Carp;
-use POE qw(
- Wheel::SocketFactory
-);
-
-use Haver::Preprocessor;
-use Haver::Server::Connection;
-
-sub create {
- my ($class, %opts) = @_;
- POE::Session->create(
- package_states =>
- [
- $class => [
- '_start',
- '_stop',
- 'socket_birth',
- 'socket_fail',
- ]
- ],
- heap => {
- port => $opts{port},
- },
- args => [EMAIL PROTECTED],
- );
-}
-
-sub _start {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
- my $port = $heap->{port};
-
-
- DEBUG: "Listener starts.";
- $kernel->post('Logger', 'note', "Listening on port $port.");
-
- $heap->{listener} = POE::Wheel::SocketFactory->new(
- #BindAddress => '127.0.0.1',
- BindPort => $port,
- Reuse => 1,
- SuccessEvent => 'socket_birth',
- FailureEvent => 'socket_fail',
- );
- $kernel->alias_set('Listener');
-}
-sub _stop {
- my ($kernel, $heap) = @_[KERNEL,HEAP];
- delete $heap->{listener};
- delete $heap->{session};
- DEBUG: "Listener stops.";
-}
-
-sub socket_birth {
- my ($kernel, $socket, $address, $port) = @_[ KERNEL, ARG0, ARG1, ARG2 ];
-
-
- create Haver::Server::Connection ($socket, $address, $port);
-}
-sub socket_fail {
- my ($kernel, $heap, $operation, $errnum, $errstr, $wheel_id) =
@_[KERNEL, HEAP, ARG0..ARG3];
- die "Listener: '$operation' failed: $errstr";
-}
-
-sub shutdown {
- $_[KERNEL]->alias_remove('Listener');
-}
-
-1;
Modified: trunk/main/server/lib/Haver/Server/Object/User.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Object/User.pm 2004-06-09 01:59:54 UTC
(rev 233)
+++ trunk/main/server/lib/Haver/Server/Object/User.pm 2004-06-09 21:07:13 UTC
(rev 234)
@@ -23,11 +23,10 @@
use Haver::Preprocessor;
use Haver::Server::Object;
use Haver::Server::Object::Index;
-use Haver::Server::Globals qw( $Store $Registry );
+use Haver::Server::Globals qw( $Config );
use base qw( Haver::Server::Object Haver::Server::Object::Index );
-use Scalar::Util qw( weaken );
our $VERSION = '0.04';
@@ -70,7 +69,7 @@
}
};
- return $Store->{Roles}{$role}{$act} if exists
$Store->{Roles}{$role}{$act};
+ return $Config->{Roles}{$role}{$act} if exists
$Store->{Roles}{$role}{$act};
return undef;
}
@@ -81,7 +80,7 @@
$me->{_access}{$key} = 1;
}
-sub ungrant {
+sub wipe {
my ($me, $act, %arg) = @_;
my $key = $arg{scope} ? "$arg{scope}:$act" : $act;
Copied: trunk/main/server/lib/Haver/Server/POE/Commands.pm (from rev 231,
trunk/main/server/lib/Haver/Server/Connection/Commands.pm)
===================================================================
--- trunk/main/server/lib/Haver/Server/Connection/Commands.pm 2004-06-09
00:52:16 UTC (rev 231)
+++ trunk/main/server/lib/Haver/Server/POE/Commands.pm 2004-06-09 21:07:13 UTC
(rev 234)
@@ -0,0 +1,367 @@
+# Haver::Server::POE::Commands,
+# Commands for Haver::Server::POE.
+#
+# 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::Commands;
+use strict;
+#use warnings;
+
+use Carp;
+use POE;
+
+use Haver::Preprocessor;
+use Digest::SHA1 qw(sha1_base64);
+use Haver::Util::Misc ();
+
+our $VERSION = 0.02;
+our $RELOAD = 1;
+our @Commands = qw(
+ IDENT
+ CANT
+ PONG
+ AUTH
+ AUTH:PASS
+ IN TO THIS
+ MSG JOIN PART QUIT
+ USERS
+);
+
+sub _mkcmd {
+ my $func = $_;
+ $func =~ s/:/_/g;
+ return ("cmd_$_" => "cmd_$func");
+}
+
+sub commands {
+ my ($this) = @_;
+ my %cmds = map _mkcmd(), @Commands;
+# $cmds{cmd_GRANT} = 'cmd_GRANTCMD';
+# $cmds{cmd_REVOKE} = 'cmd_GRANTCMD';
+# $cmds{cmd_CLEAR} = 'cmd_GRANTCMD';
+
+ $cmds{unknown_cmd} = 'do_unknown_cmd';
+ return \%cmds;
+}
+
+sub do_unknown_cmd {
+ my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
+
+ $kernel->yield('warn', UCMD => [$event], $heap->{scope}{cid});
+}
+
+#> IDENT($uid, $mode, $version)
+sub cmd_IDENT {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($uid, $mode, $version) = @$args;
+
+ return if $heap->{login};
+
+ if ($mode ne 'user') {
+ $kernel->yield('die', 'UNSUPPORTED_MODE', [$mode]);
+ return;
+ }
+
+ unless (Haver::Server::Object::User->is_valid_id($uid)) {
+ $poe_kernel->yield('die', 'UID_INVALID', [$uid]);
+ } else {
+ if ($Registry->contains('user', $uid)) {
+ $poe_kernel->yield('die', 'UID_IN_USE', [$uid]);
+ } else {
+ my $user = new Haver::Server::Object::User(
+ id => $uid,
+ sid => $_[SESSION]->ID,
+ wheel => $heap->{socket},
+ );
+ $user->set(
+ mode => $mode,
+ version => $version
+ );
+ $user->set_flags('mode', 'l');
+ $user->set_flags('version', 'i');
+ if (-e $user->filename) {
+ eval { $user->load };
+ if ($@) {
+ # This really shouldn't ever happen.
+ $kernel->post('Logger', 'error', "Error
loading ${uid}: $@");
+ $kernel->yield('die', 'LOAD_USER');
+ return;
+ }
+ $kernel->yield('auth', $uid, $user);
+ } else {
+ $kernel->yield('accept', $uid, $user);
+ }
+ }
+ }
+}
+
+
+#> CANT($want)
+sub cmd_CANT {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $want = $args->[0];
+
+ if ($want eq $heap->{want}) {
+ if (my $code = delete $heap->{want_data}{code}) {
+ $code->($kernel, $heap);
+ } else {
+ $kernel->yield('die', 'CANT', [$want]);
+ }
+ $heap->{want} = undef;
+ } else {
+ $kernel->yield('die', CANT_WRONG => [$want, $heap->{want}]);
+ }
+}
+
+#> AUTH($method)
+sub cmd_AUTH {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $method = $args->[0];
+
+ return if $heap->{login};
+
+ if ($method eq 'pass') {
+ $kernel->yield('want', 'AUTH:PASS');
+ }
+
+}
+
+#> AUTH:PASS($password)
+sub cmd_AUTH_PASS {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($pass) = @$args;
+ my $user = delete $heap->{want_data}{user};
+ my $uid = delete $heap->{want_data}{uid};
+
+ return if $heap->{login};
+
+ if ($pass eq $user->get('.password')) {
+ $kernel->yield('accept', $uid, $user);
+ } else {
+ $kernel->yield('die', 'AUTH', [$uid]);
+ }
+}
+
+#> IN($cid, @rest)
+sub cmd_IN {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $cid = shift @$args;
+ my $cmd = shift @$args;
+
+ return unless check_cid($cid);
+ $heap->{scope}{cid} = $cid;
+ $kernel->call($_[SESSION], "cmd_$cmd", $args);
+ delete $heap->{scope}{cid};
+}
+
+#> TO($uid, @rest)
+sub cmd_TO {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $uid = shift @$args;
+ my $cmd = shift @$args;
+
+ if (not $uid =~ /,/) {
+ return unless check_uid($uid);
+ } else {
+ $uid = [split(/,/, $uid)];
+ }
+ $heap->{scope}{uid} = $uid;
+ $kernel->call($_[SESSION], "cmd_$cmd", $args);
+ delete $heap->{scope}{uid};
+}
+
+#> THIS(@rest)
+sub cmd_THIS {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $cmd = shift @$args;
+
+ return unless check_uid($heap->{uid});
+ $heap->{scope}{uid} = $heap->{uid};
+ $heap->{scope}{this} = 1;
+ $kernel->call($_[SESSION], "cmd_$cmd", $args);
+ delete $heap->{scope}{uid};
+ delete $heap->{scope}{this};
+}
+
+#> MSG($type, @args)
+sub cmd_MSG {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my @msg;
+
+ if ($heap->{scope}{cid}) {
+ my $chan = $Registry->fetch('channel', $heap->{scope}{cid});
+ my $users = $chan->list_ids('user');
+ @msg = (
+ 'IN', $heap->{scope}{cid},
+ 'MSG', $heap->{uid}, @$args,
+ );
+ $kernel->post('Registry', 'broadcast', $users, [EMAIL
PROTECTED]);
+ } elsif ($heap->{scope}{uid}) {
+ if (not ref $heap->{scope}{uid}) {
+ my $user = $Registry->fetch('user',
$heap->{scope}{uid});
+ $user->send(['MSG', $heap->{uid}, @$args]);
+ } else {
+ my @msg = ( 'MSG', $heap->{uid}, @$args );
+ $kernel->post('Registry', 'broadcast',
$heap->{scope}{uid}, @msg);
+ }
+ } else {
+ return unless check_perm_access($heap->{user}, 'global msg');
+ my $users = $Registry->list_ids('user');
+ $kernel->post('Registry', 'broadcast', $users, ['MSG',
$heap->{uid}, @$args]);
+ }
+}
+
+
+#> JOIN($cid)
+sub cmd_JOIN {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($cid) = @$args;
+ my $user = $heap->{user};
+
+ return unless check_cid($cid);
+
+ # Don't join if already in the channel.
+ unless ($user->contains('channel', $cid)) {
+ my $chan = $Registry->fetch('channel', $cid);
+ ASSERT: defined $chan and ref $chan;
+ $chan->add($user);
+ $user->add($chan);
+ my $uids = $chan->list_ids('user');
+ $kernel->post('Registry', 'broadcast', $uids,
+ ['IN', $cid, 'JOIN', $heap->{uid}],
+ );
+ } else {
+ $kernel->yield('warn', ALREADY_JOINED => [$cid]);
+ }
+}
+
+#> PART($cid)
+sub cmd_PART {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($cid) = @$args;
+ my $user = $heap->{user};
+ my $uid = $heap->{uid};
+
+ return unless check_cid($cid);
+ if ($user->contains('channel', $cid)) {
+ my $chan = $Registry->fetch('channel', $cid);
+ my $uids = $chan->list_ids('user');
+ $kernel->post('Registry', 'broadcast', $uids, ['IN', $cid,
'PART', $uid]);
+ $chan->remove($user);
+ $user->remove($chan);
+ } else {
+ $kernel->yield('warn', NOT_JOINED_PART => [$cid]);
+ }
+}
+
+#> USERS()
+sub cmd_USERS {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ # ERROR: NEED_IN
+ $kernel->yield('die', NEED_IN => ['USERS']) unless $heap->{scope}{cid};
+ my $chan = $Registry->fetch('channel', $heap->{scope}{cid});
+
+ $heap->{socket}->put(['IN', $heap->{scope}{cid}, 'USERS',
$chan->list_ids('user')]);
+}
+
+#> QUIT($why)
+sub cmd_QUIT {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+
+ $kernel->yield('shutdown', 'ACTIVE', @$args);
+}
+
+#> PONG($time)
+sub cmd_PONG {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $time = $args->[0];
+ if (defined $heap->{ping_time}) {
+ if ($time eq $heap->{ping_time}) {
+ $kernel->alarm_remove($heap->{ping});
+ $heap->{ping} = $kernel->alarm_set('send_ping',
+ time + $Config->{Server}{PingTime} +
int(rand(5)));
+ $heap->{ping_time} = undef;
+ } else {
+ $kernel->yield('bye', 'BAD PING');
+ }
+ } else {
+ $kernel->yield('die', 'UNEXPECTED_PONG');
+ }
+}
+
+
+
+
+sub check_cmd_access {
+ my ($user, $cmd, $in, %arg) = @_;
+
+ unless ($user->may($cmd, %arg) or $user->may('*', %arg)) {
+ $poe_kernel->yield('warn', ACCESS => [uc($cmd)], $in);
+ return undef;
+ }
+
+ return 1;
+}
+
+sub check_perm_access {
+ my ($user, $cmd, $in, %arg) = @_;
+
+ unless ($user->may($cmd, %arg) or $user->may('*', %arg)) {
+ $poe_kernel->yield('warn', PERM => [$cmd], $in);
+ return undef;
+ }
+
+ return 1;
+}
+
+sub check_uid {
+ my $uid = shift;
+ my $in = shift;
+
+
+ unless (defined $uid and
Haver::Server::Object::User->is_valid_id($uid)) {
+ $poe_kernel->yield('warn', UID_INVALID => [$uid], $in);
+ return undef;
+ }
+
+ unless ($uid eq '.' or $Registry->contains('user', $uid)) {
+ $poe_kernel->yield('warn', UID_NOT_FOUND => [$uid], $in);
+ return undef;
+ }
+
+ return 1;
+}
+
+sub check_cid {
+ my $cid = shift;
+
+ unless (defined $cid and
Haver::Server::Object::Channel->is_valid_id($cid)) {
+ $poe_kernel->yield('warn', CID_INVALID => [$cid]);
+ return undef;
+ }
+
+ unless ($Registry->contains('channel', $cid)) {
+ $poe_kernel->yield('warn', CID_NOT_FOUND => [$cid]);
+ return undef;
+ }
+
+ return 1;
+}
+
+1;
Copied: trunk/main/server/lib/Haver/Server/POE/Connection.pm (from rev 231,
trunk/main/server/lib/Haver/Server/Connection.pm)
Copied: trunk/main/server/lib/Haver/Server/POE/Listener.pm (from rev 231,
trunk/main/server/lib/Haver/Server/Listener.pm)
===================================================================
--- trunk/main/server/lib/Haver/Server/Listener.pm 2004-06-09 00:52:16 UTC
(rev 231)
+++ trunk/main/server/lib/Haver/Server/POE/Listener.pm 2004-06-09 21:07:13 UTC
(rev 234)
@@ -0,0 +1,92 @@
+# 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, %opts) = @_;
+ POE::Session->create(
+ package_states =>
+ [
+ $class => [
+ '_start',
+ '_stop',
+ 'socket_birth',
+ 'socket_fail',
+ ]
+ ],
+ heap => {
+ port => $opts{port},
+ },
+ args => [EMAIL PROTECTED],
+ );
+}
+
+sub _start {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ my $port = $heap->{port};
+
+
+ DEBUG: "Listener starts.";
+ $kernel->post('Logger', 'note', "Listening on port $port.");
+
+ $heap->{listener} = POE::Wheel::SocketFactory->new(
+ #BindAddress => '127.0.0.1',
+ BindPort => $port,
+ Reuse => 1,
+ SuccessEvent => 'socket_birth',
+ FailureEvent => 'socket_fail',
+ );
+ $kernel->alias_set('Listener');
+}
+sub _stop {
+ my ($kernel, $heap) = @_[KERNEL,HEAP];
+ delete $heap->{listener};
+ delete $heap->{session};
+ DEBUG: "Listener stops.";
+}
+
+sub socket_birth {
+ my ($kernel, $socket, $address, $port) = @_[ KERNEL, ARG0, ARG1, ARG2 ];
+
+
+ create Haver::Server::POE::Connection ($socket, $address, $port);
+}
+sub socket_fail {
+ my ($kernel, $heap, $operation, $errnum, $errstr, $wheel_id) =
@_[KERNEL, HEAP, ARG0..ARG3];
+ die "Listener: '$operation' failed: $errstr";
+}
+
+sub shutdown {
+ $_[KERNEL]->alias_remove('Listener');
+}
+
+1;
Copied: trunk/main/server/lib/Haver/Server/POE.pm (from rev 231,
trunk/main/server/lib/Haver/Server.pm)
===================================================================
--- trunk/main/server/lib/Haver/Server.pm 2004-06-09 00:52:16 UTC (rev
231)
+++ trunk/main/server/lib/Haver/Server/POE.pm 2004-06-09 21:07:13 UTC (rev
234)
@@ -0,0 +1,218 @@
+# 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 (
+ default => {
+ IKC => {
+ Host => 'localhost',
+ Name => 'HaverServer',
+ Port => 4040,
+ },
+ Logs => {},
+ Server => {
+ LineLimit => 2048,
+ PingTime => 60,
+ Port => 7070,
+ },
+ },
+);
+
+use Haver::Server::Listener;
+use Haver::Server::Registry;
+use Haver::Server::Object::Channel;
+use Haver::Server::Object::User;
+use Haver::Server::Object::Index;
+use Haver::Server::Remote;
+
+use Haver::Util::Logger;
+use Haver::Util::Reload;
+
+our $VERSION = 0.06;
+
+my ($Config, $Registry);
+
+
+sub boot {
+ my ($this, %opts) = @_;
+ $|++;
+
+ ASSERT: $opts{confdir};
+ ASSERT: $opts{datadir};
+
+ $Config = instance Haver::Config(
+ file => "$opts{confdir}/config.yml"
+ );
+ $Registry = instance Haver::Server::Registry;
+
+
+ eval {
+ require POE::Component::IKC::Server;
+ import POE::Component::IKC::Server;
+ };
+ unless ($@) {
+ create_ikc_server(
+ ip => $Config->{IKC}{Host} || 'localhost',
+ port => $Config->{IKC}{Port} || '4040',
+ name => $Config->{IKC}{Name} || 'HaverServer',
+ a
+ );
+ }
+
+
+ Haver::Reload->init;
+ $Config->{Server}{PingTime} ||= 60;
+ Haver::Server::Object->store_dir( "$opts{datadir}/store" );
+
+
+ foreach my $cid (@{ $Store->{Channels} }) {
+ my $chan = new Haver::Server::Object::Channel(id => $cid);
+ eval { $chan->load };
+ if ($@) {
+ warn "Can't load $cid.\n$@";
+ }
+ $chan->set(_perm => 1);
+ $Registry->add($chan);
+ }
+
+
+ $this->create;
+ $poe_kernel->run();
+}
+sub create {
+ my ($class) = @_;
+ POE::Session->create(
+ package_states => [
+ $class => [
+ '_start',
+ '_stop',
+ 'interrupt',
+ 'die',
+ 'shutdown',
+ ]
+ ],
+ heap => {},
+ );
+}
+
+sub _start {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ my $port = $Config->{Server}{Port} || 7070;
+
+ DEBUG: "Server starts.";
+ create Haver::Util::Logger (
+ levels => $Config->{Logs},
+ );
+ create Haver::Server::POE::Listener (
+ port => $port
+ );
+
+
+ $kernel->sig('INT' => 'intterrupt');
+ $kernel->sig('DIE' => 'die');
+}
+sub _stop {
+ DEBUG: "Server stops.";
+
+ my @chans;
+ $Store->{Channels} = [EMAIL PROTECTED];
+
+ foreach my $chan ($Registry->list_vals('channel')) {
+ if ($chan->has('_perm')) {
+ push(@chans, $chan->id);
+ $chan->save;
+ }
+ }
+
+ $Store->save;
+ $Config->save;
+}
+
+sub die {
+ print "Got DIE\n";
+}
+
+sub interrupt {
+ print "Got INT\n";
+}
+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
Deleted: trunk/main/server/lib/Haver/Server/Remote.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Remote.pm 2004-06-09 01:59:54 UTC
(rev 233)
+++ trunk/main/server/lib/Haver/Server/Remote.pm 2004-06-09 21:07:13 UTC
(rev 234)
@@ -1,74 +0,0 @@
-# Haver::Server::IKC - Index for users, channels, etc.
-#
-# 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
-package Haver::Server::Remote;
-use strict;
-#use warnings;
-
-use Haver::Server::Globals qw( %Feature $Registry );
-
-use base qw( Haver::Singleton Haver::Server::Object::Index );
-use POE;
-
-our $VERSION = '0.03';
-our $RELOAD = 1;
-
-sub create {
- my $this = shift;
- POE::Session->create(
- package_states => [
- $this => {
- _start => 'on_start',
- _stop => 'on_stop',
- map { ($_ => "on_$_") } qw(
- bcast
- ),
- },
- ],
- );
-}
-
-
-sub on_bcast {
- my ($me, $kernel, $heap, $args) = @_[OBJECT, KERNEL, HEAP, ARG0];
- my ($cid, $msg) = @$args;
-
- if ($Registry->contains('channel', $cid)) {
- my $chan = $Registry->fetch('channel', $cid);
- my $users = $chan->list_vals('user');
-
- $kernel->post('Registry', 'broadcast', $cid, $users, @$msg);
- } else {
- $kernel->post('Logger', 'ikc', "bcast($cid) failed: no such
channel");
- }
-}
-
-
-sub on_start {
- my ($me, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
- DEBUG: "Remote starts.";
- $kernel->alias_set('Remote');
-
- $poe_kernel->post('IKC', 'publish', 'Remote', [qw( bcast )]);
-}
-
-sub on_stop {
- my ($me, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];
- DEBUG: "Remote stops."
-}
-
-1;
Deleted: trunk/main/server/lib/Haver/Server.pm
===================================================================
--- trunk/main/server/lib/Haver/Server.pm 2004-06-09 01:59:54 UTC (rev
233)
+++ trunk/main/server/lib/Haver/Server.pm 2004-06-09 21:07:13 UTC (rev
234)
@@ -1,257 +0,0 @@
-# Haver::Server - Haver server daemon.
-#
-# 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;
-use strict;
-use open ":utf8";
-
-
-use Data::Dumper;
-#use IO::Poll;
-use POE;
-
-use Haver::Preprocessor;
-use Haver::Server::Globals qw( $Store $Registry %Feature $Config );
-use Haver::Server::Listener;
-use Haver::Server::Registry;
-use Haver::Server::Object::Channel;
-use Haver::Server::Object::User;
-use Haver::Server::Object::Index;
-use Haver::Server::Remote;
-
-
-use Haver::Config;
-use Haver::Util::Logger;
-use Haver::Util::Reload;
-
-
-our $VERSION = 0.06;
-
-
-sub boot {
- my ($this, %opts) = @_;
- $|++;
-
- ASSERT: $opts{confdir};
- ASSERT: $opts{datadir};
-
- Haver::Server::Globals->init(
- Config => new Haver::Config(
- file => "$opts{confdir}/config.yml",
- default => {
- IKC => {
- Host => 'localhost',
- Name => 'HaverServer',
- Port => 4040,
- },
- Logs => {},
- Server => {
- LineLimit => 2048,
- PingTime => 60,
- Port => 7070,
- },
- },
- ),
- Store => new Haver::Config(
- file => "$opts{datadir}/store.yml",
- default => {
- Channels => [qw( lobby basement )],
- Roles => {
- admin => {
- '*' => 1,
- 'grant' => 1,
- 'revoke' => 1,
- 'clear' => 1,
- speak => 1,
- kill => 1,
- reload => 1,
- },
- },
- },
- ),
- Registry => instance Haver::Server::Registry,
- );
-
- eval {
- require POE::Component::IKC::Server;
- import POE::Component::IKC::Server;
- };
- unless ($@) {
- create_ikc_server(
- ip => $Config->{IKC}{Host} || 'localhost',
- port => $Config->{IKC}{Port} || '4040',
- name => $Config->{IKC}{Name} || 'HaverServer',
- );
- $Feature{IKC} = 1;
- }
-
-
- Haver::Reload->init;
- $Config->{Server}{PingTime} ||= 60;
- Haver::Server::Object->store_dir( "$opts{datadir}/store" );
-
-
- foreach my $cid (@{ $Store->{Channels} }) {
- my $chan = new Haver::Server::Object::Channel(id => $cid);
- eval { $chan->load };
- if ($@) {
- warn "Can't load $cid.\n$@";
- }
- $chan->set(_perm => 1);
- $Registry->add($chan);
- }
-
-
- $this->create;
- $poe_kernel->run();
-}
-sub create {
- my ($class) = @_;
- POE::Session->create(
- package_states => [
- $class => [
- '_start',
- '_stop',
- 'interrupt',
- 'die',
- 'shutdown',
- ]
- ],
- heap => {},
- );
-}
-
-sub _start {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
- my $port = $Config->{Server}{Port} || 7070;
-
- DEBUG: "Server starts.";
- IF ($DEBUG > 1) {
- create Haver::Util::Logger (
- levels => $Config->{Logs},
- );
- }
- create Haver::Server::Listener (
- port => $port
- );
- create Haver::Server::Remote;
-
-
- $kernel->sig('INT' => 'intterrupt');
- $kernel->sig('DIE' => 'die');
-}
-sub _stop {
- DEBUG: "Server stops.";
-
- my @chans;
- $Store->{Channels} = [EMAIL PROTECTED];
-
- foreach my $chan ($Registry->list_vals('channel')) {
- if ($chan->has('_perm')) {
- push(@chans, $chan->id);
- $chan->save;
- }
- }
-
- $Store->save;
- $Config->save;
-}
-
-sub die {
- print "Got DIE\n";
-}
-
-sub interrupt {
- print "Got INT\n";
-}
-sub shutdown {
-}
-
-
-1;
-__END__
-# Below is stub documentation for your module. You'd better edit it!
-
-=head1 NAME
-
-Haver::Server - Haver chat server.
-
-=head1 SYNOPSIS
-
- use Haver::Server;
- blah blah blah
-
-=head1 DESCRIPTION
-
-Haver::Server is the unified interface for the entire Haver chat server
-collection of modules. haverd.pl is just a small wrapper around
-this module. This module requires a lot more documentation than I
-can produce at this time, so I will just ramble on about how, in general,
-to use it.
-
-The most basic usage is to say perl
-C<-MHaver::Server -e'Haver::Server-E<gt>boot(option =E<gt> "value", etc =E<gt>
"foo")>
-
-There are a number of options, such as bindaddr, port, ikc_port, ikc_bindaddr,
-which I will have to explain later. Right now the interface may change or be
completely
-different. I'm not entirely sure this module shouldn't be under the
POE::Component::Server::
-namespace, as the client portion of haver is. I do really like the current
namespace,
-but this being an open source projct, perhaps I will not get my way.
-
-I do not think Haver::Server will replace IRC, IRC has some nice features that
I have no wont
-to implement in haver yet many people find necessary. Perhaps someone else can
come
-along, take the code, and implement them.
-
-
-=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
