home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / plum2_33_1.lzh / plum next >
Text File  |  1999-03-24  |  62KB  |  2,276 lines
  1. #!/bin/perl -w
  2. # $Id: plum,v 2.140 1999/03/15 14:04:30 hasegawa Exp $
  3. # copyright (c)1997-1999 Yoshinori Hasegawa <hasegawa@madoka.org>
  4.  
  5. package plum;
  6.  
  7. $NAME = 'plum';
  8. $VERSION = '2.33';
  9.  
  10. $NIL = $;;
  11. $NOTRAILING = &'list('004', '215', '221', '324', '341', '367', 'mode');
  12.  
  13. $ALIAS = '*.jp';
  14.  
  15. $TIMEOUT = 120;
  16. $READSIZE = 1024;
  17. $IRCPORT = 6667;
  18.  
  19. $SOCKADDR = 'S n N x8';
  20.  
  21. $PROTO = (getprotobyname('tcp'))[2];
  22.  
  23. if ($] < 5) {
  24.   foreach $inc (@INC) {
  25.     if (-r "$inc/sys/socket.ph") {
  26.       eval 'require "sys/socket.ph"';
  27.       $SOCKET = "$inc/sys/socket.ph" unless $@;
  28.       last;
  29.     }
  30.     if (-r "$inc/socket.ph") {
  31.       eval 'require "socket.ph"';
  32.       $SOCKET = "$inc/socket.ph" unless $@;
  33.       last;
  34.     }
  35.   }
  36. } else {
  37.   eval 'use Socket';
  38.   $SOCKET = 'Socket.pm' unless $@;
  39. }
  40. $SOCKET = '' unless $SOCKET;
  41.  
  42. $AF_INET = eval '&AF_INET' || 2;
  43. $PF_INET = eval '&PF_INET' || 2;
  44. $SOCK_STREAM = eval '&SOCK_STREAM' || 1;
  45. $SOMAXCONN = eval '&SOMAXCONN' || 16;
  46. $INADDR_ANY = eval '&INADDR_ANY' || "\0\0\0\0";
  47. $SOL_SOCKET = eval '&SOL_SOCKET';
  48. $SO_REUSEADDR = eval '&SO_REUSEADDR';
  49.  
  50. $KANJI = &'add($KANJI, 'euc') if "\241\241\242\242" !~ /\241\242/;
  51. $KANJI = &'add($KANJI, 'sjis') if "\201\201\202\202" !~ /\201\202/;
  52.  
  53. $SIG{'HUP'} = 'IGNORE' if &'exist(&'list(keys(%SIG)), 'HUP');
  54. $SIG{'PIPE'} = 'IGNORE' if &'exist(&'list(keys(%SIG)), 'PIPE');
  55.  
  56. if ($0 =~ /^(.*)[\\\/][^\\\/]*$/) {
  57.   unshift(@INC, "$1/module");
  58. } else {
  59.   unshift(@INC, './module');
  60. }
  61.  
  62. select((select(STDOUT), $| = 1)[0]);
  63. select((select(STDERR), $| = 1)[0]);
  64.  
  65. $'rin = '';
  66. $'win = '';
  67. $'rout = '';
  68. $'wout = '';
  69.  
  70. $'kanjilist = $KANJI;
  71. $'kanjilist = '' unless $'kanjilist;
  72.  
  73. $handle = 0;
  74.  
  75. srand();
  76.  
  77. &'load('', "$NAME.conf") if -r "$NAME.conf";
  78. foreach $user (@ARGV) {
  79.   &'load($user, "$NAME-$user.conf") if -r "$NAME-$user.conf";
  80. }
  81.  
  82. exit unless @'username;
  83.  
  84. print $NAME, ' ', $VERSION, "\n";
  85.  
  86. &main;
  87.  
  88. sub main {
  89.   local($access, $i, $time, $nfound, $timeleft);
  90.   $access = '';
  91.   for (;;) {
  92.     for ($i = 0; $i < @'username; $i++) {
  93.       &open_event($i, 'main_loop', $i);
  94.     }
  95.     foreach $cno (&'array($'clientlist)) {
  96.       &c_read($cno) if vec($'rout, $cno, 1);
  97.       &c_write($cno) if vec($'wout, $cno, 1);
  98.     }
  99.     foreach $sno (&'array($'serverlist)) {
  100.       &s_read($sno) if vec($'rout, $sno, 1);
  101.       &s_write($sno) if vec($'wout, $sno, 1);
  102.     }
  103.     foreach $lno (&'array($'listenlist)) {
  104.       &c_accept($lno) if vec($'rout, $lno, 1);
  105.     }
  106.     $time = time();
  107.     for ($i = 0; $i < length($access) * 8; $i++) {
  108.       $'access[$i] = $time if vec($access, $i, 1);
  109.     }
  110.     ($nfound, $timeleft) = select($'rout = $'rin, $'wout = $'win, undef, $TIMEOUT);
  111.     $access = $'rout;
  112.   }
  113. }
  114.  
  115. sub c_read {
  116.   local($clientno) = @_;
  117.   local($next, $rest, $tmp);
  118.   $tmp = '';
  119.   if (sysread($'socket[$clientno], $tmp, $READSIZE)) {
  120.     $rbuf[$clientno] .= $tmp;
  121.     while ((($next, $rest) = split(/[\r\n]+/, $rbuf[$clientno], 2)) == 2) {
  122.       $rbuf[$clientno] = $rest;
  123.       next unless $next;
  124.       if ($'avail[$clientno]) {
  125.         $next = &read_event($'userno[$clientno], 'client_read', $clientno, $next);
  126.         next unless $next;
  127.       }
  128.       &c_scan($clientno, $next);
  129.     }
  130.   } else {
  131.     &'c_close($clientno);
  132.   }
  133. }
  134.  
  135. sub c_scan {
  136.   local($clientno, $line) = @_;
  137.   local($prefix, $cmd, @params, $sub);
  138.   ($prefix, $cmd, @params) = &'parse($line);
  139.   if ($'avail[$clientno]) {
  140.     ($prefix, $cmd, @params) = &scan_event($'userno[$clientno], "cs_\L$cmd\E", $clientno, $prefix, $cmd, @params);
  141.     return unless $cmd;
  142.     return unless $'server[$clientno];
  143.     &'s_print($'server[$clientno], $prefix, $cmd, @params);
  144.   } else {
  145.     $sub = "cn_\L$cmd\E";
  146.     &$sub($clientno, $prefix, $cmd, @params) if defined(&$sub);
  147.   }
  148. }
  149.  
  150. sub 'c_print {
  151.   local($clientno, $prefix, $cmd, @params) = @_;
  152.   if ($'avail[$clientno]) {
  153.     ($prefix, $cmd, @params) = &print_event($'userno[$clientno], "cp_\L$cmd\E", $clientno, $prefix, $cmd, @params);
  154.     return unless $cmd;
  155.   }
  156.   $wbuf{$clientno} = '' unless defined($wbuf{$clientno});
  157.   $wbuf{$clientno} .= &'build($prefix, $cmd, @params) . $NIL;
  158.   vec($'win, $clientno, 1) = 1;
  159. }
  160.  
  161. sub c_write {
  162.   local($clientno) = @_;
  163.   local($socket, $next, $rest);
  164.   $socket = $'socket[$clientno];
  165.   while ($wbuf{$clientno}) {
  166.     ($next, $rest) = split(/$NIL/, $wbuf{$clientno}, 2);
  167.     $wbuf{$clientno} = $rest || '';
  168.     next unless $next;
  169.     if ($'avail[$clientno]) {
  170.       $next = &write_event($'userno[$clientno], 'client_write', $clientno, $next);
  171.       next unless $next;
  172.     }
  173.     print $socket $next, "\r\n" if fileno($socket);
  174.   }
  175.   vec($'win, $clientno, 1) = 0;
  176. }
  177.  
  178. sub 'c_flush {
  179.   local($clientno) = @_;
  180.   while (vec($'win, $clientno, 1)) {
  181.     &c_write($clientno);
  182.   }
  183. }
  184.  
  185. sub s_read {
  186.   local($serverno) = @_;
  187.   local($next, $rest, $tmp);
  188.   $tmp = '';
  189.   if (sysread($'socket[$serverno], $tmp, $READSIZE)) {
  190.     $rbuf[$serverno] .= $tmp;
  191.     while ((($next, $rest) = split(/[\r\n]+/, $rbuf[$serverno], 2)) == 2) {
  192.       $rbuf[$serverno] = $rest;
  193.       next unless $next;
  194.       if ($'avail[$serverno]) {
  195.         $next = &read_event($'userno[$serverno], 'server_read', $serverno, $next);
  196.         next unless $next;
  197.       }
  198.       &s_scan($serverno, $next);
  199.     }
  200.   } else {
  201.     &'s_close($serverno);
  202.   }
  203. }
  204.  
  205. sub s_scan {
  206.   local($serverno, $line) = @_;
  207.   local($prefix, $cmd, @params, $sub);
  208.   ($prefix, $cmd, @params) = &'parse($line);
  209.   if ($'avail[$serverno]) {
  210.     ($prefix, $cmd, @params) = &scan_event($'userno[$serverno], "ss_\L$cmd\E", $serverno, $prefix, $cmd, @params);
  211.     return unless $cmd;
  212.     foreach $cno (&'array($'clientlist)) {
  213.       next unless $'avail[$cno];
  214.       next unless $'server[$cno] == $serverno;
  215.       &'c_print($cno, $prefix, $cmd, @params);
  216.     }
  217.   } else {
  218.     $sub = "sn_\L$cmd\E";
  219.     &$sub($serverno, $prefix, $cmd, @params) if defined(&$sub);
  220.   }
  221. }
  222.  
  223. sub 's_print {
  224.   local($serverno, $prefix, $cmd, @params) = @_;
  225.   local($key);
  226.   if ($'avail[$serverno]) {
  227.     ($prefix, $cmd, @params) = &print_event($'userno[$serverno], "sp_\L$cmd\E", $serverno, $prefix, $cmd, @params);
  228.     return unless $cmd;
  229.   }
  230.   $key = "$serverno$;\L$cmd\E";
  231.   $wbuf{$key} = '' unless defined($wbuf{$key});
  232.   $wbuf{$key} .= &'build($prefix, $cmd, @params) . $NIL;
  233.   $sequence[$serverno] = &'add($sequence[$serverno], "\L$cmd\E");
  234.   vec($'win, $serverno, 1) = 1;
  235. }
  236.  
  237. sub s_write {
  238.   local($serverno) = @_;
  239.   local($socket, $next, $rest, $time, @array, $cmd);
  240.   $socket = $'socket[$serverno];
  241.   $time = time();
  242.   $timer[$serverno] = $time if ($timer[$serverno] || 0) < $time;
  243.   @array = &'array($sequence[$serverno]);
  244.   while (@array) {
  245.     if ($timer[$serverno] > $time + 10) {
  246.       $sequence[$serverno] = &'list(@array);
  247.       return;
  248.     } else {
  249.       $cmd = shift(@array);
  250.       ($next, $rest) = split(/$NIL/, $wbuf{$serverno, $cmd}, 2);
  251.       $wbuf{$serverno, $cmd} = $rest || '';
  252.       push(@array, $cmd) if $rest;
  253.       next unless $next;
  254.       if ($'avail[$serverno]) {
  255.         $next = &write_event($'userno[$serverno], 'server_write', $serverno, $next);
  256.         next unless $next;
  257.       }
  258.       print $socket $next, "\r\n" if fileno($socket);
  259.       $timer[$serverno] += 2;
  260.     }
  261.   }
  262.   $sequence[$serverno] = '';
  263.   vec($'win, $serverno, 1) = 0;
  264. }  
  265.  
  266. sub 's_flush {
  267.   local($serverno) = @_;
  268.   while (vec($'win, $serverno, 1)) {
  269.     &s_write($serverno);
  270.   }
  271. }
  272.  
  273. sub 'parse {
  274.   local($line) = @_;
  275.   local($arg, $rest, @params);
  276.   @params = ();
  277.   $line =~ s/^\s*//;
  278.   if ($line =~ /^\:(.*)$/) {
  279.     ($arg, $rest) = (split(/\s+/, $1, 2), '');
  280.   } else {
  281.     ($arg, $rest) = ('', $line);
  282.   }
  283.   while ($line) {
  284.     push(@params, $arg);
  285.     if ($rest =~ /^\:(.*)$/) {
  286.       push(@params, $1);
  287.       last;
  288.     }
  289.     $line = $rest;
  290.     ($arg, $rest) = (split(/\s+/, $line, 2), '');
  291.   }
  292.   return @params;
  293. }
  294.  
  295. sub 'build {
  296.   local($prefix, $cmd, @params) = @_;
  297.   local($trailing);
  298.   return '' unless $cmd;
  299.   if (@params) {
  300.     $trailing = pop(@params) || '';
  301.     if (&'exist($NOTRAILING, "\L$cmd\E")) {
  302.       push(@params, $trailing . ' ');
  303.     } else {
  304.       push(@params, ':' . $trailing);
  305.     }
  306.   } else {
  307.     @params = ();
  308.   }
  309.   unshift(@params, $cmd);
  310.   unshift(@params, ':' . $prefix) if $prefix;
  311.   return join(' ', @params);
  312. }
  313.  
  314. sub 'user {
  315.   local($no) = @_;
  316.   local($userno, $host);
  317.   $userno = $'userno[$no];
  318.   if (defined($userno) && $address[$userno]) {
  319.     return "$'nick[$no]\!$address[$userno]";
  320.   } elsif ($no && $'socket[$no] && fileno($'socket[$no])) {
  321.     $host = (&'peername($no))[2] || join('.', unpack('C4', pack('N', (&'peername($no))[1])));
  322.   } else {
  323.     $host = 'unknown';
  324.   }
  325.   return "$'nick[$no]!$'user[$no]\@$host";
  326. }
  327.  
  328. sub 'prefix {
  329.   local($prefix) = @_;
  330.   local($idx, $rest, $nick, $user, $host);
  331.   if (wantarray) {
  332.     if (($idx = index($prefix, '@')) != -1) {
  333.       $host = substr($prefix, $idx + 1);
  334.       $rest = substr($prefix, 0, $idx);
  335.     } else {
  336.       $host = '';
  337.       $rest = $prefix;
  338.     }
  339.     if (($idx = index($rest, '!')) != -1) {
  340.       $nick = substr($rest, 0, $idx);
  341.       $user = substr($rest, $idx + 1);
  342.     } else {
  343.       $nick = $rest;
  344.       $user = '';
  345.     }
  346.     return ($nick, $user, $host);
  347.   } else {
  348.     if (($idx = index($prefix, '!')) != -1) {
  349.       return substr($prefix, 0, $idx);
  350.     } else {
  351.       return $prefix;
  352.     }
  353.   }
  354. }
  355.  
  356. sub 'regex {
  357.   local($mask) = @_;
  358.   $mask =~ s/(\W)/\\$1/g;
  359.   $mask =~ s/\\\?/\./g;
  360.   $mask =~ s/\\\*/\.\*/g;
  361.   return "\^$mask\$";
  362. }
  363.  
  364. sub 'load {
  365.   local($user, $file) = @_;
  366.   local($userno, $newlist, $no, $var, $line, $name, $arg, @key, $label, $sub, $oldlist);
  367.   @'username = () unless @'username;
  368.   open(FILE, $file) || return;
  369.   if (!&'exist(&'list(@'username), $user)) {
  370.     push(@'username, $user);
  371.   }
  372.   for ($userno = 0; $userno < @'username; $userno++) {
  373.     last if $user eq $'username[$userno];
  374.   }
  375.   foreach $key (keys(%property)) {
  376.     ($no, $var) = split(/$;/, $key, 2);
  377.     next unless $no == $userno;
  378.     delete $property{$key};
  379.   }
  380.   $'filename[$userno] = $file;
  381.   $newlist = &'list('plum');
  382.   while (defined($line = <FILE>)) {
  383.     $line =~ s/^\s+//;
  384.     next if $line =~ /^[\#\;]/;
  385.     $line =~ tr/\r\n//d;
  386.     next unless $line;
  387.     $line =~ s/\s+$//;
  388.     if ($line =~ /^\+\s*(\S+)\s+(\S+)/) {
  389.       $name = $1;
  390.       $label = $2;
  391.       &'import($userno, $name);
  392.       $newlist = &'add($newlist, $'package{$name});
  393.       $'labellist{$userno, $'package{$name}} = &'list(split(/\,/, $label));
  394.     } elsif ($line =~ /^\+\s*(\S+)/) {
  395.       $name = $1;
  396.       &'import($userno, $name);
  397.       $newlist = &'add($newlist, $'package{$name});
  398.       $'labellist{$userno, $'package{$name}} = '';
  399.     } elsif ($line =~ /^\-\s*(\S+)/) {
  400.       $name = $1;
  401.       if ($'package{$name}) {
  402.         $newlist = &'remove($newlist, $'package{$name});
  403.         $'labellist{$userno, $'package{$name}} = '';
  404.       }
  405.     } elsif ($line =~ /^\=\s*(\S+)/) {
  406.       $name = $1;
  407.       &'import($userno, $name);
  408.       if (&'exist($'modulelist[$userno], $'package{$name})) {
  409.         $newlist = &'add($newlist, $'package{$name});
  410.       }
  411.     } elsif ((($var, $arg) = split(/\s*\:\s*/, $line, 2)) == 2) {
  412.       $arg = &kanji_jis($userno, $arg);
  413.       @key = split(/\./, $var);
  414.       $property{$userno, @key} = &'add($property{$userno, @key}, $arg);
  415.     }
  416.   }
  417.   close(FILE);
  418.   foreach $module (&'array($newlist)) {
  419.     if (!&'exist($'modulelist[$userno], $module)) {
  420.       $sub = $module . '\'module_enable';
  421.       &$sub($userno) if defined(&$sub);
  422.     }
  423.   }
  424.   $oldlist = $'modulelist[$userno];
  425.   $'modulelist[$userno] = $newlist;
  426.   foreach $module (&'array($oldlist)) {
  427.     if (!&'exist($'modulelist[$userno], $module)) {
  428.       $sub = $module . '\'module_disable';
  429.       &$sub($userno) if defined(&$sub);
  430.     }
  431.   }
  432. }
  433.  
  434. sub kanji_jis {
  435.   local($userno, $line) = @_;
  436.   local($code);
  437.   $code = '';
  438.   foreach $kanji (&'property($userno, 'kanji')) {
  439.     $code = &'add($code, split(/\,/, "\L$kanji\E"));
  440.   }
  441.   foreach $code (&'array($code)) {
  442.     if ($code eq 'euc') {
  443.       $line = &'euc_jis($line);
  444.     } elsif ($code eq 'jis') {
  445.       $line = &'jis_jis($line);
  446.     } elsif ($code eq 'sjis') {
  447.       $line = &'sjis_jis($line);
  448.     }
  449.   }
  450.   return $line;
  451. }
  452.  
  453. sub 'import {
  454.   local($userno, $name) = @_;
  455.   local($file, $pkg);
  456.   foreach $dir (&'property($userno, 'directory'), @INC) {
  457.     $file = &'expand("$dir/$name");
  458.     next unless -f $file;
  459.     $_ = $'package{$name} || 'plum';
  460.     require $file;
  461.     $pkg = $_;
  462.     $'package{$name} = $pkg;
  463.     $'directory{$pkg} = $dir;
  464.     $'filename{$pkg} = $name;
  465.     return;
  466.   }
  467.   $file = &'expand($name);
  468.   $_ = $'package{$name} || 'plum';
  469.   require $file;
  470.   $pkg = $_;
  471.   $'package{$name} = $pkg;
  472.   $'directory{$pkg} = '';
  473.   $'filename{$pkg} = $name;
  474. }
  475.  
  476. sub 'property {
  477.   local($userno, $name) = @_;
  478.   local(@pkg, $list);
  479.   @pkg = split(/\_/, (caller())[0]);
  480.   if ($label) {
  481.     $list = $property{$userno, @pkg, $label, $name} || $property{$userno, @pkg, $name};
  482.   } else {
  483.     $list = $property{$userno, @pkg, $name};
  484.   }
  485.   if (defined($list)) {
  486.     if (wantarray) {
  487.       return &'array($list);
  488.     } else {
  489.       return (&'array($list))[0];
  490.     }
  491.   } else {
  492.     if (wantarray) {
  493.       return ();
  494.     } else {
  495.       return undef;
  496.     }
  497.   }
  498. }
  499.  
  500. sub 'expand {
  501.   local($name) = @_;
  502.   local($user, $rest, $home);
  503.   if ($name =~ /^\~([^\/]*)\/(.*)$/) {
  504.     ($user, $rest) = ($1, $2);
  505.     if ($user) {
  506.       $home = eval '(getpwnam($user))[7]' || '.';
  507.     } else {
  508.       $home = $ENV{'HOME'} || eval '(getpwuid($<))[7]' || '.';
  509.     }
  510.     return "$home/$rest";
  511.   } else {
  512.     return $name;
  513.   }
  514. }
  515.  
  516. sub 'timelocal {
  517.   local(@local) = @_;
  518.   local($now, @base, $year, $day, $time);
  519.   $now = time();
  520.   @base = localtime($now);
  521.   $day = ($local[5] - $base[5]) * 365;
  522.   $year = $local[5] + 1900;
  523.   $day += int($year / 4) - int($year / 100) + int($year / 400) + &days($local[3], $local[4], $local[5]);
  524.   $year = $base[5] + 1900;
  525.   $day -= int($year / 4) - int($year / 100) + int($year / 400) + &days($base[3], $base[4], $base[5]);
  526.   $time = $now + $day * 86400 + ($local[2] - $base[2]) * 3600 + ($local[1] - $base[1]) * 60 + $local[0] - $base[0];
  527.   return $time;
  528. }
  529.  
  530. sub days {
  531.   local(@time) = @_;
  532.   local($day, $year);
  533.   $day = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334)[$time[1]];
  534.   $day += $time[0] - 1;
  535.   $year = $time[2] + 1900;
  536.   if ($time[1] < 2 && $year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) {
  537.     $day -= 1;
  538.   }
  539.   return $day;
  540. }
  541.  
  542. sub 'date {
  543.   local($format, $time) = @_;
  544.   local(@time, $char, $str, $i, $number);
  545.   $time = time() unless $time;
  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 '+' || $char eq '-') {
  555.           $i++;
  556.           $number = $char;
  557.           while ($i < length($format)) {
  558.             $char = substr($format, $i, 1);
  559.             last if index('0123456789.', $char) == -1;
  560.             $number .= $char;
  561.             $i++;
  562.           }
  563.         } else {
  564.           $number = 0;
  565.         }
  566.         if ($char eq '%') {
  567.           $str .= $char;
  568.         } elsif ($char eq 'a') {
  569.           $str .= ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat')[$time[6]];
  570.         } elsif ($char eq 'b') {
  571.           $str .= ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec')[$time[4]];
  572.         } elsif ($char eq 'd') {
  573.           $str .= sprintf('%02d', $time[3]);
  574.         } elsif ($char eq 'H') {
  575.           $str .= sprintf('%02d', $time[2]);
  576.         } elsif ($char eq 'I') {
  577.           $str .= sprintf('%02d', $time[2] % 12 + 1);
  578.         } elsif ($char eq 'j') {
  579.           $str .= sprintf('%3d', $time[7]);
  580.         } elsif ($char eq 'k') {
  581.           $str .= sprintf('%2d', $time[2]);
  582.         } elsif ($char eq 'l') {
  583.           $str .= sprintf('%2d', $time[2] % 12 + 1);
  584.         } elsif ($char eq 'M') {
  585.           $str .= sprintf('%02d', $time[1]);
  586.         } elsif ($char eq 'm') {
  587.           $str .= sprintf('%02d', $time[4] + 1);
  588.         } elsif ($char eq 'O') {
  589.           @time = localtime($time + $number * 3600);
  590.         } elsif ($char eq 'o') {
  591.           @time = localtime($time + $number);
  592.         } elsif ($char eq 'p') {
  593.           if ($time[2] < 12) {
  594.             $str .= 'AM';
  595.           } else {
  596.             $str .= 'PM';
  597.           }
  598.         } elsif ($char eq 'S') {
  599.           $str .= sprintf('%02d', $time[0]);
  600.         } elsif ($char eq 'w') {
  601.           $str .= sprintf('%d', $time[6]);
  602.         } elsif ($char eq 'Y') {
  603.           $str .= sprintf('%d', $time[5] + 1900);
  604.         } elsif ($char eq 'y') {
  605.           $str .= sprintf('%02d', $time[5] % 100);
  606.         }
  607.       } else {
  608.         $str .= $char;
  609.       }
  610.     } else {
  611.       $str .= $char;
  612.     }
  613.   }
  614.   return $str;
  615. }
  616.  
  617. sub 'format {
  618.   local($text, %data) = @_;
  619.   local($ret, $idx, $end, $ret, $str);
  620.   $ret = '';
  621.   while (($idx = index($text, '#(')) != -1) {
  622.     $end = index($text, ')', $idx + 2);
  623.     last if $end == -1;
  624.     $ret .= substr($text, 0, $idx);
  625.     foreach $item (split(/\|/, substr($text, $idx + 2, $end - $idx - 2))) {
  626.       $str = &replace($item, %data);
  627.       next unless defined($str);
  628.       $ret .= $str;
  629.       last;
  630.     }
  631.     $text = substr($text, $end + 1);
  632.   }
  633.   $ret .= $text;
  634.   return $ret;
  635. }
  636.  
  637. sub replace {
  638.   local($item, %data) = @_;
  639.   local($list, $text, @data);
  640.   ($list, $text) = split(/\;/, $item, 2);
  641.   if ($list) {
  642.     foreach $key (split(/\,/, $list)) {
  643.       if (!defined($data{$key})) {
  644.         return undef;
  645.       }
  646.       push(@data, $data{$key});
  647.     }
  648.     if ($text) {
  649.       return sprintf($text, @data);
  650.     } else {
  651.       return join('', @data);
  652.     }
  653.   } else {
  654.     return $text;
  655.   }
  656. }
  657.  
  658. sub 'real {
  659.   local($name) = @_;
  660.   if ($name =~ /^\%(.*)$/) {
  661.     return "\#$1\:$ALIAS";
  662.   } else {
  663.     return $name;
  664.   }
  665. }
  666.  
  667. sub 'alias {
  668.   local($name) = @_;
  669.   if ($name =~ /^\#(.*)\:(.*)$/ && "\L$2\E" eq "\L$ALIAS\E") {
  670.     return '%' . $1;
  671.   } else {
  672.     return $name;
  673.   }
  674. }
  675.  
  676. sub 'channel {
  677.   local($name) = @_;
  678.   if ($name && $name =~ /^[\#\&\+\!]/) {
  679.     return 1;
  680.   } else {
  681.     return 0;
  682.   }
  683. }
  684.  
  685. sub 'add {
  686.   local($list, @items) = @_;
  687.   $list = '' unless $list;
  688.   foreach $item (@items) {
  689.     next if &'exist($list, $item);
  690.     $list .= $NIL . $item;
  691.   }
  692.   return $list;
  693. }
  694.  
  695. sub 'remove {
  696.   local($list, @items) = @_;
  697.   local($idx);
  698.   $list = '' unless $list;
  699.   $list .= $NIL;
  700.   foreach $item (@items) {
  701.     $idx = index("\L$list\E", "$NIL\L$item\E$NIL");
  702.     next if $idx == -1;
  703.     substr($list, $idx, length("$NIL$item$NIL")) = $NIL;
  704.   }
  705.   return substr($list, 0, length($list) - 1);
  706. }
  707.  
  708. sub 'change {
  709.   local($list, @items) = @_;
  710.   local($old, $new, $idx);
  711.   return '' unless $list;
  712.   $list .= $NIL;
  713.   while (@items > 1) {
  714.     $old = shift(@items);
  715.     $new = shift(@items);
  716.     $idx = index("\L$list\E", "$NIL\L$old\E$NIL");
  717.     next if $idx == -1;
  718.     substr($list, $idx, length("$NIL$old$NIL")) = "$NIL$new$NIL";
  719.   }
  720.   return substr($list, 0, length($list) - 1);
  721. }
  722.  
  723. sub 'exist {
  724.   local($list, @items) = @_;
  725.   return 0 unless $list;
  726.   $list .= $NIL;
  727.   foreach $item (@items) {
  728.     return 1 if index("\L$list\E", "$NIL\L$item\E$NIL") != -1;
  729.   }
  730.   return 0;
  731. }
  732.  
  733. sub 'list {
  734.   local(@array) = @_;
  735.   return join($NIL, '', @array);
  736. }
  737.  
  738. sub 'array {
  739.   local($list) = @_;
  740.   return () unless $list;
  741.   $list = substr($list, 1);
  742.   return split(/$NIL/, $list, -1);
  743. }
  744.  
  745. sub 'euc_euc {
  746.   local($euc) = @_;
  747.   return $euc;
  748. }
  749.  
  750. sub 'euc_jis {
  751.   local($euc) = @_;
  752.   local($jis, $kanji, $c, $n, $i);
  753.   $kanji = 0;
  754.   $jis = '';
  755.   $euc = &'euc_euc($euc);
  756.   for ($i = 0; $i < length($euc); $i++) {
  757.     $c = substr($euc, $i, 1);
  758.     $n = ord($c);
  759.     if ($n >= 0241) {
  760.       if ($kanji != 1) {
  761.         $jis .= "\e\$B";
  762.         $kanji = 1;
  763.       }
  764.       $jis .= pack('C', $n & 0177);
  765.       $i++;
  766.       $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
  767.     } elsif ($n == 0216) {
  768.       if ($kanji != 2) {
  769.         $jis .= "\e(I";
  770.         $kanji = 2;
  771.       }
  772.       $i++;
  773.       $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
  774.     } elsif ($n == 0217) {
  775.       if ($kanji != 3) {
  776.         $jis .= "\e\$(D";
  777.         $kanji = 3;
  778.       }
  779.       $i++;
  780.       $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
  781.       $i++;
  782.       $jis .= pack('C', ord(substr($euc, $i, 1)) & 0177);
  783.     } else {
  784.       if ($kanji) {
  785.         $jis .= "\e\(B";
  786.         $kanji = 0;
  787.       }
  788.       $jis .= $c;
  789.     }
  790.   }
  791.   $jis .= "\e\(B" if $kanji;
  792.   return $jis;
  793. }
  794.  
  795. sub 'euc_sjis {
  796.   local($euc) = @_;
  797.   local($sjis, $c, $n1, $n2, $i);
  798.   $sjis = '';
  799.   $euc = &'euc_euc($euc);
  800.   for ($i = 0; $i < length($euc); $i++) {
  801.     $c = substr($euc, $i, 1);
  802.     $n1 = ord($c);
  803.     if ($n1 >= 0241) {
  804.       $i++;
  805.       $n2 = ord(substr($euc, $i, 1));
  806.       if (($n1 & 01) == 0) {
  807.         $n2 -= 03;
  808.       } else {
  809.         $n2 -= 0141;
  810.       }
  811.       $n2++ if $n2 >= 0177;
  812.       $n1 = ((($n1 - 0241) >> 1) + 0241) ^ 040;
  813.       $sjis .= pack('CC', $n1, $n2);
  814.     } elsif ($n1 == 0216) {
  815.       $i++;
  816.       $sjis .= substr($euc, $i, 1);
  817.     } elsif ($n1 == 0217) {
  818.       $i += 2;
  819.       $sjis .= "\201\254";
  820.     } else {
  821.       $sjis .= $c;
  822.     }
  823.   }
  824.   return $sjis;
  825. }
  826.  
  827. sub 'jis_euc {
  828.   local($jis) = @_;
  829.   local($euc, $kanji, $i);
  830.   $kanji = 0;
  831.   $euc = '';
  832.   $jis = &'jis_jis($jis);
  833.   for ($i = 0; $i < length($jis); $i++) {
  834.     if (substr($jis, $i, 3) eq "\e\(B") {
  835.       $kanji = 0;
  836.       $i += 2;
  837.       next;
  838.     } elsif (substr($jis, $i, 3) eq "\e\$B") {
  839.       $kanji = 1;
  840.       $i += 2;
  841.       next;
  842.     } elsif (substr($jis, $i, 3) eq "\e\(I") {
  843.       $kanji = 2;
  844.       $i += 2;
  845.       next;
  846.     } elsif (substr($jis, $i, 4) eq "\e\$(D") {
  847.       $kanji = 3;
  848.       $i += 3;
  849.       next;
  850.     }
  851.     if ($kanji == 0) {
  852.       $euc .= substr($jis, $i, 1);
  853.     } elsif ($kanji == 1) {
  854.       $euc .= pack('C', ord(substr($jis, $i, 1)) | 0200);
  855.       $i++;
  856.       $euc .= pack('C', ord(substr($jis, $i, 1)) | 0200);
  857.     } elsif ($kanji == 2) {
  858.       $euc .= "\216" . pack('C', ord(substr($jis, $i, 1)) | 0200);
  859.     } elsif ($kanji == 3) {
  860.       $euc .= "\217" . pack('C', ord(substr($jis, $i, 1)) | 0200);
  861.       $i++;
  862.       $euc .= pack('C', ord(substr($jis, $i, 1)) | 0200);
  863.     }
  864.   }
  865.   return $euc;
  866. }
  867.  
  868. sub 'jis_jis {
  869.   local($jis) = @_;
  870.   local($ret, $kanji, $last, $seq, $c, $i);
  871.   $kanji = 0;
  872.   $last = 0;
  873.   $ret = '';
  874.   for ($i = 0; $i < length($jis); $i++) {
  875.     $c = substr($jis, $i, 1);
  876.     $seq = substr($jis, $i, 3);
  877.     if ($seq eq "\e\$\@" || $seq eq "\e\$B") {
  878.       $ret .= "\e\$B";
  879.       $kanji = 1;
  880.       $i += 2;
  881.       next;
  882.     } elsif ($seq eq "\e(J" || $seq eq "\e(B") {
  883.       $ret .= "\e(B";
  884.       $kanji = 0;
  885.       $i += 2;
  886.       next;
  887.     } elsif ($seq eq "\e(I") {
  888.       $ret .= "\e(I";
  889.       $kanji = 2;
  890.       $i += 2;
  891.       next;
  892.     } elsif ($c eq "\cN") {
  893.       if ($kanji != 2) {
  894.         $last = $kanji;
  895.         $ret .= "\e(I";
  896.         $kanji = 2;
  897.       }
  898.       next;
  899.     } elsif ($c eq "\cO") {
  900.       if ($kanji != 2) {
  901.         if ($last) {
  902.           $ret .= "\e\$B";
  903.         } else {
  904.           $ret .= "\e(B";
  905.         }
  906.         $kanji = $last;
  907.       }
  908.       next;
  909.     } elsif (substr($jis, $i, 6) eq "\e&\@\e\$B") {
  910.       $ret .= "\e\$B";
  911.       $kanji = 1;
  912.       $i += 5;
  913.       next;
  914.     } elsif (substr($jis, $i, 4) eq "\e\$(D") {
  915.       $ret .= "\e\$(D";
  916.       $kanji = 3;
  917.       $i += 3;
  918.       next;
  919.     }
  920.     if ($kanji == 0) {
  921.       $ret .= $c;
  922.     } elsif ($kanji == 1) {
  923.       $ret .= substr($jis, $i, 2);
  924.       $i++;
  925.     } elsif ($kanji == 2) {
  926.       $ret .= $c;
  927.     } elsif ($kanji == 3) {
  928.       $ret .= substr($jis, $i, 2);
  929.       $i++;
  930.     }
  931.   }
  932.   $ret .= "\e(B" if $kanji;
  933.   return $ret;
  934. }
  935.  
  936. sub 'jis_sjis {
  937.   local($jis) = @_;
  938.   local($sjis, $kanji, $n1, $n2, $i);
  939.   $kanji = 0;
  940.   $sjis = '';
  941.   $jis = &'jis_jis($jis);
  942.   for ($i = 0; $i < length($jis); $i++) {
  943.     if (substr($jis, $i, 3) eq "\e\(B") {
  944.       $kanji = 0;
  945.       $i += 2;
  946.       next;
  947.     } elsif (substr($jis, $i, 3) eq "\e\$B") {
  948.       $kanji = 1;
  949.       $i += 2;
  950.       next;
  951.     } elsif (substr($jis, $i, 3) eq "\e\(I") {
  952.       $kanji = 2;
  953.       $i += 2;
  954.       next;
  955.     } elsif (substr($jis, $i, 4) eq "\e\$(D") {
  956.       $kanji = 3;
  957.       $i += 3;
  958.       next;
  959.     }
  960.     if ($kanji == 0) {
  961.       $sjis .= substr($jis, $i, 1);
  962.     } elsif ($kanji == 1) {
  963.       $n1 = ord(substr($jis, $i, 1));
  964.       $i++;
  965.       $n2 = ord(substr($jis, $i, 1));
  966.       if (($n1 & 01) == 0) {
  967.         $n2 += 0175;
  968.       } else {
  969.         $n2 += 037;
  970.       }
  971.       $n2++ if $n2 >= 0177;
  972.       $n1 = ((($n1 - 041) >> 1) + 0241) ^ 040;
  973.       $sjis .= pack('CC', $n1, $n2);
  974.     } elsif ($kanji == 2) {
  975.       $sjis .= pack('C', ord(substr($jis, $i, 1)) | 0200);
  976.     } elsif ($kanji == 3) {
  977.       $i++;
  978.       $sjis .= "\201\254";
  979.     }
  980.   }
  981.   return $sjis;
  982. }
  983.  
  984. sub 'sjis_euc {
  985.   local($sjis) = @_;
  986.   local($euc, $c, $n1, $n2, $i);
  987.   $euc = '';
  988.   $sjis = &'sjis_sjis($sjis);
  989.   for ($i = 0; $i < length($sjis); $i++) {
  990.     $c = substr($sjis, $i, 1);
  991.     $n1 = ord($c);
  992.     if ($n1 >= 0240 && $n1 <= 0337) {
  993.       $euc .= "\216$c";
  994.     } elsif ($n1 >= 0201) {
  995.       $i++;
  996.       $n2 = ord(substr($sjis, $i, 1));
  997.       $n2-- if $n2 > 0177;
  998.       if ($n2 >= 0236) {
  999.         $n1 = ((($n1 ^ 040) - 0241) << 1) + 0242;
  1000.         $n2 += 03;
  1001.       } else {
  1002.         $n1 = ((($n1 ^ 040) - 0241) << 1) + 0241;
  1003.         $n2 += 0141;
  1004.       }
  1005.       $euc .= pack('CC', $n1, $n2);
  1006.     } else {
  1007.       $euc .= $c;
  1008.     }
  1009.   }
  1010.   return $euc;
  1011. }
  1012.  
  1013. sub 'sjis_jis {
  1014.   local($sjis) = @_;
  1015.   local($jis, $kanji, $c, $n1, $n2, $i);
  1016.   $kanji = 0;
  1017.   $jis = '';
  1018.   $sjis = &'sjis_sjis($sjis);
  1019.   for ($i = 0; $i < length($sjis); $i++) {
  1020.     $c = substr($sjis, $i, 1);
  1021.     $n1 = ord($c);
  1022.     if ($n1 >= 0240 && $n1 <= 0337) {
  1023.       if ($kanji != 2) {
  1024.         $jis .= "\e(I";
  1025.         $kanji = 2;
  1026.       }
  1027.       $jis .= pack('C', $n1 & 0177);
  1028.     } elsif ($n1 >= 0201) {
  1029.       if ($kanji != 1) {
  1030.         $jis .= "\e\$B";
  1031.         $kanji = 1;
  1032.       }
  1033.       $i++;
  1034.       $n2 = ord(substr($sjis, $i, 1));
  1035.       $n2-- if $n2 > 0177;
  1036.       if ($n2 >= 0236) {
  1037.         $n1 = ((($n1 ^ 040) - 0241) << 1) + 042;
  1038.         $n2 -= 0175;
  1039.       } else {
  1040.         $n1 = ((($n1 ^ 040) - 0241) << 1) + 041;
  1041.         $n2 -= 037;
  1042.       }
  1043.       $jis .= pack('CC', $n1, $n2);
  1044.     } else {
  1045.       if ($kanji) {
  1046.         $jis .= "\e\(B";
  1047.         $kanji = 0;
  1048.       }
  1049.       $jis .= $c;
  1050.     }
  1051.   }
  1052.   $jis .= "\e\(B" if $kanji;
  1053.   return $jis;
  1054. }
  1055.  
  1056. sub 'sjis_sjis {
  1057.   local($sjis) = @_;
  1058.   return $sjis;
  1059. }
  1060.  
  1061. sub 'connect {
  1062.   local($host, $port) = @_;
  1063.   local($serverno, $socket, $ip, @addr, $name);
  1064.   if ($host =~ /^\d+$/) {
  1065.     $ip = $host;
  1066.   } elsif ($host =~ /^[\d\.]+$/) {
  1067.     @addr = split(/\./, $host);
  1068.     $ip = unpack('N', pack('C4', @addr, 0, 0, 0));
  1069.   } else {
  1070.     $ip = unpack('N', (gethostbyname($host))[4] || "\0\0\0\0");
  1071.   }
  1072.   return 0 unless $ip;
  1073.   $socket = '\'S' . ++$handle;
  1074.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  1075.   $name = pack($SOCKADDR, $AF_INET, $port, $ip);
  1076.   connect($socket, $name) || return 0;
  1077.   binmode($socket);
  1078.   $serverno = fileno($socket);
  1079.   vec($'rin, $serverno, 1) = 1;
  1080.   $'socket[$serverno] = $socket;
  1081.   select((select($socket), $| = 1)[0]);
  1082.   $'access[$serverno] = time();
  1083.   return $serverno;
  1084. }
  1085.  
  1086. sub 'listen {
  1087.   local($port, $count) = @_;
  1088.   local($listenno, $socket, $name);
  1089.   $socket = '\'L' . ++$handle;
  1090.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  1091.   if (defined($SOL_SOCKET) && defined($SO_REUSEADDR)) {
  1092.     setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1));
  1093.   }
  1094.   $name = pack($SOCKADDR, $AF_INET, $port, unpack('N', $INADDR_ANY));
  1095.   bind($socket, $name) || return 0;
  1096.   listen($socket, $count || $SOMAXCONN) || return 0;
  1097.   $listenno = fileno($socket);
  1098.   vec($'rin, $listenno, 1) = 1;
  1099.   $'socket[$listenno] = $socket;
  1100.   select((select($socket), $| = 1)[0]);
  1101.   $'access[$listenno] = time();
  1102.   return $listenno;
  1103. }
  1104.  
  1105. sub 'accept {
  1106.   local($listenno) = @_;
  1107.   local($clientno, $socket);
  1108.   $socket = '\'C' . ++$handle;
  1109.   accept($socket, $'socket[$listenno]) || return 0;
  1110.   binmode($socket);
  1111.   $clientno = fileno($socket);
  1112.   vec($'rin, $clientno, 1) = 1;
  1113.   $'socket[$clientno] = $socket;
  1114.   select((select($socket), $| = 1)[0]);
  1115.   $'access[$clientno] = time();
  1116.   return $clientno;
  1117. }
  1118.  
  1119. sub 'close {
  1120.   local($no) = @_;
  1121.   close($'socket[$no]);
  1122.   vec($'rin, $no, 1) = 0;
  1123. }
  1124.  
  1125. sub 'sockname {
  1126.   local($no) = @_;
  1127.   local($port, $ip, $host);
  1128.   ($port, $ip) = (unpack($SOCKADDR, getsockname($'socket[$no])))[1, 2];
  1129.   $host = (gethostbyaddr(pack('N', $ip), $AF_INET))[0];
  1130.   return ($port, $ip, $host);
  1131. }
  1132.  
  1133. sub 'peername {
  1134.   local($no) = @_;
  1135.   local($port, $ip, $host);
  1136.   ($port, $ip) = (unpack($SOCKADDR, getpeername($'socket[$no])))[1, 2];
  1137.   $host = (gethostbyaddr(pack('N', $ip), $AF_INET))[0];
  1138.   return ($port, $ip, $host);
  1139. }
  1140.  
  1141. sub 's_connect {
  1142.   local($userno) = @_;
  1143.   local($server, $host, $name, $list, $pass, $serverno, @port);
  1144.   foreach $server (&'property($userno, 'server')) {
  1145.     next if &'exist($errorlist[$userno], $server);
  1146.     ($host, $pass) = (split(/\s+/, $server), '');
  1147.     ($name, $list) = split(/\:/, $host);
  1148.     @port = split(/\,/, $list || '');
  1149.     $serverno = &'connect($name, $port[rand(@port)] || $IRCPORT);
  1150.     next unless $serverno;
  1151.     $'serverlist = &'add($'serverlist, $serverno);
  1152.     $'avail[$serverno] = 0;
  1153.     $'userno[$serverno] = $userno;
  1154.     $pass[$serverno] = $pass;
  1155.     $serverhost[$serverno] = $server;
  1156.     $rbuf[$serverno] = '';
  1157.     &s_init($serverno);
  1158.     last;
  1159.   }
  1160.   $errorlist[$userno] = '' unless $host;
  1161. }
  1162.  
  1163. sub 's_close {
  1164.   local($serverno) = @_;
  1165.   local($userno, $no, $cmd);
  1166.   $userno = $'userno[$serverno];
  1167.   $rbuf[$serverno] = '';
  1168.   $sequence[$serverno] = '';
  1169.   foreach $key (keys(%wbuf)) {
  1170.     ($no, $cmd) = split(/$;/, $key, 2);
  1171.     next unless $no == $serverno;
  1172.     delete $wbuf{$key};
  1173.   }
  1174.   $serverhost[$serverno] = '';
  1175.   &'close($serverno);
  1176.   $'serverlist = &'remove($'serverlist, $serverno);
  1177.   if ($'avail[$serverno]) {
  1178.     $'avail[$serverno] = 0;
  1179.     &close_event($userno, 'server_close', $serverno);
  1180.   }
  1181. }
  1182.  
  1183. sub c_listen {
  1184.   local($userno) = @_;
  1185.   local($listenno, $name, $port, $i, $uselist);
  1186.   foreach $port (&get_port($userno)) {
  1187.     $port = $IRCPORT unless $port;
  1188.     next if &'exist($portlist, $port);
  1189.     $listenno = &'listen($port, $SOMAXCONN);
  1190.     next unless $listenno;
  1191.     $'listenlist = &'add($'listenlist, $listenno);
  1192.     $portlist = &'add($portlist, $port);
  1193.   }
  1194.   for ($i = 0; $i < @'username; $i++) {
  1195.     foreach $port (&get_port($i)) {
  1196.       $uselist = &'add($uselist, $port || $IRCPORT);
  1197.     }
  1198.   }
  1199.   foreach $lno (&'array($'listenlist)) {
  1200.     $port = (&'sockname($lno))[0];
  1201.     next if &'exist($uselist, $port);
  1202.     &'close($lno);
  1203.     $'listenlist = &'remove($'listenlist, $lno);
  1204.     $portlist = &'remove($portlist, $port);
  1205.   }
  1206. }
  1207.  
  1208. sub c_accept {
  1209.   local($listenno) = @_;
  1210.   local($clientno, $port, $ip, $name, $host, $pass, $regex, $i);
  1211.   $clientno = &'accept($listenno);
  1212.   return unless $clientno;
  1213.   $port = (&'sockname($clientno))[0];
  1214.   $ip = join('.', unpack('C4', pack('N', (&'peername($clientno))[1])));
  1215.   $name = (&'peername($clientno))[2];
  1216.   for ($i = 0; $i < @'username; $i++) {
  1217.     foreach $client (&'property($i, 'client')) {
  1218.       ($host, $pass) = (split(/\s+/, $client), '');
  1219.       next unless $port == ((split(/\:/, $host))[1] || $IRCPORT);
  1220.       $regex = &'regex((split(/\:/, $host))[0]);
  1221.       next unless ($ip =~ /$regex/i || $name =~ /$regex/i);
  1222.       $'clientlist = &'add($'clientlist, $clientno);
  1223.       $'avail[$clientno] = 0;
  1224.       $'nick[$clientno] = '';
  1225.       $'user[$clientno] = '';
  1226.       $rbuf[$clientno] = '';
  1227.       $pass[$clientno] = '';
  1228.       return;
  1229.     }
  1230.   }
  1231.   &'close($clientno);
  1232. }
  1233.  
  1234. sub get_port {
  1235.   local($userno) = @_;
  1236.   local($host, $pass, $mask, $port, $list);
  1237.   $list = '';
  1238.   foreach $client (&'property($userno, 'client')) {
  1239.     ($host, $pass) = split(/\s+/, $client, 2);
  1240.     ($mask, $port) = split(/\:/, $host);
  1241.     $list = &'add($list, $port);
  1242.   }
  1243.   return &'array($list);
  1244. }
  1245.  
  1246. sub 'c_close {
  1247.   local($clientno) = @_;
  1248.   $rbuf[$clientno] = '';
  1249.   $sequence[$clientno] = '';
  1250.   delete $wbuf{$clientno};
  1251.   &'close($clientno);
  1252.   $'clientlist = &'remove($'clientlist, $clientno);
  1253.   if ($'avail[$clientno]) {
  1254.     $'avail[$clientno] = 0;
  1255.     &close_event($'userno[$clientno], 'client_close', $clientno);
  1256.   }
  1257. }
  1258.  
  1259. sub s_init {
  1260.   local($serverno) = @_;
  1261.   local($userno, $nick, $user, $name);
  1262.   $userno = $'userno[$serverno];
  1263.   &'s_print($serverno, '', 'PASS', $pass[$serverno]) if $pass[$serverno];
  1264.   $nick = $nickname[$userno] || &'property($userno, 'nick') || getlogin() || eval '(getpwuid($<))[0]' || "$NAME-user";
  1265.   &'s_print($serverno, '', 'NICK', (split(/\,/, $nick))[0]);
  1266.   $user = &'property($userno, 'user') || getlogin() || eval '(getpwuid($<))[0]' || "$NAME-user";
  1267.   $name = &'property($userno, 'name');
  1268.   $name = eval '((split(/\,/, (getpwuid($<))[6]))[0])' || $user unless defined($name);
  1269.   &'s_print($serverno, '', 'USER', $user, '*', '*', $name);
  1270.   $'user[$serverno] = $user;
  1271. }
  1272.  
  1273. sub c_init {
  1274.   local($clientno) = @_;
  1275.   local($port, $ip, $name, $host, $pass, $regex, $i);
  1276.   $port = (&'sockname($clientno))[0];
  1277.   $ip = join('.', unpack('C4', pack('N', (&'peername($clientno))[1])));
  1278.   $name = (&'peername($clientno))[2];
  1279.   for ($i = 0; $i < @'username; $i++) {
  1280.     foreach $client (&'property($i, 'client')) {
  1281.       ($host, $pass) = (split(/\s+/, $client), '');
  1282.       next unless $port == ((split(/\:/, $host))[1] || $IRCPORT);
  1283.       $regex = &'regex((split(/\:/, $host))[0]);
  1284.       next unless ($ip =~ /$regex/i || $name =~ /$regex/i);
  1285.       next if ($pass && $pass ne $pass[$clientno]);
  1286.       $'userno[$clientno] = $i;
  1287.       $'avail[$clientno] = 1;
  1288.       $'server[$clientno] = 0;
  1289.       $'servername[$clientno] = $NAME;
  1290.       foreach $sno (&'array($'serverlist)) {
  1291.         next unless $'avail[$sno];
  1292.         next unless $'userno[$sno] == $'userno[$clientno];
  1293.         $'server[$clientno] = $sno;
  1294.         $'servername[$clientno] = $'servername[$sno];
  1295.       }
  1296.       &open_event($'userno[$clientno], 'client_open', $clientno);
  1297.       return;
  1298.     }
  1299.   }
  1300.   &'c_print($clientno, $NAME, '464', $'nick[$clientno], 'Password incorrect');
  1301.   &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . ' (Bad Password)');
  1302.   &'c_flush($clientno);
  1303.   &'c_close($clientno);
  1304. }
  1305.  
  1306. sub cn_mode {
  1307.   local($clientno, $prefix, $cmd, @params) = @_;
  1308.   &'c_print($clientno, $NAME, '451', '*', 'You have not registered');
  1309. }
  1310.  
  1311. sub cn_nick {
  1312.   local($clientno, $prefix, $cmd, @params) = @_;
  1313.   $'nick[$clientno] = $params[0];
  1314.   &c_init($clientno) if $'user[$clientno];
  1315. }
  1316.  
  1317. sub cn_pass {
  1318.   local($clientno, $prefix, $cmd, @params) = @_;
  1319.   $pass[$clientno] = $params[0];
  1320. }
  1321.  
  1322. sub cn_ping {
  1323.   local($clientno, $prefix, $cmd, @params) = @_;
  1324.   &'c_print($clientno, $NAME, '451', '*', 'You have not registered');
  1325. }
  1326.  
  1327. sub cn_quit {
  1328.   local($clientno, $prefix, $cmd, @params) = @_;
  1329.   $params[0] = 'I Quit' unless $params[0];
  1330.   &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . " ($params[0])");
  1331.   &'c_flush($clientno);
  1332.   &'c_close($clientno);
  1333. }
  1334.  
  1335. sub cn_user {
  1336.   local($clientno, $prefix, $cmd, @params) = @_;
  1337.   if (defined(@params) && @params >= 4) {
  1338.     $'user[$clientno] = $params[0];
  1339.     &c_init($clientno) if $'nick[$clientno];
  1340.   } else {
  1341.     &'c_print($clientno, $NAME, '461', 'Not enough parameters');
  1342.   }
  1343. }
  1344.  
  1345. sub sn_error {
  1346.   local($serverno, $prefix, $cmd, @params) = @_;
  1347.   local($userno);
  1348.   $userno = $'userno[$serverno];
  1349.   $errorlist[$userno] = &'add($errorlist[$userno], $serverhost[$serverno]);
  1350. }
  1351.  
  1352. sub sn_ping {
  1353.   local($serverno, $prefix, $cmd, @params) = @_;
  1354.   &'s_print($serverno, '', 'PONG', @params);
  1355. }
  1356.  
  1357. sub sn_001 {
  1358.   local($serverno, $prefix, $cmd, @params) = @_;
  1359.   local($userno, @user);
  1360.   $userno = $'userno[$serverno];
  1361.   $'avail[$serverno] = 1;
  1362.   $'nick[$serverno] = $params[0];
  1363.   $'servername[$serverno] = $prefix;
  1364.   $nickname[$userno] = $params[0];
  1365.   $errorlist[$userno] = '';
  1366.   @user = &'prefix(substr($params[1], rindex($params[1], ' ') + 1));
  1367.   if ($user[1] && $user[2]) {
  1368.     $address[$userno] = "$user[1]\@$user[2]";
  1369.   }
  1370.   &open_event($userno, 'server_open', $serverno);
  1371. }
  1372.  
  1373. sub sn_432 {
  1374.   local($serverno, $prefix, $cmd, @params) = @_;
  1375.   &anothernick($serverno, $params[1]);
  1376. }
  1377.  
  1378. sub sn_433 {
  1379.   local($serverno, $prefix, $cmd, @params) = @_;
  1380.   &anothernick($serverno, $params[1]);
  1381. }
  1382.  
  1383. sub sn_437 {
  1384.   local($serverno, $prefix, $cmd, @params) = @_;
  1385.   &anothernick($serverno, $params[1]);
  1386. }
  1387.  
  1388. sub sn_451 {
  1389.   local($serverno, $prefix, $cmd, @params) = @_;
  1390. }
  1391.  
  1392. sub anothernick {
  1393.   local($serverno, $newnick) = @_;
  1394.   local(@nickentry, $list, $user);
  1395.   $list = '';
  1396.   foreach $nick (&'property($'userno[$serverno], 'nick')) {
  1397.     foreach $name (split(/\,/, $nick)) {
  1398.       $list = &'add($list, substr($name, 0, 9));
  1399.     }
  1400.   }
  1401.   $user = substr(getlogin() || eval '(getpwuid($<))[0]' || "$NAME-user", 0, 9);
  1402.   $list = &'add($list, $user);
  1403.   $user = substr($user, 0, 8);
  1404.   $list = &'add($list, "${user}_", "_${user}", "${user}-", "-${user}");
  1405.   @nickentry = &'array($list);
  1406.   if (&'exist($list, $newnick)) {
  1407.     while ($nickentry[0] ne $newnick) {
  1408.       push(@nickentry, shift(@nickentry));
  1409.     }
  1410.     push(@nickentry, shift(@nickentry));
  1411.   }
  1412.   &'s_print($serverno, '', 'NICK', $nickentry[0]);
  1413. }
  1414.  
  1415. sub main_loop {
  1416.   local($userno) = @_;
  1417.   &c_listen($userno);
  1418.   foreach $sno (&'array($'serverlist)) {
  1419.     return if $'userno[$sno] == $userno;
  1420.   }
  1421.   &'s_connect($userno);
  1422. }
  1423.  
  1424. sub client_open {
  1425.   local($clientno) = @_;
  1426.   local($sno);
  1427.   $sno = $'server[$clientno];
  1428.   &'c_print($clientno, $'servername[$clientno], '001', $'nick[$clientno], 'Welcome to the Internet Relay Network ' . &'user($clientno));
  1429.   if ($sno) {
  1430.     &'c_print($clientno, &'user($clientno), 'NICK', $'nick[$sno]) if ($'nick[$clientno] ne $'nick[$sno]);
  1431.     foreach $chan (&'array($'channellist[$sno])) {
  1432.       &'c_print($clientno, &'user($clientno), 'JOIN', $chan);
  1433.       &'c_print($clientno, $'servername[$clientno], '332', $'nick[$clientno], $chan, $'topic{$sno, $chan}) if $'topic{$sno, $chan};
  1434.       &'c_print($clientno, $'servername[$clientno], '353', $'nick[$clientno], '=', $chan, join(' ', reverse(&'array($'nameslist{$sno, $chan}))));
  1435.       &'c_print($clientno, $'servername[$clientno], '366', $'nick[$clientno], $chan, 'End of /NAMES list.');
  1436.     }
  1437.   }
  1438. }
  1439.  
  1440. sub client_close {
  1441.   local($clientno) = @_;
  1442.   &clear_variable($clientno);
  1443. }
  1444.  
  1445. sub server_open {
  1446.   local($serverno) = @_;
  1447.   foreach $cno (&'array($'clientlist)) {
  1448.     next unless $'avail[$cno];
  1449.     next if $'server[$cno];
  1450.     next unless $'userno[$cno] == $'userno[$serverno];
  1451.     $'server[$cno] = $serverno;
  1452.     next unless $'nick[$cno] ne $'nick[$serverno];
  1453.     &'c_print($cno, &'user($cno), 'NICK', $'nick[$serverno]);
  1454.   }
  1455. }
  1456.  
  1457. sub server_close {
  1458.   local($serverno) = @_;
  1459.   foreach $cno (&'array($'clientlist)) {
  1460.     next unless $'avail[$cno];
  1461.     next unless $'server[$cno] == $serverno;
  1462.     &'c_print($cno, '', 'NOTICE', $'nick[$cno], "*** Server $'servername[$serverno] closed the connection");
  1463.     foreach $chan (&'array($'channellist[$serverno])) {
  1464.       &'c_print($cno, &'user($cno), 'PART', $chan);
  1465.     }
  1466.     $'server[$cno] = 0;
  1467.   }
  1468.   &clear_variable($serverno);
  1469. }
  1470.  
  1471. sub clear_variable {
  1472.   local($num) = @_;
  1473.   local($no, $var);
  1474.   $'channellist[$num] = '';
  1475.   foreach $key (keys(%'nameslist)) {
  1476.     ($no, $var) = split(/$;/, $key, 2);
  1477.     next unless $no == $num;
  1478.     delete $'nameslist{$key};
  1479.   }
  1480.   foreach $key (keys(%'channelmode)) {
  1481.     ($no, $var) = split(/$;/, $key, 2);
  1482.     next unless $no == $num;
  1483.     delete $'channelmode{$key};
  1484.   }
  1485.   foreach $key (keys(%'usermode)) {
  1486.     ($no, $var) = split(/$;/, $key, 2);
  1487.     next unless $no == $num;
  1488.     delete $'usermode{$key};
  1489.   }
  1490.   foreach $key (keys(%'topic)) {
  1491.     ($no, $var) = split(/$;/, $key, 2);
  1492.     next unless $no == $num;
  1493.     delete $'topic{$key};
  1494.   }
  1495. }
  1496.  
  1497. sub cs_exit {
  1498.   local($clientno, $prefix, $cmd, @params) = @_;
  1499.   local($i, $list, $sub);
  1500.   foreach $sno (&'array($'serverlist)) {
  1501.     &'s_flush($sno);
  1502.     &'s_print($sno, '', 'QUIT', $params[0] || $NAME);
  1503.     &'s_flush($sno);
  1504.     &'s_close($sno);
  1505.   }
  1506.   $params[0] = 'I Quit' unless $params[0];
  1507.   foreach $cno (&'array($'clientlist)) {
  1508.     &'c_print($cno, '', 'ERROR', 'Closing Link: ' . &'user($cno) . " ($params[0])");
  1509.     &'c_flush($cno);
  1510.     &'c_close($cno);
  1511.   }
  1512.   foreach $lno (&'array($'listenlist)) {
  1513.     &'close($lno);
  1514.   }
  1515.   for ($i = 0; $i < @'username; $i++) {
  1516.     $list = $'modulelist[$i];
  1517.     $'modulelist[$i] = '';
  1518.     foreach $module (&'array($list)) {
  1519.       $sub = $module . '\'module_disable';
  1520.       &$sub($i) if defined(&$sub);
  1521.     }
  1522.   }
  1523.   exit(0);
  1524. }
  1525.  
  1526. sub cs_quit {
  1527.   local($clientno, $prefix, $cmd, @params) = @_;
  1528.   $params[0] = 'I Quit' unless $params[0];
  1529.   &'c_print($clientno, '', 'ERROR', 'Closing Link: ' . &'user($clientno) . " ($params[0])");
  1530.   &'c_flush($clientno);
  1531.   &'c_close($clientno);
  1532.   return ();
  1533. }
  1534.  
  1535. sub cp_join {
  1536.   local($clientno, $prefix, $cmd, $chan) = @_;
  1537.   local($userno, $nick, $name, $mode);
  1538.   $nick = &'prefix($prefix);
  1539.   ($name, $mode) = (split(/\cG/, $chan), '');
  1540.   if ($nick eq $'nick[$clientno]) {
  1541.     $'channellist[$clientno] = &'add($'channellist[$clientno], $name);
  1542.     $'nameslist{$clientno, $name} = '';
  1543.   } else {
  1544.     if (index($mode, 'o') != -1) {
  1545.       $'nameslist{$clientno, $name} = &'add($'nameslist{$clientno, $name}, "\@$nick");
  1546.     } elsif (index($mode, 'v') != -1) {
  1547.       $'nameslist{$clientno, $name} = &'add($'nameslist{$clientno, $name}, "+$nick");
  1548.     } else {
  1549.       $'nameslist{$clientno, $name} = &'add($'nameslist{$clientno, $name}, $nick);
  1550.     }
  1551.   }
  1552.   return ($prefix, $cmd, $chan);
  1553. }
  1554.  
  1555. sub ss_join {
  1556.   local($serverno, $prefix, $cmd, $chan) = @_;
  1557.   local($nick, $name, $mode);
  1558.   $nick = &'prefix($prefix);
  1559.   ($name, $mode) = (split(/\cG/, $chan), '');
  1560.   if ($nick eq $'nick[$serverno]) {
  1561.     $'channellist[$serverno] = &'add($'channellist[$serverno], $name);
  1562.     $'nameslist{$serverno, $name} = '';
  1563.   } else {
  1564.     if (index($mode, 'o') != -1) {
  1565.       $'nameslist{$serverno, $name} = &'add($'nameslist{$serverno, $name}, "\@$nick");
  1566.     } elsif (index($mode, 'v') != -1) {
  1567.       $'nameslist{$serverno, $name} = &'add($'nameslist{$serverno, $name}, "+$nick");
  1568.     } else {
  1569.       $'nameslist{$serverno, $name} = &'add($'nameslist{$serverno, $name}, $nick);
  1570.     }
  1571.   }
  1572.   return ($prefix, $cmd, $chan);
  1573. }
  1574.  
  1575. sub cp_kick {
  1576.   local($clientno, $prefix, $cmd, @params) = @_;
  1577.   if ($params[1] eq $'nick[$clientno]) {
  1578.     $'channellist[$clientno] = &'remove($'channellist[$clientno], $params[0]);
  1579.     delete $'nameslist{$clientno, $params[0]};
  1580.   } else {
  1581.     $'nameslist{$clientno, $params[0]} = &'remove($'nameslist{$clientno, $params[0]}, $params[1], "+$params[1]", "\@$params[1]");
  1582.   }
  1583.   return ($prefix, $cmd, @params);
  1584. }
  1585.  
  1586. sub ss_kick {
  1587.   local($serverno, $prefix, $cmd, @params) = @_;
  1588.   if ($params[1] eq $'nick[$serverno]) {
  1589.     $'channellist[$serverno] = &'remove($'channellist[$serverno], $params[0]);
  1590.     delete $'nameslist{$serverno, $params[0]};
  1591.   } else {
  1592.     $'nameslist{$serverno, $params[0]} = &'remove($'nameslist{$serverno, $params[0]}, $params[1], "+$params[1]", "\@$params[1]");
  1593.   }
  1594.   return ($prefix, $cmd, @params);
  1595. }
  1596.  
  1597. sub cp_mode {
  1598.   local($clientno, $prefix, $cmd, @params) = @_;
  1599.   local($chan, $mode, @modes, $char, $flag, $name, $i);
  1600.   ($chan, $mode, @modes) = @params;
  1601.   if (&'channel($chan)) {
  1602.     for ($i = 0; $i < length($mode); $i++) {
  1603.       $char = substr($mode, $i, 1);
  1604.       if ($char eq '+' || $char eq '-') {
  1605.         $flag = $char;
  1606.       } elsif ($char eq 'b') {
  1607.         shift(@modes);
  1608.       } elsif ($char eq 'e') {
  1609.         shift(@modes);
  1610.       } elsif ($char eq 'I') {
  1611.         shift(@modes);
  1612.       } elsif ($char eq 'k') {
  1613.         if ($flag eq '+') {
  1614.           $'channelmode{$clientno, $chan, $char} = shift(@modes);
  1615.         } else {
  1616.           shift(@modes);
  1617.           delete $'channelmode{$clientno, $chan, $char};
  1618.         }
  1619.       } elsif ($char eq 'l') {
  1620.         if ($flag eq '+') {
  1621.           $'channelmode{$clientno, $chan, $char} = shift(@modes);
  1622.         } else {
  1623.           delete $'channelmode{$clientno, $chan, $char};
  1624.         }
  1625.       } elsif ($char eq 'O') {
  1626.         shift(@modes);
  1627.       } elsif ($char eq 'o') {
  1628.         $name = shift(@modes);
  1629.         if ($flag eq '+') {
  1630.           $'nameslist{$clientno, $chan} = &'change($'nameslist{$clientno, $chan}, $name, "\@$name", "+$name", "\@$name");
  1631.         } elsif ($flag eq '-') {
  1632.           $'nameslist{$clientno, $chan} = &'change($'nameslist{$clientno, $chan}, "\@$name", $name);
  1633.         }
  1634.       } elsif ($char eq 'v') {
  1635.         $name = shift(@modes);
  1636.         if ($flag eq '+') {
  1637.           $'nameslist{$clientno, $chan} = &'change($'nameslist{$clientno, $chan}, $name, "+$name");
  1638.         } elsif ($flag eq '-') {
  1639.           $'nameslist{$clientno, $chan} = &'change($'nameslist{$clientno, $chan}, "+$name", $name);
  1640.         }
  1641.       } else {
  1642.         if ($flag eq '+') {
  1643.           $'channelmode{$clientno, $chan, $char} = 1;
  1644.         } else {
  1645.           delete $'channelmode{$clientno, $chan, $char};
  1646.         }        
  1647.       }
  1648.     }
  1649.   } else {
  1650.     for ($i = 0; $i < length($mode); $i++) {
  1651.       $char = substr($mode, $i, 1);
  1652.       if ($char eq '+' || $char eq '-') {
  1653.         $flag = $char;
  1654.       } else {
  1655.         if ($flag eq '+') {
  1656.           $'usermode{$serverno, $char} = 1;
  1657.         } else {
  1658.           delete $'usermode{$serverno, $char};
  1659.         }
  1660.       }
  1661.     }
  1662.   }
  1663.   return ($prefix, $cmd, @params);
  1664. }
  1665.  
  1666. sub ss_mode {
  1667.   local($serverno, $prefix, $cmd, @params) = @_;
  1668.   local($chan, $mode, @modes, $char, $flag, $name, $i);
  1669.   ($chan, $mode, @modes) = @params;
  1670.   if (&'channel($chan)) {
  1671.     for ($i = 0; $i < length($mode); $i++) {
  1672.       $char = substr($mode, $i, 1);
  1673.       if ($char eq '+' || $char eq '-') {
  1674.         $flag = $char;
  1675.       } elsif ($char eq 'b') {
  1676.         shift(@modes);
  1677.       } elsif ($char eq 'e') {
  1678.         shift(@modes);
  1679.       } elsif ($char eq 'I') {
  1680.         shift(@modes);
  1681.       } elsif ($char eq 'k') {
  1682.         if ($flag eq '+') {
  1683.           $'channelmode{$serverno, $chan, $char} = shift(@modes);
  1684.         } else {
  1685.           shift(@modes);
  1686.           delete $'channelmode{$serverno, $chan, $char};
  1687.         }
  1688.       } elsif ($char eq 'l') {
  1689.         if ($flag eq '+') {
  1690.           $'channelmode{$serverno, $chan, $char} = shift(@modes);
  1691.         } else {
  1692.           delete $'channelmode{$serverno, $chan, $char};
  1693.         }
  1694.       } elsif ($char eq 'O') {
  1695.         shift(@modes);
  1696.       } elsif ($char eq 'o') {
  1697.         $name = shift(@modes);
  1698.         if ($flag eq '+') {
  1699.           $'nameslist{$serverno, $chan} = &'change($'nameslist{$serverno, $chan}, $name, "\@$name", "+$name", "\@$name");
  1700.         } elsif ($flag eq '-') {
  1701.           $'nameslist{$serverno, $chan} = &'change($'nameslist{$serverno, $chan}, "\@$name", $name);
  1702.         }
  1703.       } elsif ($char eq 'v') {
  1704.         $name = shift(@modes);
  1705.         if ($flag eq '+') {
  1706.           $'nameslist{$serverno, $chan} = &'change($'nameslist{$serverno, $chan}, $name, "+$name");
  1707.         } elsif ($flag eq '-') {
  1708.           $'nameslist{$serverno, $chan} = &'change($'nameslist{$serverno, $chan}, "+$name", $name);
  1709.         }
  1710.       } else {
  1711.         if ($flag eq '+') {
  1712.           $'channelmode{$serverno, $chan, $char} = 1;
  1713.         } else {
  1714.           delete $'channelmode{$serverno, $chan, $char};
  1715.         }        
  1716.       }
  1717.     }
  1718.   } else {
  1719.     for ($i = 0; $i < length($mode); $i++) {
  1720.       $char = substr($mode, $i, 1);
  1721.       if ($char eq '+' || $char eq '-') {
  1722.         $flag = $char;
  1723.       } else {
  1724.         if ($flag eq '+') {
  1725.           $'usermode{$serverno, $char} = 1;
  1726.         } else {
  1727.           delete $'usermode{$serverno, $char};
  1728.         }
  1729.       }
  1730.     }
  1731.   }
  1732.   return ($prefix, $cmd, @params);
  1733. }
  1734.  
  1735. sub cp_nick {
  1736.   local($clientno, $prefix, $cmd, @params) = @_;
  1737.   local($nick);
  1738.   $nick = &'prefix($prefix);
  1739.   if ($nick eq $'nick[$clientno]) {
  1740.     $'nick[$clientno] = $params[0];
  1741.   }
  1742.   foreach $chan (&'array($'channellist[$clientno])) {
  1743.     $'nameslist{$clientno, $chan} = &'change($'nameslist{$clientno, $chan}, $nick, $params[0], "+$nick", "+$params[0]", "\@$nick", "\@$params[0]");
  1744.   }
  1745.   return ($prefix, $cmd, @params);
  1746. }
  1747.  
  1748. sub ss_nick {
  1749.   local($serverno, $prefix, $cmd, @params) = @_;
  1750.   local($userno, $nick);
  1751.   $userno = $'userno[$serverno];
  1752.   $nick = &'prefix($prefix);
  1753.   if ($nick eq $'nick[$serverno]) {
  1754.     $'nick[$serverno] = $params[0];
  1755.     $nickname[$userno] = $params[0];
  1756.   }
  1757.   foreach $chan (&'array($'channellist[$serverno])) {
  1758.     $'nameslist{$serverno, $chan} = &'change($'nameslist{$serverno, $chan}, $nick, $params[0], "+$nick", "+$params[0]", "\@$nick", "\@$params[0]");
  1759.   }
  1760.   return ($prefix, $cmd, @params);
  1761. }
  1762.  
  1763. sub cp_part {
  1764.   local($clientno, $prefix, $cmd, @params) = @_;
  1765.   local($nick);
  1766.   $nick = &'prefix($prefix);
  1767.   if ($nick eq $'nick[$clientno]) {
  1768.     $'channellist[$clientno] = &'remove($'channellist[$clientno], $params[0]);
  1769.     delete $'nameslist{$clientno, $params[0]};
  1770.   } else {
  1771.     $'nameslist{$clientno, $params[0]} = &'remove($'nameslist{$clientno, $params[0]}, $nick, "+$nick", "\@$nick");
  1772.   }
  1773.   return ($prefix, $cmd, @params);
  1774. }
  1775.  
  1776. sub ss_part {
  1777.   local($serverno, $prefix, $cmd, @params) = @_;
  1778.   local($nick);
  1779.   $nick = &'prefix($prefix);
  1780.   if ($nick eq $'nick[$serverno]) {
  1781.     $'channellist[$serverno] = &'remove($'channellist[$serverno], $params[0]);
  1782.     delete $'nameslist{$serverno, $params[0]};
  1783.   } else {
  1784.     $'nameslist{$serverno, $params[0]} = &'remove($'nameslist{$serverno, $params[0]}, $nick, "+$nick", "\@$nick");
  1785.   }
  1786.   return ($prefix, $cmd, @params);
  1787. }
  1788.  
  1789. sub ss_ping {
  1790.   local($serverno, $prefix, $cmd, @params) = @_;
  1791.   &'s_print($serverno, '', 'PONG', @params);
  1792.   return ($prefix, $cmd, @params);
  1793. }
  1794.  
  1795. sub cs_pong {
  1796.   local($clientno, $prefix, $cmd, @params) = @_;
  1797.   return ();
  1798. }
  1799.  
  1800. sub cp_quit {
  1801.   local($clientno, $prefix, $cmd, @params) = @_;
  1802.   local($nick);
  1803.   $nick = &'prefix($prefix);
  1804.   foreach $chan (&'array($'channellist[$clientno])) {
  1805.     $'nameslist{$clientno, $chan} = &'remove($'nameslist{$clientno, $chan}, $nick, "+$nick", "\@$nick");
  1806.   }
  1807.   return ($prefix, $cmd, @params);
  1808. }
  1809.  
  1810. sub ss_quit {
  1811.   local($serverno, $prefix, $cmd, @params) = @_;
  1812.   local($nick);
  1813.   $nick = &'prefix($prefix);
  1814.   foreach $chan (&'array($'channellist[$serverno])) {
  1815.     $'nameslist{$serverno, $chan} = &'remove($'nameslist{$serverno, $chan}, $nick, "+$nick", "\@$nick");
  1816.   }
  1817.   return ($prefix, $cmd, @params);
  1818. }
  1819.  
  1820. sub cp_topic {
  1821.   local($clientno, $prefix, $cmd, @params) = @_;
  1822.   $'topic{$clientno, $params[0]} = $params[1];
  1823.   return ($prefix, $cmd, @params);
  1824. }
  1825.  
  1826. sub ss_topic {
  1827.   local($serverno, $prefix, $cmd, @params) = @_;
  1828.   $'topic{$serverno, $params[0]} = $params[1];
  1829.   return ($prefix, $cmd, @params);
  1830. }
  1831.  
  1832. sub cp_324 {
  1833.   local($clientno, $prefix, $cmd, @params) = @_;
  1834.   local($nick, $chan, $mode, @modes, $char, $flag, $i);
  1835.   ($nick, $chan, $mode, @modes) = @params;
  1836.   for ($i = 0; $i < length($mode); $i++) {
  1837.     $char = substr($mode, $i, 1);
  1838.     if ($char eq '+' || $char eq '-') {
  1839.       $flag = $char;
  1840.     } elsif ($char eq 'k') {
  1841.       if ($flag eq '+') {
  1842.         $'channelmode{$clientno, $chan, $char} = shift(@modes);
  1843.       } else {
  1844.         shift(@modes);
  1845.         delete $'channelmode{$clientno, $chan, $char};
  1846.       }
  1847.     } elsif ($char eq 'l') {
  1848.       if ($flag eq '+') {
  1849.         $'channelmode{$clientno, $chan, $char} = shift(@modes);
  1850.       } else {
  1851.         delete $'channelmode{$clientno, $chan, $char};
  1852.       }
  1853.     } else {
  1854.       if ($flag eq '+') {
  1855.         $'channelmode{$clientno, $chan, $char} = 1;
  1856.       } else {
  1857.         delete $'channelmode{$clientno, $chan, $char};
  1858.       }        
  1859.     }
  1860.   }
  1861.   return ($prefix, $cmd, @params);
  1862. }
  1863.  
  1864. sub ss_324 {
  1865.   local($serverno, $prefix, $cmd, @params) = @_;
  1866.   local($nick, $chan, $mode, @modes, $char, $flag, $i);
  1867.   ($nick, $chan, $mode, @modes) = @params;
  1868.   for ($i = 0; $i < length($mode); $i++) {
  1869.     $char = substr($mode, $i, 1);
  1870.     if ($char eq '+' || $char eq '-') {
  1871.       $flag = $char;
  1872.     } elsif ($char eq 'k') {
  1873.       if ($flag eq '+') {
  1874.         $'channelmode{$serverno, $chan, $char} = shift(@modes);
  1875.       } else {
  1876.         shift(@modes);
  1877.         delete $'channelmode{$serverno, $chan, $char};
  1878.       }
  1879.     } elsif ($char eq 'l') {
  1880.       if ($flag eq '+') {
  1881.         $'channelmode{$serverno, $chan, $char} = shift(@modes);
  1882.       } else {
  1883.         delete $'channelmode{$serverno, $chan, $char};
  1884.       }
  1885.     } else {
  1886.       if ($flag eq '+') {
  1887.         $'channelmode{$serverno, $chan, $char} = 1;
  1888.       } else {
  1889.         delete $'channelmode{$serverno, $chan, $char};
  1890.       }        
  1891.     }
  1892.   }
  1893.   return ($prefix, $cmd, @params);
  1894. }
  1895.  
  1896. sub cp_332 {
  1897.   local($clientno, $prefix, $cmd, @params) = @_;
  1898.   if (&'exist($'channellist[$clientno], $params[1])) {
  1899.     $'topic{$clientno, $params[1]} = $params[2];
  1900.   }
  1901.   return ($prefix, $cmd, @params);
  1902. }
  1903.  
  1904. sub ss_332 {
  1905.   local($serverno, $prefix, $cmd, @params) = @_;
  1906.   if (&'exist($'channellist[$serverno], $params[1])) {
  1907.     $'topic{$serverno, $params[1]} = $params[2];
  1908.   }
  1909.   return ($prefix, $cmd, @params);
  1910. }
  1911.  
  1912. sub cp_353 {
  1913.   local($clientno, $prefix, $cmd, @params) = @_;
  1914.   local($key);
  1915.   $key = "$clientno$;$params[2]";
  1916.   if (&'exist($'channellist[$clientno], $params[2])) {
  1917.     $'nameslist{$key} = &'add($'nameslist{$key}, reverse(split(/\s+/, $params[3])));
  1918.     if ($params[1] eq '@') {
  1919.       $'channelmode{$key, 's'} = 1;
  1920.     } elsif ($params[1] eq '*') {
  1921.       $'channelmode{$key, 'p'} = 1;
  1922.     }
  1923.   }
  1924.   return ($prefix, $cmd, @params);
  1925. }
  1926.  
  1927. sub ss_353 {
  1928.   local($serverno, $prefix, $cmd, @params) = @_;
  1929.   local($key);
  1930.   $key = "$serverno$;$params[2]";
  1931.   if (&'exist($'channellist[$serverno], $params[2])) {
  1932.     $'nameslist{$key} = &'add($'nameslist{$key}, reverse(split(/\s+/, $params[3])));
  1933.     if ($params[1] eq '@') {
  1934.       $'channelmode{$key, 's'} = 1;
  1935.     } elsif ($params[1] eq '*') {
  1936.       $'channelmode{$key, 'p'} = 1;
  1937.     }
  1938.   }
  1939.   return ($prefix, $cmd, @params);
  1940. }
  1941.  
  1942. sub cs_privmsg {
  1943.   local($clientno, $prefix, $cmd, @params) = @_;
  1944.   local($tmp, $ctmp, $rest, $ctcp, $list);
  1945.   if ($params[1]) {
  1946.     $tmp = '';
  1947.     $ctmp = '';
  1948.     $rest = $params[1];
  1949.     while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  1950.       $tmp .= $1;
  1951.       $ctmp .= $1;
  1952.       $ctcp = $2;
  1953.       $rest = $3;
  1954.       $tmp .= &ctcp_scan($clientno, 'cpcs', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
  1955.       $list = &'add($list, $ctcp);
  1956.     }
  1957.     $tmp .= $rest || '';
  1958.     $ctmp .= $rest || '';
  1959.     return () unless $tmp;
  1960.     $params[1] = $ctmp;
  1961.     foreach $cno (&'array($'clientlist)) {
  1962.       next unless $clientno != $cno;
  1963.       next unless $'avail[$cno];
  1964.       next unless $'server[$cno] == $'server[$clientno];
  1965.       &'c_print($cno, &'user($cno), $cmd, @params);
  1966.     }
  1967.     $params[1] = $tmp;
  1968.   }
  1969.   return ($prefix, $cmd, @params);
  1970. }
  1971.  
  1972. sub cp_privmsg {
  1973.   local($clientno, $prefix, $cmd, @params) = @_;
  1974.   local($tmp, $rest, $ctcp, $list);
  1975.   if ($params[1]) {
  1976.     $tmp = '';
  1977.     $rest = $params[1];
  1978.     while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  1979.       $tmp .= $1;
  1980.       $ctcp = $2;
  1981.       $rest = $3;
  1982.       $tmp .= &ctcp_print($clientno, 'cpcp', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
  1983.       $list = &'add($list, $ctcp);
  1984.     }
  1985.     $tmp .= $rest || '';
  1986.     return () unless $tmp;
  1987.     $params[1] = $tmp;
  1988.   }
  1989.   return ($prefix, $cmd, @params);
  1990. }
  1991.  
  1992. sub ss_privmsg {
  1993.   local($serverno, $prefix, $cmd, @params) = @_;
  1994.   local($tmp, $rest, $ctcp, $list);
  1995.   if ($params[1]) {
  1996.     $tmp = '';
  1997.     $rest = $params[1];
  1998.     while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  1999.       $tmp .= $1;
  2000.       $ctcp = $2;
  2001.       $rest = $3;
  2002.       $tmp .= &ctcp_scan($serverno, 'cpss', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
  2003.       $list = &'add($list, $ctcp);
  2004.     }
  2005.     $tmp .= $rest || '';
  2006.     return () unless $tmp;
  2007.     $params[1] = $tmp;
  2008.   }
  2009.   return ($prefix, $cmd, @params);
  2010. }
  2011.  
  2012. sub sp_privmsg {
  2013.   local($serverno, $prefix, $cmd, @params) = @_;
  2014.   local($tmp, $rest, $ctcp, $list);
  2015.   if ($params[1]) {
  2016.     $tmp = '';
  2017.     $rest = $params[1];
  2018.     while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  2019.       $tmp .= $1;
  2020.       $ctcp = $2;
  2021.       $rest = $3;
  2022.       $tmp .= &ctcp_print($serverno, 'cpsp', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
  2023.       $list = &'add($list, $ctcp);
  2024.     }
  2025.     $tmp .= $rest || '';
  2026.     return () unless $tmp;
  2027.     $params[1] = $tmp;
  2028.   }
  2029.   return ($prefix, $cmd, @params);
  2030. }
  2031.  
  2032. sub cs_notice {
  2033.   local($clientno, $prefix, $cmd, @params) = @_;
  2034.   local($tmp, $ctmp, $rest, $ctcp, $list);
  2035.   if ($params[1]) {
  2036.     $tmp = '';
  2037.     $ctmp = '';
  2038.     $rest = $params[1];
  2039.     while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  2040.       $tmp .= $1;
  2041.       $ctmp .= $1;
  2042.       $ctcp = $2;
  2043.       $rest = $3;
  2044.       $tmp .= &ctcp_scan($clientno, 'cncs', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
  2045.       $list = &'add($list, $ctcp);
  2046.     }
  2047.     $tmp .= $rest || '';
  2048.     $ctmp .= $rest || '';
  2049.     return () unless $tmp;
  2050.     foreach $cno (&'array($'clientlist)) {
  2051.       next unless $clientno != $cno;
  2052.       next unless $'avail[$cno];
  2053.       next unless $'server[$cno] == $'server[$clientno];
  2054.       &'c_print($cno, &'user($cno), $cmd, $params[0], $ctmp);
  2055.     }
  2056.   }
  2057.   return ($prefix, $cmd, @params);
  2058. }
  2059.  
  2060. sub cp_notice {
  2061.   local($clientno, $prefix, $cmd, @params) = @_;
  2062.   local($tmp, $rest, $ctcp, $list);
  2063.   if ($params[1]) {
  2064.     $tmp = '';
  2065.     $rest = $params[1];
  2066.     while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  2067.       $tmp .= $1;
  2068.       $ctcp = $2;
  2069.       $rest = $3;
  2070.       $tmp .= &ctcp_print($clientno, 'cncp', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
  2071.       $list = &'add($list, $ctcp);
  2072.     }
  2073.     $tmp .= $rest || '';
  2074.     return () unless $tmp;
  2075.   }
  2076.   return ($prefix, $cmd, @params);
  2077. }
  2078.  
  2079. sub ss_notice {
  2080.   local($serverno, $prefix, $cmd, @params) = @_;
  2081.   local($tmp, $rest, $ctcp, $list);
  2082.   if ($params[1]) {
  2083.     $tmp = '';
  2084.     $rest = $params[1];
  2085.     while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  2086.       $tmp .= $1;
  2087.       $ctcp = $2;
  2088.       $rest = $3;
  2089.       $tmp .= &ctcp_scan($serverno, 'cnss', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
  2090.       $list = &'add($list, $ctcp);
  2091.     }
  2092.     $tmp .= $rest || '';
  2093.     return () unless $tmp;
  2094.   }
  2095.   return ($prefix, $cmd, @params);
  2096. }
  2097.  
  2098. sub sp_notice {
  2099.   local($serverno, $prefix, $cmd, @params) = @_;
  2100.   local($tmp, $rest, $ctcp, $list);
  2101.   if ($params[1]) {
  2102.     $tmp = '';
  2103.     $rest = $params[1];
  2104.     while ($rest =~ /^([^\cA]*)\cA([^\cA]*)\cA(.*)$/) {
  2105.       $tmp .= $1;
  2106.       $ctcp = $2;
  2107.       $rest = $3;
  2108.       $tmp .= &ctcp_print($serverno, 'cnsp', $prefix, $params[0], $ctcp) unless &'exist($list, $ctcp);
  2109.       $list = &'add($list, $ctcp);
  2110.     }
  2111.     $tmp .= $rest || '';
  2112.     return () unless $tmp;
  2113.   }
  2114.   return ($prefix, $cmd, @params);
  2115. }
  2116.  
  2117. sub ctcp_scan {
  2118.   local($no, $event, $prefix, $chan, $ctcp) = @_;
  2119.   local($cmd, $param);
  2120.   ($cmd, $param) = split(/\s+/, $ctcp, 2);
  2121.   return '' unless $cmd;
  2122.   ($prefix, $cmd, $chan, $param) = &print_event($'userno[$no], "${event}\_\L$cmd\E", $no, $prefix, $cmd, $chan, $param);
  2123.   return '' unless $cmd;
  2124.   if ($param) {
  2125.     return "\cA$cmd $param\cA";
  2126.   } else {
  2127.     return "\cA$cmd\cA";
  2128.   }
  2129. }
  2130.  
  2131. sub ctcp_print {
  2132.   local($no, $event, $prefix, $chan, $ctcp) = @_;
  2133.   local($cmd, $param);
  2134.   ($cmd, $param) = split(/\s+/, $ctcp, 2);
  2135.   return '' unless $cmd;
  2136.   ($prefix, $cmd, $chan, $param) = &print_event($'userno[$no], "${event}\_\L$cmd\E", $no, $prefix, $cmd, $chan, $param);
  2137.   return '' unless $cmd;
  2138.   if ($param) {
  2139.     return "\cA$cmd $param\cA";
  2140.   } else {
  2141.     return "\cA$cmd\cA";
  2142.   }
  2143. }
  2144.  
  2145. sub scan_event {
  2146.   local($userno, $event, $no, $prefix, $cmd, @params) = @_;
  2147.   local($name, $sub, $label);
  2148.   $name = '\'' . $event;
  2149.   foreach $module (&'array($'modulelist[$userno])) {
  2150.     $sub = $module . $name;
  2151.     next unless defined(&$sub);
  2152.     if ($'labellist{$userno, $module}) {
  2153.       foreach $label (&'array($'labellist{$userno, $module})) {
  2154.         ($prefix, $cmd, @params) = &$sub($no, $prefix, $cmd, @params);
  2155.         return () unless $cmd;
  2156.       }
  2157.     } else {
  2158.       ($prefix, $cmd, @params) = &$sub($no, $prefix, $cmd, @params);
  2159.       return () unless $cmd;
  2160.     }
  2161.   }
  2162.   return ($prefix, $cmd, @params);
  2163. }
  2164.  
  2165. sub print_event {
  2166.   local($userno, $event, $no, $prefix, $cmd, @params) = @_;
  2167.   local($name, $sub, $label);
  2168.   $name = '\'' . $event;
  2169.   foreach $module (reverse(&'array($'modulelist[$userno]))) {
  2170.     $sub = $module . $name;
  2171.     next unless defined(&$sub);
  2172.     if ($'labellist{$userno, $module}) {
  2173.       foreach $label (&'array($'labellist{$userno, $module})) {
  2174.         ($prefix, $cmd, @params) = &$sub($no, $prefix, $cmd, @params);
  2175.         return () unless $cmd;
  2176.       }
  2177.     } else {
  2178.       ($prefix, $cmd, @params) = &$sub($no, $prefix, $cmd, @params);
  2179.       return () unless $cmd;
  2180.     }
  2181.   }
  2182.   return ($prefix, $cmd, @params);
  2183. }
  2184.  
  2185. sub read_event {
  2186.   local($userno, $event, $no, $msg) = @_;
  2187.   local($name, $sub, $label);
  2188.   $name = '\'' . $event;
  2189.   foreach $module (&'array($'modulelist[$userno])) {
  2190.     $sub = $module . $name;
  2191.     next unless defined(&$sub);
  2192.     if ($'labellist{$userno, $module}) {
  2193.       foreach $label (&'array($'labellist{$userno, $module})) {
  2194.         $msg = &$sub($no, $msg);
  2195.         return '' unless $msg;
  2196.       }
  2197.     } else {
  2198.       $msg = &$sub($no, $msg);
  2199.       return '' unless $msg;
  2200.     }
  2201.   }
  2202.   return $msg;
  2203. }
  2204.  
  2205. sub write_event {
  2206.   local($userno, $event, $no, $msg) = @_;
  2207.   local($name, $sub, $label);
  2208.   $name = '\'' . $event;
  2209.   foreach $module (reverse(&'array($'modulelist[$userno]))) {
  2210.     $sub = $module . $name;
  2211.     next unless defined(&$sub);
  2212.     if ($'labellist{$userno, $module}) {
  2213.       foreach $label (&'array($'labellist{$userno, $module})) {
  2214.         $msg = &$sub($no, $msg);
  2215.         return '' unless $msg;
  2216.       }
  2217.     } else {
  2218.       $msg = &$sub($no, $msg);
  2219.       return '' unless $msg;
  2220.     }
  2221.   }
  2222.   return $msg;
  2223. }
  2224.  
  2225. sub open_event {
  2226.   local($userno, $event, $no) = @_;
  2227.   local($name, $sub, $label);
  2228.   $name = '\'' . $event;
  2229.   foreach $module (&'array($'modulelist[$userno])) {
  2230.     $sub = $module . $name;
  2231.     next unless defined(&$sub);
  2232.     if ($'labellist{$userno, $module}) {
  2233.       foreach $label (&'array($'labellist{$userno, $module})) {
  2234.         &$sub($no);
  2235.       }
  2236.     } else {
  2237.       &$sub($no);
  2238.     }
  2239.   }
  2240. }
  2241.  
  2242. sub close_event {
  2243.   local($userno, $event, $no) = @_;
  2244.   local($name, $sub, $label);
  2245.   $name = '\'' . $event;
  2246.   foreach $module (reverse(&'array($'modulelist[$userno]))) {
  2247.     $sub = $module . $name;
  2248.     next unless defined(&$sub);
  2249.     if ($'labellist{$userno, $module}) {
  2250.       foreach $label (&'array($'labellist{$userno, $module})) {
  2251.         &$sub($no);
  2252.       }
  2253.     } else {
  2254.       &$sub($no);
  2255.     }
  2256.   }
  2257. }
  2258.  
  2259. __END__
  2260. <DL>
  2261. <DT>  plum.kanji* ({euc|jis|sjis})
  2262. </DT>
  2263. <DT>  plum.nick* ($B%K%C%/%M!<%`(B)
  2264. </DT>
  2265. <DT>  plum.user $B%f!<%6%M!<%`(B
  2266. </DT>
  2267. <DT>  plum.name $B<BL>(B
  2268. </DT>
  2269. <DT>  plum.server* $B%5!<%PL>(B[:($B%]!<%HHV9f(B)] [$B%Q%9%o!<%I(B]
  2270. </DT>
  2271. <DT>  plum.client* $B%/%i%$%"%s%H%^%9%/(B[:$B%]!<%HHV9f(B] [$B%Q%9%o!<%I(B]
  2272. </DT>
  2273. <DT>  plum.directory* $B%G%#%l%/%H%j(B
  2274. </DT>
  2275. </DL>
  2276.