Author: dylan
Date: 2004-07-24 20:35:49 -0400 (Sat, 24 Jul 2004)
New Revision: 328
Modified:
branches/protocol-v4/main/server/lib/Haver/Server/Object.pm
branches/protocol-v4/main/server/lib/Haver/Server/POE.pm
branches/protocol-v4/main/server/lib/Haver/Server/POE/Commands.pm
branches/protocol-v4/main/server/lib/Haver/Server/POE/Connection.pm
Log:
New protocol implemented. Docs will follow.
Modified: branches/protocol-v4/main/server/lib/Haver/Server/Object.pm
===================================================================
--- branches/protocol-v4/main/server/lib/Haver/Server/Object.pm 2004-07-24
01:11:19 UTC (rev 327)
+++ branches/protocol-v4/main/server/lib/Haver/Server/Object.pm 2004-07-25
00:35:49 UTC (rev 328)
@@ -344,7 +344,13 @@
wantarray ? @v : [EMAIL PROTECTED];
}
+
sub list_vals {
+ carp "->list_vals is deprecated!";
+ shift->contents(@_);
+}
+
+sub contents {
my ($me, $ns) = @_;
my $h = $me->{".$ns"};
Modified: branches/protocol-v4/main/server/lib/Haver/Server/POE/Commands.pm
===================================================================
--- branches/protocol-v4/main/server/lib/Haver/Server/POE/Commands.pm
2004-07-24 01:11:19 UTC (rev 327)
+++ branches/protocol-v4/main/server/lib/Haver/Server/POE/Commands.pm
2004-07-25 00:35:49 UTC (rev 328)
@@ -36,12 +36,14 @@
our @Commands = qw(
IDENT
CANT
- PONG
AUTH
AUTH:PASS
- IN TO
- MSG JOIN PART QUIT
- USERS CHANS INFO MARK
+ MSG PMSG
+ JOIN PART BYE
+ HAVER
+ INFO
+ MARK
+ FOREACH
);
@@ -58,36 +60,53 @@
# $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];
+#> [HAVER]
+#> C: HAVER $client
+#> S: HAVER $server
+sub cmd_HAVER {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $client = $args->[0];
- $kernel->yield('warn', 'unknown.cmd' => [$event], $heap->{scope}{cid});
+ $heap->{socket}->put(['HAVER',
"Haver::Server::POE/$Haver::Server::POE::VERSION"]);
+ $heap->{client} = $client;
+ $kernel->yield('want', 'IDENT');
}
-#> IDENT($uid, $type)
+#> [IDENT]
+#> C: IDENT $id [$type]
+#> S: ACCEPT $id
+#> | WANT AUTH ...
+#> Errors:
+#> * unknown-type -- %1 is an unknown type of client.
+#> * syntax -- %1 this is an illegal id.
+#> * reserved -- %1 is reserved for something else.
+#> * used -- %1 is already being used.
sub cmd_IDENT {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- my ($uid, $type, $client) = @$args;
+ my ($uid, $type) = @$args;
+ $type ||= 'user';
return if $heap->{login};
if ($type ne 'user') {
- $kernel->yield('die', 'unknown.type', [$type]);
+ $kernel->yield('die', 'unknown-type', [$type]);
return;
}
unless (Haver::Server::Object::User->is_valid_id($uid)) {
- $poe_kernel->yield('die', 'syntax.id.user', [$uid]);
+ $kernel->yield('fail', 'IDENT', 'syntax', [$uid]);
+ $kernel->yield('want', 'IDENT');
} elsif ($type eq 'user' and ($uid =~ /&/ or $uid =~ /@/)) {
- $poe_kernel->yield('die', 'reserved.id.user', [$uid]);
+ $poe_kernel->yield('fail', 'IDENT', 'reserved', [$uid]);
+ $kernel->yield('want', 'IDENT');
} else {
if ($Registry->contains('user', $uid)) {
- $poe_kernel->yield('die', 'exists.user', [$uid]);
+ $poe_kernel->yield('fail', 'IDENT', 'used', [$uid]);
+ $kernel->yield('want', 'IDENT');
} else {
my $user = new Haver::Server::Object::User(
id => $uid,
@@ -95,10 +114,11 @@
sid => $_[SESSION]->ID,
);
$user->set(
- ClientType => $type,
- Client => $client,
+ Type => $type,
+ Client => $heap->{client},
Rank => 0,
Role => 'User',
+ _info => [qw( Rank Role Client IP Login Idle
)],
);
if (-e $user->filename) {
eval { $user->load };
@@ -118,8 +138,9 @@
}
}
-
-#> CANT($want)
+#> [CANT]
+#> C: CANT $want
+#> S: ...
sub cmd_CANT {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
my $want = $args->[0];
@@ -132,11 +153,15 @@
}
$heap->{want} = undef;
} else {
- $kernel->yield('die', 'cant.stupid' => [$want, $heap->{want}]);
+ $kernel->yield('die', 'cant.insane' => [$want, $heap->{want}]);
}
}
-#> AUTH($method)
+#> [AUTH]
+#> C: AUTH $method ...
+#> S: WANT AUTH:uc($method) ...
+#> Errors:
+#> * unknown -- auth method %1 is unknown
sub cmd_AUTH {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
my $method = $args->[0];
@@ -146,12 +171,17 @@
if ($method eq 'pass') {
$kernel->yield('want', 'AUTH:PASS');
} else {
- $kernel->yield('die', 'auth', [$method]);
+ $kernel->yield('fail', 'AUTH', 'unknown', [$method]);
+ $kernel->yield('want', 'IDENT');
}
}
-#> AUTH:PASS($password)
+#> [AUTH:PASS]
+#> C: AUTH:PASS $password
+#> S: ACCEPT $uid
+#> Errors:
+#> * nomatch -- password did not match,
sub cmd_AUTH_PASS {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
my ($pass) = @$args;
@@ -163,33 +193,11 @@
if ($pass eq $user->get('.password')) {
$kernel->yield('accept', $uid, $user);
} else {
- $kernel->yield('die', 'auth.pass', [$uid]);
+ $kernel->yield('fail', 'AUTH:PASS', 'nomatch', []);
+ $kernel->yield('bye', 'monkeys');
}
}
-#> IN($cid, @rest)
-sub cmd_IN {
- my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- my $cid = shift @$args;
- my $cmd = shift @$args;
-
- $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;
-
- $heap->{scope}{uid} = $uid;
- $kernel->call($_[SESSION], "cmd_$cmd", $args);
- delete $heap->{scope}{uid};
-}
-
-#> MARK($mark, @rest)
sub cmd_MARK {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
my $mark = shift @$args;
@@ -200,164 +208,166 @@
delete $heap->{scope}{mark};
}
-#> MSG($type, @args)
+
+#> [MSG]
+#> C: MSG $cid $type @args
+#> S: MSG $cid $uid $type @args
+#> Errors:
+#> * syntax -- the cid %1 is invalid.
+#> * notfound -- the cid %1 was not found.
sub cmd_MSG {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($cid, $type) = (shift @$args, shift @$args);
+ my $chan = check_cid($cid, 'MSG') or return;
+ my $users = $chan->contents('user');
$heap->{user}->set(_last => time);
- if ($heap->{scope}{cid}) {
- my $chan = check_cid($heap->{scope}{cid}) or return;
- my $users = $chan->list_vals('user');
- $kernel->post('Broadcaster', 'send', $users, [
- 'IN', $heap->{scope}{cid},
- 'OF', $heap->{uid}, 'MSG', @$args]);
- } elsif ($heap->{scope}{uid}) {
- my $user = check_uid($heap->{scope}{uid}) or return;
- $user->put(['OF', $heap->{uid}, 'MSG', @$args]);
- } else {
- #return unless check_perm_access($heap->{user}, 'global msg');
- #my $users = $Registry->list_vals('user');
- #$kernel->post('Broadcaster', 'send', $users, ['OF',
$heap->{uid}, 'MSG', @$args]);
- }
+
+ $kernel->post('Broadcaster', 'send', $users,
+ ['MSG', $chan->id, $heap->{uid}, $type, @$args]);
}
+#> [PMSG]
+#> C: PMSG $uid $type @args
+#> S: PMSG $uid $type @args
+#> Errors:
+#> * syntax -- the uid %1 is invalid.
+#> * notfound -- the uid %1 was not found.
+sub cmd_PMSG {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my $uid = shift @$args;
+ my $user = check_uid($uid, 'PMSG') or return;
+
+ $heap->{user}->set(_last => time);
-#> JOIN($cid)
+ $user->put(['PMSG', $heap->{uid}, @$args]);
+}
+
+#> [JOIN]
+#> C: JOIN $cid
+#> S: JOIN $cid $uid
+#> Errors:
+#> * notfound -- the cid %1 was not found.
+#> * syntax -- the cid %1 is invalid.
+#> * joined -- tried to join %1 while already in it.
sub cmd_JOIN {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- my ($cid) = @$args;
+ my $cid = shift @$args;
+ my $chan = check_cid($cid, 'JOIN') or return;
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('Broadcaster', 'send', $uids,
- ['IN', $cid, 'OF', $heap->{uid}, 'JOIN'],
- );
- } else {
- # ERROR: insane.join You can't join a channel twice...
- $kernel->yield('warn', 'insane.join' => [$cid]);
+ if ($chan->contains('user', $heap->{uid})) {
+ $kernel->yield('fail', 'JOIN', joined => [$cid]);
+ return;
}
+
+ $chan->add($user);
+ $user->add($chan);
+ my $users = $chan->contents('user');
+ $kernel->post('Broadcaster', 'send', $users, ['JOIN', $cid, $user->id]);
}
-#> PART($cid)
+#> [PART]
+#> C: PART $cid
+#> S: PART $cid $uid
+#> Errors:
+#> * notfound -- the cid %1 was not found.
+#> * syntax -- the cid %1 is invalid.
+#> * timetravel -- you tried to part %1 before you joined it...
sub cmd_PART {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- my ($cid) = @$args;
+ my $cid = shift @$args;
+ my $chan = check_cid($cid, 'PART') or return;
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('Broadcaster', 'send', $uids, ['IN', $cid, 'OF',
$uid, 'PART']);
- $chan->remove($user);
- $user->remove($chan);
- } else {
- # ERROR: insane.part You can't part a channel you're not in...
- $kernel->yield('warn', 'insane.part' => [$cid]);
+
+ unless ($chan->contains('user', $heap->{uid})) {
+ $kernel->yield('fail', 'PART', timetravel => [$cid]);
+ return;
}
-}
+ my $users = $chan->contents('user');
-#> USERS()
-sub cmd_USERS {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
-
- my $chan = $Registry;
- my @p = ();
- if ($heap->{scope}{cid}) {
- $chan = $Registry->fetch('channel', $heap->{scope}{cid});
- @p = ('IN', $heap->{scope}{cid});
- }
-
- $heap->{socket}->put([EMAIL PROTECTED], 'USERS',
$chan->list_ids('user')]);
+ $kernel->post('Broadcaster', 'send', $users, ['PART', $cid, $user->id]);
+ $chan->remove($user);
+ $user->remove($chan);
}
-sub cmd_CHANS {
- my ($kernel, $heap) = @_[KERNEL, HEAP];
- $heap->{socket}->put(['CHANS', $Registry->list_ids('channel')]);
-}
-
-#> QUIT($why)
-sub cmd_QUIT {
+#> [BYE]
+#> C: BYE [$reason]
+#> S: BYE ACTIVE [$reason]
+sub cmd_BYE {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
$kernel->yield('shutdown', 'ACTIVE', @$args);
}
-#> INFO()
+#> [INFO]
+#> C: INFO $type $id
+#> S: INFO $type $id (list of key value pairs)
+#> Errors:
+#> * notfound -- the id %1 of type %2 was not found.
+#> * syntax -- the id %1 of type %2 is invalid.
sub cmd_INFO {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- my ($targ, $chan);
- my @in = ();
- my @mark = ();
+ my ($type, $id) = @$args;
+ my $obj = check_id($type, $id, 'INFO') or return;
+ my @keys = @{ $obj->get('_info') };
+ my @out = ('INFO', $type, $id, map { ($_ => $obj->get($_)) } @keys);
- if ($heap->{scope}{mark}) {
- @mark = ('MARK', $heap->{scope}{mark});
+ $heap->{socket}->put([EMAIL PROTECTED]);
+}
+
+
+#> [FOREACH]
+#> C: FOREACH type cid @subcmd
+#> S: ...
+sub cmd_FOREACH {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($type, $cid, $cmd) = splice(@$args, 0, 3);
+ my $chan = check_cid($cid, 'FOREACH');
+
+ if ($cmd ne 'INFO') {
+ $kernel->yield('fail', 'FOREACH', 'forbidden', $cmd);
+ return;
}
-
- if ($heap->{scope}{cid}) {
- $chan = check_cid($heap->{scope}{cid}) or return;
- @in = ('IN', $chan->id);
- } else {
- $chan = $Registry;
+ foreach my $obj ($chan->contents($type)) {
+ my @args = map {
+ if ($_ eq '%id%') {
+ $obj->id;
+ } else {
+ $_;
+ }
+ } @$args;
+ $kernel->post($_[SESSION], "cmd_$cmd", [EMAIL PROTECTED]);
}
-
- if ($heap->{scope}{uid} eq '*') {
- my @users = $chan->list_vals('user');
- foreach my $user (@users) {
- my @info = map { ($_ => $user->get($_)) }
grep(/^[A-Z]/, $user->list_fields);
- $heap->{user}->put([EMAIL PROTECTED], 'OF', $user->id,
@in, 'INFO', @info]);
- }
- } elsif ($heap->{scope}{uid}) {
- my $user = check_uid($heap->{scope}{uid}) or return;
- my @info = map { ($_ => $user->get($_)) } grep(/^[A-Z]/,
$user->list_fields);
- $heap->{user}->put([EMAIL PROTECTED], 'OF', $user->id, @in,
'INFO', @info]);
- }
}
-sub check_uid {
- my $uid = shift;
- my $in = shift;
+sub check_id {
+ my ($type, $id, $cmd) = @_;
-
- # ERROR: syntax.id Badly formed identifier.
- unless (defined $uid and
Haver::Server::Object::User->is_valid_id($uid)) {
- $poe_kernel->yield('warn', 'syntax.id.user' => [$uid], $in);
+ unless (Haver::Server::Object->is_valid_id($id)) {
+ $poe_kernel->yield('fail', $cmd, 'syntax', [$id]);
return undef;
}
-
- unless ($uid eq '.' or $Registry->contains('user', $uid)) {
- $poe_kernel->yield('warn', 'notfound.user' => [$uid], $in);
+ unless ($Registry->contains($type, $id)) {
+ $poe_kernel->yield('fail', $cmd, 'notfound', [$id]);
return undef;
}
- return $Registry->fetch('user', $uid);
+ return $Registry->fetch($type, $id);
}
sub check_cid {
- my $cid = shift;
-
- unless (defined $cid and
Haver::Server::Object::Channel->is_valid_id($cid)) {
- $poe_kernel->yield('warn', 'syntax.id.channel' => [$cid]);
- return undef;
- }
+ my ($id, $cmd) = @_;
- unless ($Registry->contains('channel', $cid)) {
- $poe_kernel->yield('warn', 'notfound.channel' => [$cid]);
- return undef;
- }
+ check_id('channel', $id, $cmd);
+}
- return $Registry->fetch('channel', $cid);
+sub check_uid {
+ my ($id, $cmd) = @_;
+
+ check_id('user', $id, $cmd);
}
1;
Modified: branches/protocol-v4/main/server/lib/Haver/Server/POE/Connection.pm
===================================================================
--- branches/protocol-v4/main/server/lib/Haver/Server/POE/Connection.pm
2004-07-24 01:11:19 UTC (rev 327)
+++ branches/protocol-v4/main/server/lib/Haver/Server/POE/Connection.pm
2004-07-25 00:35:49 UTC (rev 328)
@@ -60,7 +60,7 @@
want => 'on_want',
cleanup => 'on_cleanup',
'shutdown' => 'on_shutdown',
- 'warn' => 'on_warn',
+ 'fail' => 'on_fail',
'die' => 'on_die',
'accept' => 'on_accept',
auth => 'on_auth',
@@ -99,6 +99,8 @@
);
%$heap = (
+ address => $address,
+ port => $port,
timer => $timer,
socket => $sock,
shutdown => 0,
@@ -108,13 +110,6 @@
user => undef,
uid => undef,
);
-
- $sock->put(['HAVER', 3, 2048]);
- $kernel->yield('want', 'IDENT',
- address => $address,
- port => $port,
- );
-
}
sub _stop {
my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION];
@@ -178,12 +173,11 @@
}
}
- if ($heap->{user} or $want or $cmd eq 'CANT') {
- $heap->{scope} = {
- };
+ if ($heap->{user} or $want or $cmd eq 'CANT' or $cmd eq 'HAVER') {
+ $heap->{scope} = {};
$kernel->yield("cmd_$cmd", $args);
} else {
- $kernel->yield('die', 'SPEEDY');
+ $kernel->yield('die', 'speedy');
}
}
@@ -208,7 +202,9 @@
sub on_unknown_cmd {
my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
- $kernel->yield('warn', UCMD => [$event], $heap->{scope}{cid});
+
+
+ $heap->{socket}->put(['WARN', 'unknown.command', $event]);
}
sub on_shutdown {
@@ -264,11 +260,10 @@
push(@users, $chan->list_ids('user'));
}
my %users = map { ($_ => $_) } @users;
- my $msg = ['OF', $uid, 'QUIT', @args];
+ my $msg = ['QUIT', $uid, @args];
$kernel->post('Broadcaster', 'send', [ keys %users ],
$msg);
}
if ($user) {
- ($heap->{port}, $heap->{address}) = $user->get('_port',
'_address');
$user->save if $user->has('_reg');
}
} else {
@@ -277,7 +272,7 @@
}
sub on_die {
- my ($kernel, $heap, $err, $data, $in) = @_[KERNEL, HEAP, ARG0 .. $#_];
+ my ($kernel, $heap, $err, $data) = @_[KERNEL, HEAP, ARG0 .. $#_];
if (not defined $data) {
$data = [];
@@ -287,12 +282,11 @@
$data = [$data];
}
- my @p = $in ? (IN => $in) : ();
- eval { $heap->{socket}->put([EMAIL PROTECTED], 'DIE', $err, @$data]) };
+ eval { $heap->{socket}->put(['DIE', $err, @$data]) };
$kernel->yield('shutdown', 'DIE');
}
-sub on_warn {
- my ($kernel, $heap, $err, $data, $in) = @_[KERNEL, HEAP, ARG0 .. $#_];
+sub on_fail {
+ my ($kernel, $heap, $cmd, $err, $data) = @_[KERNEL, HEAP, ARG0 .. $#_];
if (not defined $data) {
$data = [];
@@ -302,9 +296,8 @@
$data = [$data];
}
- my @p = $in ? (IN => $in) : ();
- $kernel->post('Logger', 'warn', "Warning $heap->{uid}: $err");
- eval { $heap->{socket}->put([EMAIL PROTECTED], 'WARN', $err, @$data]) };
+ $kernel->post('Logger', 'fail', "failing $heap->{uid} with $cmd -
$err");
+ eval { $heap->{socket}->put(['FAIL', $cmd, $err, @$data]) };
}
sub on_accept {
@@ -316,7 +309,7 @@
$Registry->add($user);
$heap->{user} = $user;
$heap->{uid} = $uid;
- my $addr = join('.', (split(/\./, $heap->{want_data}{address}))[0,1,2])
. '.*';
+ my $addr = join('.', (split(/\./, $heap->{address}))[0,1,2]) . '.*';
my $login_time = time;
$user->set(
IP => $addr,
@@ -328,9 +321,7 @@
my ($u) = @_;
time - $u->get('_last');
},
- '.IP' => $heap->{want_data}{address},
- _address => delete $heap->{want_data}{address},
- _port => delete $heap->{want_data}{port},
+ '.IP' => $heap->{address},
);
delete $heap->{want_data};
$heap->{login} = 1;
Modified: branches/protocol-v4/main/server/lib/Haver/Server/POE.pm
===================================================================
--- branches/protocol-v4/main/server/lib/Haver/Server/POE.pm 2004-07-24
01:11:19 UTC (rev 327)
+++ branches/protocol-v4/main/server/lib/Haver/Server/POE.pm 2004-07-25
00:35:49 UTC (rev 328)
@@ -38,7 +38,7 @@
use Haver::Util::Reload;
-our $VERSION = 0.06;
+our $VERSION = 0.07;
my %Default = (
logger => {
