Author: dylan
Date: 2004-07-26 16:34:30 -0400 (Mon, 26 Jul 2004)
New Revision: 329
Added:
branches/protocol-v4/docs/manual/haver.bib
Modified:
branches/protocol-v4/docs/manual/chap/concepts.tex
branches/protocol-v4/docs/manual/chap/introduction.tex
branches/protocol-v4/docs/manual/chap/protocol.tex
branches/protocol-v4/docs/manual/haver.tex
branches/protocol-v4/jarverd/lib/Jarver/Connection.pm
branches/protocol-v4/main/server/lib/Haver/Server/Object.pm
branches/protocol-v4/main/server/lib/Haver/Server/POE/Commands.pm
branches/protocol-v4/main/server/lib/Haver/Server/POE/Connection.pm
Log:
Commiting various changes so I can work on it with my laptop.
Modified: branches/protocol-v4/docs/manual/chap/concepts.tex
===================================================================
--- branches/protocol-v4/docs/manual/chap/concepts.tex 2004-07-25 00:35:49 UTC
(rev 328)
+++ branches/protocol-v4/docs/manual/chap/concepts.tex 2004-07-26 20:34:30 UTC
(rev 329)
@@ -1,6 +1,18 @@
\chapter{Concepts}
+WRITE SUMMARY HERE.
+
+
+\section{Object Data}
+
+Describe per-object data. e.g. channel topics,
+nicknames, away messages...
+
+\section{User IDs Are Not Nicks}
+
+UIDs are not nicknames...
+
WRITE ME.
Modified: branches/protocol-v4/docs/manual/chap/introduction.tex
===================================================================
--- branches/protocol-v4/docs/manual/chap/introduction.tex 2004-07-25
00:35:49 UTC (rev 328)
+++ branches/protocol-v4/docs/manual/chap/introduction.tex 2004-07-26
20:34:30 UTC (rev 329)
@@ -20,16 +20,16 @@
There are several different types of clients, and each may have access to
special features
of the server.
-Each client of a given type (which is its namespace) must have a unique id.
That is to say,
-each type and id combination must be unique.
+Each client of a given type (which is its namespace) must have a unique ID.
That is to say,
+each type and ID combination must be unique.
-The format of identifiers and namespaces is defined in
Section~\ref{sec:format.id}.
+The format of identifiers and namespaces is defined in
Section~\ref{protocol.format.id}.
\subsection{Users}
The vast majority of clients will be representations of users.
Users are the chatters of the network.
-They may be real people, bots, or GreenReaper.
+They may be real people or bots.
Users may or may not require authorization, depending
on if the user is registered or not.
@@ -41,19 +41,16 @@
Services add new protocol commands to the server,
and will typically require some form of authorization.
-\subsubsection{Agents}
-
Services may produce virtual user-like entities to interact with
-users. These are called agents, and are rather like privileged bots.
+the real users. These are called agents, and are rather like privileged bots.
% cross-ref: Authoriztion.
-
\section{Channels}
Channels are collections of users, much like in IRC,
except they must be created by a server admin or by some other controlled
means.
-Channel ids (cids) follow the same rules as identifiers for client objects
-as defined in section~\ref{sec:format.id}.
+Channel IDs (cids) follow the same rules as identifiers for client objects
+as defined in section~\ref{protocol.format.id}.
Modified: branches/protocol-v4/docs/manual/chap/protocol.tex
===================================================================
--- branches/protocol-v4/docs/manual/chap/protocol.tex 2004-07-25 00:35:49 UTC
(rev 328)
+++ branches/protocol-v4/docs/manual/chap/protocol.tex 2004-07-26 20:34:30 UTC
(rev 329)
@@ -14,7 +14,7 @@
have special meaning. CR (Carriage Return) followed by LF (Line Feed)
terminates a line. Each line is subdivided into tokens separated by Tabs.
Esc is used for encoding literal CR, LF, Tab, and Esc characters.
-See Section~\ref{sec:esc} for details on escaping.
+See Section~\ref{protocol.parse.esc} for details on escaping.
\begin{table}
\caption{Special Characters}
@@ -28,17 +28,17 @@
\end{tabular}
\end{table}
-\subsection{Lines}
+ \subsection{Lines}
-Lines are terminated by the sequence CR LF,
-which is a carriage return followed by a line feed.
-A carriage return not followed by a line feed is illegal,
-as is a line feed not preceded with a carriage return.
-The previous sentence may be ignored for simplicity.
+ Lines are terminated by the sequence CR LF,
+ which is a carriage return followed by a line feed.
+ A carriage return not followed by a line feed is illegal,
+ as is a line feed not preceded with a carriage return.
+ The previous sentence may be ignored for simplicity.
-Most programming languages have a fairly easy
-way of reading lines from sockets. In perl,
-the \function{readline} function should do.
+ Most programming languages have a fairly easy
+ way of reading lines from sockets. In perl,
+ the \function{readline} function should do.
\subsection{Lists}
@@ -51,7 +51,7 @@
\function{g\_strsplit} function, as well.
\subsection{Escaping and Unescaping}
- \label{sec:esc}
+ \label{protocol.parse.esc}
Escape sequences are used to encode ``CR'', ``LF'', ``Tab'', and
``Esc'' (as defined
in Table~\ref{tab:chars}) as ``Esc r'', ``Esc n'', ``Esc t'', and ``Esc
e''
@@ -82,6 +82,7 @@
TODO. WRITE ME.
\section{Formats}
+\label{protocol.format}
This section describes formats used in the haver protocol,
such as how dates, times, and time zones are formatted.
@@ -89,19 +90,22 @@
\subsection{Dates and Times}
-Haver dates are
+Time stamps are written as either ``Date Time'' or ``Date Time Timezone'',
+where the format of Date, Time, and Timezone is as defined in
Table~\ref{tab:format.time}.
+Further explaination is given in the following subsections.
+
\begin{table}
\caption{Timestamp formats}
\label{tab:format.time}
-\begin{tabular}{|l|l|} \hline
-Symbolic Name & Perl Regex & Example\\
+\begin{tabular}{|l|l|l|} \hline
+Name & Perl Regex & Example \\
\hline
-\emph{Date} & \verb!/\d{4}-\d{2}-\d{2}/! & 1985-09-14 \\
+Date & \verb!/\d{4}-\d{2}-\d{2}/! & 1985-09-14 \\
\hline
-\emph{Time} & \verb!/\d{2}:\d{2}:\d{2}(\.\d+)?/! & 01:18:14 \\
+Time & \verb!/\d{2}:\d{2}:\d{2}(\.\d+)?/! & 01:18:14 \\
\hline
-\emph{Timezone} & \verb!/[+-]\d{2}\d{2}/! & -0400 \\
+Timezone & \verb!/[+-]\d{2}\d{2}/! & -0400 \\
\hline
\end{tabular}
\end{table}
@@ -110,8 +114,6 @@
which is June 6th, 1944 at half past noon (and 41 seconds...) in the UTC + 1
time zone.
-
-
\subsubsection{Dates}
Dates are expressed as YYYY-MM-DD, which MM and DD are zero-padded if
necessary.
For example would be 1985-09-14.
@@ -120,9 +122,9 @@
\subsubsection{Times}
Time is expressed as HH:MM:SS, where the hour ranges from 00 to 23,
the minute and second range from 00 to 59.
-A period (``.'') me be appended to SS to express any fractional part of a
second.
+A period (``.'') followed by up to six digits may be appended to SS to
+express any fractional part of a second.
-
\subsubsection{Time Zones}
All times are assumed to be in UTC unless a different time zone is specified.
@@ -130,35 +132,50 @@
HH the hour offset and MM is the minute offset. For example, Eastern Daylight
Time is
-0400.
+\subsection{Identifiers, Namespaces and Commands}
+\label{protocol.format.id}
-\subsection{Identifiers and Namespaces}
-\label{sec:format.id}
-
This section describes the various naming convention for
objects such as channels, users, and services within a haver server.
-\subsubsection{Identifiers}
+The form of identifiers, namespaces and commands is defined
+in Table~\ref{tab:id}, and explained in greater detail in the following
subsections.
-Identifiers may begin with an optional ampersand or dollar sign,
-and must then be followed (or start with in the first place) a lower-case
letter,
-and then must be followed by at least one lower case letter, number,
-underscore, single quote, hyphen or at symbol.
+\begin{table}
+\caption{IDs, Namespaces and Commands}
+\label{tab:id}
+\begin{tabular}{|l|l|} \hline
+Name & Perl Regex \\
+\hline
+IDs & \verb!/&?[A-Za-z][A-Za-z0-9_.'@-]+/! \\
+\hline
+Namespace & \verb!/[a-z]+/! \\
+\hline
+Command & \verb!/[A-Z][A-Z:_-]+/! \\
+\hline
+\end{tabular}
+\end{table}
-All identifiers that begin with either an ampersand or dollar sign,
-or that contain the at symbol, are reserved for the server and for services
-with appropriate authority.
-\verb!/[&$]?[a-z][a-z0-9_'@-]+/!
+\subsubsection{Identifiers}
-A user client will not be allowed to login with user ids that fail to match
\verb!/[a-z][a-z0-9_'-]+/!,
-nor create channel ids fail to match the same.
+Each channel, user, and service is identified with a unique string
+characters, and this is called the identifier, or ID.
+Identifiers (henceforth refered to as IDs) may be prefixed with an ampersand,
+must begin with a letter, and must be followed by one or more of: letters;
+numbers; periods; hyphens; underscores; single quotes; or the ``at'' symbol.
+All other characters constitute an illegal ID.
+
\subsubsection{Namespaces}
-Namespaces are used to separate the identifiers for different types of things,
-so that, for example, there may be a channel named joe and a user named joe.
-Namespaces are composed of only lower case letters.
+Name spaces must contain one or more lower-case letters,
+and may contain no other character.
+\subsubsection{Commands}
-\verb!/[a-z]+/!
+The commands to and from the server must begin with an upper case
+letter and may be followed by one or more of upper case letters, the
underscore, hyphens, or the colon.
+Commands containing any other characters will be considered illegal.
+
Added: branches/protocol-v4/docs/manual/haver.bib
===================================================================
--- branches/protocol-v4/docs/manual/haver.bib 2004-07-25 00:35:49 UTC (rev
328)
+++ branches/protocol-v4/docs/manual/haver.bib 2004-07-26 20:34:30 UTC (rev
329)
@@ -0,0 +1,18 @@
+
[EMAIL PROTECTED](rfc:1459,
+ TITLE = {RFC 1459},
+ HOWPUBLISHED = {\url{http://www.irchelp.org/irchelp/text/rfc1459.txt}},
+ AUTHOR = { Unknown },
+)
+
[EMAIL PROTECTED](silc,
+ TITLE = {SILC net},
+ HOWPUBLISHED = {\url{http://silcnet.org/}},
+ AUTHOR = { Unknown },
+)
+
[EMAIL PROTECTED](jabber,
+ TITLE = {Extensible Messaging and Presence Protocol},
+ HOWPUBLISHED =
{\url{http://www.ietf.org/html.charters/xmpp-charter.html}},
+ AUTHOR = { Unknown },
+)
Modified: branches/protocol-v4/docs/manual/haver.tex
===================================================================
--- branches/protocol-v4/docs/manual/haver.tex 2004-07-25 00:35:49 UTC (rev
328)
+++ branches/protocol-v4/docs/manual/haver.tex 2004-07-26 20:34:30 UTC (rev
329)
@@ -29,7 +29,7 @@
\include{chap/introduction}
\include{chap/protocol}
-\include{chap/concepts}
+\include{chap/commands}
\bibliographystyle{plain}
\bibliography{haver}
Modified: branches/protocol-v4/jarverd/lib/Jarver/Connection.pm
===================================================================
--- branches/protocol-v4/jarverd/lib/Jarver/Connection.pm 2004-07-25
00:35:49 UTC (rev 328)
+++ branches/protocol-v4/jarverd/lib/Jarver/Connection.pm 2004-07-26
20:34:30 UTC (rev 329)
@@ -62,8 +62,6 @@
haver_error
cmd_WANT
cmd_ACCEPT
- cmd_IN
- cmd_OF
cmd_JOIN
cmd_MSG
cmd_USERS
@@ -72,6 +70,9 @@
cmd_PART
cmd_MARK
cmd_INFO
+ cmd_LINFO
+ cmd_PMSG
+ cmd_FAIL
)],
],
heap => {
@@ -132,11 +133,11 @@
$heap->{channel} = $1;
$heap->{haver}->put(['JOIN', $1]);
} elsif (/^Hc$/ or /^Hc\t(.+)$/) {
- $heap->{haver}->put(['IN', $1 || $heap->{channel}, 'USERS']);
+ $heap->{haver}->put(['USERS', $1 || $heap->{channel}]);
} elsif (/^Hb$/) {
$heap->{haver}->put(['CHANS']);
} elsif (/^Ha$/) {
- $heap->{haver}->put(['USERS']);
+ $heap->{haver}->put(['USERS', '*']);
} elsif (/^E(.+)$/) {
my $msg = $1;
my $kind;
@@ -145,24 +146,30 @@
} else {
$kind = '"';
}
- $heap->{haver}->put(['IN', $heap->{channel}, 'MSG', $kind,
$msg]);
+ $heap->{haver}->put(['MSG', $heap->{channel}, $kind, $msg]);
} elsif (/^F([^\t]+)\t(.+)$/) {
my $to = $1;
my $msg = $2;
+ my $omsg = $msg;
my $kind;
if ($msg =~ s/^\.me //) {
$kind = ':';
} else {
$kind = '"';
}
- $heap->{haver}->put(['TO', $to, 'MSG', $kind, $msg]);
- $heap->{jrc}->put(join("\t", "F$heap->{name}", $to, $msg.'F'));
+ $heap->{haver}->put(['PMSG', $to, $kind, $msg]);
+ $heap->{jrc}->put(join("\t", "F$heap->{name}", $to, $omsg.'F'));
} elsif (/^\^(.+)\t(.+)$/) {
- my ($type, $data) = ($1, $2);
+ my ($mark, $data) = ($1, $2);
if ($data =~ /^Ic$/) {
- $heap->{haver}->put(['MARK', $type, 'TO', '*', 'IN',
$heap->{channel}, 'INFO']);
+ $heap->{haver}->put(
+ [
+ 'MARK', $mark,
+ 'LINFO', $heap->{channel}, '*'
+ ]
+ );
} elsif ($data =~ /^Ia\t?(.+)$/) {
- $heap->{haver}->put(['MARK', $type, 'TO', $1, 'IN',
$heap->{channel}, 'INFO']);
+ $heap->{haver}->put(['MARK', $mark, 'INFO', 'user',
$1]);
} else {
$kernel->post('Logger', 'error', "Unknown whois:
$data");
}
@@ -186,7 +193,8 @@
"Socket generated $operation error ${errnum}: $errstr");
$heap->{jrc} = undef;
- $kernel->yield('cleanup', 'DISCON');
+ $kernel->yield('shutdown', 'DISCON');
+ eval { $heap->{haver}->put(['BYE']) };
}
@@ -227,7 +235,7 @@
# Connecting Internet domain socket.
my $wheel = POE::Wheel::SocketFactory->new(
RemoteAddress => "localhost", # Sets the connect() addre
- RemotePort => "7071", # Sets the connect() port
+ RemotePort => "7070", # Sets the connect() port
SuccessEvent => 'haver_connect', # Event to emit on
connection
FailureEvent => 'haver_fail', # Event to emit on error
);
@@ -258,6 +266,7 @@
ErrorEvent => 'haver_error',
);
+ $wheel->put(['HAVER', $heap->{version}]);
$heap->{haver} = $wheel;
}
@@ -283,52 +292,29 @@
my ($kernel, $heap, $operation, $errnum, $errstr) = @_[KERNEL, HEAP,
ARG0..ARG3];
$kernel->post('Logger', 'error',
- "Socket generated $operation error ${errnum}: $errstr");
+ "Haver socket generated $operation error ${errnum}: $errstr");
$heap->{haver} = undef;
- $kernel->yield('cleanup', 'DISCON');
+ $kernel->yield('shutdown', 'DISCON');
+ eval { $heap->{jrc}->put('wCLost haver connectionw') };
}
-sub cmd_IN {
- my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
- my ($in, $event, @rest) = @$args;
- my $cmd = "cmd_$event";
-
-
- print "Calling $cmd...\n";
- $heap->{in} = $in;
- $kernel->call($_[SESSION], $cmd, [EMAIL PROTECTED]);
- $heap->{in} = undef;
-}
-
sub cmd_MARK {
my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
my ($mark, $event, @rest) = @$args;
my $cmd = "cmd_$event";
- print "Calling $cmd...\n";
$heap->{mark} = $mark;
$kernel->call($_[SESSION], $cmd, [EMAIL PROTECTED]);
$heap->{mark} = undef;
}
-sub cmd_OF {
- my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
- my ($of, $event, @rest) = @$args;
- my $cmd = "cmd_$event";
-
-
- print "Calling $cmd...\n";
- $heap->{of} = $of;
- $kernel->call($_[SESSION], $cmd, [EMAIL PROTECTED]);
- $heap->{of} = undef;
-}
-
sub cmd_JOIN {
my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my ($cid, $uid) = @$args;
- eval { $heap->{jrc}->put('D'.$heap->{of}."\t".$heap->{in}.'D') };
+ eval { $heap->{jrc}->put('D'.$uid."\t".$cid.'D') };
}
sub cmd_WANT {
@@ -336,7 +322,7 @@
my $want = shift @$args;
if ($want eq 'IDENT') {
- $heap->{haver}->put(['IDENT', $heap->{name}, 'user', "Jarver +
$heap->{version}"]);
+ $heap->{haver}->put(['IDENT', $heap->{name}]);
} else {
$heap->{haver}->put(['CANT', $want]);
}
@@ -351,7 +337,7 @@
sub cmd_MSG {
my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
- my ($type, $msg) = @$args;
+ my ($cid, $uid, $type, $msg) = @$args;
if ($type eq ':') {
$msg = ".me $msg";
@@ -361,18 +347,30 @@
return;
}
- if ($heap->{in}) {
- $heap->{jrc}->put('E'.$heap->{of}."\t".$msg.'E');
- } else {
- $heap->{jrc}->put('F'.$heap->{of}."\t".$msg.'F');
+ $heap->{jrc}->put('E'.$uid."\t".$msg.'E');
+}
+
+sub cmd_PMSG {
+ my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my ($uid, $type, $msg) = @$args;
+
+ if ($type eq ':') {
+ $msg = ".me $msg";
}
+
+ if ($type ne '"' && $type ne ':') {
+ return;
+ }
+
+ $heap->{jrc}->put('F'.$uid."\t".$msg.'F');
}
sub cmd_USERS {
my ($kernel, $heap, $args) = @_[KERNEL,HEAP,ARG0];
+ my $cid = shift @$args;
- if ($heap->{in}) {
- $heap->{jrc}->put('H'.$heap->{name}."\tc$heap->{in}\t" .
join("\t", @$args) . 'H');
+ if ($cid ne '*') {
+ $heap->{jrc}->put('H'.$heap->{name}."\tc$cid\t" . join("\t",
@$args) . 'H');
} else {
$heap->{jrc}->put('H'.$heap->{name}."\ta".join("\t", @$args) .
'H');
}
@@ -385,17 +383,20 @@
sub cmd_QUIT {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- $heap->{jrc}->put('C'.$heap->{of}."\t".$heap->{channel}.'C');
+ my $uid = shift @$args;
+ $heap->{jrc}->put('C'.$uid."\t".$heap->{channel}.'C');
}
sub cmd_PART {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- $heap->{jrc}->put('C'.$heap->{of}."\t".$heap->{in}.'C');
+ my ($cid, $uid) = $args;
+ $heap->{jrc}->put('C'.$uid."\t".$cid.'C');
}
sub cmd_INFO {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- my $msg = "^$heap->{name}\t$heap->{mark}\tIa$heap->{of}\t";
+ my ($type, $id) = splice(@$args, 0, 2);
+ my $msg = "^$heap->{name}\t$heap->{mark}\tIa$id\t";
my %hash = @$args;
$hash{Access} = delete($hash{Role}) . "\t" . delete($hash{Rank});
@@ -407,6 +408,46 @@
$heap->{jrc}->put($msg);
}
+sub cmd_LINFO {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($cid, $uid) = splice(@$args, 0, 2);
+ my $msg = "^$heap->{name}\t$heap->{mark}\tIa$uid\t";
+ my %hash = @$args;
+ $hash{Access} = delete($hash{Role}) . "\t" . delete($hash{Rank});
+
+ foreach my $key (keys %hash) {
+ $msg .= "$key\cB$hash{$key}\cC";
+ }
+ $msg .= "\cD^";
+ $heap->{jrc}->put($msg);
+}
+
+sub cmd_FAIL {
+ my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
+ my ($cmd, $err, @args) = @$args;
+
+ if ($cmd eq 'IDENT') {
+ if ($err eq 'used' or $err eq 'reserved') {
+ $heap->{jrc}->put("xAName in usex");
+ } elsif ($err eq 'syntax') {
+ $heap->{jrc}->put("xASyntax errorx");
+ }
+ $heap->{jrc}->put('wCw');
+ $heap->{haver}->put(['BYE']);
+ $kernel->yield('shutdown');
+ } elsif ($cmd eq 'PMSG') {
+ if ($err eq 'notfound.uid' or $err eq 'syntax.uid') {
+ $heap->{jrc}->put("xya$args[0]x");
+ }
+ } elsif ($cmd eq 'JOIN') {
+ if ($err eq 'notfound.cid') {
+ $heap->{jrc}->put("xyb$args[0]x");
+ } elsif ($err eq 'syntax.cid') {
+ $heap->{jrc}->put("xzb$args[0]x");
+ }
+ }
+}
+
1;
Modified: branches/protocol-v4/main/server/lib/Haver/Server/Object.pm
===================================================================
--- branches/protocol-v4/main/server/lib/Haver/Server/Object.pm 2004-07-25
00:35:49 UTC (rev 328)
+++ branches/protocol-v4/main/server/lib/Haver/Server/Object.pm 2004-07-26
20:34:30 UTC (rev 329)
@@ -85,6 +85,7 @@
$me->SUPER::initialize();
$me->{_fields} = {};
+ $me->{_loc} = {};
$me->{id} ||= $ID++;
my @ns = @{ (delete $me->{namespaces}) || [] };
@@ -135,6 +136,14 @@
}
}
+sub lset {
+ my ($me, $loc, @set) = @_;
+
+ while (my ($k,$v) = splice(@set, 0, 2)) {
+ $me->{_loc}{$loc}{$k} = $v;
+ }
+}
+
sub get {
my ($me, @keys) = @_;
@@ -150,6 +159,20 @@
return wantarray ? @values : [EMAIL PROTECTED] ;
}
+sub lget {
+ my ($me, $loc, @keys) = @_;
+
+ if (@keys <= 1) {
+ return _val($me->{_loc}{$loc}{$keys[0]}, $me);
+ }
+ my @values;
+
+ foreach my $key (@keys) {
+ push(@values, _val($me->{_loc}{$loc}{$key}, $me));
+ }
+
+ return wantarray ? @values : [EMAIL PROTECTED] ;
+}
sub _val {
return $_[0] if not ref $_[0];
@@ -263,7 +286,6 @@
-
sub has_namespace {
my ($me, $ns) = @_;
return exists $me->{".$ns"};
@@ -273,7 +295,11 @@
my ($this, $uid) = @_;
if (defined $uid && $uid =~ /^$IdPattern$/) {
- return 1;
+ if (length($uid) > 2 and length($uid) < 20) {
+ return 1;
+ } else {
+ return 0;
+ }
} else {
return 0;
}
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-25 00:35:49 UTC (rev 328)
+++ branches/protocol-v4/main/server/lib/Haver/Server/POE/Commands.pm
2004-07-26 20:34:30 UTC (rev 329)
@@ -42,8 +42,10 @@
JOIN PART BYE
HAVER
INFO
+ LINFO
MARK
- FOREACH
+ USERS
+ CHANS
);
@@ -213,8 +215,8 @@
#> 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.
+#> * syntax.cid -- the cid %1 is invalid.
+#> * notfound.cid -- the cid %1 was not found.
sub cmd_MSG {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
my ($cid, $type) = (shift @$args, shift @$args);
@@ -231,8 +233,8 @@
#> C: PMSG $uid $type @args
#> S: PMSG $uid $type @args
#> Errors:
-#> * syntax -- the uid %1 is invalid.
-#> * notfound -- the uid %1 was not found.
+#> * syntax.uid -- the uid %1 is invalid.
+#> * notfound.uid -- the uid %1 was not found.
sub cmd_PMSG {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
my $uid = shift @$args;
@@ -247,8 +249,8 @@
#> C: JOIN $cid
#> S: JOIN $cid $uid
#> Errors:
-#> * notfound -- the cid %1 was not found.
-#> * syntax -- the cid %1 is invalid.
+#> * notfound.cid -- the cid %1 was not found.
+#> * syntax.cid -- the cid %1 is invalid.
#> * joined -- tried to join %1 while already in it.
sub cmd_JOIN {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
@@ -271,8 +273,8 @@
#> C: PART $cid
#> S: PART $cid $uid
#> Errors:
-#> * notfound -- the cid %1 was not found.
-#> * syntax -- the cid %1 is invalid.
+#> * notfound.cid -- the cid %1 was not found.
+#> * syntax.cid -- 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];
@@ -302,7 +304,7 @@
}
#> [INFO]
-#> C: INFO $type $id
+#> C: INFO $id
#> S: INFO $type $id (list of key value pairs)
#> Errors:
#> * notfound -- the id %1 of type %2 was not found.
@@ -317,41 +319,50 @@
$heap->{socket}->put([EMAIL PROTECTED]);
}
-
-#> [FOREACH]
-#> C: FOREACH type cid @subcmd
-#> S: ...
-sub cmd_FOREACH {
+#> [LINFO]
+#> C: LINFO $cid $uid
+#> S: LINFO $cid $uid (key-value pairs)
+#> Errors:
+#> * notfound.cid -- the cid %1 was not found.
+#> * notfound.uid -- the uid %1 was not found.
+#> * syntax.cid -- the cid %1 is invalid.
+#> * syntax.uid -- the uid %1 is invalid.
+sub cmd_LINFO {
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
- my ($type, $cid, $cmd) = splice(@$args, 0, 3);
- my $chan = check_cid($cid, 'FOREACH');
+ my ($cid, $uid) = @$args;
+ my $chan = check_cid($cid, 'LINFO') or return;
+ my @m = $heap->{scope}{mark} ? ('MARK', $heap->{scope}{mark}) : ();
+ if ($uid ne '*') {
+ my $user = check_uid($uid, 'LINFO') or return;
+ my @keys = @{ $user->get('_info') };
+ my @out = (@m, 'LINFO', $cid, $uid, map { ($_ =>
$user->get($_)) } @keys);
- if ($cmd ne 'INFO') {
- $kernel->yield('fail', 'FOREACH', 'forbidden', $cmd);
- return;
+ $heap->{socket}->put([EMAIL PROTECTED]);
+ } else {
+ foreach my $user ($chan->contents('user')) {
+ my @keys = @{ $user->get('_info') };
+ my @out = (@m, 'LINFO', $cid, $user->id, map { ($_ =>
$user->get($_)) } @keys);
+ $heap->{socket}->put([EMAIL PROTECTED]);
+ }
}
- foreach my $obj ($chan->contents($type)) {
- my @args = map {
- if ($_ eq '%id%') {
- $obj->id;
- } else {
- $_;
- }
- } @$args;
- $kernel->post($_[SESSION], "cmd_$cmd", [EMAIL PROTECTED]);
- }
}
+
+sub err {
+ my ($s, $d) = @_;
+
+ return $d ? "$s.$d" : $s;
+}
sub check_id {
- my ($type, $id, $cmd) = @_;
+ my ($type, $id, $cmd, $d) = @_;
unless (Haver::Server::Object->is_valid_id($id)) {
- $poe_kernel->yield('fail', $cmd, 'syntax', [$id]);
+ $poe_kernel->yield('fail', $cmd, err('syntax', $d), [$id]);
return undef;
}
unless ($Registry->contains($type, $id)) {
- $poe_kernel->yield('fail', $cmd, 'notfound', [$id]);
+ $poe_kernel->yield('fail', $cmd, err('notfound', $d), [$id]);
return undef;
}
@@ -361,13 +372,13 @@
sub check_cid {
my ($id, $cmd) = @_;
- check_id('channel', $id, $cmd);
+ check_id('channel', $id, $cmd, 'cid');
}
sub check_uid {
my ($id, $cmd) = @_;
- check_id('user', $id, $cmd);
+ check_id('user', $id, $cmd, 'uid');
}
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-25 00:35:49 UTC (rev 328)
+++ branches/protocol-v4/main/server/lib/Haver/Server/POE/Connection.pm
2004-07-26 20:34:30 UTC (rev 329)
@@ -211,7 +211,7 @@
my ($kernel, $heap, $session, @args) = @_[KERNEL, HEAP, SESSION, ARG0
.. $#_];
return if $heap->{shutdown};
- $heap->{socket}->put(['BYE', @args]);
+ eval { $heap->{socket}->put(['BYE', @args]) };
$heap->{shutdown} = 1;
$kernel->yield('cleanup', @args);
}
