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