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