Author: dylan
Date: 2004-05-31 18:43:04 -0400 (Mon, 31 May 2004)
New Revision: 213
Modified:
trunk/haver-server/NEWS
trunk/haver-server/lib/Haver/Server/Connection.pm
trunk/haver-server/lib/Haver/Server/Connection/Commands.pm
Log:
Some minor changes.
Modified: trunk/haver-server/NEWS
===================================================================
--- trunk/haver-server/NEWS 2004-05-31 22:41:46 UTC (rev 212)
+++ trunk/haver-server/NEWS 2004-05-31 22:43:04 UTC (rev 213)
@@ -1 +1,3 @@
-The server now supports UTF-8.
+
+* The server uses the new, saner, v3 protocol.
+
Modified: trunk/haver-server/lib/Haver/Server/Connection/Commands.pm
===================================================================
--- trunk/haver-server/lib/Haver/Server/Connection/Commands.pm 2004-05-31
22:41:46 UTC (rev 212)
+++ trunk/haver-server/lib/Haver/Server/Connection/Commands.pm 2004-05-31
22:43:04 UTC (rev 213)
@@ -39,7 +39,8 @@
AUTH
AUTH:PASS
IN TO THIS
- MSG
+ MSG JOIN PART QUIT
+ USERS
);
sub _mkcmd {
@@ -62,7 +63,7 @@
sub do_unknown_cmd {
my ($kernel, $heap, $event, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
- $kernel->yield('warn', UCMD => $event);
+ $kernel->yield('warn', UCMD => [$event], $heap->{scope}{cid});
}
#> IDENT($uid, $mode, $version)
@@ -73,15 +74,15 @@
return if $heap->{login};
if ($mode ne 'user') {
- $kernel->yield('die', 'UNSUPPORTED_MODE', $mode);
+ $kernel->yield('die', 'UNSUPPORTED_MODE', [$mode]);
return;
}
unless (Haver::Server::Object::User->is_valid_id($uid)) {
- $poe_kernel->yield('die', 'REJECT', $uid, 'UID_INVALID');
+ $poe_kernel->yield('die', 'UID_INVALID', [$uid]);
} else {
if ($Registry->contains('user', $uid)) {
- $poe_kernel->yield('die', 'REJECT', $uid, 'UID_IN_USE');
+ $poe_kernel->yield('die', 'UID_IN_USE', [$uid]);
} else {
my $user = new Haver::Server::Object::User(
id => $uid,
@@ -120,11 +121,11 @@
if (my $code = delete $heap->{want_data}{code}) {
$code->($kernel, $heap);
} else {
- $kernel->yield('die', 'CANT', $want);
+ $kernel->yield('die', 'CANT', [$want]);
}
$heap->{want} = undef;
} else {
- $kernel->yield('die', CANT_WRONG => $want, $heap->{want});
+ $kernel->yield('die', CANT_WRONG => [$want, $heap->{want}]);
}
}
@@ -153,7 +154,7 @@
if ($pass eq $user->get('.password')) {
$kernel->yield('accept', $uid, $user);
} else {
- $kernel->yield('die', 'REJECT', $uid, 'AUTH');
+ $kernel->yield('die', 'AUTH', [$uid]);
}
}
@@ -204,7 +205,7 @@
my @msg;
if ($heap->{scope}{cid}) {
- my $chan = $Registry->fetch('user', $heap->{scope}{cid});
+ my $chan = $Registry->fetch('channel', $heap->{scope}{cid});
my $users = $chan->list_ids('user');
@msg = (
'IN', $heap->{scope}{cid},
@@ -227,25 +228,66 @@
}
-#> JOIN()
+#> JOIN($cid)
sub cmd_JOIN {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- my $chan = $Registry->fetch('channel', $heap->{scope}{cid});
- ASSERT: $chan;
+ my ($cid) = @$args;
+ my $user = $heap->{user};
+
+ return unless check_cid($cid);
- unless ($heap->{user}->contains('channel', $heap->{scope}{cid})) {
- my $chan = $Registry->fetch('channel', $heap->{scope}{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->yield('broadcast', $uids,
- ['IN', $heap->{scope}{cid}, 'JOIN', $heap->{uid}],
+ $kernel->post('Registry', 'broadcast', $uids,
+ ['IN', $cid, 'JOIN', $heap->{uid}],
);
} else {
- $kernel->yield('warn', ALREADY_JOINED => $cid);
+ $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];
@@ -268,10 +310,10 @@
sub check_cmd_access {
- my ($user, $cmd, %arg) = @_;
+ my ($user, $cmd, $in, %arg) = @_;
unless ($user->may($cmd, %arg) or $user->may('*', %arg)) {
- $poe_kernel->yield('warn', ACCESS => uc($cmd));
+ $poe_kernel->yield('warn', ACCESS => [uc($cmd)], $in);
return undef;
}
@@ -279,10 +321,10 @@
}
sub check_perm_access {
- my ($user, $cmd, %arg) = @_;
+ my ($user, $cmd, $in, %arg) = @_;
unless ($user->may($cmd, %arg) or $user->may('*', %arg)) {
- $poe_kernel->yield('warn', PERM => $cmd);
+ $poe_kernel->yield('warn', PERM => [$cmd], $in);
return undef;
}
@@ -291,16 +333,16 @@
sub check_uid {
my $uid = shift;
+ my $in = shift;
- return undef unless defined $uid;
- unless (Haver::Server::Object::User->is_valid_id($uid)) {
- $poe_kernel->yield('warn', UID_INVALID => $uid);
+ 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);
+ $poe_kernel->yield('warn', UID_NOT_FOUND => [$uid], $in);
return undef;
}
@@ -309,15 +351,14 @@
sub check_cid {
my $cid = shift;
- return undef unless defined $cid;
- unless (Haver::Server::Object::Channel->is_valid_id($cid)) {
- $poe_kernel->yield('warn', CID_INVALID => $cid);
+ 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);
+ $poe_kernel->yield('warn', CID_NOT_FOUND => [$cid]);
return undef;
}
Modified: trunk/haver-server/lib/Haver/Server/Connection.pm
===================================================================
--- trunk/haver-server/lib/Haver/Server/Connection.pm 2004-05-31 22:41:46 UTC
(rev 212)
+++ trunk/haver-server/lib/Haver/Server/Connection.pm 2004-05-31 22:43:04 UTC
(rev 213)
@@ -138,7 +138,7 @@
@_[ARG0 .. $#_] = @{ $_[ARG1] };
goto &$code;
} else {
- $kernel->yield('unknown_cmd', $event, $_[ARG1][0]);
+ $kernel->call($_[SESSION], 'unknown_cmd', $event,
$_[ARG1][0]);
}
}
$kernel->post('Logger', 'error', "Unknown event: $event");
@@ -183,12 +183,12 @@
$want = 1;
$heap->{want} = undef;
} else {
- $kernel->yield('die', 'WANT', $heap->{want}, $cmd);
+ $kernel->yield('die', 'WANT', [$heap->{want}, $cmd]);
return;
}
}
- if ($heap->{user} or $want) {
+ if ($heap->{user} or $want or $cmd eq 'CANT') {
$heap->{scope} = {
};
$kernel->yield("cmd_$cmd", $args);
@@ -281,16 +281,34 @@
}
sub on_die {
- my ($kernel, $heap, $err, @data) = @_[KERNEL, HEAP, ARG0 .. $#_];
+ my ($kernel, $heap, $err, $data, $in) = @_[KERNEL, HEAP, ARG0 .. $#_];
- eval { $heap->{socket}->put(['DIE', $err, @data]) };
+ 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) = @_[KERNEL, HEAP, ARG0 .. $#_];
+ 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(['WARN', $err, @data]) };
+ eval { $heap->{socket}->put([EMAIL PROTECTED], 'WARN', $err, @$data]) };
}
sub on_accept {
