home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / 1.x / plum12.lzh / plum12 / plum < prev    next >
Text File  |  1997-09-25  |  21KB  |  826 lines
  1. #!/usr/bin/perl -w
  2.  
  3. # plum version 1.2
  4. #   copyright (c)1997 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  5.  
  6. package main;
  7.  
  8. $NAME = 'plum';
  9. $VERSION = '1.2';
  10.  
  11. $PROPERTY = '.plumrc';
  12. $LOCALMASK = '*.jp';
  13.  
  14. $IRCPORT = 6667;
  15. $COUNT = 10;
  16. $READSIZE = 1024;
  17. $TIMEOUT = 120;
  18.  
  19. $SOCKADDR = 'S n a4 x8';
  20. $PROTO = getprotobyname('tcp');
  21. $HOSTNAME = $ENV{'HOST'} || $ENV{'HOSTNAME'};
  22. $THISADDR = (gethostbyname($HOSTNAME))[4];
  23.  
  24. if ($] < 5) {
  25.   foreach $inc (@INC) {
  26.     if (-r "$inc/sys/socket.ph") {
  27.       eval 'require "sys/socket.ph"';
  28.       $SOCKET = "$inc/sys/socket.ph" unless $@;
  29.       last;
  30.     }
  31.   }
  32. } else {
  33.   eval 'use Socket';
  34.   $SOCKET = 'Socket.pm' unless $@;
  35. }
  36. if ($SOCKET) {
  37.   ($AF_INET, $PF_INET, $SOCK_STREAM) = (&AF_INET, &PF_INET, &SOCK_STREAM);
  38. } else {
  39.   $SOCKET = '';
  40.   ($AF_INET, $PF_INET, $SOCK_STREAM) = (2, 2, 1);
  41. }
  42.  
  43. $rin = $win = '';
  44. $unique = 0;
  45.  
  46. print $NAME, ' ', $VERSION, "\n";
  47.  
  48. if (-r $PROPERTY) {
  49.   &load('', $PROPERTY);
  50. }
  51. foreach $user (@ARGV) {
  52.   if (-r "$PROPERTY-$user") {
  53.     &load($user, "$PROPERTY-$user");
  54.   }
  55. }
  56.  
  57. exit unless scalar(@username);
  58.  
  59. for ($userno = 0; $userno < scalar(@username); $userno++) {
  60.   foreach $module (&property($userno, 'module')) {
  61.     &import($userno, $module);
  62.   }
  63. }
  64.  
  65. &main;
  66.  
  67. sub main {
  68.   local($nfound, $timeleft, $rout, $wout, $sub, $i);
  69.   for (;;) {
  70.     &c_listen;
  71.     for ($i = 0; $i < scalar(@username); $i++) {
  72.       &s_connect($i);
  73.     }
  74.     ($nfound, $timeleft) = select($rout = $rin, $wout = $win, undef, $TIMEOUT);
  75.     foreach $clientno (&array($clientlist)) {
  76.       &c_read($clientno) if vec($rout, $clientno, 1);
  77.       &c_write($clientno) if vec($wout, $clientno, 1);
  78.     }
  79.     foreach $serverno (&array($serverlist)) {
  80.       &s_read($serverno) if vec($rout, $serverno, 1);
  81.       &s_write($serverno) if vec($wout, $serverno, 1);
  82.     }
  83.     foreach $listenno (&array($listenlist)) {
  84.       &c_accept($listenno) if vec($rout, $listenno, 1);
  85.     }
  86.     for ($i = 0; $i < scalar(@username); $i++) {
  87.       foreach $module (&array($modulelist[$i])) {
  88.         $sub = "${module}'main_loop";
  89.         &$sub($i) if defined(&$sub);
  90.       }
  91.     }
  92.   }
  93. }
  94.  
  95. sub load {
  96.   local($user, $file) = @_;
  97.   local($list, $line, $var, $arg);
  98.   @username = () unless @username;
  99.   $list = &list(@username);
  100.   if (!&exist($list, $user)) {
  101.     push(@username, $user);
  102.     $list = &add($list, $user);
  103.   }
  104.   if (open(FILE, $file)) {
  105.     while (defined($line = <FILE>)) {
  106.       next if $line =~ /^\s*[\#\;]/;
  107.       chop($line);
  108.       ($var, $arg) = split(/\s*\:\s*/, &jis($line), 2);
  109.       next unless $arg;
  110.       $property{$user, $var} = &add($property{$user, $var}, $arg);
  111.     }
  112.     close(FILE);
  113.   }
  114. }
  115.  
  116. sub import {
  117.   local($userno, $module) = @_;
  118.   local($file) = &expand($module);
  119.   require $file;
  120.   $package{$module} = $_ unless $package{$module};
  121.   $modulelist[$userno] = &add($modulelist[$userno], $package{$module});
  122. }
  123.  
  124. sub c_read {
  125.   local($clientno) = @_;
  126.   local($next, $rest, $tmp);
  127.   $tmp = '';
  128.   if (sysread($socket[$clientno], $tmp, $READSIZE)) {
  129.     $rbuf[$clientno] .= $tmp;
  130.     while ((($next, $rest) = split(/\r?\n/, $rbuf[$clientno], 2)) == 2) {
  131.       $rbuf[$clientno] = $rest;
  132.       &c_scan($clientno, &jis($next));
  133.     }
  134.     $rbuf[$clientno] = $next || '';
  135.   } else {
  136.     &c_close($clientno);
  137.   }
  138. }
  139.  
  140. sub c_scan {
  141.   local($clientno, $line) = @_;
  142.   local($prefix, $cmd, @params) = &parse($line);
  143.   local($sub);
  144.   if ($avail[$clientno]) {
  145.     foreach $module (&array($modulelist[$userno[$clientno]])) {
  146.       $sub = "${module}'cs_\L$cmd\E";
  147.       next unless defined(&$sub);
  148.       ($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
  149.       last unless $cmd;
  150.     }
  151.     return unless $cmd;
  152.     return unless $avail[$server[$userno[$clientno]]];
  153.     &s_print($server[$userno[$clientno]], $prefix, $cmd, @params);
  154.   } else {
  155.     $sub = "cn_\L$cmd\E";
  156.     &$sub($clientno, $prefix, $cmd, @params) if defined(&$sub);
  157.   }
  158. }
  159.  
  160. sub c_write {
  161.   local($clientno) = @_;
  162.   local($socket, $next, $rest);
  163.   $socket = $socket[$clientno];
  164.   while ((($next, $rest) = split(/\r?\n/, $wbuf[$clientno], 2)) == 2) {
  165.     $wbuf[$clientno] = $rest;
  166.     print $socket $next, "\r\n" if fileno($socket);
  167.   }
  168.   $wbuf[$clientno] = $next || '';
  169.   vec($win, $clientno, 1) = 0;
  170. }
  171.  
  172. sub c_print {
  173.   local($clientno, $prefix, $cmd, @params) = @_;
  174.   local($sub);
  175.   return unless $cmd;
  176.   return unless $clientno;
  177.   if ($avail[$clientno]) {
  178.     foreach $module (&array($modulelist[$userno[$clientno]])) {
  179.       $sub = "${module}'cp_\L$cmd\E";
  180.       next unless defined(&$sub);
  181.       ($prefix, $cmd, @params) = &$sub($clientno, $prefix, $cmd, @params);
  182.       last unless $cmd;
  183.     }
  184.     return unless $cmd;
  185.   }
  186.   $wbuf[$clientno] .= &restore($prefix, $cmd, @params);
  187.   vec($win, $clientno, 1) = 1;
  188. }
  189.  
  190. sub c_flush {
  191.   local($clientno) = @_;
  192.   while (vec($win, $clientno, 1)) {
  193.     &c_write($clientno);
  194.   }
  195. }
  196.  
  197. sub s_read {
  198.   local($serverno) = @_;
  199.   local($next, $rest, $tmp);
  200.   $tmp = '';
  201.   if (sysread($socket[$serverno], $tmp, $READSIZE)) {
  202.     $rbuf[$serverno] .= $tmp;
  203.     while ((($next, $rest) = split(/\r?\n/, $rbuf[$serverno], 2)) == 2) {
  204.       $rbuf[$serverno] = $rest;
  205.       &s_scan($serverno, $next);
  206.     }
  207.     $rbuf[$serverno] = $next || '';
  208.   } else {
  209.     &s_close($userno[$serverno]);
  210.     &s_connect($userno[$serverno]);
  211.   }
  212. }
  213.  
  214. sub s_scan {
  215.   local($serverno, $line) = @_;
  216.   local($prefix, $cmd, @params) = &parse($line);
  217.   local($sub);
  218.   if ($avail[$serverno]) {
  219.     foreach $module (&array($modulelist[$userno[$serverno]])) {
  220.       $sub = "${module}'ss_\L$cmd\E";
  221.       next unless defined(&$sub);
  222.       ($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
  223.       last unless $cmd;
  224.     }
  225.     return unless $cmd;
  226.     foreach $clientno (&array($clientlist)) {
  227.       next unless $avail[$clientno];
  228.       next unless $userno[$clientno] == $userno[$serverno];
  229.       &c_print($clientno, $prefix, $cmd, @params);
  230.     }
  231.   } else {
  232.     $sub = "sn_\L$cmd\E";
  233.     &$sub($serverno, $prefix, $cmd, @params) if defined(&$sub);
  234.   }
  235. }
  236.  
  237. sub s_write {
  238.   local($serverno) = @_;
  239.   local($socket, $next, $rest);
  240.   $socket = $socket[$serverno];
  241.   while ((($next, $rest) = split(/\r?\n/, $wbuf[$serverno], 2)) == 2) {
  242.     $wbuf[$serverno] = $rest;
  243.     print $socket $next, "\r\n" if fileno($socket);
  244.   }
  245.   $wbuf[$serverno] = $next || '';
  246.   vec($win, $serverno, 1) = 0;
  247. }
  248.  
  249. sub s_print {
  250.   local($serverno, $prefix, $cmd, @params) = @_;
  251.   local($sub);
  252.   return unless $cmd;
  253.   return unless $serverno;
  254.   foreach $module (&array($modulelist[$userno[$serverno]])) {
  255.     $sub = "${module}'sp_\L$cmd\E";
  256.     next unless defined(&$sub);
  257.     ($prefix, $cmd, @params) = &$sub($serverno, $prefix, $cmd, @params);
  258.     last unless $cmd;
  259.   }
  260.   return unless $cmd;
  261.   $wbuf[$serverno] .= &restore($prefix, $cmd, @params);
  262.   vec($win, $serverno, 1) = 1;
  263. }
  264.  
  265. sub s_flush {
  266.   local($serverno) = @_;
  267.   while (vec($win, $serverno, 1)) {
  268.     &s_write($serverno);
  269.   }
  270. }
  271.  
  272. sub parse {
  273.   local($line) = @_;
  274.   local($arg, $rest, @params);
  275.   @params = ();
  276.   $line =~ s/^\s*//;
  277.   if ($line =~ /^\:/) {
  278.     ($arg, $rest) = split(/\s+/, $', 2);
  279.   } else {
  280.     ($arg, $rest) = ('', $line);
  281.   }
  282.   while ($line) {
  283.     push(@params, $arg);
  284.     if ($rest =~ /^\:/) {
  285.       push(@params, $');
  286.       last;
  287.     }
  288.     $line = $rest;
  289.     ($arg, $rest) = (split(/\s+/, $line, 2), '');
  290.   }
  291.   return @params;
  292. }
  293.  
  294. sub restore {
  295.   local($prefix, $cmd, @params) = @_;
  296.   local($trailing);
  297.   return '' unless $cmd;
  298.   if (@params) {
  299.     $trailing = pop(@params) || '';
  300.     if ($trailing =~ /^[\w\d]+$/) {
  301.       push(@params, $trailing . ' ');
  302.     } else {
  303.       push(@params, ':' . $trailing);
  304.     }
  305.   }
  306.   unshift(@params, $cmd);
  307.   if ($prefix) {
  308.     unshift(@params, ':' . $prefix);
  309.   }
  310.   return join(' ', @params) . "\r\n";
  311. }
  312.  
  313. sub user {
  314.   local($no) = @_;
  315.   return "$nick[$no]\!$user[$no]\@$host[$no]";
  316. }
  317.  
  318. sub prefix {
  319.   local($prefix) = @_;
  320.   $prefix =~ /([^\!\@]*)(\!([^\!\@]*))?(\@([^\!\@]*))?$/;
  321.   if (wantarray) {
  322.     return ($1 || '', $3 || '', $5 || '');
  323.   } else {
  324.     return $1;
  325.   }
  326. }
  327.  
  328. sub regex {
  329.   local($mask) = @_;
  330.   $mask =~ s/(\W)/\\$1/g;
  331.   $mask =~ s/\\\?/\./g;
  332.   $mask =~ s/\\\*/\.\*/g;
  333.   $mask =~ s/\\[\[\{]/\[\\\[\\\{\]/g;
  334.   $mask =~ s/\\[\]\}]/\[\\\]\\\}\]/g;
  335.   $mask =~ s/\\[\|\\]/\[\\\|\\\\\]/g;
  336.   return "\^$mask\$";
  337. }
  338.  
  339. sub property {
  340.   local($userno, $name, $no) = @_;
  341.   local($list) = $property{$username[$userno], $name};
  342.   if (wantarray) {
  343.     return &array($list);
  344.   } else {
  345.     return (&array($list))[$no || 0];
  346.   }
  347. }
  348.  
  349. sub expand {
  350.   local($name) = @_;
  351.   local($user, $rest, $home);
  352.   if ($name =~ /^\~([^\/]*)\/(.*)$/) {
  353.     ($user, $rest) = ($1, $2);
  354.     if ($user) {
  355.       $home = (getpwnam($user))[7];
  356.     } else {
  357.       $home = $ENV{'HOME'} || (getpwuid($<))[7];
  358.     }
  359.     return "$home/$rest";
  360.   } else {
  361.     return $name;
  362.   }
  363. }
  364.  
  365. sub jis {
  366.   local($euc) = @_;
  367.   local($jis, $kanji, $c, $i);
  368.   $kanji = 0;
  369.   $jis = '';
  370.   for ($i = 0; $i < length($euc); $i++) {
  371.     $c = substr($euc, $i, 1);
  372.     if (unpack('C', $c) < 0x80) {
  373.       if ($kanji) {
  374.         $jis .= "\c[\(B";
  375.         $kanji = 0;
  376.       }
  377.       $jis .= $c;
  378.     } else {
  379.       if (!$kanji) {
  380.         $jis .= "\c[\$B";
  381.         $kanji = 1;
  382.       }
  383.       $jis .= pack('C', unpack('C', $c) & 0x7f);
  384.       if (++$i < length($euc)) {
  385.         $c = substr($euc, $i, 1);
  386.         $jis .= pack('C', unpack('C', $c) & 0x7f);
  387.       }
  388.     }
  389.   }
  390.   if ($kanji) {
  391.     $jis .= "\c[\(B";
  392.   }
  393.   return $jis;
  394. }
  395.  
  396. sub euc {
  397.   local($jis) = @_;
  398.   local($euc, $kanji, $c, $i);
  399.   $kanji = 0;
  400.   $euc = '';
  401.   for ($i = 0; $i < length($jis); $i++) {
  402.     if (substr($jis, $i, 3) eq "\c[\$B") {
  403.       $kanji = 1;
  404.       $i += 2;
  405.       next;
  406.     } elsif (substr($jis, $i, 3) eq "\c[\(B") {
  407.       $kanji = 0;
  408.       $i += 2;
  409.       next;
  410.     }
  411.     if ($kanji) {
  412.       $c = substr($jis, $i, 1);
  413.       $euc .= pack('C', unpack('C', $c) | 0x80);
  414.       if (++$i < length($jis)) {
  415.         $c = substr($jis, $i, 1);
  416.         $euc .= pack('C', unpack('C', $c) | 0x80);
  417.       }
  418.     } else {
  419.       $euc .= substr($jis, $i, 1);
  420.     }
  421.   }
  422.   return $euc;
  423. }
  424.  
  425. sub rchan {
  426.   local($vchan) = @_;
  427.   if ($vchan =~ /^\%(.*)$/) {
  428.     return "\#$1\:$LOCALMASK";
  429.   } else {
  430.     return $vchan;
  431.   }
  432. }
  433.  
  434. sub vchan {
  435.   local($rchan) = @_;
  436.   if ($rchan =~ /^\#(.*)\:(.*)$/ && "\L$2\E" eq "\L$LOCALMASK\E") {
  437.     return "\%$1";
  438.   } else {
  439.     return $rchan;
  440.   }
  441. }
  442.  
  443. sub add {
  444.   local($list, @items) = @_;
  445.   $list = $; unless $list;
  446.   foreach $item (@items) {
  447.     next if &exist($list, $item);
  448.     $list = "${list}${item}$;";
  449.   }
  450.   return $list;
  451. }
  452.  
  453. sub array {
  454.   local($list) = @_;
  455.   local(@array) = ();
  456.   $list = $; unless $list;
  457.   foreach $item (split(/$;/, $list)) {
  458.     next unless $item;
  459.     push(@array, $item);
  460.   }
  461.   return @array;
  462. }
  463.  
  464. sub change {
  465.   local($list, @items) = @_;
  466.   local($old, $new, $idx, $i);
  467.   $list = $; unless $list;
  468.   for ($i = 0; $i < scalar(@items) / 2; $i++) {
  469.     ($old, $new) = @items[$i * 2, $i * 2 + 1];
  470.     next if ($idx = index($list, "$;$old$;")) == -1;
  471.     substr($list, $idx, length("$;$old$;")) = "$;$new$;";
  472.   }
  473.   return $list;
  474. }
  475.  
  476. sub exist {
  477.   local($list, @items) = @_;
  478.   $list = $; unless $list;
  479.   foreach $item (@items) {
  480.     return 1 if index($list, "$;$item$;") != -1;
  481.   }
  482.   return 0;
  483. }
  484.  
  485. sub list {
  486.   local(@array) = @_;
  487.   local($list);
  488.   if (@array) {
  489.     $list = $; . join($;, @array) . $;;
  490.   } else {
  491.     $list = $;
  492.   }
  493.   return $list;
  494. }
  495.  
  496. sub rarray {
  497.   local($list) = @_;
  498.   local(@array) = ();
  499.   $list = $; unless $list;
  500.   foreach $item (split(/$;/, $list)) {
  501.     next unless $item;
  502.     unshift(@array, $item);
  503.   }
  504.   return @array;
  505. }
  506.  
  507. sub remove {
  508.   local($list, @items) = @_;
  509.   local($idx);
  510.   $list = $; unless $list;
  511.   foreach $item (@items) {
  512.     $idx = index($list, "$;$item$;");
  513.     next if $idx == -1;
  514.     substr($list, $idx, length("$;$item$;")) = $;;
  515.   }
  516.   return $list;
  517. }
  518.  
  519. sub connect {
  520.   local($host, $port) = @_;
  521.   local($serverno, $socket, $this, $thataddr, $that);
  522.   $this = pack($SOCKADDR, $AF_INET, 0, $THISADDR);
  523.   if ($host =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
  524.     $thataddr = pack('C4', $1, $2, $3, $4);
  525.     $host = (gethostbyaddr($thataddr, $AF_INET))[0];
  526.   } elsif ($host =~ /^\d+$/) {
  527.     $thataddr = pack('N', $host);
  528.     $host = (gethostbyaddr($thataddr, $AF_INET))[0];
  529.   } else {
  530.     $thataddr = (gethostbyname($host))[4];
  531.   }
  532.   return 0 unless $thataddr;
  533.   $that = pack($SOCKADDR, $AF_INET, $port, $thataddr);
  534.   $socket = 'S' . ++$unique;
  535.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  536.   bind($socket, $this) || return 0;
  537.   connect($socket, $that) || return 0;
  538.   $serverno = fileno($socket);
  539.   $socket[$serverno] = $socket;
  540.   select((select($socket), $| = 1)[0]);
  541.   $host[$serverno] = $host;
  542.   $addr[$serverno] = $thataddr;
  543.   return $serverno;
  544. }
  545.  
  546. sub listen {
  547.   local($port, $count) = @_;
  548.   local($listenno, $socket, $this);
  549.   $this = pack($SOCKADDR, $AF_INET, $port, $THISADDR);
  550.   $socket = 'L' . ++$unique;
  551.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  552.   bind($socket, $this) || return 0;
  553.   listen($socket, $count) || return 0;
  554.   $listenno = fileno($socket);
  555.   $socket[$listenno] = $socket;
  556.   select((select($socket), $| = 1)[0]);
  557.   $port[$listenno] = (unpack($SOCKADDR, getsockname($socket)))[1];
  558.   return $listenno;
  559. }
  560.  
  561. sub close {
  562.   local($no) = @_;
  563.   close($socket[$no]);
  564. }
  565.  
  566. sub accept {
  567.   local($listenno) = @_;
  568.   local($clientno, $socket, $thataddr, $host);
  569.   $socket = 'C' . ++$unique;
  570.   accept($socket, $socket[$listenno]) || return 0;
  571.   $clientno = fileno($socket);
  572.   $socket[$clientno] = $socket;
  573.   select((select($socket), $| = 1)[0]);
  574.   $thataddr = (unpack($SOCKADDR, getpeername($socket)))[2];
  575.   $host[$clientno] = (gethostbyaddr($thataddr, $AF_INET))[0];
  576.   $addr[$clientno] = $thataddr;
  577.   return $clientno;
  578. }
  579.  
  580. sub s_connect {
  581.   local($userno) = @_;
  582.   local($server, $host, $port, $pass, $serverno, $sub);
  583.   return if $server[$userno];
  584.   foreach $server (&property($userno, 'server')) {
  585.     next if &'exist($errorlist[$userno], $server);
  586.     ($host, $port, $pass) = split(/\:/, $server);
  587.     $serverno = &connect($host, $port || $IRCPORT);
  588.     next unless $serverno;
  589.     vec($rin, $serverno, 1) = 1;
  590.     $serverlist = &add($serverlist, $serverno);
  591.     $rbuf[$serverno] = '';
  592.     $wbuf[$serverno] = '';
  593.     $avail[$serverno] = 0;
  594.     $server[$userno] = $serverno;
  595.     $userno[$serverno] = $userno;
  596.     $pass[$serverno] = $pass || '';
  597.     $entry[$serverno] = $server;
  598.     &s_init($serverno);
  599.     last;
  600.   }
  601. }
  602.  
  603. sub s_close {
  604.   local($userno) = @_;
  605.   local($sub, $serverno);
  606.   $serverno = $server[$userno];
  607.   &close($serverno);
  608.   vec($rin, $serverno, 1) = 0;
  609.   foreach $module (&rarray($modulelist[$userno])) {
  610.     $sub = "${module}'server_close";
  611.     &$sub($serverno) if defined(&$sub);
  612.   }
  613.   $serverlist = &remove($serverlist, $serverno);
  614.   $avail[$serverno] = 0;
  615.   $userno[$serverno] = 0;
  616.   $server[$userno] = 0;
  617. }
  618.  
  619. sub c_listen {
  620.   local($listenno, $host, $port, $pass, $i);
  621.   for ($i = 0; $i < scalar(@username); $i++) {
  622.     foreach $client (&property($i, 'client')) {
  623.       ($host, $port, $pass) = split(/\:/, $client);
  624.       next if &exist($portlist, $port || $IRCPORT);
  625.       $listenno = &listen($port || $IRCPORT, $COUNT);
  626.       next unless $listenno;
  627.       vec($rin, $listenno, 1) = 1;
  628.       $listenlist = &add($listenlist, $listenno);
  629.       $portlist = &add($portlist, $port || $IRCPORT);
  630.     }
  631.   }
  632. }
  633.  
  634. sub c_accept {
  635.   local($listenno) = @_;
  636.   local($clientno, $host, $port, $pass, $regex, $i);
  637.   $clientno = &accept($listenno);
  638.   return unless $clientno;
  639.   for ($i = 0; $i < scalar(@username); $i++) {
  640.     foreach $client (&property($i, 'client')) {
  641.       ($host, $port, $pass) = split(/\:/, $client);
  642.       next unless ($port || $IRCPORT) == $port[$listenno];
  643.       $regex = ®ex($host);
  644.       next unless $host[$clientno] =~ /$regex/i;
  645.       vec($rin, $clientno, 1) = 1;
  646.       $clientlist = &add($clientlist, $clientno);
  647.       $rbuf[$clientno] = '';
  648.       $wbuf[$clientno] = '';
  649.       $avail[$clientno] = 0;
  650.       $port[$clientno] = $port[$listenno];
  651.       $nick[$clientno] = '';
  652.       $user[$clientno] = '';
  653.       $pass[$clientno] = '';
  654.       return;
  655.     }
  656.   }
  657.   &close($clientno);
  658. }
  659.  
  660. sub c_close {
  661.   local($clientno) = @_;
  662.   local($sub);
  663.   &c_flush($clientno);
  664.   &close($clientno);
  665.   vec($rin, $clientno, 1) = 0;
  666.   $clientlist = &remove($clientlist, $clientno);
  667.   if ($avail[$clientno]) {
  668.     $avail[$clientno] = 0;
  669.     foreach $module (&rarray($modulelist[$userno[$clientno]])) {
  670.       $sub = "${module}'client_close";
  671.       &$sub($clientno) if defined(&$sub);
  672.     }
  673.   }
  674.   $userno[$clientno] = 0;
  675. }
  676.  
  677. sub s_init {
  678.   local($serverno) = @_;
  679.   local($nickname, $nick, $msg, $username, $user, $name);
  680.   &s_print($serverno, '', 'PASS', $pass[$serverno]) if $pass[$serverno];
  681.   $nickname = $nickname[$userno[$serverno]] || &property($userno[$serverno], 'nick') || getlogin || (getpwuid($<))[0];
  682.   ($nick, $msg) = split(/\s+/, $nickname, 2);
  683.   &s_print($serverno, '', 'NICK', $nick);
  684.   $username = &property($userno[$serverno], 'user');
  685.   if ($username) {
  686.     ($user, $name) = split(/\s+/, $username, 2);
  687.   } else {
  688.     $user = getlogin || (getpwuid($<))[0];
  689.     $name = (getpwuid($<))[6];
  690.   }
  691.   &s_print($serverno, '', 'USER', "\L$user\E", '*', '*', $name);
  692. }
  693.  
  694. sub c_init {
  695.   local($clientno) = @_;
  696.   local($host, $port, $pass, $serverno, $regex, $i);
  697.   for ($i = 0; $i < scalar(@username); $i++) {
  698.     foreach $client (&property($i, 'client')) {
  699.       ($host, $port, $pass) = split(/\:/, $client);
  700.       next unless ($port || $IRCPORT) == $port[$clientno];
  701.       $regex = ®ex($host);
  702.       next unless $host[$clientno] =~ /$regex/i;
  703.       next if $pass && $pass ne $pass[$clientno];
  704.       $userno[$clientno] = $i;
  705.       $avail[$clientno] = 1;
  706.       $serverno = $server[$userno[$clientno]];
  707.       &c_print($clientno, $HOSTNAME, '001', $nick[$clientno], "Welcome to the Internet Relay Network $nick[$clientno]");
  708.       foreach $module (&array($modulelist[$userno[$clientno]])) {
  709.         $sub = "${module}'client_open";
  710.         &$sub($clientno) if defined(&$sub);
  711.       }
  712.       return;
  713.     }
  714.   }
  715.   &c_print($clientno, $HOSTNAME, '464', $nick[$clientno], 'Password incorrect');
  716.   &c_print($clientno, '', 'ERROR', "Closing Link: $nick[$clientno] (Bad Password)");
  717.   &c_close($clientno);
  718. }
  719.  
  720. sub cn_ping {
  721.   local($clientno, $prefix, $cmd, @params) = @_;
  722.   &c_print($clientno, &user($clientno), '451', 'PING', 'You have not registered');
  723. }
  724.  
  725. sub cn_pass {
  726.   local($clientno, $prefix, $cmd, $pass) = @_;
  727.   $pass[$clientno] = $pass if $pass;
  728. }
  729.  
  730. sub cn_nick {
  731.   local($clientno, $prefix, $cmd, $nick) = @_;
  732.   $nick[$clientno] = $nick;
  733.   &c_init($clientno) if $user[$clientno];
  734. }
  735.  
  736. sub cn_user {
  737.   local($clientno, $prefix, $cmd, @params) = @_;
  738.   if (scalar(@params) >= 4) {
  739.     $user[$clientno] = $params[0];
  740.     &c_init($clientno) if $nick[$clientno];
  741.   } else {
  742.     &c_print($clientno, $HOSTNAME, '461', 'Not enough parameters');
  743.   }
  744. }
  745.  
  746. sub cn_quit {
  747.   local($clientno, $prefix, $cmd, @params) = @_;
  748.   &c_print($clientno, '', 'ERROR', "Closing Link: [$host[$clientno]] ($nick[$clientno])\n");
  749.   &c_close($clientno);
  750. }
  751.  
  752. sub sn_error {
  753.   local($serverno, $prefix, $cmd, @params) = @_;
  754.   $errorlist[$userno[$serverno]] = &'add($errorlist[$userno[$serverno]], $entry[$serverno]);
  755. }
  756.  
  757. sub sn_ping {
  758.   local($serverno, $prefix, $cmd, @params) = @_;
  759.   &s_print($serverno, '', 'PONG', @params);
  760. }
  761.  
  762. sub sn_001 {
  763.   local($serverno, $prefix, $cmd, $nick, $msg) = @_;
  764.   local($sub);
  765.   $avail[$serverno] = 1;
  766.   $nick[$serverno] = $nick;
  767.   $nickname[$userno[$serverno]] = $nick;
  768.   $errorlist[$userno[$serverno]] = $;;
  769.   foreach $module (&array($modulelist[$userno[$serverno]])) {
  770.     $sub = "${module}'server_open";
  771.     &$sub($serverno) if defined(&$sub);
  772.   }
  773. }
  774.  
  775. sub sn_451 {
  776.   local($serverno, $prefix, $cmd, @params) = @_;
  777.   return ();
  778. }
  779.  
  780. sub sn_433 {
  781.   local($serverno, $prefix, $cmd, @params) = @_;
  782.   local(@nickentry, $list, $nick, $msg);
  783.   foreach $nickname (&property($userno[$serverno], 'nick')) {
  784.     ($nick, $msg) = split(/\s+/, $nickname, 2);
  785.     $list = &add($list, $nick);
  786.   }
  787.   if (!$list) {
  788.     $nick = getlogin || (getpwuid($<))[0];
  789.     $list = &list($nick);
  790.     $nick = substr($nick, 8);
  791.     $list = &add($list, "${name}_", "${name}-", "${name}2", "${name}3");
  792.   }
  793.   if (&exist($list, $params[1])) {
  794.     @nickentry = &array($list);
  795.     while ($nickentry[0] ne $params[1]) {
  796.       push(@nickentry, shift(@nickentry));
  797.     }
  798.     push(@nickentry, shift(@nickentry));
  799.   }
  800.   &s_print($serverno, '', 'NICK', $nickentry[0]);
  801. }
  802.  
  803. sub sn_437 {
  804.   local($serverno, $prefix, $cmd, @params) = @_;
  805.   local(@nickentry, $list, $nick, $msg);
  806.   foreach $nickname (&property($userno[$serverno], 'nick')) {
  807.     ($nick, $msg) = split(/\s+/, $nickname, 2);
  808.     $list = &add($list, $nick);
  809.   }
  810.   if (!$list) {
  811.     $nick = getlogin || (getpwuid($<))[0];
  812.     $list = &list($nick);
  813.     $nick = substr($nick, 8);
  814.     $list = &add($list, "${name}_", "${name}-", "${name}2", "${name}3");
  815.   }
  816.   if (&exist($list, $params[1])) {
  817.     @nickentry = &array($list);
  818.     while ($nickentry[0] ne $params[1]) {
  819.       push(@nickentry, shift(@nickentry));
  820.     }
  821.     push(@nickentry, shift(@nickentry));
  822.   }
  823.   &s_print($serverno, '', 'NICK', $nickentry[0]);
  824. }
  825.  
  826.