Author: dylan
Date: 2005-05-21 03:41:24 -0400 (Sat, 21 May 2005)
New Revision: 697
Modified:
trunk/
trunk/main/server/lib/Haver/Server/Avatar.pm
trunk/main/server/lib/Haver/Server/Listener.pm
trunk/main/server/lib/Haver/Server/Talker.pm
Log:
[EMAIL PROTECTED]: dylan | 2005-05-21 03:41:21 -0400
Server responds to HAVER now.
Tomorrow, IDENT. and the rest of the core.txt stuff.
Make sure I document all this in the Divine Secrets please.
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:988
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:991
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Modified: trunk/main/server/lib/Haver/Server/Avatar.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Avatar.pm 2005-05-21 06:46:02 UTC
(rev 696)
+++ trunk/main/server/lib/Haver/Server/Avatar.pm 2005-05-21 07:41:24 UTC
(rev 697)
@@ -1,7 +1,7 @@
# 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 );
+use Haver::Base -Base;
our $VERSION = 0.07;
@@ -9,22 +9,26 @@
field _access => {};
sub grant {
- my ($me, $where, $what, $level) = @_;
+ my ($where, $what, $level) = @_;
- $me->{_access}{$where}{$what} = $level || 1;
+ $self->{_access}{$where}{$what} = $level || 1;
}
sub revoke {
- my ($me, $where, $what) = @_;
+ my ($where, $what) = @_;
- return undef if not exists $me->{_access}{$where};
- return delete $me->{_access}{$where}{$what};
+ return undef if not exists $self->{_access}{$where};
+ return delete $self->{_access}{$where}{$what};
}
sub may {
- my ($me, $where, $what) = @_;
+ my ($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 $self->{_access}{$where};
+ return undef unless exists $self->{_access}{$where}{$what};
+ return $self->{_access}{$where}{$what};
}
+
+sub compare {
+ my ($where, $what)
+}
Modified: trunk/main/server/lib/Haver/Server/Listener.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Listener.pm 2005-05-21 06:46:02 UTC
(rev 696)
+++ trunk/main/server/lib/Haver/Server/Listener.pm 2005-05-21 07:41:24 UTC
(rev 697)
@@ -23,7 +23,6 @@
sub _start {
my ($kernel, $heap, $opt) = @_[KERNEL, HEAP, ARG0];
- $heap->{acceptor} = $opt->{acceptor};
$heap->{wheels} = {};
$heap->{children} = {};
$kernel->alias_set($Alias);
Modified: trunk/main/server/lib/Haver/Server/Talker.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Talker.pm 2005-05-21 06:46:02 UTC
(rev 696)
+++ trunk/main/server/lib/Haver/Server/Talker.pm 2005-05-21 07:41:24 UTC
(rev 697)
@@ -3,17 +3,19 @@
use strict;
use warnings;
+use Haver::Server;
use Haver::Protocol::Filter;
use POE::Wheel::ReadWrite;
use POE::Driver::SysRW;
+our $VERSION = '0.08';
states qw(
- _start _stop
+ _start _stop _default
input error flush
- shutdown
-
- msg_BYE
+ bye shutdown
+
+ msg_HAVER
);
sub _start {
@@ -33,7 +35,7 @@
%$heap = (
%$opt,
- client => $client,
+ client => $client,
);
}
@@ -46,6 +48,24 @@
}
+sub _default {
+ my ($kernel, $heap, $name, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
+ my $cmd = $args->[1];
+ if ($name =~ /^msg_/) {
+ if (not $heap->{version}) {
+ Log('warning', "Client issued unknown command ($cmd)
before HAVER.");
+ Log('warning', 'Probably a search engine...');
+ delete $heap->{client};
+ $kernel->yield('shutdown', 'borked');
+ } else {
+ Log('warning', "Client isseud unknown command $cmd");
+ $heap->{client}->put(['FAIL', $cmd, 'unknown.cmd']);
+ }
+ }
+
+ 0;
+}
+
sub input {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
@@ -57,45 +77,76 @@
my $event = 'msg_' . $cmd;
$event =~ s/:/_/g;
- Log('info', "Command: $cmd");
- $kernel->yield($event, $args, $cmd);
+ Log('info', "Command: '$cmd' ('$event')");
+ $kernel->call($_[SESSION], $event, $args, $cmd);
}
-sub msg_BYE {
- $_[KERNEL]->yield('shutdown', 'bye');
+sub msg_HAVER {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($version) = @$args;
+
+ Log('notice', 'Client is ' . $version);
+ $heap->{client}->put(['HAVER',
"Haver::Server/$Haver::Server::VERSION"]);
+ $heap->{version} = $version;
}
-sub flush {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
- if ($heap->{shutdown}) {
- delete $heap->{client};
- }
-}
-
sub error {
my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
+ my $type;
if ($errnum == 0) {
- $kernel->yield('shutdown', 'closed');
+ $type = 'closed';
} else {
Log('error',
"Talker for $heap->{address}:$heap->{port}: ",
"Socket generated $operation error ${errnum}: $errstr");
- $kernel->yield('shutdown', 'error');
+ $type = 'error';
}
+
+
+ delete $heap->{client};
+ $heap->{error} = 1;
+ $kernel->yield('shutdown', $type);
}
sub shutdown {
- my ($kernel, $heap, $session, @args) = @_[KERNEL, HEAP, SESSION, ARG0
.. $#_];
- return if $heap->{shutdown};
-
- Log('info', "Shutting down talker for $heap->{address}:$heap->{port}
(@args)");
- eval { $heap->{client}->put(['BYE', @args]) };
+ my ($kernel, $heap, $session, @pair) = @_[KERNEL, HEAP, SESSION, ARG0,
ARG1];
+
+ if ($heap->{shutdown}) {
+ Log('critical', 'Race condition: shutdown called more than
once!');
+ }
+ Log('info', "Shutting down talker for $heap->{address}:$heap->{port}");
+
$heap->{shutdown} = 1;
$kernel->alarm_remove_all();
+ $kernel->yield('bye', @pair) if $heap->{client};
}
+
+sub bye {
+ my ($kernel, $heap, @pair) = @_[KERNEL, HEAP, ARG0, ARG1];
+
+ if ($heap->{client}) {
+ $heap->{client}->put(['BYE', @pair]);
+ } elsif (not $heap->{error}) {
+ Log('error', "Bye called and then client wheel disappeared.");
+ }
+}
+
+sub flush {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+
+ Log('warning', "Flush happened after an error") if $heap->{error};
+ if ($heap->{shutdown}) {
+ delete $heap->{client};
+ }
+}
+
+
+
+
+
1;
