Author: dylan
Date: 2005-05-10 04:17:03 -0400 (Tue, 10 May 2005)
New Revision: 680
Removed:
trunk/main/server/lib/Haver/Server/Broadcaster.pm
Modified:
trunk/
trunk/main/server/bin/haverd.pl
trunk/main/server/lib/Haver/Server/Avatar.pm
trunk/main/server/lib/Haver/Server/Listener.pm
trunk/main/server/lib/Haver/Server/Speaker.pm
Log:
[EMAIL PROTECTED]: dylan | 2005-05-10 03:59:29 -0400
Broadcaster was too specialized. it's dead.
Avatar just has spaces -> tabs changes.
Speaker has been gutted, awaiting rewrite. It works for a limited definition
of "works".
Listener works. It does not suppor listening on a specific interface though.
I don't need that right now, so I'm not implementing it.
Also it has no mechanism for discontinuning to listen on a port.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:953
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:954
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Modified: trunk/main/server/bin/haverd.pl
===================================================================
--- trunk/main/server/bin/haverd.pl 2005-05-10 08:16:59 UTC (rev 679)
+++ trunk/main/server/bin/haverd.pl 2005-05-10 08:17:03 UTC (rev 680)
@@ -18,9 +18,20 @@
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
use strict;
use warnings;
-use Haver::Preprocessor qw( -verbose -assert -debug );
-use Haver::Server::POE;
+use Haver::Server::Listener;
+use POE;
-Haver::Server::POE->boot('config.yml');
+create Haver::Server::Listener;
+
+POE::Session->create(
+ inline_states => {
+ _start => sub {
+ $_[KERNEL]->post('Listener', 'listen', '7777');
+ },
+ });
+
+
+
+
POE::Kernel->run;
Modified: trunk/main/server/lib/Haver/Server/Avatar.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Avatar.pm 2005-05-10 08:16:59 UTC
(rev 679)
+++ trunk/main/server/lib/Haver/Server/Avatar.pm 2005-05-10 08:17:03 UTC
(rev 680)
@@ -1,4 +1,4 @@
-# vim: set ts=4 sw=4 expandtab si ai sta tw=104:
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=104:
# This module is copyrighted, see end of file for details.
package Haver::Server::Avatar;
use Haver::Base qw( -Base );
@@ -9,22 +9,22 @@
field _access => {};
sub grant {
- my ($me, $where, $what, $level) = @_;
+ my ($me, $where, $what, $level) = @_;
- $me->{_access}{$where}{$what} = $level || 1;
+ $me->{_access}{$where}{$what} = $level || 1;
}
sub revoke {
- my ($me, $where, $what) = @_;
+ my ($me, $where, $what) = @_;
- return undef if not exists $me->{_access}{$where};
- return delete $me->{_access}{$where}{$what};
+ return undef if not exists $me->{_access}{$where};
+ return delete $me->{_access}{$where}{$what};
}
sub may {
- my ($me, $where, $what) = @_;
+ my ($me, $where, $what) = @_;
- return undef unless exists $me->{_access}{$where};
- return undef unless exists $me->{_access}{$where}{$what};
- return $me->{_access}{$where}{$what};
+ return undef unless exists $me->{_access}{$where};
+ return undef unless exists $me->{_access}{$where}{$what};
+ return $me->{_access}{$where}{$what};
}
Deleted: trunk/main/server/lib/Haver/Server/Broadcaster.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Broadcaster.pm 2005-05-10 08:16:59 UTC
(rev 679)
+++ trunk/main/server/lib/Haver/Server/Broadcaster.pm 2005-05-10 08:17:03 UTC
(rev 680)
@@ -1,70 +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];
- 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;
-
Modified: trunk/main/server/lib/Haver/Server/Listener.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Listener.pm 2005-05-10 08:16:59 UTC
(rev 679)
+++ trunk/main/server/lib/Haver/Server/Listener.pm 2005-05-10 08:17:03 UTC
(rev 680)
@@ -1,9 +1,14 @@
package Haver::Server::Listener;
-use Haver::Base::Session '-Base';
+use strict;
+use warnings;
-use POE;
+use Haver::Base::Session -base;
+use Haver::Server::Speaker;
use POE::Wheel::SocketFactory;
+our $VERSION = '0.02';
+our $Alias = 'Listener';
+
states qw(
_start
_stop
@@ -11,22 +16,26 @@
socket_birth
socket_fail
listen
- unlisten
shutdown
);
+
sub _start {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
+ my ($kernel, $heap, $opt) = @_[KERNEL, HEAP, ARG0];
- $heap->{listeners} = {};
+ $heap->{acceptor} = $opt->{acceptor};
+ $heap->{wheels} = {};
$heap->{children} = {};
- $heap->{names} = {};
- $kernel->alias_set('Listener');
+ $kernel->alias_set($Alias);
+
+
+ Log("$Alias starts.");
}
sub _stop {
my ($kernel, $heap) = @_[KERNEL,HEAP];
+
+ Log("$Alias stops.");
}
sub _child {
@@ -34,75 +43,62 @@
if ($type eq 'create' or $type eq 'gain') {
$heap->{children}{$kid->ID} = 1;
+ Log('debug', "New speaker session: ", $kid->ID);
} elsif ($type eq 'lose') {
delete $heap->{children}{$kid->ID};
+ Log('debug', "Lost speaker session: ", $kid->ID);
} else {
die "I don't know how I got here!\n";
}
}
-# $iface = {
-# name => 'example.com',
-# port => 7070,
-# addr => "IP address of interface bind to",
-# }
sub listen {
- my ($kernel, $heap, $iface) = @_[KERNEL, HEAP, ARG0, ARG1];
-
- $kernel->post('Logger', 'note', "Listening on port $iface->{port}.");
-
+ my ($kernel, $heap, $port) = @_[KERNEL, HEAP, ARG0];
+ Log('notice', "Listening on port $port.");
+
my $wheel = POE::Wheel::SocketFactory->new(
- BindPort => $iface->{port},
- BindAddress => $iface->{addr},
+ BindPort => $port,
+ #BindAddress => $addr,
Reuse => 1,
SuccessEvent => 'socket_birth',
FailureEvent => 'socket_fail',
);
- $heap->{listeners}{$wheel->ID} = {
- wheel => $wheel,
- iface => $iface,
- };
- $heap->{names}{ $iface->{name} } = $wheel->ID;
+ $heap->{wheels}{$wheel->ID} = $wheel;
}
-sub unlisten {
- my ($kernel, $heap, $name) = @_[KERNEL, HEAP, ARG0];
- my $wid = delete $heap->{names}{ $iface->{name} }
- unless ($wid) {
- warn "$name is not a valid listener name.";
- }
-
- delete $heap->{listeners}{$wid}
- or warn "Unable to delete wheel with id $wid (name: $name)";
-}
-
sub socket_birth {
my ($kernel, $heap, $socket, $address, $port, $wid) =
@_[KERNEL, HEAP, ARG0, ARG1, ARG2, ARG3];
- my $info = $heap->{listeners}{$wid}{iface};
-
- $heap->{acceptor}->create(
+
+ Log('Socket birth.');
+ create Haver::Server::Speaker (
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->{listeners}{$wheel_id}{wheel};
+ my ($kernel, $heap, $operation, $errnum, $errstr, $wid) = @_[KERNEL,
HEAP, ARG0..ARG3];
+ delete $heap->{wheels}{$wid};
- warn "Operation '$operation' failed: $errstr ($errnum)";
+ Log("Listener: Operation '$operation' failed: $errstr ($errnum)\n");
}
sub shutdown {
my ($kernel, $heap) = @_[KERNEL, HEAP];
- $kernel->alias_remove('Listener');
+
+ Log("Shutting down $Alias.");
+
+ $kernel->alias_remove($Alias);
foreach my $kid (keys %{ $heap->{children} }) {
$kernel->post($kid, 'shutdown');
}
- %$heap = ();
+
+ delete $heap->{wheels};
}
+
+
+1;
Modified: trunk/main/server/lib/Haver/Server/Speaker.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Speaker.pm 2005-05-10 08:16:59 UTC
(rev 679)
+++ trunk/main/server/lib/Haver/Server/Speaker.pm 2005-05-10 08:17:03 UTC
(rev 680)
@@ -1,30 +1,29 @@
package Haver::Server::Speaker;
-use Haver::Base::Session '-Base';
+use Haver::Base::Session -base;
+use strict;
+use warnings;
+
+use Haver::Protocol::Filter;
use POE::Wheel::ReadWrite;
use POE::Driver::SysRW;
states qw(
- _start _stop _default
+ _start _stop
input error flush
- cleanup shutdown
- fail oops
+ shutdown
);
-
sub _start {
- my ($heap, $session, $kernel, $opt) = @_[ HEAP, SESSION, KERNEL,
ARG0];
+ 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";
+ Log('notice', "Connection from $address:$port");
+ binmode $socket, ":utf8";
my $client = new POE::Wheel::ReadWrite(
Handle => $socket,
Driver => new POE::Driver::SysRW,
- Filter => new Haver::Core::Filter;
+ Filter => new Haver::Protocol::Filter,
InputEvent => 'input',
FlushedEvent => 'flush',
ErrorEvent => 'error',
@@ -33,13 +32,7 @@
%$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');
}
@@ -51,55 +44,19 @@
}
-sub 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/^evt_//) {
- $kernel->call($_[SESSION], 'unknown_cmd', $event, $_[ARG1][0],
$cmd);
- }
- $kernel->post('Logger', 'error', "Unknown event: $event");
-
- return 0;
-}
-
sub 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 = 'evt_' . $cmd;
+ my $event = 'msg_' . $cmd;
+ $event =~ s/:/_/g;
+ Log('info', "Command: $cmd");
$kernel->yield($event, $args, $cmd);
-
}
sub flush {
@@ -113,11 +70,10 @@
sub error {
my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
-
- $kernel->post('Logger', 'error',
+
+ Log('error',
"Socket generated $operation error ${errnum}: $errstr");
-
$kernel->yield('shutdown', 'DISCON');
}
@@ -126,47 +82,10 @@
my ($kernel, $heap, $session, @args) = @_[KERNEL, HEAP, SESSION, ARG0
.. $#_];
return if $heap->{shutdown};
- $kernel->call('Logger', 'note', 'Shutting down client session.');
+ Log('info', 'Shutting down client session');
eval { $heap->{client}->put(['BYE', @args]) };
$heap->{shutdown} = 1;
$kernel->alarm_remove_all();
-
- $kernel->yield('cleanup', @args);
}
-sub cleanup {
- my ($kernel, $heap, @args) = @_[KERNEL, HEAP, ARG0 .. $#_];
-
-}
-
-sub 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 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;