home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / 2.x / plum2_17_1.lzh / plum next >
Text File  |  1998-01-25  |  53KB  |  1,859 lines
  1. #!/bin/perl -w
  2. # $Id: plum,v 2.36 1998/01/25 19:55:51 hasegawa Exp $
  3. # copyright (c)1997 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  4.  
  5. package plum;
  6.  
  7. $NAME = 'plum';
  8. $VERSION = '2.17';
  9.  
  10. if ($] < 5) {
  11.   foreach $inc (@INC) {
  12.     if (-r "$inc/sys/socket.ph") {
  13.       eval { require 'sys/socket.ph' };
  14.       $SOCKET = "$inc/sys/socket.ph" unless $@;
  15.       last;
  16.     }
  17.     if (-r "$inc/socket.ph") {
  18.       eval { require 'socket.ph' };
  19.       $SOCKET = "$inc/socket.ph" unless $@;
  20.       last;
  21.     }
  22.   }
  23. } else {
  24.   eval 'use Socket';
  25.   $SOCKET = 'Socket.pm' unless $@;
  26. }
  27.  
  28. $'NIL = $;;
  29.  
  30. $ALIAS = '*.jp';
  31. $NOTRAILING = &'list('004', '215', '221', '324', '341', '367', 'mode');
  32.  
  33. $IRCPORT = 6667;
  34. $READSIZE = 1024;
  35. $TIMEOUT = 120;
  36. $SOCKADDR = 'S n a4 x8';
  37.  
  38. $PROTO = getprotobyname('tcp');
  39.  
  40. $AF_INET = eval { &AF_INET } || 2;
  41. $PF_INET = eval { &PF_INET } || 2;
  42. $SOCK_STREAM = eval { &SOCK_STREAM } || 1;
  43. $SOMAXCONN = eval { &SOMAXCONN } || 16;
  44. $INADDR_ANY = eval { &INADDR_ANY } || "\0\0\0\0";
  45. $SOL_SOCKET = eval { &SOL_SOCKET};
  46. $SO_REUSEADDR = eval { &SO_REUSEADDR };
  47. $SO_KEEPALIVE = eval { &SO_KEEPALIVE };
  48.  
  49. $'rin = '';
  50. $'win = '';
  51. $'rout = '';
  52. $'wout = '';
  53.  
  54. $handle = 0;
  55.  
  56. srand();
  57.  
  58. select((select(STDOUT), $| = 1)[0]);
  59. select((select(STDERR), $| = 1)[0]);
  60.  
  61. if ($0 =~ /^(.*)[\\\/][^\\\/]*$/) {
  62.   unshift(@INC, "$1/module");
  63. } else {
  64.   unshift(@INC, './module');
  65. }
  66.  
  67. &'load('', "$NAME.conf") if -r "$NAME.conf";
  68. foreach $user (@ARGV) {
  69.   &'load($user, "$NAME-$user.conf") if -r "$NAME-$user.conf";
  70. }
  71.  
  72. exit unless scalar(@'username);
  73.  
  74. print "$NAME $VERSION\n";
  75.  
  76. &main;
  77.  
  78. sub main {
  79.   local($nfound, $timeleft, $sub, $label, $i);
  80.   for (;;) {
  81.     for ($i = 0; $i < scalar(@'username); $i++) {
  82.       foreach $module (&'array($'modulelist[$i])) {
  83.         $sub = "${module}\'main_loop";
  84.         next unless defined(&$sub);
  85.         if ($'labellist{$module}) {
  86.           foreach $label (&'array($'labellist{$module})) {
  87.             &$sub($i);
  88.           }
  89.         } else {
  90.           &$sub($i);
  91.         }
  92.       }
  93.     }
  94.     foreach $cno (&'array($'clientlist)) {
  95.       &c_read($cno) if vec($'rout, $cno, 1);
  96.       &c_write($cno) if vec($'wout, $cno, 1);
  97.     }
  98.     foreach $sno (&'array($'serverlist)) {
  99.       &s_read($sno) if vec($'rout, $sno, 1);
  100.       &s_write($sno) if vec($'wout, $sno, 1);
  101.     }
  102.     foreach $lno (&'array($'listenlist)) {
  103.       &c_accept($lno) if vec($'rout, $lno, 1);
  104.     }
  105.     ($nfound, $timeleft) = select($'rout = $'rin, $'wout = $'win, undef, $TIMEOUT);
  106.     for ($i = 0; $i < length($'rout) * 8; $i++) {
  107.       $'access[$i] = time() if vec($'rout, $i, 1);
  108.     }
  109.   }
  110. }
  111.  
  112. sub c_read {
  113.   local($clientno) = @_;
  114.   local($next, $rest, $tmp, $sub, $label);
  115.   $tmp = '';
  116.   if (sysread($'socket[$clientno], $tmp, $READSIZE)) {
  117.     $rbuf[$clientno] .= $tmp;
  118.     while ((($next, $rest) = split(/[\r\n]+/, $rbuf[$clientno], 2)) == 2) {
  119.       $rbuf[$clientno] = $rest;
  120.       next unless $next;
  121.       if ($'avail[$clientno]) {
  122.         foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  123.           $sub = "${module}\'client_read";
  124.           next unless defined(&$sub);
  125.           if ($'labellist{$module}) {
  126.             foreach $label (&'array($'labellist{$module})) {
  127.               $next = &$sub($clientno, $next);
  128.               last unless $next;
  129.             }
  130.           } else {
  131.             $next = &$sub($clientno, $next);
  132.             last unless $next;
  133.           }
  134.         }
  135.       }
  136.       next unless $next;
  137.       &c_scan($clientno, $next);
  138.     }
  139.     $rbuf[$clientno] = $next || '';
  140.   } else {
  141.     &'c_close($clientno);
  142.   }
  143. }
  144.  
  145. sub c_scan {
  146.   local($clientno, $line) = @_;
  147.   local($prefix, $cmd, @params, $sub, $label);
  148.   ($prefix, $cmd, @params) = &'parse($line);
  149.   return unless $cmd;
  150.   if ($'avail[$clientno]) {
  151.     foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  152.       $sub = "${module}\'cs_\L$cmd\E";
  153.       next unless defined(&$sub);
  154.       if ($'labellist{$module}) {
  155.         foreach $label (&'array($'labellist{$module})) {
  156.           ($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
  157.           last unless $cmd;
  158.         }
  159.       } else {
  160.         ($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
  161.       }
  162.       last unless $cmd;
  163.     }
  164.     return unless $cmd;
  165.     return unless $'server[$'userno[$clientno]];
  166.     return unless $'avail[$'server[$'userno[$clientno]]];
  167.     &'s_print($'server[$'userno[$clientno]], $prefix, $cmd, @params);
  168.   } else {
  169.     $sub = "cn_\L$cmd\E";
  170.     &$sub($clientno, $prefix, $cmd, @params) if defined(&$sub);
  171.   }
  172. }
  173.  
  174. sub 'c_print {
  175.   local($clientno, $prefix, $cmd, @params) = @_;
  176.   local($sub, $label, $key);
  177.   return unless $cmd;
  178.   return unless $clientno;
  179.   if ($'avail[$clientno]) {
  180.     foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  181.       $sub = "${module}\'cp_\L$cmd\E";
  182.       next unless defined(&$sub);
  183.       if ($'labellist{$module}) {
  184.         foreach $label (&'array($'labellist{$module})) {
  185.           ($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
  186.           last unless $cmd;
  187.         }
  188.       } else {
  189.         ($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
  190.       }
  191.       last unless $cmd;
  192.     }
  193.     return unless $cmd;
  194.   }
  195.   $key = $clientno . $; . "\L$cmd\E";
  196.   $wbuf{$key} = '' unless defined($wbuf{$key});
  197.   $wbuf{$key} .= &'build($prefix, $cmd, @params);
  198.   $sequence[$clientno] = &'add($sequence[$clientno], "\L$cmd\E");
  199.   vec($'win, $clientno, 1) = 1;
  200. }
  201.  
  202. sub c_write {
  203.   local($clientno) = @_;
  204.   local($socket, $next, $rest, $sub, $label, @array, $cmd);
  205.   $socket = $'socket[$clientno];
  206.   @array = &'array($sequence[$clientno]);
  207.   while (@array) {
  208.     $cmd = shift(@array);
  209.     ($next, $rest) = split(/[\r\n]+/, $wbuf{$clientno, $cmd}, 2);
  210.     $wbuf{$clientno, $cmd} = $rest || '';
  211.     push(@array, $cmd) if $rest;
  212.     if ($'avail[$clientno]) {
  213.       foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  214.         $sub = "${module}\'client_write";
  215.         next unless defined(&$sub);
  216.         if ($'labellist{$module}) {
  217.           foreach $label (&'array($'labellist{$module})) {
  218.             $next = &$sub($clientno, $next);
  219.             last unless $next;
  220.           }
  221.         } else {
  222.           $next = &$sub($clientno, $next);
  223.         }
  224.         last unless $next;
  225.       }
  226.     }
  227.     next unless $next;
  228.     print $socket $next, "\r\n" if fileno($socket);
  229.   }
  230.   $sequence[$clientno] = '';
  231.   vec($'win, $clientno, 1) = 0;
  232. }
  233.  
  234. sub 'c_flush {
  235.   local($clientno) = @_;
  236.   while (vec($'win, $clientno, 1)) {
  237.     &c_write($clientno);
  238.   }
  239. }
  240.  
  241. sub s_read {
  242.   local($serverno) = @_;
  243.   local($userno, $next, $rest, $tmp, $sub, $label);
  244.   $userno = $'userno[$serverno];
  245.   $tmp = '';
  246.   if (sysread($'socket[$serverno], $tmp, $READSIZE)) {
  247.     $rbuf[$serverno] .= $tmp;
  248.     while ((($next, $rest) = split(/[\r\n]+/, $rbuf[$serverno], 2)) == 2) {
  249.       $rbuf[$serverno] = $rest;
  250.       next unless $next;
  251.       if ($'avail[$serverno]) {
  252.         foreach $module (&'array($'modulelist[$userno])) {
  253.           $sub = "${module}\'server_read";
  254.           next unless defined(&$sub);
  255.           if ($'labellist{$module}) {
  256.             foreach $label (&'array($'labellist{$module})) {
  257.               $next = &$sub($serverno, $next);
  258.               last unless $next;
  259.             }
  260.           } else {
  261.             $next = &$sub($serverno, $next);
  262.           }
  263.         last unless $next;
  264.         }
  265.       }
  266.       next unless $next;
  267.       &s_scan($serverno, $next);
  268.     }
  269.     $rbuf[$serverno] = $next || '';
  270.   } else {
  271.     &'s_close($userno);
  272.     &'s_connect($userno);
  273.   }
  274. }
  275.  
  276. sub s_scan {
  277.   local($serverno, $line) = @_;
  278.   local($prefix, $cmd, @params, $sub, $label);
  279.   ($prefix, $cmd, @params) = &'parse($line);
  280.   return unless $cmd;
  281.   if ($'avail[$serverno]) {
  282.     foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  283.       $sub = "${module}\'ss_\L$cmd\E";
  284.       next unless defined(&$sub);
  285.       if ($'labellist{$module}) {
  286.         foreach $label (&'array($'labellist{$module})) {
  287.           ($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
  288.           last unless $cmd;
  289.         }
  290.       } else {
  291.         ($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
  292.       }
  293.       last unless $cmd;
  294.     }
  295.     return unless $cmd;
  296.     foreach $cno (&'array($'clientlist)) {
  297.       next unless $'avail[$cno];
  298.       next unless $'userno[$cno] == $'userno[$serverno];
  299.       &'c_print($cno, $prefix, $cmd, @params);
  300.     }
  301.   } else {
  302.     $sub = "sn_\L$cmd\E";
  303.     &$sub($serverno, $prefix, $cmd, @params) if defined(&$sub);
  304.   }
  305. }
  306.  
  307. sub 's_print {
  308.   local($serverno, $prefix, $cmd, @params) = @_;
  309.   local($sub, $label, $key);
  310.   return unless $cmd;
  311.   return unless $serverno;
  312.   if ($'avail[$serverno]) {
  313.     foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  314.       $sub = "${module}\'sp_\L$cmd\E";
  315.       next unless defined(&$sub);
  316.       if ($'labellist{$module}) {
  317.         foreach $label (&'array($'labellist{$module})) {
  318.           ($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
  319.           last unless $cmd;
  320.         }
  321.       } else {
  322.         ($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
  323.       }
  324.       last unless $cmd;
  325.     }
  326.     return unless $cmd;
  327.   }
  328.   $key = $serverno . $; . "\L$cmd\E";
  329.   $wbuf{$key} = '' unless defined($wbuf{$key});
  330.   $wbuf{$key} .= &'build($prefix, $cmd, @params);
  331.   $sequence[$serverno] = &'add($sequence[$serverno], "\L$cmd\E");
  332.   vec($'win, $serverno, 1) = 1;
  333. }
  334.  
  335. sub s_write {
  336.   local($serverno) = @_;
  337.   local($socket, $next, $rest, $sub, $label, $time, @array, $cmd);
  338.   $socket = $'socket[$serverno];
  339.   $time = time();
  340.   $timer[$serverno] = $time if ($timer[$serverno] || 0) < $time;
  341.   @array = &'array($sequence[$serverno]);
  342.   while (@array) {
  343.     if ($timer[$serverno] > $time + 10) {
  344.       $sequence[$serverno] = &'list(@array);
  345.       return;
  346.     } else {
  347.       $cmd = shift(@array);
  348.       ($next, $rest) = split(/[\r\n]+/, $wbuf{$serverno, $cmd}, 2);
  349.       $wbuf{$serverno, $cmd} = $rest || '';
  350.       push(@array, $cmd) if $rest;
  351.       if ($'avail[$serverno]) {
  352.         foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  353.           $sub = "${module}\'server_write";
  354.           next unless defined(&$sub);
  355.           if ($'labellist{$module}) {
  356.             foreach $label (&'array($'labellist{$module})) {
  357.               $next = &$sub($serverno, $next);
  358.               last unless $next;
  359.             }
  360.           } else {
  361.             $next = &$sub($serverno, $next);
  362.           }
  363.           last unless $next;
  364.         }
  365.       }
  366.       next unless $next;
  367.       print $socket $next, "\r\n" if fileno($socket);
  368.       $timer[$serverno] += 2;
  369.     }
  370.   }
  371.   $sequence[$serverno] = '';
  372.   vec($'win, $serverno, 1) = 0;
  373. }  
  374.  
  375. sub 's_flush {
  376.   local($serverno) = @_;
  377.   while (vec($'win, $serverno, 1)) {
  378.     &s_write($serverno);
  379.   }
  380. }
  381.  
  382. sub 'parse {
  383.   local($line) = @_;
  384.   local($arg, $rest, @params);
  385.   @params = ();
  386.   $line =~ s/^\s*//;
  387.   if ($line =~ /^\:(.*)$/) {
  388.     ($arg, $rest) = split(/\s+/, $1, 2);
  389.   } else {
  390.     ($arg, $rest) = ('', $line);
  391.   }
  392.   while ($line) {
  393.     push(@params, $arg);
  394.     if ($rest =~ /^\:(.*)$/) {
  395.       push(@params, $1);
  396.       last;
  397.     }
  398.     $line = $rest;
  399.     ($arg, $rest) = (split(/\s+/, $line, 2), '');
  400.   }
  401.   return @params;
  402. }
  403.  
  404. sub 'build {
  405.   local($prefix, $cmd, @params) = @_;
  406.   local($trailing);
  407.   return '' unless $cmd;
  408.   if (scalar(@params)) {
  409.     $trailing = pop(@params) || '';
  410.     if (&'exist($NOTRAILING, "\L$cmd\E")) {
  411.       push(@params, "$trailing ");
  412.     } else {
  413.       push(@params, ":$trailing");
  414.     }
  415.   } else {
  416.     @params = ();
  417.   }
  418.   unshift(@params, $cmd);
  419.   unshift(@params, ":$prefix") if $prefix;
  420.   return join(' ', @params) . "\r\n";
  421. }
  422.  
  423. sub 'user {
  424.   local($no) = @_;
  425.   local($addr, $host);
  426.   if (fileno($'socket[$no])) {
  427.     $addr = (unpack($SOCKADDR, getsockname($'socket[$no])))[2];
  428.     $host = (gethostbyaddr($addr, $AF_INET))[0] || join('.', unpack('C4', $addr));
  429.   } else {
  430.     $host = 'unknown';
  431.   }
  432.   return "$'nick[$no]!$'user[$no]\@$host";
  433. }
  434.  
  435. sub 'prefix {
  436.   local($prefix) = @_;
  437.   $prefix =~ /^([^\!\@]*)(\!([^\!\@]*))?(\@([^\!\@]*))?$/;
  438.   if (wantarray) {
  439.     return ($1 || '', $3 || '', $5 || '');
  440.   } else {
  441.     return $1;
  442.   }
  443. }
  444.  
  445. sub 'regex {
  446.   local($mask) = @_;
  447.   $mask =~ s/(\W)/\\$1/g;
  448.   $mask =~ s/\\\?/\./g;
  449.   $mask =~ s/\\\*/\.\*/g;
  450.   $mask =~ s/\\[\[\{]/\[\\\[\\\{\]/g;
  451.   $mask =~ s/\\[\]\}]/\[\\\]\\\}\]/g;
  452.   $mask =~ s/\\[\|\\]/\[\\\|\\\\\]/g;
  453.   return "\^$mask\$";
  454. }
  455.  
  456. sub 'load {
  457.   local($user, $file) = @_;
  458.   local($userno, @key, $no, $var, $line, $arg, $name, $label);
  459.   @'username = () unless @'username;
  460.   open(FILE, $file) || return;
  461.   if (!&'exist(&'list(@'username), $user)) {
  462.     push(@'username, $user);
  463.   }
  464.   for ($userno = 0; $userno < scalar(@'username); $userno++) {
  465.     last if $user eq $'username[$userno];
  466.   }
  467.   foreach $key (keys(%property)) {
  468.     ($no, $var) = split(/$;/, $key, 2);
  469.     next unless $no == $userno;
  470.     delete $property{$key};
  471.   }
  472.   $'filename{$user} = $file;
  473.   $'modulelist[$userno] = &'list('plum');
  474.   while (defined($line = <FILE>)) {
  475.     $line =~ s/^\s+//;
  476.     next if $line =~ /^[\#\;]/;
  477.     $line =~ s/[\r\n]+//;
  478.     next unless $line;
  479.     $line =~ s/\s+$//;
  480.     foreach $kanji (&'property($userno, 'kanji')) {
  481.       foreach $code (split(/\,/, $kanji)) {
  482.         if ("\L$code\E" eq 'euc') {
  483.           $line = &'euc_jis($line);
  484.         } elsif ("\L$code\E" eq 'jis') {
  485.           $line = &'jis_jis($line);
  486.         } elsif ("\L$code\E" eq 'sjis') {
  487.           $line = &'sjis_jis($line);
  488.         }
  489.       }
  490.     }
  491.     if ($line =~ /^\+\s*(\S+)\s+(\S+)/) {
  492.       $name = $1;
  493.       $label = $2;
  494.       &'import($name);
  495.       $'modulelist[$userno] = &'add($'modulelist[$userno], $'package{$name});
  496.       $'labellist{$'package{$name}} = &'list(split(/\,/, $label));
  497.     } elsif ($line =~ /^\+\s*(\S+)/) {
  498.       $name = $1;
  499.       &'import($name);
  500.       $'modulelist[$userno] = &'add($'modulelist[$userno], $'package{$name});
  501.       $'labellist{$'package{$name}} = '';
  502.     } elsif ($line =~ /^\-\s*(\S+)/) {
  503.       $name = $1;
  504.       if ($'package{$name}) {
  505.         $'modulelist[$userno] = &'remove($'modulelist[$userno], $'package{$name});
  506.         $'labellist{$'package{$name}} = '';
  507.       }
  508.     } elsif ($line =~ /^\=\s*(\S+)/) {
  509.       $name = $1;
  510.       &'import($name);
  511.     } elsif ((($var, $arg) = split(/\s*\:\s*/, $line, 2)) == 2) {
  512.       @key = split(/\./, $var);
  513.       $property{$userno, @key} = &'add($property{$userno, @key}, $arg);
  514.     }
  515.   }
  516.   close(FILE);
  517. }
  518.  
  519. sub 'import {
  520.   local($name) = @_;
  521.   $_ = $'package{$name} || 'main';
  522.   require $name;
  523.   $'package{$name} = $_;
  524.   $'filename{$'package{$name}} = $name;
  525. }
  526.  
  527. sub 'property {
  528.   local($userno, $name) = @_;
  529.   local(@pkg, $list);
  530.   @pkg = split(/\_/, (caller())[0]);
  531.   if ($label) {
  532.     $list = $property{$userno, @pkg, $label, $name} || $property{$userno, @pkg, $name};
  533.   } else {
  534.     $list = $property{$userno, @pkg, $name};
  535.   }
  536.   if (defined($list)) {
  537.     if (wantarray) {
  538.       return &'array($list);
  539.     } else {
  540.       return (&'array($list))[0];
  541.     }
  542.   } else {
  543.     if (wantarray) {
  544.       return ();
  545.     } else {
  546.       return undef;
  547.     }
  548.   }
  549. }
  550.  
  551. sub 'expand {
  552.   local($name) = @_;
  553.   local($user, $rest, $home);
  554.   if ($name =~ /^\~([^\/]*)\/(.*)$/) {
  555.     ($user, $rest) = ($1, $2);
  556.     if ($user) {
  557.       $home = eval { (getpwnam($user))[7] } || '.';
  558.     } else {
  559.       $home = $ENV{'HOME'} || eval { (getpwuid($<))[7] } || '.';
  560.     }
  561.     return "$home/$rest";
  562.   } else {
  563.     return $name;
  564.   }
  565. }
  566.  
  567. sub 'date {
  568.   local($format) = @_;
  569.   local(@time, $char, $str, $i);
  570.   @time = localtime(time());
  571.   $str = '';
  572.   for ($i = 0; $i < length($format); $i++) {
  573.     $char = substr($format, $i, 1);
  574.     if ($char eq '%') {
  575.       $i++;
  576.       if ($i < length($format)) {
  577.         $char = substr($format, $i, 1);
  578.         if ($char eq '%') {
  579.           $str .= $char;
  580.         } elsif ($char eq 'a') {
  581.           $str .= ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$time[6]];
  582.         } elsif ($char eq 'b') {
  583.           $str .= ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$time[4]];
  584.         } elsif ($char eq 'd') {
  585.           $str .= sprintf('%02d', $time[3]);
  586.         } elsif ($char eq 'H') {
  587.           $str .= sprintf('%02d', $time[2]);
  588.         } elsif ($char eq 'I') {
  589.           $str .= sprintf('%02d', $time[2] % 12 + 1);
  590.         } elsif ($char eq 'j') {
  591.           $str .= sprintf('%3d', $time[7]);
  592.         } elsif ($char eq 'k') {
  593.           $str .= sprintf('%2d', $time[2]);
  594.         } elsif ($char eq 'l') {
  595.           $str .= sprintf('%2d', $time[2] % 12 + 1);
  596.         } elsif ($char eq 'M') {
  597.           $str .= sprintf('%02d', $time[1]);
  598.         } elsif ($char eq 'm') {
  599.           $str .= sprintf('%02d', $time[4] + 1);
  600.         } elsif ($char eq 'S') {
  601.           $str .= sprintf('%02d', $time[0]);
  602.         } elsif ($char eq 'w') {
  603.           $str .= sprintf('%d', $time[6]);
  604.         } elsif ($char eq 'Y') {
  605.           $str .= sprintf('%d', $time[5] + 1900);
  606.         } elsif ($char eq 'y') {
  607.           $str .= sprintf('%02d', $time[5]);
  608.         }
  609.       } else {
  610.         $str .= $char;
  611.       }
  612.     } else {
  613.       $str .= $char;
  614.     }
  615.   }
  616.   return $str;
  617. }
  618.  
  619. sub 'real {
  620.   local($name) = @_;
  621.   if ($name =~ /^\%(.*)$/) {
  622.     return "\#$1\:$ALIAS";
  623.   } else {
  624.     return $name;
  625.   }
  626. }
  627.  
  628. sub 'alias {
  629.   local($name) = @_;
  630.   if ($name =~ /^\#(.*)\:(.*)$/ && "\L$2\E" eq "\L$ALIAS\E") {
  631.     return "\%$1";
  632.   } else {
  633.     return $name;
  634.   }
  635. }
  636.  
  637. sub 'add {
  638.   local($list, @items) = @_;
  639.   $list = $'NIL unless $list;
  640.   foreach $item (@items) {
  641.     next if &'exist($list, $item);
  642.     $list = $list . $item . $'NIL;
  643.   }
  644.   $list = '' if $list eq $'NIL;
  645.   return $list;
  646. }
  647.  
  648. sub 'remove {
  649.   local($list, @items) = @_;
  650.   local($idx);
  651.   $list = $'NIL unless $list;
  652.   foreach $item (@items) {
  653.     $idx = index("\L$list\E", $'NIL . "\L$item\E" . $'NIL);
  654.     next if $idx == -1;
  655.     substr($list, $idx, length($'NIL . $item . $'NIL)) = $'NIL;
  656.   }
  657.   $list = '' if $list eq $'NIL;
  658.   return $list;
  659. }
  660.  
  661. sub 'change {
  662.   local($list, @items) = @_;
  663.   local($old, $new, $idx, $i);
  664.   $list = $'NIL unless $list;
  665.   for ($i = 0; $i < scalar(@items) / 2; $i++) {
  666.     ($old, $new) = @items[$i * 2, $i * 2 + 1];
  667.     next if ($idx = index("\L$list\E", $'NIL . "\L$old\E" . $'NIL)) == -1;
  668.     substr($list, $idx, length($'NIL . $old . $'NIL)) = $'NIL . $new . $'NIL;
  669.   }
  670.   $list = '' if $list eq $'NIL;
  671.   return $list;
  672. }
  673.  
  674. sub 'exist {
  675.   local($list, @items) = @_;
  676.   return 0 unless $list;
  677.   foreach $item (@items) {
  678.     return 1 if index("\L$list\E", $'NIL . "\L$item\E" . $'NIL) != -1;
  679.   }
  680.   return 0;
  681. }
  682.  
  683. sub 'list {
  684.   local(@array) = @_;
  685.   local($list);
  686.   if (scalar(@array)) {
  687.     $list = $'NIL . join($'NIL, @array) . $'NIL;
  688.   } else {
  689.     $list = '';
  690.   }
  691.   return $list;
  692. }
  693.  
  694. sub 'array {
  695.   local($list) = @_;
  696.   $list = $'NIL unless $list;
  697.   return () if $list eq $'NIL;
  698.   $list = substr($list, 1, length($list) - 2);
  699.   return split(/$'NIL/, $list);
  700. }
  701.  
  702. sub 'euc_jis {
  703.   local($euc) = @_;
  704.   local($jis, $kanji, $c, $n, $i);
  705.   $kanji = 0;
  706.   $jis = '';
  707.   for ($i = 0; $i < length($euc); $i++) {
  708.     $c = substr($euc, $i, 1);
  709.     $n = unpack('C', $c);
  710.     if ($n >= 0xa1) {
  711.       if ($kanji != 1) {
  712.         $jis .= "\e\$B";
  713.         $kanji = 1;
  714.       }
  715.       $jis .= pack('C', $n & 0x7f);
  716.       $i++;
  717.       $jis .= pack('C', unpack('C', substr($euc, $i, 1)) & 0x7f);
  718.     } elsif ($n == 0x8e) {
  719.       if ($kanji != 2) {
  720.         $jis .= "\e(I";
  721.         $kanji = 2;
  722.       }
  723.       $i++;
  724.       $jis .= pack('C', unpack('C', substr($euc, $i, 1)) & 0x7f);
  725.     } else {
  726.       if ($kanji != 0) {
  727.         $jis .= "\e\(B";
  728.         $kanji = 0;
  729.       }
  730.       $jis .= $c;
  731.     }
  732.   }
  733.   $jis .= "\e\(B" if $kanji != 0;
  734.   return $jis;
  735. }
  736.  
  737. sub 'euc_sjis {
  738.   local($euc) = @_;
  739.   local($sjis, $c, $n1, $n2, $i);
  740.   $sjis = '';
  741.   for ($i = 0; $i < length($euc); $i++) {
  742.     $c = substr($euc, $i, 1);
  743.     $n1 = unpack('C', $c);
  744.     if ($n1 >= 0xa1) {
  745.       $i++;
  746.       $n2 = unpack('C', substr($euc, $i, 1));
  747.       if (($n1 & 0x01) == 0) {
  748.         $n2 -= 0x03;
  749.       } else {
  750.         $n2 -= 0x61;
  751.       }
  752.       $n2++ if $n2 >= 0x7f;
  753.       $n1 = ($n1 - 0xa1 >> 1) + 0x81;
  754.       $sjis .= pack('CC', $n1, $n2);
  755.     } elsif ($n1 == 0x8e) {
  756.       $i++;
  757.       $sjis .= substr($euc, $i, 1);
  758.     } else {
  759.       $sjis .= $c;
  760.     }
  761.   }
  762.   return $sjis;
  763. }
  764.  
  765. sub 'jis_euc {
  766.   local($jis) = @_;
  767.   local($euc, $kanji, $i);
  768.   $jis = &'jis_jis($jis);
  769.   $kanji = 0;
  770.   $euc = '';
  771.   for ($i = 0; $i < length($jis); $i++) {
  772.     if (substr($jis, $i, 3) eq "\e\(B") {
  773.       $kanji = 0;
  774.       $i += 2;
  775.       next;
  776.     } elsif (substr($jis, $i, 3) eq "\e\$B") {
  777.       $kanji = 1;
  778.       $i += 2;
  779.       next;
  780.     } elsif (substr($jis, $i, 3) eq "\e\(I") {
  781.       $kanji = 2;
  782.       $i += 2;
  783.       next;
  784.     }
  785.     if ($kanji == 0) {
  786.       $euc .= substr($jis, $i, 1);
  787.     } elsif ($kanji == 1) {
  788.       $euc .= pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
  789.       $i++;
  790.       $euc .= pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
  791.     } else {
  792.       $euc .= "\x8e" . pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
  793.     }
  794.   }
  795.   return $euc;
  796. }
  797.  
  798. sub 'jis_jis {
  799.   local($jis) = @_;
  800.   $jis =~ s/\e\$\@/\e\$B/g;
  801.   $jis =~ s/\e\(J/\e\(B/g;
  802.   $jis =~ s/\cN/\e\(I/g;
  803.   $jis =~ s/\cO/\e\(B/g;
  804.   return $jis;
  805. }
  806.  
  807. sub 'jis_sjis {
  808.   local($jis) = @_;
  809.   local($sjis, $kanji, $n1, $n2, $i);
  810.   $jis = &'jis_jis($jis);
  811.   $kanji = 0;
  812.   $sjis = '';
  813.   for ($i = 0; $i < length($jis); $i++) {
  814.     if (substr($jis, $i, 3) eq "\e\(B") {
  815.       $kanji = 0;
  816.       $i += 2;
  817.       next;
  818.     } elsif (substr($jis, $i, 3) eq "\e\$B") {
  819.       $kanji = 1;
  820.       $i += 2;
  821.       next;
  822.     } elsif (substr($jis, $i, 3) eq "\e\(I") {
  823.       $kanji = 2;
  824.       $i += 2;
  825.       next;
  826.     }
  827.     if ($kanji == 0) {
  828.       $sjis .= substr($jis, $i, 1);
  829.     } elsif ($kanji == 1) {
  830.       $n1 = unpack('C', substr($jis, $i, 1));
  831.       $i++;
  832.       $n2 = unpack('C', substr($jis, $i, 1));
  833.       if (($n1 & 0x01) == 0) {
  834.         $n2 += 0x7d;
  835.       } else {
  836.         $n2 += 0x1f;
  837.       }
  838.       $n2++ if $n2 >= 0x7f;
  839.       $n1 = ($n1 - 0x21 >> 1) + 0x81;
  840.       $sjis .= pack('CC', $n1, $n2);
  841.     } else {
  842.       $sjis .= pack('C', unpack('C', substr($jis, $i, 1)) | 0x80);
  843.     }
  844.   }
  845.   return $sjis;
  846. }
  847.  
  848. sub 'sjis_euc {
  849.   local($sjis) = @_;
  850.   local($euc, $c, $n1, $n2, $i);
  851.   $euc = '';
  852.   for ($i = 0; $i < length($sjis); $i++) {
  853.     $c = substr($sjis, $i, 1);
  854.     $n1 = unpack('C', $c);
  855.     if ($n1 >= 0xa0 && $n1 <= 0xdf) {
  856.       $euc .= "\x8e$c";
  857.     } elsif ($n1 >= 0x81) {
  858.       $i++;
  859.       $n2 = unpack('C', substr($sjis, $i, 1));
  860.       $n2-- if $n2 > 0x7f;
  861.       if ($n2 >= 0x9e) {
  862.         $n1 = (($n1 - 0x81) << 1) + 0xa2;
  863.         $n2 += 0x03;
  864.       } else {
  865.         $n1 = (($n1 - 0x81) << 1) + 0xa1;
  866.         $n2 += 0x61
  867.       }
  868.       $euc .= pack('CC', $n1, $n2);
  869.     } else {
  870.       $euc .= $c;
  871.     }
  872.   }
  873.   return $euc;
  874. }
  875.  
  876. sub 'sjis_jis {
  877.   local($sjis) = @_;
  878.   local($jis, $kanji, $c, $n1, $n2, $i);
  879.   $kanji = 0;
  880.   $jis = '';
  881.   for ($i = 0; $i < length($sjis); $i++) {
  882.     $c = substr($sjis, $i, 1);
  883.     $n1 = unpack('C', $c);
  884.     if ($n1 >= 0xa0 && $n1 <= 0xdf) {
  885.       if ($kanji != 2) {
  886.         $jis .= "\e(I";
  887.         $kanji = 2;
  888.       }
  889.       $jis .= pack('C', $n1 & 0x7f);
  890.     } elsif ($n1 >= 0x81) {
  891.       if ($kanji != 1) {
  892.         $jis .= "\e\$B";
  893.         $kanji = 1;
  894.       }
  895.       $i++;
  896.       $n2 = unpack('C', substr($sjis, $i, 1));
  897.       $n2-- if $n2 > 0x7f;
  898.       if ($n2 >= 0x9e) {
  899.         $n1 = (($n1 - 0x81) << 1) + 0x22;
  900.         $n2 -= 0x7d;
  901.       } else {
  902.         $n1 = (($n1 - 0x81) << 1) + 0x21;
  903.         $n2 -= 0x1f;
  904.       }
  905.       $jis .= pack('CC', $n1, $n2);
  906.     } else {
  907.       if ($kanji != 0) {
  908.         $jis .= "\e\(B";
  909.         $kanji = 0;
  910.       }
  911.       $jis .= $c;
  912.     }
  913.   }
  914.   $jis .= "\e\(B" if $kanji != 0;
  915.   return $jis;
  916. }
  917.  
  918. sub 'connect {
  919.   local($host, $port) = @_;
  920.   local($serverno, $socket, $addr);
  921.   if ($host =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
  922.     $addr = pack('C4', $1, $2, $3, $4);
  923.   } elsif ($host =~ /^\d+$/) {
  924.     $addr = pack('N', $host);
  925.   } else {
  926.     $addr = (gethostbyname($host))[4];
  927.   }
  928.   return 0 unless $addr;
  929.   $socket = '\'S' . ++$handle;
  930.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  931.   connect($socket, pack($SOCKADDR, $AF_INET, $port, $addr)) || return 0;
  932.   $serverno = fileno($socket);
  933.   vec($'rin, $serverno, 1) = 1;
  934.   $'socket[$serverno] = $socket;
  935.   select((select($socket), $| = 1)[0]);
  936.   $'access[$serverno] = time();
  937.   return $serverno;
  938. }
  939.  
  940. sub 'listen {
  941.   local($port, $count) = @_;
  942.   local($listenno, $socket);
  943.   $socket = '\'L' . ++$handle;
  944.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  945.   if (defined($SOL_SOCKET)) {
  946.     setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1)) if defined($SO_REUSEADDR);
  947.     setsockopt($socket, $SOL_SOCKET, $SO_KEEPALIVE, pack('l', 1)) if defined($SO_KEEPALIVE);
  948.   }
  949.   bind($socket, pack($SOCKADDR, $AF_INET, $port, $INADDR_ANY)) || return 0;
  950.   listen($socket, $count || $SOMAXCONN) || return 0;
  951.   $listenno = fileno($socket);
  952.   vec($'rin, $listenno, 1) = 1;
  953.   $'socket[$listenno] = $socket;
  954.   select((select($socket), $| = 1)[0]);
  955.   return $listenno;
  956. }
  957.  
  958. sub 'accept {
  959.   local($listenno) = @_;
  960.   local($clientno, $socket);
  961.   $socket = '\'C' . ++$handle;
  962.   accept($socket, $'socket[$listenno]) || return 0;
  963.   $clientno = fileno($socket);
  964.   vec($'rin, $clientno, 1) = 1;
  965.   $'socket[$clientno] = $socket;
  966.   select((select($socket), $| = 1)[0]);
  967.   $'access[$clientno] = time();
  968.   return $clientno;
  969. }
  970.  
  971. sub 'close {
  972.   local($no) = @_;
  973.   close($'socket[$no]);
  974.   vec($'rin, $no, 1) = 0;
  975. }
  976.  
  977. sub 's_connect {
  978.   local($userno) = @_;
  979.   local($server, $host, $name, $port, $pass, $serverno, $no, $cmd);
  980.   return if $'server[$userno];
  981.   foreach $server (&'property($userno, 'server')) {
  982.     next if &'exist($errorlist[$userno], $server);
  983.     ($host, $pass) = (split(/\s+/, $server), '');
  984.     ($name, $port) = (split(/\:/, $host), '');
  985.     $serverno = &'connect($name, $port || $IRCPORT);
  986.     next unless $serverno;
  987.     $'serverlist = &'add($'serverlist, $serverno);
  988.     $'avail[$serverno] = 0;
  989.     $'userno[$serverno] = $userno;
  990.     $'server[$userno] = $serverno;
  991.     $rbuf[$serverno] = '';
  992.     foreach $key (keys(%wbuf)) {
  993.       ($no, $cmd) = split(/$;/, $key, 2);
  994.       next unless $no == $serverno;
  995.       delete $wbuf{$key};
  996.     }
  997.     $sequence[$serverno] = '';
  998.     $pass[$serverno] = $pass;
  999.     $serverhost[$serverno] = $server;
  1000.     &s_init($serverno);
  1001.     last;
  1002.   }
  1003.   $'servername[$userno] = $NAME;
  1004.   $errorlist[$userno] = '' unless $host;
  1005. }
  1006.  
  1007. sub 's_close {
  1008.   local($userno) = @_;
  1009.   local($serverno, $sub, $label, $no, $cmd);
  1010.   $serverno = $'server[$userno];
  1011.   &'s_flush($serverno);
  1012.   &'close($serverno);
  1013.   $'serverlist = &'remove($'serverlist, $serverno);
  1014.   if ($'avail[$serverno]) {
  1015.     foreach $module (reverse(&'array($'modulelist[$userno]))) {
  1016.       $sub = "${module}\'server_close";
  1017.       next unless defined(&$sub);
  1018.       if ($'labellist{$module}) {
  1019.         foreach $label (&'array($'labellist{$module})) {
  1020.          &$sub($serverno);
  1021.         }
  1022.       } else {
  1023.         &$sub($serverno);
  1024.       }
  1025.     }
  1026.     $'avail[$serverno] = 0;
  1027.   }
  1028.   $'userno[$serverno] = undef;
  1029.   $'server[$userno] = undef;
  1030.   $'servername[$userno] = $NAME;
  1031. }
  1032.  
  1033. sub c_listen {
  1034.   local($userno) = @_;
  1035.   local($listenno, $host, $pass, $name, $port, $i, $uselist);
  1036.   foreach $client (&'property($userno, 'client')) {
  1037.     ($host, $pass) = (split(/\s+/, $client), '');
  1038.     ($name, $port) = split(/\:/, $host);
  1039.     $port = $IRCPORT unless $port;
  1040.     next if &'exist($portlist, $port);
  1041.     $listenno = &'listen($port, $SOMAXCONN);
  1042.     next unless $listenno;
  1043.     $'listenlist = &'add($'listenlist, $listenno);
  1044.     $portlist = &'add($portlist, $port);
  1045.   }
  1046.   for ($i = 0; $i < scalar(@'username); $i++) {
  1047.     foreach $client (&'property($i, 'client')) {
  1048.       $host = (split(/\s+/, $client))[0];
  1049.       $port = (split(/\:/, $host))[1];
  1050.       $uselist = &'add($uselist, $port || $IRCPORT);
  1051.     }
  1052.   }
  1053.   foreach $lno (&'array($'listenlist)) {
  1054.     $port = (unpack($SOCKADDR, getsockname($'socket[$lno])))[1];
  1055.     next if &'exist($uselist, $port);
  1056.     &'close($lno);
  1057.     $'listenlist = &'remove($'listenlist, $lno);
  1058.     $portlist = &'remove($portlist, $port);
  1059.   }
  1060. }
  1061.  
  1062. sub c_accept {
  1063.   local($listenno) = @_;
  1064.   local($clientno, $addr, $name, $port, $host, $pass, $regex, $i);
  1065.   $clientno = &'accept($listenno);
  1066.   return unless $clientno;
  1067.   $port = (unpack($SOCKADDR, getsockname($'socket[$clientno])))[1];
  1068.   $addr = (unpack($SOCKADDR, getpeername($'socket[$clientno])))[2];
  1069.   $name = (gethostbyaddr($addr, $AF_INET) || '')[0];
  1070.   for ($i = 0; $i < scalar(@'username); $i++) {
  1071.     foreach $client (&'property($i, 'client')) {
  1072.       ($host, $pass) = (split(/\s+/, $client), '');
  1073.       next unless $port == ((split(/\:/, $host))[1] || $IRCPORT);
  1074.       $regex = &'regex((split(/\:/, $host))[0]);
  1075.       next unless $name =~ /$regex/i;
  1076.       $'clientlist = &'add($'clientlist, $clientno);
  1077.       $'avail[$clientno] = 0;
  1078.       $'nick[$clientno] = '';
  1079.       $'user[$clientno] = '';
  1080.       $rbuf[$clientno] = '';
  1081.       foreach $key (keys(%wbuf)) {
  1082.         ($no, $cmd) = split(/$;/, $key, 2);
  1083.         next unless $no == $clientno;
  1084.         delete $wbuf{$key};
  1085.       }
  1086.       $sequence[$clientno] = '';
  1087.       $pass[$clientno] = '';
  1088.       return;
  1089.     }
  1090.   }
  1091.   &'close($clientno);
  1092. }
  1093.  
  1094. sub 'c_close {
  1095.   local($clientno) = @_;
  1096.   local($sub, $label, $no, $cmd);
  1097.   &'c_flush($clientno);
  1098.   &'close($clientno);
  1099.   $'clientlist = &'remove($'clientlist, $clientno);
  1100.   if ($'avail[$clientno]) {
  1101.     foreach $module (reverse(&'array($'modulelist[$'userno[$clientno]]))) {
  1102.       $sub = "${module}\'client_close";
  1103.       next unless defined(&$sub);
  1104.       if ($'labellist{$module}) {
  1105.         foreach $label (&'array($'labellist{$module})) {
  1106.           &$sub($clientno);
  1107.         }
  1108.       } else {
  1109.         &$sub($clientno);
  1110.       }
  1111.     }
  1112.     $'avail[$clientno] = 0;
  1113.   }
  1114.   $'userno[$clientno] = undef;
  1115. }
  1116.  
  1117. sub s_init {
  1118.   local($serverno) = @_;
  1119.   local($userno, $nick, $user, $name);
  1120.   $userno = $'userno[$serverno];
  1121.   &'s_print($serverno, '', 'PASS', $pass[$serverno]) if $pass[$serverno];
  1122.   $nick = $'nickname[$userno] || &'property($userno, 'nick') || getlogin() || eval { (getpwuid($<))[0] } || "$NAME-user";
  1123.   &'s_print($serverno, '', 'NICK', (split(/\,/, $nick))[0]);
  1124.   $user = &'property($userno, 'user') || getlogin() || eval { (getpwuid($<))[0] } || "$NAME-user";
  1125.   $name = &'property($userno, 'name');
  1126.   $name = eval { ((split(/\,/, (getpwuid($<))[6]))[0]) } || $user unless defined($name);
  1127.   &'s_print($serverno, '', 'USER', $user, '*', '*', $name);
  1128. }
  1129.  
  1130. sub c_init {
  1131.   local($clientno) = @_;
  1132.   local($addr, $name, $port, $host, $pass, $regex, $sub, $label, $i);
  1133.   $port = (unpack($SOCKADDR, getsockname($'socket[$clientno])))[1];
  1134.   $addr = (unpack($SOCKADDR, getpeername($'socket[$clientno])))[2];
  1135.   $name = (gethostbyaddr($addr, $AF_INET) || '')[0];
  1136.   for ($i = 0; $i < scalar(@'username); $i++) {
  1137.     foreach $client (&'property($i, 'client')) {
  1138.       ($host, $pass) = (split(/\s+/, $client), '');
  1139.       next unless $port == ((split(/\:/, $host))[1] || $IRCPORT);
  1140.       $regex = &'regex((split(/\:/, $host))[0]);
  1141.       next unless $name =~ /$regex/i;
  1142.       next if $pass && $pass ne $pass[$clientno];
  1143.       $'userno[$clientno] = $i;
  1144.       $'avail[$clientno] = 1;
  1145.       &'c_print($clientno, $'servername[$'userno[$clientno]], '001', $'nick[$clientno], 'Welcome to the Internet Relay Network ' . &'user($clientno));
  1146.       foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  1147.         $sub = "${module}\'client_open";
  1148.         next unless defined(&$sub);
  1149.         if ($'labellist{$module}) {
  1150.           foreach $label (&'array($'labellist{$module})) {
  1151.             &$sub($clientno);
  1152.           }
  1153.         } else {
  1154.           &$sub($clientno);
  1155.         }
  1156.       }
  1157.       return;
  1158.     }
  1159.   }
  1160.   &'c_print($clientno, $NAME, '464', $'nick[$clientno], 'Password incorrect');
  1161.   &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . ' (Bad Password)');
  1162.   &'c_close($clientno);
  1163. }
  1164.  
  1165. sub cn_nick {
  1166.   local($clientno, $prefix, $cmd, $nick) = @_;
  1167.   $'nick[$clientno] = $nick;
  1168.   &c_init($clientno) if $'user[$clientno];
  1169. }
  1170.  
  1171. sub cn_pass {
  1172.   local($clientno, $prefix, $cmd, $pass) = @_;
  1173.   $pass[$clientno] = $pass;
  1174. }
  1175.  
  1176. sub cn_ping {
  1177.   local($clientno, $prefix, $cmd, @params) = @_;
  1178.   &'c_print($clientno, &'user($clientno), '451', 'PING', 'You have not registered');
  1179. }
  1180.  
  1181. sub cn_quit {
  1182.   local($clientno, $prefix, $cmd, $msg) = @_;
  1183.   $msg = 'I Quit' unless $msg;
  1184.   &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . " ($msg)");
  1185.   &'c_close($clientno);
  1186. }
  1187.  
  1188. sub cn_user {
  1189.   local($clientno, $prefix, $cmd, @params) = @_;
  1190.   if (defined(@params) && scalar(@params) >= 4) {
  1191.     $'user[$clientno] = $params[0];
  1192.     &c_init($clientno) if $'nick[$clientno];
  1193.   } else {
  1194.     &'c_print($clientno, $NAME, '461', 'Not enough parameters');
  1195.   }
  1196. }
  1197.  
  1198. sub sn_error {
  1199.   local($serverno, $prefix, $cmd, @params) = @_;
  1200.   $errorlist[$'userno[$serverno]] = &'add($errorlist[$'userno[$serverno]], $serverhost[$serverno]);
  1201. }
  1202.  
  1203. sub sn_ping {
  1204.   local($serverno, $prefix, $cmd, @params) = @_;
  1205.   &'s_print($serverno, '', 'PONG', @params);
  1206. }
  1207.  
  1208. sub sn_001 {
  1209.   local($serverno, $prefix, $cmd, $nick, $msg) = @_;
  1210.   local($userno, $sub, $label);
  1211.   $userno = $'userno[$serverno];
  1212.   $'avail[$serverno] = 1;
  1213.   $'nick[$serverno] = $nick;
  1214.   $'nickname[$userno] = $nick;
  1215.   $'servername[$userno] = $prefix;
  1216.   $errorlist[$userno] = '';
  1217.   foreach $module (&'array($'modulelist[$userno])) {
  1218.     $sub = "${module}\'server_open";
  1219.     next unless defined(&$sub);
  1220.     if ($'labellist{$module}) {
  1221.       foreach $label (&'array($'labellist{$module})) {
  1222.         &$sub($serverno);
  1223.       }
  1224.     } else {
  1225.       &$sub($serverno);
  1226.     }
  1227.   }
  1228. }
  1229.  
  1230. sub sn_433 {
  1231.   local($serverno, $prefix, $cmd, $nick, $newnick, $msg) = @_;
  1232.   &anothernick($serverno, $newnick);
  1233. }
  1234.  
  1235. sub sn_437 {
  1236.   local($serverno, $prefix, $cmd, $nick, $newnick, $msg) = @_;
  1237.   &anothernick($serverno, $newnick);
  1238. }
  1239.  
  1240. sub sn_451 {
  1241.   local($serverno, $prefix, $cmd, @params) = @_;
  1242. }
  1243.  
  1244. sub anothernick {
  1245.   local($serverno, $newnick) = @_;
  1246.   local(@nickentry, $list, $user);
  1247.   foreach $nick (&'property($'userno[$serverno], 'nick')) {
  1248.     $list = &'add($list, split(/\,/, $nick));
  1249.   }
  1250.   $list = &'add($list, getlogin() || eval { (getpwuid($<))[0] });
  1251.   $user = substr(getlogin() || eval { (getpwuid($<))[0] } || "$NAME-user", 0, 8);
  1252.   $list = &'add($list, "${user}_", "_${user}", "${user}-", "-${user}");
  1253.   if (&'exist($list, $newnick)) {
  1254.     @nickentry = &'array($list);
  1255.     while ($nickentry[0] ne $newnick) {
  1256.       push(@nickentry, shift(@nickentry));
  1257.     }
  1258.     push(@nickentry, shift(@nickentry));
  1259.   }
  1260.   &'s_print($serverno, '', 'NICK', $nickentry[0]);
  1261. }
  1262.  
  1263. sub main_loop {
  1264.   local($userno) = @_;
  1265.   &'s_connect($userno);
  1266.   &c_listen($userno);
  1267. }
  1268.  
  1269. sub client_open {
  1270.   local($clientno) = @_;
  1271.   local($userno, $serverno);
  1272.   $userno = $'userno[$clientno];
  1273.   $serverno = $'server[$userno];
  1274.   &'c_print($clientno, &'user($clientno), 'NICK', $'nick[$serverno]) if ($serverno && $'avail[$serverno] && $'nick[$clientno] ne $'nick[$serverno]);
  1275.   &'c_print($clientno, $'servername[$userno], '002', $'nick[$clientno], &'array($msg002[$userno])) if $msg002[$userno];
  1276.   &'c_print($clientno, $'servername[$userno], '003', $'nick[$clientno], &'array($msg003[$userno])) if $msg003[$userno];
  1277.   &'c_print($clientno, $'servername[$userno], '004', $'nick[$clientno], &'array($msg004[$userno])) if $msg004[$userno];
  1278.   foreach $chan (&'array($'channellist[$userno])) {
  1279.     &'c_print($clientno, &'user($clientno), 'JOIN', $chan);
  1280.     &'c_print($clientno, $'servername[$userno], '332', $'nick[$clientno], $chan, $'topic{$userno, $chan}) if $'topic{$userno, $chan};
  1281.     &'c_print($clientno, $'servername[$userno], '353', $'nick[$clientno], '=', $chan, join(' ', reverse(&'array($'nameslist{$userno, $chan}))));
  1282.     &'c_print($clientno, $'servername[$userno], '366', $'nick[$clientno], $chan, 'End of /NAMES list.');
  1283.   }
  1284. }
  1285.  
  1286. sub server_open {
  1287.   local($serverno) = @_;
  1288.   foreach $cno (&'array($'clientlist)) {
  1289.     next unless $'avail[$cno];
  1290.     next unless $'userno[$cno] == $'userno[$serverno];
  1291.     next unless $'nick[$cno] ne $'nick[$serverno];
  1292.     &'c_print($cno, &'user($cno), 'NICK', $'nick[$serverno]);
  1293.   }
  1294. }
  1295.  
  1296. sub server_close {
  1297.   local($serverno) = @_;
  1298.   local($userno);
  1299.   $userno = $'userno[$serverno];
  1300.   foreach $cno (&'array($'clientlist)) {
  1301.     next unless $'avail[$cno];
  1302.     next unless $'userno[$cno] == $userno;
  1303.     &'c_print($cno, '', 'NOTICE', $'nick[$cno], "*** Server $'servername[$userno] closed the connection");
  1304.     foreach $chan (&'array($'channellist[$userno])) {
  1305.       &'c_print($cno, &'user($cno), 'PART', $chan);
  1306.     }
  1307.   }
  1308.   $'channellist[$userno] = '';
  1309.   $msg002[$userno] = '';
  1310.   $msg003[$userno] = '';
  1311.   $msg004[$userno] = '';
  1312. }
  1313.  
  1314. sub cs_exit {
  1315.   local($clientno, $prefix, $cmd, $msg) = @_;
  1316.   foreach $sno (&'array($'serverlist)) {
  1317.     &'s_print($sno, '', 'QUIT', $msg || $NAME);
  1318.     &'s_close($'userno[$sno]);
  1319.   }
  1320.   $msg = 'I Quit' unless $msg;
  1321.   foreach $cno (&'array($'clientlist)) {
  1322.     &'c_print($cno, '', 'ERROR', 'Closing Link: ' . &'user($cno) . " ($msg)");
  1323.     &'c_close($cno);
  1324.   }
  1325.   foreach $lno (&'array($'listenlist)) {
  1326.     &'close($lno);
  1327.   }
  1328.   exit(0);
  1329. }
  1330.  
  1331. sub cs_quit {
  1332.   local($clientno, $prefix, $cmd, $msg) = @_;
  1333.   $msg = 'I Quit' unless $msg;
  1334.   &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . " ($msg)");
  1335.   &'c_close($clientno);
  1336.   return ();
  1337. }
  1338.  
  1339. sub cp_nick {
  1340.   local($clientno, $prefix, $cmd, $newnick) = @_;
  1341.   $'nick[$clientno] = $newnick if &'prefix($prefix) eq $'nick[$clientno];
  1342.   return ($prefix, $cmd, $newnick);
  1343. }
  1344.  
  1345. sub ss_join {
  1346.   local($serverno, $prefix, $cmd, $chan) = @_;
  1347.   local($userno, $nick, $name, $mode);
  1348.   $userno = $'userno[$serverno];
  1349.   $nick = &'prefix($prefix);
  1350.   ($name, $mode) = (split(/\cG/, $chan), '');
  1351.   if ($nick eq $'nick[$serverno]) {
  1352.     $'channellist[$userno] = &'add($'channellist[$userno], $name);
  1353.     $'nameslist{$userno, $name} = '';
  1354.   } else {
  1355.     if (index($mode, 'o') != -1) {
  1356.       $'nameslist{$userno, $name} = &'add($'nameslist{$userno, $name}, "\@$nick");
  1357.     } elsif (index($mode, 'v') != -1) {
  1358.       $'nameslist{$userno, $name} = &'add($'nameslist{$userno, $name}, "\+$nick");
  1359.     } else {
  1360.       $'nameslist{$userno, $name} = &'add($'nameslist{$userno, $name}, $nick);
  1361.     }
  1362.   }
  1363.   return ($prefix, $cmd, $chan);
  1364. }
  1365.  
  1366. sub ss_kick {
  1367.   local($serverno, $prefix, $cmd, $chan, $who, $msg) = @_;
  1368.   local($userno);
  1369.   $userno = $'userno[$serverno];
  1370.   if ($who eq $'nick[$serverno]) {
  1371.     $'channellist[$userno] = &'remove($'channellist[$userno], $chan);
  1372.     delete $'nameslist{$userno, $chan};
  1373.   } else {
  1374.     $'nameslist{$userno, $chan} = &'remove($'nameslist{$userno, $chan}, $who, "+$who", "\@$who");
  1375.   }
  1376.   return ($prefix, $cmd, $chan, $who, $msg);
  1377. }
  1378.  
  1379. sub ss_mode {
  1380.   local($serverno, $prefix, $cmd, @params) = @_;
  1381.   local($chan, $mode, @modes, $userno, $char, $flag, $name, $i);
  1382.   ($chan, $mode, @modes) = @params;
  1383.   $userno = $'userno[$serverno];
  1384.   for ($i = 0; $i < length($mode); $i++) {
  1385.     $char = substr($mode, $i, 1);
  1386.     if ($char eq '+' || $char eq '-') {
  1387.       $flag = $char;
  1388.     } elsif ($char eq 'b') {
  1389.       shift(@modes);
  1390.     } elsif ($char eq 'k') {
  1391.       if ($flag eq '+') {
  1392.         $'channelmode{$userno, $chan, $char} = shift(@modes);
  1393.       } else {
  1394.         shift(@modes);
  1395.         delete $'channelmode{$userno, $chan, $char};
  1396.       }
  1397.     } elsif ($char eq 'l') {
  1398.       if ($flag eq '+') {
  1399.         $'channelmode{$userno, $chan, $char} = shift(@modes);
  1400.       } else {
  1401.         delete $'channelmode{$userno, $chan, $char};
  1402.       }
  1403.     } elsif ($char eq 'o') {
  1404.       $name = shift(@modes);
  1405.       if ($flag eq '+') {
  1406.         $'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, $name, "\@$name", "+$name", "\@$name");
  1407.       } elsif ($flag eq '-') {
  1408.         $'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, "\@$name", $name);
  1409.       }
  1410.     } elsif ($char eq 'v') {
  1411.       $name = shift(@modes);
  1412.       if ($flag eq '+') {
  1413.         $'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, $name, "+$name");
  1414.       } elsif ($flag eq '-') {
  1415.         $'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, "+$name", $name);
  1416.       }
  1417.     } else {
  1418.       if ($flag eq '+') {
  1419.         $'channelmode{$userno, $chan, $char} = 1;
  1420.       } else {
  1421.         delete $'channelmode{$userno, $chan, $char};
  1422.       }        
  1423.     }
  1424.   }
  1425.   return ($prefix, $cmd, @params);
  1426. }
  1427.  
  1428. sub ss_nick {
  1429.   local($serverno, $prefix, $cmd, $newnick) = @_;
  1430.   local($userno, $nick);
  1431.   $userno = $'userno[$serverno];
  1432.   $nick = &'prefix($prefix);
  1433.   if ($nick eq $'nick[$serverno]) {
  1434.     $'nick[$serverno] = $newnick;
  1435.     $'nickname[$userno] = $newnick;
  1436.   }
  1437.   foreach $chan (&'array($'channellist[$userno])) {
  1438.     $'nameslist{$userno, $chan} = &'change($'nameslist{$userno, $chan}, $nick, $newnick, "+$nick", "+$newnick", "\@$nick", "\@$newnick");
  1439.   }
  1440.   return ($prefix, $cmd, $newnick);
  1441. }
  1442.  
  1443. sub ss_part {
  1444.   local($serverno, $prefix, $cmd, $chan, $msg) = @_;
  1445.   local($userno, $nick);
  1446.   $userno = $'userno[$serverno];
  1447.   $nick = &'prefix($prefix);
  1448.   if ($nick eq $'nick[$serverno]) {
  1449.     $'channellist[$userno] = &'remove($'channellist[$userno], $chan);
  1450.     delete $'nameslist{$userno, $chan};
  1451.   } else {
  1452.     $'nameslist{$userno, $chan} = &'remove($'nameslist{$userno, $chan}, $nick, "+$nick", "\@$nick");
  1453.   }
  1454.   return ($prefix, $cmd, $chan, $msg);
  1455. }
  1456.  
  1457. sub ss_ping {
  1458.   local($serverno, $prefix, $cmd, @params) = @_;
  1459.   &'s_print($serverno, '', 'PONG', @params);
  1460.   return ($prefix, $cmd, @params);
  1461. }
  1462.  
  1463. sub ss_quit {
  1464.   local($serverno, $prefix, $cmd, $msg) = @_;
  1465.   local($userno, $nick);
  1466.   $userno = $'userno[$serverno];
  1467.   $nick = &'prefix($prefix);
  1468.   foreach $chan (&'array($'channellist[$userno])) {
  1469.     $'nameslist{$userno, $chan} = &'remove($'nameslist{$userno, $chan}, $nick, "+$nick", "\@$nick");
  1470.   }
  1471.   return ($prefix, $cmd, $msg);
  1472. }
  1473.  
  1474. sub ss_topic {
  1475.   local($serverno, $prefix, $cmd, $chan, $topic) = @_;
  1476.   $'topic{$'userno[$serverno], $chan} = $topic;
  1477.   return ($prefix, $cmd, $chan, $topic);
  1478. }
  1479.  
  1480. sub ss_002 {
  1481.   local($serverno, $prefix, $cmd, $nick, @params) = @_;
  1482.   $msg002[$'userno[$serverno]] = &'list(@params);
  1483.   return ($prefix, $cmd, $nick, @params);
  1484. }
  1485.  
  1486. sub ss_003 {
  1487.   local($serverno, $prefix, $cmd, $nick, @params) = @_;
  1488.   $msg003[$'userno[$serverno]] = &'list(@params);
  1489.   return ($prefix, $cmd, $nick, @params);
  1490. }
  1491.  
  1492. sub ss_004 {
  1493.   local($serverno, $prefix, $cmd, $nick, @params) = @_;
  1494.   $msg004[$'userno[$serverno]] = &'list(@params);
  1495.   return ($prefix, $cmd, $nick, @params);
  1496. }
  1497.  
  1498. sub ss_332 {
  1499.   local($serverno, $prefix, $cmd, $nick, $chan, $topic) = @_;
  1500.   $'topic{$'userno[$serverno], $chan} = $topic;
  1501.   return ($prefix, $cmd, $nick, $chan, $topic);
  1502. }
  1503.  
  1504. sub ss_353 {
  1505.   local($serverno, $prefix, $cmd, @params) = @_;
  1506.   local($userno);
  1507.   $userno = $'userno[$serverno];
  1508.   $'nameslist{$userno, $params[2]} = &'add($'nameslist{$userno, $params[2]}, reverse(split(/\s+/, $params[3])));
  1509.   return ($prefix, $cmd, @params);
  1510. }
  1511.  
  1512. sub cs_privmsg {
  1513.   local($clientno, $prefix, $cmd, $chan, $msg) = @_;
  1514.   local($tmp, $ctmp, $rest, $ctcp, $list);
  1515.   return () unless $msg;
  1516.   $tmp = '';
  1517.   $ctmp = '';
  1518.   $rest = $msg;
  1519.   while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  1520.     $tmp .= $1;
  1521.     $ctmp .= $1;
  1522.     $ctcp = $2;
  1523.     $rest = $3;
  1524.     $tmp .= &cpc_scan($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1525.     $list = &'add($list, $ctcp);
  1526.   }
  1527.   $tmp .= $rest || '';
  1528.   $ctmp .= $rest || '';
  1529.   return () unless $tmp;
  1530.   foreach $cno (&'array($'clientlist)) {
  1531.     next unless $clientno != $cno;
  1532.     next unless $'avail[$cno];
  1533.     next unless $'userno[$clientno] == $'userno[$cno];
  1534.     &'c_print($cno, &'user($cno), $cmd, $chan, $ctmp);
  1535.   }
  1536.   return ($prefix, $cmd, $chan, $tmp);
  1537. }
  1538.  
  1539. sub cp_privmsg {
  1540.   local($clientno, $prefix, $cmd, $chan, $msg) = @_;
  1541.   local($tmp, $rest, $ctcp, $list);
  1542.   return () unless $msg;
  1543.   $tmp = '';
  1544.   $rest = $msg;
  1545.   while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  1546.     $tmp .= $1;
  1547.     $ctcp = $2;
  1548.     $rest = $3;
  1549.     $tmp .= &cpc_print($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1550.     $list = &'add($list, $ctcp);
  1551.   }
  1552.   $tmp .= $rest || '';
  1553.   return () unless $tmp;
  1554.   return ($prefix, $cmd, $chan, $tmp);
  1555. }
  1556.  
  1557. sub ss_privmsg {
  1558.   local($serverno, $prefix, $cmd, $chan, $msg) = @_;
  1559.   local($tmp, $rest, $ctcp, $list);
  1560.   return () unless $msg;
  1561.   $tmp = '';
  1562.   $rest = $msg;
  1563.   while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  1564.     $tmp .= $1;
  1565.     $ctcp = $2;
  1566.     $rest = $3;
  1567.     $tmp .= &cps_scan($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1568.     $list = &'add($list, $ctcp);
  1569.   }
  1570.   $tmp .= $rest || '';
  1571.   return () unless $tmp;
  1572.   return ($prefix, $cmd, $chan, $tmp);
  1573. }
  1574.  
  1575. sub sp_privmsg {
  1576.   local($serverno, $prefix, $cmd, $chan, $msg) = @_;
  1577.   local($tmp, $rest, $ctcp, $list);
  1578.   return () unless $msg;
  1579.   $tmp = '';
  1580.   $rest = $msg;
  1581.   while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  1582.     $tmp .= $1;
  1583.     $ctcp = $2;
  1584.     $rest = $3;
  1585.     $tmp .= &cps_print($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1586.     $list = &'add($list, $ctcp);
  1587.   }
  1588.   $tmp .= $rest || '';
  1589.   return () unless $tmp;
  1590.   return ($prefix, $cmd, $chan, $tmp);
  1591. }
  1592.  
  1593. sub cpc_scan {
  1594.   local($clientno, $prefix, $ctcp) = @_;
  1595.   local($cmd, $msg, $sub, $label);
  1596.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1597.   return '' unless $cmd;
  1598.   foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  1599.     $sub = "${module}\'cpcs_\L$cmd\E";
  1600.     next unless defined(&$sub);
  1601.     if ($'labellist{$module}) {
  1602.       foreach $label (&'array($'labellist{$module})) {
  1603.         ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1604.         last unless $cmd;
  1605.       }
  1606.     } else {
  1607.       ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1608.     }
  1609.     last unless $cmd;
  1610.   }
  1611.   return '' unless $cmd;
  1612.   return "\cA$cmd $msg\cA";
  1613. }
  1614.  
  1615. sub cpc_print {
  1616.   local($clientno, $prefix, $ctcp) = @_;
  1617.   local($cmd, $msg, $sub, $label);
  1618.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1619.   return '' unless $cmd;
  1620.   foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  1621.     $sub = "${module}\'cpcp_\L$cmd\E";
  1622.     next unless defined(&$sub);
  1623.     if ($'labellist{$module}) {
  1624.       foreach $label (&'array($'labellist{$module})) {
  1625.         ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1626.         last unless $cmd;
  1627.       }
  1628.     } else {
  1629.       ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1630.     }
  1631.     last unless $cmd;
  1632.   }
  1633.   return '' unless $cmd;
  1634.   return "\cA$cmd $msg\cA";
  1635. }
  1636.  
  1637. sub cps_scan {
  1638.   local($serverno, $prefix, $ctcp) = @_;
  1639.   local($cmd, $msg, $sub, $label);
  1640.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1641.   return '' unless $cmd;
  1642.   foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  1643.     $sub = "${module}\'cpss_\L$cmd\E";
  1644.     next unless defined(&$sub);
  1645.     if ($'labellist{$module}) {
  1646.       foreach $label (&'array($'labellist{$module})) {
  1647.         ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1648.         last unless $cmd;
  1649.       }
  1650.     } else {
  1651.       ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1652.     }
  1653.     last unless $cmd;
  1654.   }
  1655.   return '' unless $cmd;
  1656.   return "\cA$cmd $msg\cA";
  1657. }
  1658.  
  1659. sub cps_print {
  1660.   local($serverno, $prefix, $ctcp) = @_;
  1661.   local($cmd, $msg, $sub, $label);
  1662.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1663.   return '' unless $cmd;
  1664.   foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  1665.     $sub = "${module}\'cpsp_\L$cmd\E";
  1666.     next unless defined(&$sub);
  1667.     if ($'labellist{$module}) {
  1668.       foreach $label (&'array($'labellist{$module})) {
  1669.         ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1670.         last unless $cmd;
  1671.       }
  1672.     } else {
  1673.       ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1674.     }
  1675.     last unless $cmd;
  1676.   }
  1677.   return '' unless $cmd;
  1678.   return "\cA$cmd $msg\cA";
  1679. }
  1680.  
  1681. sub cs_notice {
  1682.   local($clientno, $prefix, $cmd, $chan, $msg) = @_;
  1683.   local($tmp, $ctmp, $rest, $ctcp, $list);
  1684.   return () unless $msg;
  1685.   $tmp = '';
  1686.   $ctmp = '';
  1687.   $rest = $msg;
  1688.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1689.     $tmp .= $1;
  1690.     $ctmp .= $1;
  1691.     $ctcp = $2;
  1692.     $rest = $3;
  1693.     $tmp .= &cnc_scan($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1694.     $list = &'add($list, $ctcp);
  1695.   }
  1696.   $tmp .= $rest || '';
  1697.   $ctmp .= $rest || '';
  1698.   return () unless $tmp;
  1699.   foreach $cno (&'array($'clientlist)) {
  1700.     next unless $clientno != $cno;
  1701.     next unless $'avail[$cno];
  1702.     next unless $'userno[$clientno] == $'userno[$cno];
  1703.     &'c_print($cno, &'user($cno), $cmd, $chan, $ctmp);
  1704.   }
  1705.   return ($prefix, $cmd, $chan, $tmp);
  1706. }
  1707.  
  1708. sub cp_notice {
  1709.   local($clientno, $prefix, $cmd, $chan, $msg) = @_;
  1710.   local($tmp, $rest, $ctcp, $list);
  1711.   return () unless $msg;
  1712.   $tmp = '';
  1713.   $rest = $msg;
  1714.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1715.     $tmp .= $1;
  1716.     $ctcp = $2;
  1717.     $rest = $3;
  1718.     $tmp .= &cnc_print($clientno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1719.     $list = &'add($list, $ctcp);
  1720.   }
  1721.   $tmp .= $rest || '';
  1722.   return () unless $tmp;
  1723.   return ($prefix, $cmd, $chan, $tmp);
  1724. }
  1725.  
  1726. sub ss_notice {
  1727.   local($serverno, $prefix, $cmd, $chan, $msg) = @_;
  1728.   local($tmp, $rest, $ctcp, $list);
  1729.   return () unless $msg;
  1730.   $tmp = '';
  1731.   $rest = $msg;
  1732.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1733.     $tmp .= $1;
  1734.     $ctcp = $2;
  1735.     $rest = $3;
  1736.     $tmp .= &cns_scan($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1737.     $list = &'add($list, $ctcp);
  1738.   }
  1739.   $tmp .= $rest || '';
  1740.   return () unless $tmp;
  1741.   return ($prefix, $cmd, $chan, $tmp);
  1742. }
  1743.  
  1744. sub sp_notice {
  1745.   local($serverno, $prefix, $cmd, $chan, $msg) = @_;
  1746.   local($tmp, $rest, $ctcp, $list);
  1747.   return () unless $msg;
  1748.   $tmp = '';
  1749.   $rest = $msg;
  1750.   while ($rest =~ /^(.*)\cA([^\cA]*)\cA(.*)$/) {
  1751.     $tmp .= $1;
  1752.     $ctcp = $2;
  1753.     $rest = $3;
  1754.     $tmp .= &cns_print($serverno, $prefix, $ctcp) unless &'exist($list, $ctcp);
  1755.     $list = &'add($list, $ctcp);
  1756.   }
  1757.   $tmp .= $rest || '';
  1758.   return () unless $tmp;
  1759.   return ($prefix, $cmd, $chan, $tmp);
  1760. }
  1761.  
  1762. sub cnc_scan {
  1763.   local($clientno, $prefix, $ctcp) = @_;
  1764.   local($cmd, $msg, $sub, $label);
  1765.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1766.   return '' unless $cmd;
  1767.   foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  1768.     $sub = "${module}\'cncs_\L$cmd\E";
  1769.     next unless defined(&$sub);
  1770.     if ($'labellist{$module}) {
  1771.       foreach $label (&'array($'labellist{$module})) {
  1772.         ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1773.         last unless $cmd;
  1774.       }
  1775.     } else {
  1776.       ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1777.     }
  1778.     last unless $cmd;
  1779.   }
  1780.   return '' unless $cmd;
  1781.   return "\cA$cmd $msg\cA";
  1782. }
  1783.  
  1784. sub cnc_print {
  1785.   local($clientno, $prefix, $ctcp) = @_;
  1786.   local($cmd, $msg, $sub, $label);
  1787.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1788.   return '' unless $cmd;
  1789.   foreach $module (&'array($'modulelist[$'userno[$clientno]])) {
  1790.     $sub = "${module}\'cncp_\L$cmd\E";
  1791.     next unless defined(&$sub);
  1792.     if ($'labellist{$module}) {
  1793.       foreach $label (&'array($'labellist{$module})) {
  1794.         ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1795.         last unless $cmd;
  1796.       }
  1797.     } else {
  1798.       ($prefix, $cmd, $msg) = &$sub($clientno, $prefix, $cmd, $msg);
  1799.     }
  1800.     last unless $cmd;
  1801.   }
  1802.   return '' unless $cmd;
  1803.   return "\cA$cmd $msg\cA";
  1804. }
  1805.  
  1806. sub cns_scan {
  1807.   local($serverno, $prefix, $ctcp) = @_;
  1808.   local($cmd, $msg, $sub, $label);
  1809.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1810.   return '' unless $cmd;
  1811.   foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  1812.     $sub = "${module}\'cnss_\L$cmd\E";
  1813.     next unless defined(&$sub);
  1814.     if ($'labellist{$module}) {
  1815.       foreach $label (&'array($'labellist{$module})) {
  1816.         ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1817.         last unless $cmd;
  1818.       }
  1819.     } else {
  1820.       ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1821.     }
  1822.     last unless $cmd;
  1823.   }
  1824.   return '' unless $cmd;
  1825.   return "\cA$cmd $msg\cA";
  1826. }
  1827.  
  1828. sub cns_print {
  1829.   local($serverno, $prefix, $ctcp) = @_;
  1830.   local($cmd, $msg, $sub, $label);
  1831.   ($cmd, $msg) = (split(/\s+/, $ctcp, 2), '');
  1832.   return '' unless $cmd;
  1833.   foreach $module (&'array($'modulelist[$'userno[$serverno]])) {
  1834.     $sub = "${module}\'cnsp_\L$cmd\E";
  1835.     next unless defined(&$sub);
  1836.     if ($'labellist{$module}) {
  1837.       foreach $label (&'array($'labellist{$module})) {
  1838.         ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1839.         last unless $cmd;
  1840.       }
  1841.     } else {
  1842.       ($prefix, $cmd, $msg) = &$sub($serverno, $prefix, $cmd, $msg);
  1843.     }
  1844.     last unless $cmd;
  1845.   }
  1846.   return '' unless $cmd;
  1847.   return "\cA$cmd $msg\cA";
  1848. }
  1849.  
  1850. __END__
  1851. <DL>
  1852. <DT> plum.kanji* ({euc|jis|sjis})
  1853. <DT> plum.nick* ($B%K%C%/%M!<%`(B)
  1854. <DT> plum.user $B%f!<%6%M!<%`(B
  1855. <DT> plum.name $B<BL>(B
  1856. <DT> plum.server* $B%5!<%PL>(B[:$B%]!<%HHV9f(B] [$B%Q%9%o!<%I(B]
  1857. <DT> plum.client* $B%/%i%$%"%s%H%^%9%/(B[:$B%]!<%HHV9f(B] [$B%Q%9%o!<%I(B]
  1858. </DL>
  1859.