Committer : entrope
CVSROOT : /cvsroot/undernet-ircu
Module : ircu2.10
Commit time: 2005-05-10 03:43:19 UTC
Modified files:
ChangeLog ircd/ircd_parser.y ircd/motd.c ircd/msgq.c
ircd/s_stats.c
Added files:
ircd/test/channel-1.cmd ircd/test/client-1.cmd
ircd/test/ircd-t1.conf ircd/test/stats-1.cmd
ircd/test/test-driver.pl
Log message:
Add some automated test scripts and fix bugs exposed by them.
---------------------- diff included ----------------------
Index: ircu2.10/ChangeLog
diff -u ircu2.10/ChangeLog:1.628 ircu2.10/ChangeLog:1.629
--- ircu2.10/ChangeLog:1.628 Sun May 8 18:55:08 2005
+++ ircu2.10/ChangeLog Mon May 9 20:43:07 2005
@@ -1,3 +1,27 @@
+n2005-08-09 Michael Poole <[EMAIL PROTECTED]>
+
+ * ircd/ircd_parser.y: Move error tokens to top level of parse, and
+ make ';' a synchronizing token for them. This avoids crashes in
+ situations like missing ';' between two Kill blocks. Move several
+ ';'s earlier for earlier detection of syntax errors.
+
+ * ircd/motd.c (motd_memory_count): Use size_t for memory counts to
+ match the format strings used for those variables.
+
+ * ircd/msgq.c (msgq_histogram): tmp.sizes[] is an array of
+ unsigned int, not unsigned long; use correct format string.
+
+ * ircd/s_stats.c (stats_crule_list): Restore display of 'D' vs 'd'
+ based on crule type, rather than query type.
+ (statsinfo): Remove STAT_FLAG_VARPARAM from the "modules" and
+ "help" stats, which don't use the varparam.
+
+ * ircd/test/test-driver.pl: Interpreter for test scripts.b
+
+ * ircd/test/ircd-t1.conf: Configuration file for test scripts.
+
+ * ircd/test/*.cmd: New test scripts for test-driver.pl.
+
2005-05-08 Jukka Ollila <[EMAIL PROTECTED]>
(Adapted slightly by Michael Poole.)
Index: ircu2.10/ircd/ircd_parser.y
diff -u ircu2.10/ircd/ircd_parser.y:1.53 ircu2.10/ircd/ircd_parser.y:1.54
--- ircu2.10/ircd/ircd_parser.y:1.53 Wed Apr 27 19:00:09 2005
+++ ircu2.10/ircd/ircd_parser.y Mon May 9 20:43:08 2005
@@ -17,7 +17,7 @@
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
* USA.
- * $Id: ircd_parser.y,v 1.53 2005/04/28 02:00:09 entrope Exp $
+ * $Id: ircd_parser.y,v 1.54 2005/05/10 03:43:08 entrope Exp $
*/
%{
@@ -182,7 +182,7 @@
block: adminblock | generalblock | classblock | connectblock |
uworldblock | operblock | portblock | jupeblock | clientblock |
killblock | cruleblock | motdblock | featuresblock | quarantineblock |
- pseudoblock | iauthblock | error;
+ pseudoblock | iauthblock | error ';';
/* The timespec, sizespec and expr was ripped straight from
* ircd-hybrid-7. */
@@ -256,22 +256,22 @@
jupeblock: JUPE '{' jupeitems '}' ';' ;
jupeitems: jupeitem jupeitems | jupeitem;
-jupeitem: jupenick | error;
-jupenick: NICK '=' QSTRING
+jupeitem: jupenick;
+jupenick: NICK '=' QSTRING ';'
{
addNickJupes($3);
MyFree($3);
-} ';';
+};
-generalblock: GENERAL '{' generalitems '}'
+generalblock: GENERAL '{' generalitems '}' ';'
{
if (localConf.name == NULL)
parse_error("Your General block must contain a name.");
if (localConf.numeric == 0)
parse_error("Your General block must contain a numeric (between 1 and
4095).");
-} ';' ;
+};
generalitems: generalitem generalitems | generalitem;
-generalitem: generalnumeric | generalname | generalvhost | generaldesc | error;
+generalitem: generalnumeric | generalname | generalvhost | generaldesc;
generalnumeric: NUMERIC '=' NUMBER ';'
{
if (localConf.numeric == 0)
@@ -312,7 +312,7 @@
MyFree($3);
};
-adminblock: ADMIN '{' adminitems '}'
+adminblock: ADMIN '{' adminitems '}' ';'
{
if (localConf.location1 == NULL)
DupString(localConf.location1, "");
@@ -320,9 +320,9 @@
DupString(localConf.location2, "");
if (localConf.contact == NULL)
DupString(localConf.contact, "");
-} ';';
+};
adminitems: adminitems adminitem | adminitem;
-adminitem: adminlocation | admincontact | error;
+adminitem: adminlocation | admincontact;
adminlocation: LOCATION '=' QSTRING ';'
{
if (localConf.location1 == NULL)
@@ -340,7 +340,7 @@
classblock: CLASS {
tping = 90;
-} '{' classitems '}'
+} '{' classitems '}' ';'
{
if (name != NULL)
{
@@ -362,10 +362,10 @@
sendq = 0;
memset(&privs, 0, sizeof(privs));
memset(&privs_dirty, 0, sizeof(privs_dirty));
-} ';';
+};
classitems: classitem classitems | classitem;
classitem: classname | classpingfreq | classconnfreq | classmaxlinks |
- classsendq | classusermode | priv | error;
+ classsendq | classusermode | priv;
classname: NAME '=' QSTRING ';'
{
MyFree(name);
@@ -397,7 +397,7 @@
{
maxlinks = 65535;
flags = CONF_AUTOCONNECT;
-} '{' connectitems '}'
+} '{' connectitems '}' ';'
{
struct ConfItem *aconf = NULL;
if (name == NULL)
@@ -433,11 +433,11 @@
name = pass = host = origin = hub_limit = NULL;
c_class = NULL;
port = flags = 0;
-}';';
+};
connectitems: connectitem connectitems | connectitem;
connectitem: connectname | connectpass | connectclass | connecthost
| connectport | connectvhost | connectleaf | connecthub
- | connecthublimit | connectmaxhops | connectauto | error;
+ | connecthublimit | connectmaxhops | connectauto;
connectname: NAME '=' QSTRING ';'
{
MyFree(name);
@@ -492,7 +492,7 @@
uworldblock: UWORLD '{' uworlditems '}' ';';
uworlditems: uworlditem uworlditems | uworlditem;
-uworlditem: uworldname | error;
+uworlditem: uworldname;
uworldname: NAME '=' QSTRING ';'
{
make_conf(CONF_UWORLD)->host = $3;
@@ -532,7 +532,7 @@
memset(&privs_dirty, 0, sizeof(privs_dirty));
};
operitems: operitem | operitems operitem;
-operitem: opername | operpass | operhost | operclass | priv | error;
+operitem: opername | operpass | operhost | operclass | priv;
opername: NAME '=' QSTRING ';'
{
MyFree(name);
@@ -621,7 +621,7 @@
port = tconn = tping = 0;
};
portitems: portitem portitems | portitem;
-portitem: portnumber | portvhost | portmask | portserver | porthidden | error;
+portitem: portnumber | portvhost | portmask | portserver | porthidden;
portnumber: PORT '=' NUMBER ';'
{
port = $3;
@@ -696,7 +696,7 @@
pass = NULL;
};
clientitems: clientitem clientitems | clientitem;
-clientitem: clienthost | clientip | clientusername | clientclass | clientpass
| clientmaxlinks | error;
+clientitem: clienthost | clientip | clientusername | clientclass | clientpass
| clientmaxlinks;
clienthost: HOST '=' QSTRING ';'
{
char *sep = strchr($3, '@');
@@ -749,7 +749,7 @@
killblock: KILL
{
dconf = (struct DenyConf*) MyCalloc(1, sizeof(*dconf));
-} '{' killitems '}'
+} '{' killitems '}' ';'
{
if (dconf->usermask || dconf->hostmask ||dconf->realmask) {
dconf->next = denyConfList;
@@ -765,9 +765,9 @@
parse_error("Kill block must match on at least one of username, host or
realname");
}
dconf = NULL;
-} ';';
+};
killitems: killitem killitems | killitem;
-killitem: killuhost | killreal | killusername | killreasonfile | killreason |
error;
+killitem: killuhost | killreal | killusername | killreasonfile | killreason;
killuhost: HOST '=' QSTRING ';'
{
char *h;
@@ -845,7 +845,7 @@
};
cruleitems: cruleitem cruleitems | cruleitem;
-cruleitem: cruleserver | crulerule | cruleall | error;
+cruleitem: cruleserver | crulerule | cruleall;
cruleserver: SERVER '=' QSTRING ';'
{
@@ -878,7 +878,7 @@
};
motditems: motditem motditems | motditem;
-motditem: motdhost | motdfile | error;
+motditem: motdhost | motdfile;
motdhost: HOST '=' QSTRING ';'
{
host = $3;
@@ -967,7 +967,7 @@
};
pseudoitems: pseudoitem pseudoitems | pseudoitem;
-pseudoitem: pseudoname | pseudoprepend | pseudonick | pseudoflags | error;
+pseudoitem: pseudoname | pseudoprepend | pseudonick | pseudoflags;
pseudoname: NAME '=' QSTRING ';'
{
MyFree(smap->name);
@@ -1016,7 +1016,7 @@
};
iauthitems: iauthitem iauthitems | iauthitem;
-iauthitem: iauthpass | iauthhost | iauthport | iauthconnfreq | iauthtimeout |
error;
+iauthitem: iauthpass | iauthhost | iauthport | iauthconnfreq | iauthtimeout;
iauthpass: PASS '=' QSTRING ';'
{
MyFree(pass);
Index: ircu2.10/ircd/motd.c
diff -u ircu2.10/ircd/motd.c:1.21 ircu2.10/ircd/motd.c:1.22
--- ircu2.10/ircd/motd.c:1.21 Wed Feb 2 14:29:07 2005
+++ ircu2.10/ircd/motd.c Mon May 9 20:43:08 2005
@@ -23,7 +23,7 @@
*/
/** @file
* @brief Message-of-the-day manipulation implementation.
- * @version $Id: motd.c,v 1.21 2005/02/02 22:29:07 entrope Exp $
+ * @version $Id: motd.c,v 1.22 2005/05/10 03:43:08 entrope Exp $
*/
#include "config.h"
@@ -447,10 +447,10 @@
struct Motd *ptr;
struct MotdCache *cache;
unsigned int mt = 0, /* motd count */
- mtm = 0, /* memory consumed by motd */
mtc = 0, /* motd cache count */
- mtcm = 0, /* memory consumed by motd cache */
mtf = 0; /* motd free list count */
+ size_t mtm = 0, /* memory consumed by motd */
+ mtcm = 0; /* memory consumed by motd cache */
if (MotdList.local)
{
mt++;
Index: ircu2.10/ircd/msgq.c
diff -u ircu2.10/ircd/msgq.c:1.11 ircu2.10/ircd/msgq.c:1.12
--- ircu2.10/ircd/msgq.c:1.11 Sun Mar 20 08:06:29 2005
+++ ircu2.10/ircd/msgq.c Mon May 9 20:43:08 2005
@@ -18,7 +18,7 @@
*/
/** @file
* @brief Outbound message queue implementation.
- * @version $Id: msgq.c,v 1.11 2005/03/20 16:06:29 entrope Exp $
+ * @version $Id: msgq.c,v 1.12 2005/05/10 03:43:08 entrope Exp $
*/
#include "config.h"
@@ -614,8 +614,8 @@
send_reply(cptr, SND_EXPLICIT | RPL_STATSDEBUG,
":Histogram of message lengths (%lu messages)", tmp.msgs);
for (i = 0; i + 16 <= BUFSIZE; i += 16)
- send_reply(cptr, SND_EXPLICIT | RPL_STATSDEBUG, ":% 4d: %lu %lu %lu %lu "
- "%lu %lu %lu %lu %lu %lu %lu %lu %lu %lu %lu %lu", i + 1,
+ send_reply(cptr, SND_EXPLICIT | RPL_STATSDEBUG, ":% 4d: %u %u %u %u "
+ "%u %u %u %u %u %u %u %u %u %u %u %u", i + 1,
tmp.sizes[i + 0], tmp.sizes[i + 1], tmp.sizes[i + 2],
tmp.sizes[i + 3], tmp.sizes[i + 4], tmp.sizes[i + 5],
tmp.sizes[i + 6], tmp.sizes[i + 7], tmp.sizes[i + 8],
Index: ircu2.10/ircd/s_stats.c
diff -u ircu2.10/ircd/s_stats.c:1.39 ircu2.10/ircd/s_stats.c:1.40
--- ircu2.10/ircd/s_stats.c:1.39 Tue May 3 19:55:38 2005
+++ ircu2.10/ircd/s_stats.c Mon May 9 20:43:08 2005
@@ -62,7 +62,7 @@
/** @file
* @brief Report configuration lines and other statistics from this
* server.
- * @version $Id: s_stats.c,v 1.39 2005/05/04 02:55:38 entrope Exp $
+ * @version $Id: s_stats.c,v 1.40 2005/05/10 03:43:08 entrope Exp $
*
* Note: The info is reported in the order the server uses
* it--not reversed as in ircd.conf!
@@ -133,7 +133,7 @@
for ( ; p; p = p->next)
{
if (p->type & sd->sd_funcdata)
- send_reply(to, RPL_STATSDLINE, sd->sd_c, p->hostmask, p->rule);
+ send_reply(to, RPL_STATSDLINE, (p->type & CRULE_ALL ? 'D' : 'd'),
p->hostmask, p->rule);
}
}
@@ -246,20 +246,30 @@
for (conf = conf_get_deny_list(); conf; conf = conf->next)
{
- if ((!wilds && ((user || conf->hostmask) &&
- !match(conf->hostmask, host) &&
- (!user || !match(conf->usermask, user)))) ||
- (wilds && !mmatch(host, conf->hostmask) &&
- (!user || !mmatch(user, conf->usermask))))
- {
- send_reply(sptr, RPL_STATSKLINE, conf->bits > 0 ? 'k' : 'K',
- conf->usermask ? conf->usermask : "*",
- conf->hostmask ? conf->hostmask : "*",
- conf->message ? conf->message : "(none)",
- conf->realmask ? conf->realmask : "*");
- if (--count == 0)
- return;
- }
+ /* Skip this block if the user is searching for a user-matching
+ * mask but the current Kill doesn't have a usermask, or if user
+ * is searching for a host-matching mask but the Kill has no
+ * hostmask, or if the user mask is specified and doesn't match,
+ * or if the host mask is specified and doesn't match.
+ */
+ if ((user && !conf->usermask)
+ || (host && !conf->hostmask)
+ || (user && conf->usermask
+ && (wilds
+ ? mmatch(user, conf->usermask)
+ : match(conf->usermask, user)))
+ || (host && conf->hostmask
+ && (wilds
+ ? mmatch(host, conf->hostmask)
+ : match(conf->hostmask, host))))
+ continue;
+ send_reply(sptr, RPL_STATSKLINE, conf->bits > 0 ? 'k' : 'K',
+ conf->usermask ? conf->usermask : "*",
+ conf->hostmask ? conf->hostmask : "*",
+ conf->message ? conf->message : "(none)",
+ conf->realmask ? conf->realmask : "*");
+ if (--count == 0)
+ return;
}
}
@@ -546,7 +556,7 @@
FEAT_HIS_STATS_l,
stats_links, 0,
"Current connections information." },
- { 'L', "modules", (STAT_FLAG_OPERFEAT | STAT_FLAG_VARPARAM |
STAT_FLAG_CASESENS),
+ { 'L', "modules", (STAT_FLAG_OPERFEAT | STAT_FLAG_CASESENS),
FEAT_HIS_STATS_L,
stats_modules, 0,
"Dynamically loaded modules." },
@@ -602,7 +612,7 @@
{ 'z', "memory", STAT_FLAG_OPERFEAT, FEAT_HIS_STATS_z,
count_memory, 0,
"Memory/Structure allocation information." },
- { '*', "help", (STAT_FLAG_CASESENS | STAT_FLAG_VARPARAM), FEAT_LAST_F,
+ { '*', "help", STAT_FLAG_CASESENS, FEAT_LAST_F,
stats_help, 0,
"Send help for stats." },
{ '\0', 0, FEAT_LAST_F, 0, 0, 0 }
@@ -653,7 +663,7 @@
stats_find(const char *name_or_char)
{
if (!name_or_char[1])
- return statsmap[(int)name_or_char[0]];
+ return statsmap[name_or_char[0] - CHAR_MIN];
else
return bsearch(name_or_char, statsinfo, statscount, sizeof(statsinfo[0]),
stats_search);
}
@@ -663,11 +673,6 @@
stats_init(void)
{
struct StatDesc *sd;
- int i;
-
- /* Make darn sure the statsmap array is initialized to all zeros */
- for (i = 0; i < 256; i++)
- statsmap[i] = 0;
/* Count number of stats entries and sort them. */
for (statscount = 0, sd = statsinfo; sd->sd_name; sd++, statscount++) {}
@@ -680,12 +685,12 @@
continue;
else if (sd->sd_flags & STAT_FLAG_CASESENS)
/* case sensitive character... */
- statsmap[(int)sd->sd_c] = sd;
+ statsmap[sd->sd_c - CHAR_MIN] = sd;
else
{
/* case insensitive--make sure to put in two entries */
- statsmap[(int)ToLower((int)sd->sd_c)] = sd;
- statsmap[(int)ToUpper((int)sd->sd_c)] = sd;
+ statsmap[ToLower(sd->sd_c) - CHAR_MIN] = sd;
+ statsmap[ToUpper(sd->sd_c) - CHAR_MIN] = sd;
}
}
}
Index: ircu2.10/ircd/test/channel-1.cmd
diff -u /dev/null ircu2.10/ircd/test/channel-1.cmd:1.1
--- /dev/null Mon May 9 20:43:19 2005
+++ ircu2.10/ircd/test/channel-1.cmd Mon May 9 20:43:09 2005
@@ -0,0 +1,50 @@
+define srv localhost:7701
+
+connect cl1 Alex alex %srv% :Test client 1
+connect cl2 Bubb bubb %srv% :Test client 2
+:cl1 join #test
+:cl1 join #test2
+:cl1 mode #test +bb [EMAIL PROTECTED] [EMAIL PROTECTED]
+:cl2 wait cl1
+:cl2 join #test
+:cl1 wait cl2
+:cl1 invite Bubb #test
+:cl2 expect *cl1 invite #test
+:cl2 join #test
+:cl2 privmsg #test :Hello, *cl1.
+:cl2 nick Buba
+:cl2 mode #test +l 15
+:cl1 wait cl2
+:cl1 privmsg #test :Hello, *cl2.
+:cl1 mode #test -b+kv [EMAIL PROTECTED] secret Bubb
+:cl1 mode #test +b [EMAIL PROTECTED]
+:cl1 mode #test +b
+:cl1 mode #test :
+:cl1 mode #test
+:cl1 raw who #test %lfuh
+:cl2 wait cl1
+:cl2 part #test
+:cl1 wait cl2
+:cl2 join #test public
+:cl2 join #test secret
+:cl1 join 0
+:cl1 join #test2
+:cl2 wait cl1
+:cl2 join #test2
+:cl1 wait cl2
+:cl1 mode #test2 +smtinrDlAU 15 apples oranges
+:cl1 mode #test2
+:cl2 wait cl1
+:cl2 join #test2 apples
+:cl2 privmsg #test2 :Hello, oplevels.
+:cl2 mode #test2
+:cl2 mode #test2 -io+v Alex Alex
+:cl1 wait cl2
+:cl1 part #test2
+:cl1 join #test2
+:cl2 wait cl1
+:cl2 mode #test2 -D
+:cl2 mode #test +v Alex
+:cl1 oper oper1 oper1
+:cl1 wait cl2
+:cl1 raw die :testing over
Index: ircu2.10/ircd/test/client-1.cmd
diff -u /dev/null ircu2.10/ircd/test/client-1.cmd:1.1
--- /dev/null Mon May 9 20:43:19 2005
+++ ircu2.10/ircd/test/client-1.cmd Mon May 9 20:43:09 2005
@@ -0,0 +1,11 @@
+define srv localhost:7701
+
+connect cl1 Alex alex %srv% :Test client 1
+connect cl2 Bubb bubb %srv% :Test client 2
+:cl1 oper oper1 oper1
+:cl2 wait cl1
+:cl2 oper oper3 oper4
+:cl2 oper oper2 oper2
+:cl1 raw :privs Bubb
+:cl2 raw :privs Alex Alex
+sync cl1,cl2
Index: ircu2.10/ircd/test/ircd-t1.conf
diff -u /dev/null ircu2.10/ircd/test/ircd-t1.conf:1.1
--- /dev/null Mon May 9 20:43:19 2005
+++ ircu2.10/ircd/test/ircd-t1.conf Mon May 9 20:43:09 2005
@@ -0,0 +1,94 @@
+General {
+ name = "test-1.example.net";
+ vhost = "127.0.0.1";
+ vhost = "::1";
+ description = "Test Server 1";
+ numeric = 1;
+};
+
+Admin {
+ location = "Somewhere";
+ contact = "Someone";
+};
+
+Class {
+ name = "Server";
+ pingfreq = 180 seconds;
+ connectfreq = 300 seconds;
+ maxlinks = 1;
+ sendq = 9000000;
+};
+
+Class {
+ name = "others";
+ pingfreq = 180 seconds;
+ sendq = 160000;
+ maxlinks = 100;
+ usermode = "+oiwx";
+};
+
+Class {
+ name = "Opers";
+ pingfreq = 180 seconds;
+ sendq = 160000;
+ maxlinks = 10;
+ local = no;
+};
+
+Connect {
+ name = "bogus.example.net";
+ host = "example.net";
+ password = "bogus_example";
+ port = 7700;
+ class = "Server";
+ maxhops = 2;
+ hub = "*.example.net";
+ autoconnect = yes; # forces a DNS resolution attempt
+};
+
+CRule {
+ server = "bogus.example.net";
+ all = yes;
+ rule = "connected(*)";
+};
+
+CRule {
+ server = "bogus.example.net";
+ all = no;
+ rule = "directcon(*)";
+};
+
+UWorld {
+ name = "uworld.example.net";
+ name = "uworld2.example.net";
+};
+
+Jupe {
+ nick = "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q";
+ nick = "R,S,T,U,V,W,X,Y,Z,{,|,},~,-,_,`";
+};
+
+Operator { name = "oper1"; host = "[EMAIL PROTECTED]"; password =
"$PLAIN$oper1"; class = "Opers"; };
+Operator { name = "oper2"; host = "[EMAIL PROTECTED]"; password =
"$PLAIN$oper2"; class = "Opers"; local = yes; };
+
+Kill { username = "sub7"; realname = "s*7*"; reason = "You are infected with a
Trojan"; };
+Kill { realname = "Chloe"; reason = "drones"; };
+Kill { username = "sub7"; reason = "You are infected with a Trojan"; };
+
+Client { class = "others"; ip = "*"; };
+
+Port { server = yes; port = 7700; };
+Port { server = no; port = 7701; };
+
+Quarantine {
+ "#shells" = "Thou shalt not support the h4><0rz";
+};
+
+Pseudo "X" {
+ name = "X";
+ nick = "[EMAIL PROTECTED]";
+};
+
+Features {
+ "HIS_STATS_k" = "FALSE";
+};
Index: ircu2.10/ircd/test/stats-1.cmd
diff -u /dev/null ircu2.10/ircd/test/stats-1.cmd:1.1
--- /dev/null Mon May 9 20:43:19 2005
+++ ircu2.10/ircd/test/stats-1.cmd Mon May 9 20:43:09 2005
@@ -0,0 +1,91 @@
+# Connect to server
+connect cl1 Alex alex localhost:7701 :Test client 1
+:cl1 oper oper1 oper1
+
+# Single letter stats commands
+:cl1 raw :stats a
+:cl1 raw :stats c
+:cl1 raw :stats d
+:cl1 raw :stats D
+:cl1 raw :stats e
+:cl1 raw :stats f
+:cl1 raw :stats g
+:cl1 raw :stats i
+:cl1 raw :stats j
+:cl1 raw :stats J
+:cl1 raw :stats k
+:cl1 raw :stats l
+:cl1 raw :stats L
+:cl1 raw :stats m
+:cl1 raw :stats o
+:cl1 raw :stats p
+:cl1 raw :stats q
+:cl1 raw :stats r
+:cl1 raw :stats R
+:cl1 raw :stats t
+:cl1 raw :stats T
+:cl1 raw :stats u
+:cl1 raw :stats U
+:cl1 raw :stats v
+:cl1 raw :stats V
+:cl1 raw :stats w
+:cl1 raw :stats x
+:cl1 raw :stats z
+:cl1 raw :stats *
+
+# Named stats commands
+:cl1 raw :stats nameservers
+:cl1 raw :stats connect
+:cl1 raw :stats maskrules
+:cl1 raw :stats crules
+:cl1 raw :stats engine
+:cl1 raw :stats features
+:cl1 raw :stats glines
+:cl1 raw :stats access
+:cl1 raw :stats histogram
+:cl1 raw :stats jupes
+:cl1 raw :stats klines
+:cl1 raw :stats links
+:cl1 raw :stats modules
+:cl1 raw :stats commands
+:cl1 raw :stats operators
+:cl1 raw :stats ports
+:cl1 raw :stats quarantines
+:cl1 raw :stats mappings
+:cl1 raw :stats usage
+:cl1 raw :stats motds
+:cl1 raw :stats locals
+:cl1 raw :stats uworld
+:cl1 raw :stats uptime
+:cl1 raw :stats vservers
+:cl1 raw :stats vserversmach
+:cl1 raw :stats userload
+:cl1 raw :stats memusage
+:cl1 raw :stats classes
+:cl1 raw :stats memory
+:cl1 raw :stats help
+:cl1 raw :hash
+:cl1 raw :rehash
+:cl1 nick Alexey
+
+# Varparam stats
+:cl1 raw :stats access * 127.0.0.1
+:cl1 raw :stats access * *
+:cl1 raw :stats klines * *
+:cl1 raw :stats klines * [EMAIL PROTECTED]
+:cl1 raw :stats links * *
+:cl1 raw :stats ports * 7700
+:cl1 raw :stats quarantines * #frou-frou
+:cl1 raw :stats vservers * *.example.net
+
+# Invalid or nonexistent stats requests
+:cl1 raw :stats y
+:cl1 raw :stats ÿ
+:cl1 raw :stats mºD٣˧
+:cl1 raw :stats long_garbage_here_to_hopefully_trigger_the_core_reported_by_dan
+
+# Drop oper status and try a few others
+:cl1 mode Alex -o
+:cl1 raw :stats k
+:cl1 raw :stats k * *
+:cl1 raw :stats k * [EMAIL PROTECTED]
Index: ircu2.10/ircd/test/test-driver.pl
diff -u /dev/null ircu2.10/ircd/test/test-driver.pl:1.1
--- /dev/null Mon May 9 20:43:19 2005
+++ ircu2.10/ircd/test/test-driver.pl Mon May 9 20:43:09 2005
@@ -0,0 +1,537 @@
+#! /usr/bin/perl -wT
+
+# If you edit this file, please check carefully that the garbage
+# collection isn't broken. POE is sometimes too clever for our good
+# in finding references to sessions, and keeps running even after we
+# want to stop.
+# $Id: test-driver.pl,v 1.1 2005/05/10 03:43:09 entrope Exp $
+
+# This interprets a simple scripting language. Lines starting with a
+# hash mark (#, aka octothorpe, pound sign, etc) are ignored. The
+# special commands look like this, where angle brackets indicate a
+# metavariable:
+# define <macro> <value>
+# undef <macro>
+# connect <name> <nick> <ident> <server> :<userinfo>
+# sync <name1>,<name2>[,<name3>]*
+# :<name> <command>[ <args]*
+# For the last line syntax, <command> may be an IRC or IRC-like
+# command. Supported non-IRC commands are:
+# :<name> expect <source|*name2> [...]
+# :<name> raw <text>
+# :<name> sleep <seconds>
+# :<name> wait <name2>
+
+require 5.006;
+
+use bytes;
+use warnings;
+use strict;
+use vars;
+use constant DELAY => 2;
+use constant EXPECT_TIMEOUT => 15;
+use constant RECONNECT_TIMEOUT => 5;
+use constant THROTTLED_TIMEOUT => 90;
+
+use FileHandle;
+use POE;
+use POE::Component::IRC;
+
+# this defines commands that take "zero time" to execute
+# (specifically, those which do not send commands from the issuing
+# client to the server)
+our $zero_time = {
+ expect => 1,
+ sleep => 1,
+ wait => 1,
+ };
+
+# Create the main session and start POE.
+# All the empty anonymous subs are just to make POE:Session::ASSERT_STATES
happy.
+POE::Session->create(inline_states =>
+ {
+ # POE kernel interaction
+ _start => \&drv_start,
+ _child => sub {},
+ _stop => sub {
+ my $heap = $_[HEAP];
+ print "\nThat's all, folks!";
+ print "(exiting at line $heap->{lineno}:
$heap->{line})"
+ if $heap->{line};
+ print "\n";
+ },
+ _default => \&drv_default,
+ # generic utilities or miscellaneous functions
+ heartbeat => \&drv_heartbeat,
+ timeout_expect => \&drv_timeout_expect,
+ reconnect => \&drv_reconnect,
+ enable_client => sub { $_[ARG0]->{ready} = 1; },
+ disable_client => sub { $_[ARG0]->{ready} = 0; },
+ die => sub { $_[KERNEL]->signal($_[SESSION], 'TERM'); },
+ # client-based command issuers
+ cmd_die => \&cmd_generic,
+ cmd_expect => \&cmd_expect,
+ cmd_invite => \&cmd_generic,
+ cmd_join => \&cmd_generic,
+ cmd_mode => \&cmd_generic,
+ cmd_nick => \&cmd_generic,
+ cmd_notice => \&cmd_message,
+ cmd_oper => \&cmd_generic,
+ cmd_part => \&cmd_generic,
+ cmd_privmsg => \&cmd_message,
+ cmd_quit => \&cmd_generic,
+ cmd_raw => \&cmd_raw,
+ cmd_sleep => \&cmd_sleep,
+ cmd_wait => \&cmd_wait,
+ # handlers for messages from IRC
+ irc_001 => \&irc_connected, # Welcome to ...
+ irc_snotice => sub {}, # notice from a server
(anonymous/our uplink)
+ irc_notice => \&irc_notice, # NOTICE to self or channel
+ irc_msg => \&irc_msg, # PRIVMSG to self
+ irc_public => \&irc_public, # PRIVMSG to channel
+ irc_connected => sub {},
+ irc_ctcp_action => sub {},
+ irc_ctcp_ping => sub {},
+ irc_ctcp_time => sub {},
+ irc_ctcpreply_ping => sub {},
+ irc_ctcpreply_time => sub {},
+ irc_invite => \&irc_invite, # INVITE to channel
+ irc_join => sub {},
+ irc_kick => sub {},
+ irc_kill => sub {},
+ irc_mode => sub {},
+ irc_nick => sub {},
+ irc_part => sub {},
+ irc_ping => sub {},
+ irc_quit => sub {},
+ irc_topic => sub {},
+ irc_error => \&irc_error,
+ irc_disconnected => \&irc_disconnected,
+ irc_socketerr => \&irc_socketerr,
+ },
+ args => [EMAIL PROTECTED]);
+
+$| = 1;
+$poe_kernel->run();
+exit;
+
+# Core/bookkeeping test driver functions
+
+sub drv_start {
+ my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
+
+ # initialize heap
+ $heap->{clients} = {}; # session details, indexed by (short) session name
+ $heap->{sessions} = {}; # session details, indexed by session ref
+ $heap->{servers} = {}; # server addresses, indexed by short names
+ $heap->{macros} = {}; # macros
+
+ # Parse arguments
+ foreach my $arg (@_[ARG0..$#_]) {
+ if ($arg =~ /^-D$/) {
+ $heap->{irc_debug} = 1;
+ } elsif ($arg =~ /^-V$/) {
+ $heap->{verbose} = 1;
+ } else {
+ die "Extra command-line argument $arg\n" if $heap->{script};
+ $heap->{script} = new FileHandle($arg, 'r')
+ or die "Unable to open $arg for reading: $!\n";
+ }
+ }
+ die "No test name specified\n" unless $heap->{script};
+
+ # hook in to POE
+ $kernel->alias_set('control');
+ $kernel->yield('heartbeat');
+}
+
+sub drv_heartbeat {
+ my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
+ my $script = $heap->{script};
+ my $used = {};
+ my $delay = DELAY;
+
+ while (1) {
+ my ($line, $lineno);
+ if ($heap->{line}) {
+ $line = delete $heap->{line};
+ } elsif (defined($line = <$script>)) {
+ $heap->{lineno} = $.;
+ print "." unless $heap->{irc_debug};
+ } else {
+ # close all connections
+ foreach my $client (values %{$heap->{clients}}) {
+ $kernel->call($client->{irc}, 'quit', "I fell off the end of my
script");
+ $client->{quitting} = 1;
+ }
+ # unalias the control session
+ $kernel->alias_remove('control');
+ # die in a few seconds
+ $kernel->delay_set('die', 5);
+ return;
+ }
+
+ chomp $line;
+ # ignore comments and blank lines
+ next if $line =~ /^\#/ or $line !~ /\S/;
+
+ # expand any macros in the line
+ $line =~ s/(?<=[^\\])%(\S+?)%/$heap->{macros}->{$1}
+ or die "Use of undefined macro $1 at $heap->{lineno}\n"/eg;
+ # remove any \-escapes
+ $line =~ s/\\(.)/$1/g;
+ # figure out the type of line
+ if ($line =~ /^#/) {
+ # comment, silently ignore it
+ } elsif ($line =~ /^define (\S+) (.+)$/i) {
+ # define a new macro
+ $heap->{macros}->{$1} = $2;
+ } elsif ($line =~ /^undef (\S+)$/i) {
+ # remove the macro
+ delete $heap->{macros}->{$1};
+ } elsif ($line =~ /^connect (\S+) (\S+) (\S+) (\S+) :(.+)$/i) {
+ # connect a new session (named $1) to server $4
+ my ($name, $nick, $ident, $server, $userinfo, $port) = ($1, $2, $3, $4,
$5, 6667);
+ $server = $heap->{servers}->{$server} || $server;
+ if ($server =~ /(.+):(\d+)/) {
+ $server = $1;
+ $port = $2;
+ }
+ die "Client with nick $nick already exists (line $heap->{lineno})" if
$heap->{clients}->{$nick};
+ my $alias = "client_$name";
+ POE::Component::IRC->new($alias)
+ or die "Unable to create new user $nick (line $heap->{lineno}): $!";
+ my $client = { name => $name,
+ nick => $nick,
+ ready => 0,
+ expect => [],
+ expect_alarms => [],
+ irc => $kernel->alias_resolve($alias),
+ params => { Nick => $nick,
+ Server => $server,
+ Port => $port,
+ Username => $ident,
+ Ircname => $userinfo,
+ Debug => $heap->{irc_debug},
+ }
+ };
+ $heap->{clients}->{$client->{name}} = $client;
+ $heap->{sessions}->{$client->{irc}} = $client;
+ $kernel->call($client->{irc}, 'register', 'all');
+ $kernel->call($client->{irc}, 'connect', $client->{params});
+ $used->{$name} = 1;
+ } elsif ($line =~ /^sync (.+)$/i) {
+ # do multi-way synchronization between every session named in $1
+ my @synced = split(/,|\s/, $1);
+ # first, check that they exist and are ready
+ foreach my $clnt (@synced) {
+ die "Unknown session name $clnt (line $heap->{lineno})" unless
$heap->{clients}->{$clnt};
+ goto REDO unless $heap->{clients}->{$clnt}->{ready};
+ }
+ # next we actually send the synchronization signals
+ foreach my $clnt (@synced) {
+ my $client = $heap->{clients}->{$clnt};
+ $client->{sync_wait} = [map { $_ eq $clnt ? () :
$heap->{clients}->{$_}->{nick} } @synced];
+ $kernel->call($client->{irc}, 'notice', $client->{sync_wait}, 'SYNC');
+ $kernel->call($session, 'disable_client', $client);
+ }
+ } elsif ($line =~ /^:(\S+) (\S+)(.*)$/i) {
+ # generic command handler
+ my ($names, $cmd, $args) = ($1, lc($2), $3);
+ my (@avail, @unavail);
+ # figure out whether each listed client is available or not
+ foreach my $c (split ',', $names) {
+ my $client = $heap->{clients}->{$c};
+ if (not $client) {
+ print "ERROR: Unknown session name $c (line $heap->{lineno};
ignoring)\n";
+ } elsif (($used->{$c} and not $zero_time->{$cmd}) or not
$client->{ready}) {
+ push @unavail, $c;
+ } else {
+ push @avail, $c;
+ }
+ }
+ # redo command with unavailable clients
+ if (@unavail) {
+ # This will break if the command can cause a redo for
+ # available clients.. this should be fixed sometime
+ $line = ':'.join(',', @unavail).' '.$cmd.$args;
+ $heap->{redo} = 1;
+ }
+ # do command with available clients
+ if (@avail) {
+ # split up the argument part of the line
+ $args =~ /^((?:(?: [^:])|[^ ])+)?(?: :(.+))?$/;
+ $args = [($1 ? split(' ', $1) : ()), ($2 ? $2 : ())];
+ # find the client and figure out if we need to wait
+ foreach my $c (@avail) {
+ my $client = $heap->{clients}->{$c};
+ die "Client $c used twice as source (line $heap->{lineno})" if
$used->{c} and not $zero_time->{$cmd};
+ $kernel->call($session, 'cmd_'.$cmd, $client, $args);
+ $used->{$c} = 1 unless $zero_time->{$cmd};
+ }
+ }
+ } else {
+ die "Unrecognized input line $heap->{lineno}: $line";
+ }
+ if ($heap->{redo}) {
+ REDO:
+ delete $heap->{redo};
+ $heap->{line} = $line;
+ last;
+ }
+ }
+ # issue new heartbeat with appropriate delay
+ $kernel->delay_set('heartbeat', $delay);
+}
+
+sub drv_timeout_expect {
+ my ($kernel, $session, $client) = @_[KERNEL, SESSION, ARG0];
+ print "ERROR: Dropping timed-out expectation by $client->{name}: ".join(',',
@{$client->{expect}->[0]})."\n";
+ $client->{expect_alarms}->[0] = undef;
+ unexpect($kernel, $session, $client);
+}
+
+sub drv_reconnect {
+ my ($kernel, $session, $client) = @_[KERNEL, SESSION, ARG0];
+ $kernel->call($client->{irc}, 'connect', $client->{params});
+}
+
+sub drv_default {
+ my ($kernel, $heap, $sender, $session, $state, $args) = @_[KERNEL, HEAP,
SENDER, SESSION, ARG0, ARG1];
+ if ($state =~ /^irc_(\d\d\d)$/) {
+ my $client = $heap->{sessions}->{$sender};
+ if (@{$client->{expect}}
+ and $args->[0] eq $client->{expect}->[0]->[0]
+ and $client->{expect}->[0]->[1] eq "$1") {
+ my $expect = $client->{expect}->[0];
+ my $mismatch;
+ for (my $x=2; ($x<=$#$expect) and ($x<=$#$args) and not $mismatch; $x++)
{
+ $mismatch = 1 unless $args->[$x] =~ /$expect->[$x]/i;
+ }
+ unexpect($kernel, $session, $client) unless $mismatch;
+ }
+ return undef;
+ }
+ print "ERROR: Unexpected event $state to test driver (from
".$sender->ID.")\n";
+ return undef;
+}
+
+# client-based command issuers
+
+sub cmd_message {
+ my ($kernel, $heap, $event, $client, $args) = @_[KERNEL, HEAP, STATE, ARG0,
ARG1];
+ die "Missing arguments" unless $#$args >= 1;
+ # translate each target as appropriate (e.g. *sessionname)
+ my @targets = split(/,/, $args->[0]);
+ foreach my $target (@targets) {
+ if ($target =~ /^\*(.+)$/) {
+ my $other = $heap->{clients}->{$1} or die "Unknown session name $1 (line
$heap->{lineno})\n";
+ $target = $other->{nick};
+ }
+ }
+ $kernel->call($client->{irc}, substr($event, 4), [EMAIL PROTECTED],
$args->[1]);
+}
+
+sub cmd_generic {
+ my ($kernel, $heap, $event, $client, $args) = @_[KERNEL, HEAP, STATE, ARG0,
ARG1];
+ $event =~ s/^cmd_//;
+ $kernel->call($client->{irc}, $event, @$args);
+}
+
+sub cmd_raw {
+ my ($kernel, $heap, $client, $args) = @_[KERNEL, HEAP, ARG0, ARG1];
+ die "Missing argument" unless $#$args >= 0;
+ $kernel->call($client->{irc}, 'sl', $args->[0]);
+}
+
+sub cmd_sleep {
+ my ($kernel, $session, $heap, $client, $args) = @_[KERNEL, SESSION, HEAP,
ARG0, ARG1];
+ die "Missing argument" unless $#$args >= 0;
+ $kernel->call($session, 'disable_client', $client);
+ $kernel->delay_set('enable_client', $args->[0], $client);
+}
+
+sub cmd_wait {
+ my ($kernel, $session, $heap, $client, $args) = @_[KERNEL, SESSION, HEAP,
ARG0, ARG1];
+ die "Missing argument" unless $#$args >= 0;
+ # if argument was comma-delimited, split it up (space-delimited is split by
generic parser)
+ $args = [split(/,/, $args->[0])] if $args->[0] =~ /,/;
+ # make sure we only wait if all the other clients are ready
+ foreach my $other (@$args) {
+ if (not $heap->{clients}->{$other}->{ready}) {
+ $heap->{redo} = 1;
+ return;
+ }
+ }
+ # disable this client, make the others send SYNC to it
+ $kernel->call($session, 'disable_client', $client);
+ $client->{sync_wait} = [map { $heap->{clients}->{$_}->{nick} } @$args];
+ foreach my $other (@$args) {
+ die "Cannot wait on self" if $other eq $client->{name};
+ $kernel->call($heap->{clients}->{$other}->{irc}, 'notice',
$client->{nick}, 'SYNC');
+ }
+}
+
+sub cmd_expect {
+ my ($kernel, $session, $heap, $client, $args) = @_[KERNEL, SESSION, HEAP,
ARG0, ARG1];
+ die "Missing argument" unless $#$args >= 0;
+ push @{$client->{expect}}, $args;
+ push @{$client->{expect_alarms}}, $kernel->delay_set('timeout_expect',
EXPECT_TIMEOUT, $client);
+ $kernel->call($session, 'disable_client', $client);
+}
+
+# handlers for messages from IRC
+
+sub unexpect {
+ my ($kernel, $session, $client) = @_;
+ shift @{$client->{expect}};
+ my $alarm_id = shift @{$client->{expect_alarms}};
+ $kernel->alarm_remove($alarm_id) if $alarm_id;
+ $kernel->call($session, 'enable_client', $client) unless
@{$client->{expect}};
+}
+
+sub check_expect {
+ my ($kernel, $session, $heap, $poe_sender, $sender, $text) = @_[KERNEL,
SESSION, HEAP, SENDER, ARG0, ARG1];
+ my $client = $heap->{sessions}->{$poe_sender};
+ my $expected = $client->{expect}->[0];
+
+ # check sender
+ if ($expected->[0] =~ /\*(.+)/) {
+ # we expect *sessionname, so look up session's current nick
+ my $exp = $1;
+ $sender =~ /^(.+)!/;
+ return 0 if lc($heap->{clients}->{$exp}->{nick}) ne lc($1);
+ } elsif ($expected->[0] =~ /^:?(.+!.+)/) {
+ # expect :[EMAIL PROTECTED], so compare whole thing
+ return 0 if lc($1) ne lc($sender);
+ } else {
+ # we only expect :nick, so compare that part
+ $sender =~ /^:?(.+)!/;
+ return 0 if lc($expected->[0]) ne lc($1);
+ }
+
+ # compare text
+ return 0 if lc($text) !~ /$expected->[2]/i;
+
+ # drop expectation of event
+ unexpect($kernel, $session, $client);
+}
+
+sub irc_connected {
+ my ($kernel, $session, $heap, $sender) = @_[KERNEL, SESSION, HEAP, SENDER];
+ my $client = $heap->{sessions}->{$sender};
+ print "Client $client->{name} connected to server $_[ARG0]\n" if
$heap->{verbose};
+ $kernel->call($session, 'enable_client', $client);
+}
+
+sub irc_disconnected {
+ my ($kernel, $session, $heap, $sender, $server) = @_[KERNEL, SESSION, HEAP,
SENDER, ARG0];
+ my $client = $heap->{sessions}->{$sender};
+ print "Client $client->{name} disconnected from server $_[ARG0]\n" if
$heap->{verbose};
+ if ($client->{quitting}) {
+ $kernel->call($sender, 'unregister', 'all');
+ delete $heap->{sessions}->{$sender};
+ delete $heap->{clients}->{$client->{name}};
+ } else {
+ if ($client->{disconnect_expected}) {
+ delete $client->{disconnect_expected};
+ } else {
+ print "Got unexpected disconnect for $client->{name} (nick
$client->{nick})\n";
+ }
+ $kernel->call($session, 'disable_client', $client);
+ $kernel->delay_set('reconnect', $client->{throttled} ? THROTTLED_TIMEOUT :
RECONNECT_TIMEOUT, $client);
+ delete $client->{throttled};
+ }
+}
+
+sub irc_socketerr {
+ my ($kernel, $session, $heap, $sender, $msg) = @_[KERNEL, SESSION, HEAP,
SENDER, ARG0];
+ my $client = $heap->{sessions}->{$sender};
+ print "Client $client->{name} (re-)connect error: $_[ARG0]\n";
+ if ($client->{quitting}) {
+ $kernel->call($sender, 'unregister', 'all');
+ delete $heap->{sessions}->{$sender};
+ delete $heap->{clients}->{$client->{name}};
+ } else {
+ if ($client->{disconnect_expected}) {
+ delete $client->{disconnect_expected};
+ } else {
+ print "Got unexpected disconnect for $client->{name} (nick
$client->{nick})\n";
+ }
+ $kernel->call($session, 'disable_client', $client);
+ $kernel->delay_set('reconnect', $client->{throttled} ? THROTTLED_TIMEOUT :
RECONNECT_TIMEOUT, $client);
+ delete $client->{throttled};
+ }
+}
+
+sub irc_notice {
+ my ($kernel, $session, $heap, $sender, $from, $to, $text) = @_[KERNEL,
SESSION, HEAP, SENDER, ARG0, ARG1, ARG2];
+ my $client = $heap->{sessions}->{$sender};
+ if ($client->{sync_wait} and $text eq 'SYNC') {
+ $from =~ s/!.+$//;
+ my $x;
+ # find who sent it..
+ for ($x=0; $x<=$#{$client->{sync_wait}}; $x++) {
+ last if $from eq $client->{sync_wait}->[$x];
+ }
+ # exit if we don't expect them
+ if ($x>$#{$client->{sync_wait}}) {
+ print "Got unexpected SYNC from $from to $client->{name}
($client->{nick})\n";
+ return;
+ }
+ # remove from the list of people we're waiting for
+ splice @{$client->{sync_wait}}, $x, 1;
+ # re-enable client if we're done waiting
+ if ($#{$client->{sync_wait}} == -1) {
+ delete $client->{sync_wait};
+ $kernel->call($session, 'enable_client', $client);
+ }
+ } elsif (@{$client->{expect}}
+ and $client->{expect}->[0]->[1] =~ /notice/i) {
+ check_expect(@_[0..ARG0], $text);
+ }
+}
+
+sub irc_msg {
+ my ($kernel, $session, $heap, $sender, $from, $to, $text) = @_[KERNEL,
SESSION, HEAP, SENDER, ARG0, ARG1, ARG2];
+ my $client = $heap->{sessions}->{$sender};
+ if (@{$client->{expect}}
+ and $client->{expect}->[0]->[1] =~ /msg/i) {
+ check_expect(@_[0..ARG0], $text);
+ }
+}
+
+sub irc_public {
+ my ($kernel, $session, $heap, $sender, $from, $to, $text) = @_[KERNEL,
SESSION, HEAP, SENDER, ARG0, ARG1, ARG2];
+ my $client = $heap->{sessions}->{$sender};
+ if (@{$client->{expect}}
+ and $client->{expect}->[0]->[1] =~ /public/i
+ and grep($client->{expect}->[0]->[2], @$to)) {
+ splice @{$client->{expect}->[0]}, 2, 1;
+ check_expect(@_[0..ARG0], $text);
+ }
+}
+
+sub irc_invite {
+ my ($kernel, $session, $heap, $sender, $from, $to) = @_[KERNEL, SESSION,
HEAP, SENDER, ARG0, ARG1, ARG2];
+ my $client = $heap->{sessions}->{$sender};
+ if (ref $client->{expect} eq 'ARRAY'
+ and $client->{expect}->[0]->[1] =~ /invite/i
+ and $to =~ /$client->{expect}->[0]->[2]/) {
+ check_expect(@_[0..ARG0], $to);
+ }
+}
+
+sub irc_error {
+ my ($kernel, $session, $heap, $sender, $what) = @_[KERNEL, SESSION, HEAP,
SENDER, ARG0];
+ my $client = $heap->{sessions}->{$sender};
+ if (@{$client->{expect}}
+ and $client->{expect}->[0]->[1] =~ /error/i) {
+ splice @{$client->{expect}->[0]}, 2, 1;
+ unexpect($kernel, $session, $client);
+ $client->{disconnect_expected} = 1;
+ } else {
+ print "ERROR: From server to $client->{name}: $what\n";
+ }
+ $client->{throttled} = 1 if $what =~ /throttled/i;
+}
----------------------- End of diff -----------------------
_______________________________________________
Patches mailing list
[email protected]
http://undernet.sbg.org/mailman/listinfo/patches
