home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / 2.x / plum2_28_2.lzh / module / sys / web.plm < prev   
Text File  |  1998-10-15  |  42KB  |  1,248 lines
  1. <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN"><!-- $_ if 0; # -*- perl -*-
  2. # $Id: web.plm,v 2.15 1998/10/13 14:09:54 hasegawa Exp $
  3. # copyright (c)1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  4.  
  5. package sys_web;
  6.  
  7. $READSIZE = 1024;
  8. $TIMEOUT = 3600;
  9. $METHOD = 'get';
  10. $HEADER = '%H:%M';
  11. $LINE = 50;
  12. $BASE64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  13.  
  14. $_ = 'sys_web';
  15.  
  16. sub main_loop {
  17.   local($userno) = @_;
  18.   foreach $lno (&'array($httplistenlist)) {
  19.     if (vec($'rout, $lno, 1)) {
  20.       &http_listen($lno);
  21.       vec($'rout, $lno, 1) = 0;
  22.     }
  23.   }
  24.   foreach $cno (&'array($httpclientlist)) {
  25.     if (vec($'rout, $cno, 1)) {
  26.       &http_client($cno);
  27.       vec($'rout, $cno, 1) = 0;
  28.     } elsif (time() - $'access[$cno] > $TIMEOUT) {
  29.       $httpclientlist = &'remove($httpclientlist, $cno);
  30.       &'close($cno);
  31.     }
  32.   }
  33. }
  34.  
  35. sub server_open {
  36.   local($serverno) = @_;
  37.   local($userno, $host, $id, $mask, $port, $lno);
  38.   $userno = $'userno[$serverno];
  39.   foreach $client (&'property($userno, 'client')) {
  40.     ($host, $id) = split(/\s+/, $client, 2);
  41.     ($mask, $port) = split(/\:/, $host);
  42.     if (!&'exist($portlist[$serverno], $port)) {
  43.       if ($lno = &'listen($port)) {
  44.         $httplistenlist = &'add($httplistenlist, $lno);
  45.         $server[$lno] = $serverno;
  46.         $portlist[$serverno] = &'add($portlist[$serverno], $port);
  47.       }
  48.     }
  49.   }
  50. }
  51.  
  52. sub server_close {
  53.   local($serverno) = @_;
  54.   local($port);
  55.   foreach $lno (&'array($httplistenlist)) {
  56.     $port = (&'sockname($lno))[0];
  57.     if (&'exist($portlist[$serverno], $port)) {
  58.       $httplistenlist = &'remove($httplistenlist, $lno);
  59.       &'close($lno);
  60.     }
  61.   }
  62. }
  63.  
  64. sub ss_invite {
  65.   local($serverno, $prefix, $cmd, @params) = @_;
  66.   local($nick, $vchan);
  67.   $nick = &'prefix($prefix);
  68.   $vchan = &'alias($params[1]);
  69.   &writelog($serverno, $params[1], "*** $nick invites you to channel $vchan");
  70.   return ($prefix, $cmd, @params);
  71. }
  72.  
  73. sub ss_join {
  74.   local($serverno, $prefix, $cmd, @params) = @_;
  75.   local($nick, $name, $mode, $vchan);
  76.   $nick = &'prefix($prefix);
  77.   ($name, $mode) = (split(/\cG/, $params[0]), '');
  78.   if ($nick eq $'nick[$serverno]) {
  79.     $nameslist{$serverno, $name} = '';
  80.   } else {
  81.     $nameslist{$serverno, $name} = &'add($nameslist{$serverno, $name}, $nick);
  82.   }
  83.   $vchan = &'alias($name);
  84.   if (index($mode, 'o') != -1) {
  85.     &writelog($serverno, $name, "\@$nick has joined channel $vchan");
  86.   } elsif (index($mode, 'v') != -1) {
  87.     &writelog($serverno, $name, "+$nick has joined channel $vchan");
  88.   } else {
  89.     &writelog($serverno, $name, "$nick has joined channel $vchan");
  90.   }
  91.   return ($prefix, $cmd, @params);
  92. }
  93.  
  94. sub ss_kick {
  95.   local($serverno, $prefix, $cmd, @params) = @_;
  96.   local($nick, $vchan);
  97.   $nick = &'prefix($prefix);
  98.   $vchan = &'alias($params[0]);
  99.   if ($params[1] eq $'nick[$serverno]) {
  100.     &writelog($serverno, '', "You were kicked off channel $vchan by $nick ($params[2])");
  101.   } else {
  102.     &writelog($serverno, $params[0], "$nick has kicked $params[1] out from channel $vchan ($params[2])");
  103.   }
  104.   if ($nick eq $'nick[$serverno]) {
  105.     delete $nameslist{$serverno, $params[0]};
  106.   } else {
  107.     $nameslist{$serverno, $params[0]} = &'remove($nameslist{$serverno, $params[0]}, $params[1]);
  108.   }
  109.   return ($prefix, $cmd, @params);
  110. }
  111.  
  112. sub ss_mode {
  113.   local($serverno, $prefix, $cmd, @params) = @_;
  114.   local($nick, $vchan, @mode);
  115.   @mode = @params;
  116.   shift(@mode);
  117.   $nick = &'prefix($prefix);
  118.   if ($params[0] =~ /^[\#\&\+]/) {
  119.     $vchan = &'alias($params[0]);
  120.     &writelog($serverno, $params[0], "New mode for $vchan set by $nick: " . join(' ', @mode));
  121.   } else {
  122.     &writelog($serverno, '', "Your new mode is set: " . join(' ', @mode));
  123.   }
  124.   return ($prefix, $cmd, @params);
  125. }
  126.  
  127. sub ss_nick {
  128.   local($serverno, $prefix, $cmd, @params) = @_;
  129.   local($nick);
  130.   $nick = &'prefix($prefix);
  131.   if ($nick eq $'nick[$serverno]) {
  132.     &writelog($serverno, '', "$nick is now known as $params[0]");
  133.   }
  134.   &writelog($serverno, $nick, "$nick is now known as $params[0]");
  135.   foreach $chan (&'array($'channellist[$serverno])) {
  136.     $nameslist{$serverno, $chan} = &'change($nameslist{$serverno, $chan}, $nick, $params[0]);
  137.   }
  138.   return ($prefix, $cmd, @params);
  139. }
  140.  
  141. sub sp_notice {
  142.   local($serverno, $prefix, $cmd, @params) = @_;
  143.   local($chan);
  144.   if ($params[1]) {
  145.     foreach $chan (split(/\,/, $params[0])) {
  146.       if ($chan =~ /^[\#\&\+]/) {
  147.         &writelog($serverno, $chan, ">$'nick[$serverno]< $params[1]");
  148.       } else {
  149.         &writelog($serverno, '', ">$chan< $params[1]");
  150.       }
  151.     }
  152.   }
  153.   return ($prefix, $cmd, @params);
  154. }
  155.  
  156. sub ss_notice {
  157.   local($serverno, $prefix, $cmd, @params) = @_;
  158.   local($nick);
  159.   if ($params[1]) {
  160.     $nick = &'prefix($prefix);
  161.     if ($params[0] =~ /^[\#\&\+]/) {
  162.       if (&'exist($nameslist{$serverno, $params[0]}, $nick)) {
  163.         &writelog($serverno, $params[0], "<$nick> $params[1]");
  164.       } else {
  165.         &writelog($serverno, $params[0], "($nick) $params[1]");
  166.       }
  167.     } else {
  168.       &writelog($serverno, '', "=$nick= $params[1]");
  169.     }
  170.   }
  171.   return ($prefix, $cmd, @params);
  172. }
  173.  
  174. sub ss_part {
  175.   local($serverno, $prefix, $cmd, @params) = @_;
  176.   local($nick, $vchan);
  177.   $nick = &'prefix($prefix);
  178.   $vchan = &'alias($params[0]);
  179.   if ($nick eq $'nick[$serverno]) {
  180.     &writelog($serverno, '', "$nick has left channel $vchan ($params[1])");
  181.   }
  182.   &writelog($serverno, $params[0], "$nick has left channel $vchan ($params[1])");
  183.   if ($nick eq $'nick[$serverno]) {
  184.     delete $nameslist{$serverno, $params[0]};
  185.   } else {
  186.     $nameslist{$serverno, $params[0]} = &'remove($nameslist{$serverno, $params[0]}, $nick);
  187.   }
  188.   return ($prefix, $cmd, @params);
  189. }
  190.  
  191. sub sp_privmsg {
  192.   local($serverno, $prefix, $cmd, @params) = @_;
  193.   local($chan);
  194.   if ($params[1]) {
  195.     foreach $chan (split(/\,/, $params[0])) {
  196.       if ($chan =~ /^[\#\&\+]/) {
  197.         &writelog($serverno, $chan, ">$'nick[$serverno]< $params[1]");
  198.       } else {
  199.         &writelog($serverno, '', ">$chan< $params[1]");
  200.       }
  201.     }
  202.   }
  203.   return ($prefix, $cmd, @params);
  204. }
  205.  
  206. sub ss_privmsg {
  207.   local($serverno, $prefix, $cmd, @params) = @_;
  208.   local($nick);
  209.   if ($params[1]) {
  210.     $nick = &'prefix($prefix);
  211.     if ($params[0] =~ /^[\#\&\+]/) {
  212.       if (&'exist($nameslist{$serverno, $params[0]}, $nick)) {
  213.         &writelog($serverno, $params[0], "<$nick> $params[1]");
  214.       } else {
  215.         &writelog($serverno, $params[0], "($nick) $params[1]");
  216.       }
  217.     } else {
  218.       &writelog($serverno, '', "=$nick= $params[1]");
  219.     }
  220.   }
  221.   return ($prefix, $cmd, @params);
  222. }
  223.  
  224. sub ss_quit {
  225.   local($serverno, $prefix, $cmd, @params) = @_;
  226.   local($nick);
  227.   $nick = &'prefix($prefix);
  228.   &writelog($serverno, $nick, "$nick has left IRC ($params[0])");
  229.   foreach $chan (&'array($'channellist[$serverno])) {
  230.     $nameslist{$serverno, $chan} = &'remove($nameslist{$serverno, $chan}, $nick);
  231.   }
  232.   return ($prefix, $cmd, @params);
  233. }
  234.  
  235. sub ss_topic {
  236.   local($serverno, $prefix, $cmd, @params) = @_;
  237.   local($nick, $vchan);
  238.   $nick = &'prefix($prefix);
  239.   $vchan = &'alias($params[0]);
  240.   &writelog($serverno, $params[0], "New topic on $vchan set by $nick: $params[1]");
  241.   return ($prefix, $cmd, @params);
  242. }
  243.  
  244. sub ss_301 {
  245.   local($serverno, $prefix, $cmd, @params) = @_;
  246.   &writelog($serverno, '', "AWAY: $params[2]");
  247.   return ($prefix, $cmd, @params);
  248. }
  249.  
  250. sub ss_302 {
  251.   local($serverno, $prefix, $cmd, @params) = @_;
  252.   local($nick, $name);
  253.   if ($params[1]) {
  254.     ($nick, $name) = split(/\*?\=[\+\-]/, $params[1]);
  255.     if ($nick eq $'nick[$serverno]) {
  256.       &writelog($serverno, '', "*** You are $name");
  257.     } else {
  258.       &writelog($serverno, '', "$nick is <$name>");
  259.     }
  260.   }
  261.   return ($prefix, $cmd, @params);
  262. }
  263.  
  264. sub ss_303 {
  265.   local($serverno, $prefix, $cmd, @params) = @_;
  266.   if ($params[1]) {
  267.     &writelog($serverno, '', "No one you requested is on now.");
  268.   } else {
  269.     &writelog($serverno, '', "Following people(s) are on: $params[1]");
  270.   }
  271.   return ($prefix, $cmd, @params);
  272. }
  273.  
  274. sub ss_305 {
  275.   local($serverno, $prefix, $cmd, @params) = @_;
  276.   &writelog($serverno, '', "*** $params[1]");
  277.   return ($prefix, $cmd, @params);
  278. }
  279.  
  280. sub ss_306 {
  281.   local($serverno, $prefix, $cmd, @params) = @_;
  282.   &writelog($serverno, '', "*** $params[1]");
  283.   return ($prefix, $cmd, @params);
  284. }
  285.  
  286. sub ss_311 {
  287.   local($serverno, $prefix, $cmd, @params) = @_;
  288.   &writelog($serverno, '', "$params[1] is <$params[2]\@$params[3]> $params[5]");
  289.   return ($prefix, $cmd, @params);
  290. }
  291.  
  292. sub ss_312 {
  293.   local($serverno, $prefix, $cmd, @params) = @_;
  294.   &writelog($serverno, '', "on via server $params[2] ($params[3])");
  295.   return ($prefix, $cmd, @params);
  296. }
  297.  
  298. sub ss_313 {
  299.   local($serverno, $prefix, $cmd, @params) = @_;
  300.   &writelog($serverno, '', "STATUS: $params[2]");
  301.   return ($prefix, $cmd, @params);
  302. }
  303.  
  304. sub ss_314 {
  305.   local($serverno, $prefix, $cmd, @params) = @_;
  306.   &writelog($serverno, '', "$params[1] was <$params[2]\@$params[3]> $params[5]");
  307.   return ($prefix, $cmd, @params);
  308. }
  309.  
  310. sub ss_317 {
  311.   local($serverno, $prefix, $cmd, @params) = @_;
  312.   local($day, $hour, $min, $sec);
  313.   $sec = $params[2];
  314.   $day = int($sec / 86400);
  315.   $sec %= 86400;
  316.   $hour = int($sec / 3600);
  317.   $sec %= 3600;
  318.   $min = int($sec / 60);
  319.   $sec %= 60;
  320.   if ($day) {
  321.     &writelog($serverno, '', "IDLE for $day days $hour hours");
  322.   } elsif ($hour) {
  323.     &writelog($serverno, '', "IDLE for $hour hours $min minutes");
  324.   } elsif ($min) {
  325.     &writelog($serverno, '', "IDLE for $min minutes $sec seconds");
  326.   } else {
  327.     &writelog($serverno, '', "IDLE for $sec seconds");
  328.   }
  329.   return ($prefix, $cmd, @params);
  330. }
  331.  
  332. sub ss_319 {
  333.   local($serverno, $prefix, $cmd, @params) = @_;
  334.   local($str);
  335.   $str = 'channels:';
  336.   foreach $chan (split(/\s+/, $params[2])) {
  337.     if ($chan =~ /^[\@\+]/) {
  338.       $str .= ' ' . substr($chan, 0, 1) . &'alias(substr($chan, 1));
  339.     } else {
  340.       $str .= ' ' . &'alias($chan);
  341.     }
  342.   }
  343.   &writelog($serverno, '', $str);
  344.   return ($prefix, $cmd, @params);
  345. }
  346.  
  347. sub ss_322 {
  348.   local($serverno, $prefix, $cmd, @params) = @_;
  349.   local($vchan);
  350.   $vchan = &'alias($params[2]);
  351.   &writelog($serverno, '', "*** Inviting user $params[1] to channel $vchan");
  352.   return ($prefix, $cmd, @params);
  353. }
  354.  
  355. sub ss_324 {
  356.   local($serverno, $prefix, $cmd, @params) = @_;
  357.   local($vchan);
  358.   $vchan = &'alias($params[1]);
  359.   &writelog($serverno, '', "Mode for $vchan: $params[2]");
  360.   return ($prefix, $cmd, @params);
  361. }
  362.  
  363. sub ss_331 {
  364.   local($serverno, $prefix, $cmd, @params) = @_;
  365.   local($vchan);
  366.   $vchan = &'alias($params[1]);
  367.   &writelog($serverno, '', "No topic is set for $vchan");
  368.   return ($prefix, $cmd, @params);
  369. }
  370.  
  371. sub ss_332 {
  372.   local($serverno, $prefix, $cmd, @params) = @_;
  373.   local($vchan);
  374.   $vchan = &'alias($params[1]);
  375.   &writelog($serverno, '', "Topic for $vchan: $params[2]");
  376.   return ($prefix, $cmd, @params);
  377. }
  378.  
  379. sub ss_341 {
  380.   local($serverno, $prefix, $cmd, @params) = @_;
  381.   local($vchan);
  382.   $vchan = &'alias($params[1]);
  383.   &writelog($serverno, '', "Topic for $vchan ($params[2] users): $params[3]");
  384.   return ($prefix, $cmd, @params);
  385. }
  386.  
  387. sub ss_351 {
  388.   local($serverno, $prefix, $cmd, @params) = @_;
  389.   &writelog($serverno, '', "*** $params[2] is running IRC version $params[1] ($params[3]");
  390.   return ($prefix, $cmd, @params);
  391. }
  392.  
  393. sub ss_352 {
  394.   local($serverno, $prefix, $cmd, @params) = @_;
  395.   local($vchan, $name);
  396.   $vchan = &'alias($params[1]);
  397.   $name = (split(/\s+/, $params[7]))[1] || '';
  398.   &writelog($serverno, '', "$params[6] $vchan $params[5] <$params[2]\@$params[3]> $name");
  399.   return ($prefix, $cmd, @params);
  400. }
  401.  
  402. sub ss_353 {
  403.   local($serverno, $prefix, $cmd, @params) = @_;
  404.   if (&'exist($'channellist[$serverno], $params[2])) {
  405.     foreach $name (split(/\s+/, $params[3])) {
  406.       $name =~ tr/\+\@//d;
  407.       $nameslist{$serverno, $params[2]} = &'add($nameslist{$serverno, $params[2]}, $name);
  408.     }
  409.   }
  410.   return ($prefix, $cmd, @params);
  411. }
  412.  
  413. sub ss_364 {
  414.   local($serverno, $prefix, $cmd, @params) = @_;
  415.   local($info);
  416.   $info = (split(/\s+/, $params[3]))[1] || '';
  417.   &writelog($serverno, '', "$params[1] $info");
  418.   return ($prefix, $cmd, @params);
  419. }
  420.  
  421. sub ss_367 {
  422.   local($serverno, $prefix, $cmd, @params) = @_;
  423.   local($vchan);
  424.   $vchan = &'alias($params[1]);
  425.   &writelog($serverno, '', "Banned on $vchan: $params[2]");
  426.   return ($prefix, $cmd, @params);
  427. }
  428.  
  429. sub ss_371 {
  430.   local($serverno, $prefix, $cmd, @params) = @_;
  431.   &writelog($serverno, '', "*** $params[1]");
  432.   return ($prefix, $cmd, @params);
  433. }
  434.  
  435. sub ss_372 {
  436.   local($serverno, $prefix, $cmd, @params) = @_;
  437.   &writelog($serverno, '', "*** $params[1]");
  438.   return ($prefix, $cmd, @params);
  439. }
  440.  
  441. sub ss_381 {
  442.   local($serverno, $prefix, $cmd, @params) = @_;
  443.   &writelog($serverno, '', "OPER: $params[1]");
  444.   return ($prefix, $cmd, @params);
  445. }
  446.  
  447. sub ss_391 {
  448.   local($serverno, $prefix, $cmd, @params) = @_;
  449.   &writelog($serverno, '', "TIME: $params[2] ($params[1])");
  450.   return ($prefix, $cmd, @params);
  451. }
  452.  
  453. sub writelog {
  454.   local($serverno, $chan, $msg) = @_;
  455.   local($userno);
  456.   $userno = $'userno[$serverno];
  457.   if ($chan eq '') {
  458.     &channellog($serverno, $chan, $msg);
  459.   } elsif ($chan =~ /^[\#\&\+]/) {
  460.     &channellog($serverno, $chan, $msg);
  461.   } else {
  462.     foreach $rchan (&'array($'channellist[$serverno])) {
  463.       if (&'exist($nameslist{$serverno, $rchan}, $chan)) {
  464.         &channellog($serverno, $rchan, $msg);
  465.       }
  466.     }
  467.   }
  468. }
  469.  
  470. sub channellog {
  471.   local($serverno, $chan, $msg) = @_;
  472.   local($userno, @list, $header, $line);
  473.   $userno = $'userno[$serverno];
  474.   $header = &'property($userno, 'header');
  475.   $header = $HEADER unless defined($header);
  476.   $header = &'date($header);
  477.   @list = &'array($message{$serverno, $chan});
  478.   push(@list, "e("$header $msg") . '<BR>');
  479.   $line = &'property($userno, 'line');
  480.   $line = $LINE unless defined($line);
  481.   while (scalar(@list) > $line) {
  482.     shift(@list);
  483.   }
  484.   $message{$serverno, $chan} = &'list(@list);
  485. }
  486.  
  487. sub http_listen {
  488.   local($lno) = @_;
  489.   local($cno, $host, $id, $mask, $port, $ip, $name, $regex);
  490.   if ($cno = &'accept($lno)) {
  491.     foreach $client (&'property($'userno[$server[$lno]], 'client')) {
  492.       ($host, $id) = split(/\s+/, $client, 2);
  493.       ($mask, $port) = split(/\:/, $host);
  494.       next unless $port == (&'sockname($lno))[0];
  495.       $ip = join('.', unpack('C4', pack('N', (&'peername($cno))[1])));
  496.       $name = (&'peername($cno))[2];
  497.       $regex = &'regex($mask);
  498.       next unless ($name =~ /$regex/i || $ip =~ /$regex/);
  499.       $httpclientlist = &'add($httpclientlist, $cno);
  500.       $server[$cno] = $server[$lno];
  501.       $rbuf[$cno] = '';
  502.       $request[$cno] = '';
  503.       return;
  504.     }
  505.     &'close($cno);
  506.   }
  507. }
  508.  
  509. sub http_client {
  510.   local($cno) = @_;
  511.   local($tmp, $socket, $next, $rest, $method, $url, $ver, $name, $val);
  512.   $tmp = '';
  513.   $socket = $'socket[$cno];
  514.   if (sysread($socket, $tmp, $READSIZE)) {
  515.     $rbuf[$cno] .= $tmp;
  516.     while ((($next, $rest) = split(/\r\n/, $rbuf[$cno], 2)) == 2) {
  517.       $rbuf[$cno] = $rest;
  518.       if ($next) {
  519.         $request[$cno] = &'add($request[$cno], $next);
  520.       } else {
  521.         ($method, $url, $ver) = split(/\s+/, (&'array($request[$cno]))[0]);
  522.         if ("\L$method\E" eq 'get') {
  523.           &process($cno, (split(/\?/, $url), ''));
  524.         } elsif ("\L$method\E" eq 'post') {
  525.           foreach $line (&'array($request[$cno])) {
  526.             ($name, $val) = split(/\s*:\s*/, $line, 2);
  527.             next unless $val;
  528.             next unless "\L$name\E" eq 'content-length';
  529.             if (length($rest) < $val) {
  530.               sysread($socket, $rest, $val - length($rest), length($rest));
  531.             }
  532.             &process($cno, $url, substr($rest, 0, $val));
  533.             last;
  534.           }
  535.         } else {
  536.           print $socket 'HTTP/1.0 501 Not Implemented', "\r\n";
  537.           print $socket "\r\n";
  538.         }
  539.         $httpclientlist = &'remove($httpclientlist, $cno);
  540.         &'close($cno);
  541.         last;
  542.       }
  543.     }
  544.   } else {
  545.     $httpclientlist = &'remove($httpclientlist, $cno);
  546.     &'close($cno);
  547.   }
  548. }
  549.  
  550. sub process {
  551.   local($cno, $path, $query) = @_;
  552.   local($socket, $dir, $file, $idx);
  553.   $socket = $'socket[$cno];
  554.   $path = substr($path, 1);
  555.   if (($idx = rindex($path, '/')) != -1) {
  556.     $dir = substr($path, 0, $idx - 1);
  557.     $file = substr($path, $idx + 1);
  558.   } else {
  559.     $dir = '';
  560.     $file = $path;
  561.   }
  562.   if (&check_auth($'userno[$server[$cno]], &'array($request[$cno]))) {
  563.     if ($dir eq '') {
  564.       if ($file eq '') {
  565.         &top($cno, $query);
  566.       } elsif ($file eq 'channel') {
  567.         &channel($cno, $query);
  568.       } elsif ($file eq 'message') {
  569.         &message($cno, $query);
  570.       } elsif ($file eq 'input') {
  571.         &input($cno, $query);
  572.       } else {
  573.         print $socket 'HTTP/1.0 404 Not Fonud', "\r\n";
  574.         print $socket "\r\n";
  575.       }
  576.     } else {
  577.       print $socket 'HTTP/1.0 404 Not Fonud', "\r\n";
  578.       print $socket "\r\n";
  579.     }
  580.   } else {
  581.     print $socket 'HTTP/1.0 401 Unauthorized', "\r\n";
  582.     print $socket 'WWW-Authenticate: Basic realm="authentication"', "\r\n";
  583.     print $socket "\r\n";
  584.   }
  585. }
  586.  
  587. sub check_auth {
  588.   local($userno, @request) = @_;
  589.   local($name, $val, $type, $str, $pass, $host, $id);
  590.   foreach $data (@request) {
  591.     ($name, $val) = split(/\s*\:\s*/, $data, 2);
  592.     next unless $val;
  593.     next unless "\L$name\E" eq 'authorization';
  594.     ($type, $str) = split(/\s+/, $val, 2);
  595.     if ("\L$type\E" eq 'basic') {
  596.       $pass = &base64($str, 2);
  597.     } else {
  598.       $pass = '';
  599.     }
  600.     foreach $client (&'property($userno, 'client')) {
  601.       ($host, $id) = split(/\s+/, $client, 2);
  602.       next unless $id eq $pass;
  603.       return 1;
  604.     }
  605.   }
  606.   return 0;
  607. }
  608.  
  609. sub top {
  610.   local($cno, $query) = @_;
  611.   local($socket);
  612.   $socket = $'socket[$cno];
  613.   print $socket 'HTTP/1.0 200 Ok', "\r\n";
  614.   print $socket 'Content-Type: text/html', "\r\n";
  615.   print $socket "\r\n";
  616.   print $socket '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Frameset//EN">', "\r\n";
  617.   print $socket '<HTML><HEAD>', "\r\n";
  618.   print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  619.   print $socket '<TITLE>plum webchat interface</TITLE>', "\r\n";
  620.   print $socket '</HEAD>', "\r\n";
  621.   print $socket '<FRAMESET COLS="20%,80%">', "\r\n";
  622.   print $socket '<FRAME TITLE="channel" NAME="channel" SRC="channel">', "\r\n";
  623.   print $socket '<FRAMESET ROWS="80%,20%">', "\r\n";
  624.   print $socket '<FRAME TITLE="message" NAME="message" SRC="message">', "\r\n";
  625.   print $socket '<FRAME TITLE="input" NAME="input" SRC="input">', "\r\n";
  626.   print $socket '</FRAMESET>', "\r\n";
  627.   print $socket '<NOFRAMES>', "\r\n";
  628.   print $socket '<BODY>this page requires frame</BODY>', "\r\n";
  629.   print $socket '</NOFRAMES>', "\r\n";
  630.   print $socket '</FRAMESET>', "\r\n";
  631.   print $socket '</HTML>', "\r\n";
  632. }
  633.  
  634. sub channel {
  635.   local($cno, $query) = @_;
  636.   local($sno, $socket, $vchan);
  637.   $sno = $server[$cno];
  638.   $socket = $'socket[$cno];
  639.   print $socket 'HTTP/1.0 200 Ok', "\r\n";
  640.   print $socket 'Content-Type: text/html', "\r\n";
  641.   print $socket "\r\n";
  642.   print $socket '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">', "\r\n";
  643.   print $socket '<HTML><HEAD>', "\r\n";
  644.   print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  645.   print $socket '<TITLE>channel frame</TITLE></HEAD><BODY>', "\r\n";
  646.   print $socket '<A HREF="message" TARGET="message">*PRIVATE*</A><BR>', "\r\n";
  647.   foreach $chan (&'array($'channellist[$sno])) {
  648.     $vchan = &'alias($chan);
  649.     print $socket '<A HREF="message?channel=', &encode($vchan), '" TARGET="message">', $vchan, '</A><BR>', "\r\n";
  650.   }
  651.   print $socket '</BODY></HTML>', "\r\n";
  652. }
  653.  
  654. sub message {
  655.   local($cno, $query) = @_;
  656.   local($socket, %param, $sno, $var, $val, $chan, $vchan, @list, $str);
  657.   $sno = $server[$cno];
  658.   if ($query) {
  659.     foreach $param (split(/\&/, $query)) {
  660.       ($var, $val) = split(/\=/, $param, 2);
  661.       $param{$var} = &decode($val);
  662.     }
  663.     if ($param{'channel'}) {
  664.       $chan = &'real($param{'channel'});
  665.     }
  666.   }
  667.   if (!$chan || !&'exist($'channellist[$sno], $chan)) {
  668.     $chan = '';
  669.   }
  670.   $vchan = &'alias($chan);
  671.   $socket = $'socket[$cno];
  672.   print $socket 'HTTP/1.0 200 Ok', "\r\n";
  673.   print $socket 'Content-Type: text/html', "\r\n";
  674.   print $socket "\r\n";
  675.   print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  676.   print $socket '<HTML><HEAD>', "\r\n";
  677.   print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  678.   print $socket '<TITLE>message frame</TITLE></HEAD><BODY><CODE>', "\r\n";
  679.   if ($chan) {
  680.     $str = '*** ' . $vchan . ' = ' . join(' ', reverse(&'array($'nameslist{$sno, $chan})));
  681.     print $socket "e($str), '<BR>', "\r\n";
  682.     if ($'topic{$sno, $chan}) {
  683.       $str = '*** Topic for ' . $vchan . ':' . $'topic{$sno, $chan};
  684.       print $socket "e($str), '<BR>', "\r\n";
  685.     }
  686.   }
  687.   @list = &'array($message{$sno, $chan});
  688.   print $socket join("\r\n", @list), "\r\n";
  689.   print $socket '</CODE></BODY></HTML>', "\r\n";
  690. }
  691.  
  692. sub input {
  693.   local($cno, $query) = @_;
  694.   local($socket, %param, $cmd, $var, $val, $chan, $msg);
  695.   $socket = $'socket[$cno];
  696.   if ($query) {
  697.     foreach $param (split(/\&/, $query)) {
  698.       ($var, $val) = split(/\=/, $param, 2);
  699.       $param{$var} = &decode($val);
  700.     }
  701.   }
  702.   if ($param{'command'}) {
  703.     $cmd = "\L$param{'command'}\E";
  704.   } else {
  705.     $cmd = '*';
  706.   }
  707.   if ($cmd eq '*') {
  708.     &send($cno, %param);
  709.   } else {
  710.     $sub = "send_\L$cmd\E";
  711.     if (defined(&$sub)) {
  712.       &$sub($cno, %param);
  713.     } else {
  714.       &send($cno);
  715.     }
  716.   }
  717. }
  718.  
  719. sub send {
  720.   local($cno, %param) = @_;
  721.   local($socket, $method, $msg, @msg);
  722.   $socket = $'socket[$cno];
  723.   $method = &'property($'userno[$server[$cno]], 'method') || $METHOD;
  724.   $method = "\U$method\E";
  725.   $msg = &'sjis_jis(&'jis_jis($param{'message'} || ''));
  726.   if ($msg) {
  727.     @msg = &'parse($msg);
  728.     &'s_print($server[$cno], @msg);
  729.     print $socket 'HTTP/1.0 204 No Content', "\r\n";
  730.     print $socket "\r\n";
  731.   } else {
  732.     print $socket 'HTTP/1.0 200 Ok', "\r\n";
  733.     print $socket 'Content-Type: text/html', "\r\n";
  734.     print $socket "\r\n";
  735.     print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  736.     print $socket '<HTML><HEAD>', "\r\n";
  737.     print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  738.     print $socket '<TITLE>input frame</TITLE></HEAD><BODY>', "\r\n";
  739.     print $socket &links($cno, '*'), "\r\n";
  740.     print $socket '<HR>', "\r\n";
  741.     print $socket '<FORM ACTION="input" METHOD="', $method, '">', "\r\n";
  742.     print $socket '<INPUT TYPE="text" NAME="message" SIZE="60">', "\r\n";
  743.     print $socket '<INPUT TYPE="hidden" NAME="command" VALUE="*">', "\r\n";
  744.     print $socket '<INPUT TYPE="submit" VALUE="SEND">', "\r\n";
  745.     print $socket '</FORM>', "\r\n";
  746.     print $socket '</BODY></HTML>', "\r\n";
  747.   }
  748. }
  749.  
  750. sub send_join {
  751.   local($cno, %param) = @_;
  752.   local($socket, $method, $chan);
  753.   $socket = $'socket[$cno];
  754.   $method = &'property($'userno[$server[$cno]], 'method') || $METHOD;
  755.   $method = "\U$method\E";
  756.   $chan = &'sjis_jis(&'jis_jis($param{'channel'} || ''));
  757.   if ($chan) {
  758.     &'s_print($server[$cno], '', 'JOIN', &'real($chan));
  759.     print $socket 'HTTP/1.0 204 No Content', "\r\n";
  760.     print $socket "\r\n";
  761.   } else {
  762.     print $socket 'HTTP/1.0 200 Ok', "\r\n";
  763.     print $socket 'Content-Type: text/html', "\r\n";
  764.     print $socket "\r\n";
  765.     print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  766.     print $socket '<HTML><HEAD>', "\r\n";
  767.     print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  768.     print $socket '<TITLE>input join frame</TITLE></HEAD><BODY>', "\r\n";
  769.     print $socket &links($cno, 'join'), "\r\n";
  770.     print $socket '<HR>', "\r\n";
  771.     print $socket '<FORM ACTION="input" METHOD="', $method, '">', "\r\n";
  772.     print $socket '<INPUT TYPE="text" NAME="channel" SIZE="20">', "\r\n";
  773.     print $socket '<INPUT TYPE="hidden" NAME="command" VALUE="join">', "\r\n";
  774.     print $socket '<INPUT TYPE="submit" VALUE="SEND">', "\r\n";
  775.     print $socket '</FORM>', "\r\n";
  776.     print $socket '</BODY></HTML>', "\r\n";
  777.   }
  778. }
  779.  
  780. sub send_part {
  781.   local($cno, %param) = @_;
  782.   local($socket, $method, $chan, $msg);
  783.   $socket = $'socket[$cno];
  784.   $method = &'property($'userno[$server[$cno]], 'method') || $METHOD;
  785.   $method = "\U$method\E";
  786.   $chan = &'sjis_jis(&'jis_jis($param{'channel'} || ''));
  787.   $msg = &'sjis_jis(&'jis_jis($param{'message'} || ''));
  788.   if ($chan) {
  789.     &'s_print($server[$cno], '', 'PART', &'real($chan), $msg);
  790.     print $socket 'HTTP/1.0 204 No Content', "\r\n";
  791.     print $socket "\r\n";
  792.   } else {
  793.     print $socket 'HTTP/1.0 200 Ok', "\r\n";
  794.     print $socket 'Content-Type: text/html', "\r\n";
  795.     print $socket "\r\n";
  796.     print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  797.     print $socket '<HTML><HEAD>', "\r\n";
  798.     print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  799.     print $socket '<TITLE>input part frame</TITLE></HEAD><BODY>', "\r\n";
  800.     print $socket &links($cno, 'part'), "\r\n";
  801.     print $socket '<HR>', "\r\n";
  802.     print $socket '<FORM ACTION="input" METHOD="', $method, '">', "\r\n";
  803.     print $socket '<SELECT NAME="channel">', "\r\n";
  804.     foreach $chan (&'array($'channellist[$server[$cno]])) {
  805.       print $socket '<OPTION VALUE="', $chan, '">', $chan, "\r\n";
  806.     }
  807.     print $socket '</SELECT>', "\r\n";
  808.     print $socket '<INPUT TYPE="text" NAME="message" SIZE="60">', "\r\n";
  809.     print $socket '<INPUT TYPE="hidden" NAME="command" VALUE="part">', "\r\n";
  810.     print $socket '<INPUT TYPE="submit" VALUE="SEND">', "\r\n";
  811.     print $socket '</FORM>', "\r\n";
  812.     print $socket '</BODY></HTML>', "\r\n";
  813.   }
  814. }
  815.  
  816. sub send_privmsg {
  817.   local($cno, %param) = @_;
  818.   local($socket, $method, $chan, $msg);
  819.   $socket = $'socket[$cno];
  820.   $method = &'property($'userno[$server[$cno]], 'method') || $METHOD;
  821.   $method = "\U$method\E";
  822.   $chan = &'sjis_jis(&'jis_jis($param{'channel'} || ''));
  823.   $msg = &'sjis_jis(&'jis_jis($param{'message'} || ''));
  824.   $nick = $param{'nickname'} || '';
  825.   if (defined($param{'message'})) {
  826.     if ($nick) {
  827.       &privmsg($server[$cno], $nick, $msg);
  828.     } elsif ($chan eq '*PRIVATE*') {
  829.       &privmsg($server[$cno], $'nick[$server[$cno]], $msg);
  830.     } elsif ($chan ne '*PRIVATE*') {
  831.       &privmsg($server[$cno], &'real($chan), $msg);
  832.     }
  833.     print $socket 'HTTP/1.0 204 No Content', "\r\n";
  834.     print $socket "\r\n";
  835.   } else {
  836.     print $socket 'HTTP/1.0 200 Ok', "\r\n";
  837.     print $socket 'Content-Type: text/html', "\r\n";
  838.     print $socket "\r\n";
  839.     print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  840.     print $socket '<HTML><HEAD>', "\r\n";
  841.     print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  842.     print $socket '<TITLE>input privmsg frame</TITLE></HEAD><BODY>', "\r\n";
  843.     print $socket &links($cno, 'privmsg'), "\r\n";
  844.     print $socket '<HR>', "\r\n";
  845.     print $socket '<FORM ACTION="input" METHOD="', $method, '">', "\r\n";
  846.     print $socket '<SELECT NAME="channel">', "\r\n";
  847.     print $socket '<OPTION VALUE="*PRIVATE*">*PRIVATE*', "\r\n";
  848.     foreach $chan (&'array($'channellist[$server[$cno]])) {
  849.       print $socket '<OPTION VALUE="', $chan, '">', $chan, "\r\n";
  850.     }
  851.     print $socket '</SELECT>', "\r\n";
  852.     print $socket '<INPUT TYPE="text" NAME="nickname" SIZE="20">', "\r\n";
  853.     print $socket '<INPUT TYPE="text" NAME="message" SIZE="60">', "\r\n";
  854.     print $socket '<INPUT TYPE="hidden" NAME="command" VALUE="privmsg">', "\r\n";
  855.     print $socket '<INPUT TYPE="submit" VALUE="SEND">', "\r\n";
  856.     print $socket '</FORM>', "\r\n";
  857.     print $socket '</BODY></HTML>', "\r\n";
  858.   }
  859. }
  860.  
  861. sub send_topic {
  862.   local($cno, %param) = @_;
  863.   local($socket, $method, $chan, $msg);
  864.   $socket = $'socket[$cno];
  865.   $method = &'property($'userno[$server[$cno]], 'method') || $METHOD;
  866.   $method = "\U$method\E";
  867.   $chan = &'sjis_jis(&'jis_jis($param{'channel'} || ''));
  868.   $msg = &'sjis_jis(&'jis_jis($param{'message'} || ''));
  869.   if ($chan) {
  870.     &'s_print($server[$cno], '', 'TOPIC', &'real($chan), $msg);
  871.     print $socket 'HTTP/1.0 204 No Content', "\r\n";
  872.     print $socket "\r\n";
  873.   } else {
  874.     print $socket 'HTTP/1.0 200 Ok', "\r\n";
  875.     print $socket 'Content-Type: text/html', "\r\n";
  876.     print $socket "\r\n";
  877.     print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  878.     print $socket '<HTML><HEAD>', "\r\n";
  879.     print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  880.     print $socket '<TITLE>input topic frame</TITLE></HEAD><BODY>', "\r\n";
  881.     print $socket &links($cno, 'topic'), "\r\n";
  882.     print $socket '<HR>', "\r\n";
  883.     print $socket '<FORM ACTION="input" METHOD="', $method, '">', "\r\n";
  884.     print $socket '<SELECT NAME="channel">', "\r\n";
  885.     foreach $chan (&'array($'channellist[$server[$cno]])) {
  886.       print $socket '<OPTION VALUE="', $chan, '">', $chan, "\r\n";
  887.     }
  888.     print $socket '</SELECT>', "\r\n";
  889.     print $socket '<INPUT TYPE="text" NAME="message" SIZE="60">', "\r\n";
  890.     print $socket '<INPUT TYPE="hidden" NAME="command" VALUE="topic">', "\r\n";
  891.     print $socket '<INPUT TYPE="submit" VALUE="SEND">', "\r\n";
  892.     print $socket '</FORM>', "\r\n";
  893.     print $socket '</BODY></HTML>', "\r\n";
  894.   }
  895. }
  896.  
  897. sub send_nick {
  898.   local($cno, %param) = @_;
  899.   local($socket, $method, $nick);
  900.   $socket = $'socket[$cno];
  901.   $method = &'property($'userno[$server[$cno]], 'method') || $METHOD;
  902.   $method = "\U$method\E";
  903.   $nick = $param{'nickname'} || '';
  904.   if ($nick) {
  905.     &'s_print($server[$cno], '', 'nick', $nick);
  906.     print $socket 'HTTP/1.0 204 No Content', "\r\n";
  907.     print $socket "\r\n";
  908.   } else {
  909.     print $socket 'HTTP/1.0 200 Ok', "\r\n";
  910.     print $socket 'Content-Type: text/html', "\r\n";
  911.     print $socket "\r\n";
  912.     print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  913.     print $socket '<HTML><HEAD>', "\r\n";
  914.     print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  915.     print $socket '<TITLE>input nick frame</TITLE></HEAD><BODY>', "\r\n";
  916.     print $socket &links($cno, 'nick'), "\r\n";
  917.     print $socket '<HR>', "\r\n";
  918.     print $socket '<FORM ACTION="input" METHOD="', $method, '">', "\r\n";
  919.     print $socket '<INPUT TYPE="text" NAME="nickname" SIZE="20">', "\r\n";
  920.     print $socket '<INPUT TYPE="hidden" NAME="command" VALUE="nick">', "\r\n";
  921.     print $socket '<INPUT TYPE="submit" VALUE="SEND">', "\r\n";
  922.     print $socket '</FORM>', "\r\n";
  923.     print $socket '</BODY></HTML>', "\r\n";
  924.   }
  925. }
  926.  
  927. sub send_kick {
  928.   local($cno, %param) = @_;
  929.   local($socket, $method, $chan, $nick, $msg);
  930.   $socket = $'socket[$cno];
  931.   $method = &'property($'userno[$server[$cno]], 'method') || $METHOD;
  932.   $method = "\U$method\E";
  933.   $chan = &'sjis_jis(&'jis_jis($param{'channel'} || ''));
  934.   $msg = &'sjis_jis(&'jis_jis($param{'message'} || ''));
  935.   $nick = $param{'nickname'} || '';
  936.   if ($chan && $nick) {
  937.     &'s_print($server[$cno], '', 'KICK', &'real($chan), $nick, $msg);
  938.     print $socket 'HTTP/1.0 204 No Content', "\r\n";
  939.     print $socket "\r\n";
  940.   } else {
  941.     print $socket 'HTTP/1.0 200 Ok', "\r\n";
  942.     print $socket 'Content-Type: text/html', "\r\n";
  943.     print $socket "\r\n";
  944.     print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  945.     print $socket '<HTML><HEAD>', "\r\n";
  946.     print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  947.     print $socket '<TITLE>input kick frame</TITLE></HEAD><BODY>', "\r\n";
  948.     print $socket &links($cno, 'kick'), "\r\n";
  949.     print $socket '<HR>', "\r\n";
  950.     print $socket '<FORM ACTION="input" METHOD="', $method, '">', "\r\n";
  951.     print $socket '<SELECT NAME="channel">', "\r\n";
  952.     foreach $chan (&'array($'channellist[$server[$cno]])) {
  953.       print $socket '<OPTION VALUE="', $chan, '">', $chan, "\r\n";
  954.     }
  955.     print $socket '</SELECT>', "\r\n";
  956.     print $socket '<INPUT TYPE="text" NAME="nickname" SIZE="20">', "\r\n";
  957.     print $socket '<INPUT TYPE="text" NAME="message" SIZE="60">', "\r\n";
  958.     print $socket '<INPUT TYPE="hidden" NAME="command" VALUE="kick">', "\r\n";
  959.     print $socket '<INPUT TYPE="submit" VALUE="SEND">', "\r\n";
  960.     print $socket '</FORM>', "\r\n";
  961.     print $socket '</BODY></HTML>', "\r\n";
  962.   }
  963. }
  964.  
  965. sub send_mode {
  966.   local($cno, %param) = @_;
  967.   local($socket, $method, $chan, $mode);
  968.   $socket = $'socket[$cno];
  969.   $method = &'property($'userno[$server[$cno]], 'method') || $METHOD;
  970.   $method = "\U$method\E";
  971.   $chan = &'sjis_jis(&'jis_jis($param{'channel'} || ''));
  972.   $mode = &'sjis_jis(&'jis_jis($param{'mode'} || ''));
  973.   if ($chan && $mode) {
  974.     &'s_print($server[$cno], '', 'MODE', &'real($chan), $mode);
  975.     print $socket 'HTTP/1.0 204 No Content', "\r\n";
  976.     print $socket "\r\n";
  977.   } else {
  978.     print $socket 'HTTP/1.0 200 Ok', "\r\n";
  979.     print $socket 'Content-Type: text/html', "\r\n";
  980.     print $socket "\r\n";
  981.     print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  982.     print $socket '<HTML><HEAD>', "\r\n";
  983.     print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  984.     print $socket '<TITLE>input mode frame</TITLE></HEAD><BODY>', "\r\n";
  985.     print $socket &links($cno, 'mode'), "\r\n";
  986.     print $socket '<HR>', "\r\n";
  987.     print $socket '<FORM ACTION="input" METHOD="', $method, '">', "\r\n";
  988.     print $socket '<SELECT NAME="channel">', "\r\n";
  989.     foreach $chan (&'array($'channellist[$server[$cno]])) {
  990.       print $socket '<OPTION VALUE="', $chan, '">', $chan, "\r\n";
  991.     }
  992.     print $socket '</SELECT>', "\r\n";
  993.     print $socket '<INPUT TYPE="text" NAME="mode" SIZE="60">', "\r\n";
  994.     print $socket '<INPUT TYPE="hidden" NAME="command" VALUE="mode">', "\r\n";
  995.     print $socket '<INPUT TYPE="submit" VALUE="SEND">', "\r\n";
  996.     print $socket '</FORM>', "\r\n";
  997.     print $socket '</BODY></HTML>', "\r\n";
  998.   }
  999. }
  1000.  
  1001. sub send_invite {
  1002.   local($cno, %param) = @_;
  1003.   local($socket, $method, $chan, $nick);
  1004.   $socket = $'socket[$cno];
  1005.   $method = &'property($'userno[$server[$cno]], 'method') || $METHOD;
  1006.   $method = "\U$method\E";
  1007.   $chan = &'sjis_jis(&'jis_jis($param{'channel'} || ''));
  1008.   $nick = $param{'nickname'} || '';
  1009.   if ($chan && $nick) {
  1010.     &'s_print($server[$cno], '', 'INVITE', &'real($chan), $nick);
  1011.     print $socket 'HTTP/1.0 204 No Content', "\r\n";
  1012.     print $socket "\r\n";
  1013.   } else {
  1014.     print $socket 'HTTP/1.0 200 Ok', "\r\n";
  1015.     print $socket 'Content-Type: text/html', "\r\n";
  1016.     print $socket "\r\n";
  1017.     print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  1018.     print $socket '<HTML><HEAD>', "\r\n";
  1019.     print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  1020.     print $socket '<TITLE>input invite frame</TITLE></HEAD><BODY>', "\r\n";
  1021.     print $socket &links($cno, 'invite'), "\r\n";
  1022.     print $socket '<HR>', "\r\n";
  1023.     print $socket '<FORM ACTION="input" METHOD="', $method, '">', "\r\n";
  1024.     print $socket '<SELECT NAME="channel">', "\r\n";
  1025.     foreach $chan (&'array($'channellist[$server[$cno]])) {
  1026.       print $socket '<OPTION VALUE="', $chan, '">', $chan, "\r\n";
  1027.     }
  1028.     print $socket '</SELECT>', "\r\n";
  1029.     print $socket '<INPUT TYPE="text" NAME="nickname" SIZE="20">', "\r\n";
  1030.     print $socket '<INPUT TYPE="hidden" NAME="command" VALUE="invite">', "\r\n";
  1031.     print $socket '<INPUT TYPE="submit" VALUE="SEND">', "\r\n";
  1032.     print $socket '</FORM>', "\r\n";
  1033.     print $socket '</BODY></HTML>', "\r\n";
  1034.   }
  1035. }
  1036.  
  1037. sub send_away {
  1038.   local($cno, %param) = @_;
  1039.   local($socket, $method, $msg);
  1040.   $socket = $'socket[$cno];
  1041.   $method = &'property($'userno[$server[$cno]], 'method') || $METHOD;
  1042.   $method = "\U$method\E";
  1043.   $msg = &'sjis_jis(&'jis_jis($param{'message'} || ''));
  1044.   if (defined($param{'message'})) {
  1045.     &'s_print($server[$cno], '', 'AWAY', $msg);
  1046.     print $socket 'HTTP/1.0 204 No Content', "\r\n";
  1047.     print $socket "\r\n";
  1048.   } else {
  1049.     print $socket 'HTTP/1.0 200 Ok', "\r\n";
  1050.     print $socket 'Content-Type: text/html', "\r\n";
  1051.     print $socket "\r\n";
  1052.     print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  1053.     print $socket '<HTML><HEAD>', "\r\n";
  1054.     print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  1055.     print $socket '<TITLE>input away frame</TITLE></HEAD><BODY>', "\r\n";
  1056.     print $socket &links($cno, 'away'), "\r\n";
  1057.     print $socket '<HR>', "\r\n";
  1058.     print $socket '<FORM ACTION="input" METHOD="', $method, '">', "\r\n";
  1059.     print $socket '<INPUT TYPE="text" NAME="message" SIZE="60">', "\r\n";
  1060.     print $socket '<INPUT TYPE="hidden" NAME="command" VALUE="away">', "\r\n";
  1061.     print $socket '<INPUT TYPE="submit" VALUE="SEND">', "\r\n";
  1062.     print $socket '</FORM>', "\r\n";
  1063.     print $socket '</BODY></HTML>', "\r\n";
  1064.   }
  1065. }
  1066.  
  1067. sub send_whois {
  1068.   local($cno, %param) = @_;
  1069.   local($socket, $method, $nick);
  1070.   $socket = $'socket[$cno];
  1071.   $method = &'property($'userno[$server[$cno]], 'method') || $METHOD;
  1072.   $method = "\U$method\E";
  1073.   $nick = $param{'nickname'} || '';
  1074.   if ($nick) {
  1075.     &'s_print($server[$cno], '', 'WHOIS', $nick);
  1076.     print $socket 'HTTP/1.0 204 No Content', "\r\n";
  1077.     print $socket "\r\n";
  1078.   } else {
  1079.     print $socket 'HTTP/1.0 200 Ok', "\r\n";
  1080.     print $socket 'Content-Type: text/html', "\r\n";
  1081.     print $socket "\r\n";
  1082.     print $socket '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">', "\r\n";
  1083.     print $socket '<HTML><HEAD>', "\r\n";
  1084.     print $socket '<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">', "\r\n";
  1085.     print $socket '<TITLE>input whois frame</TITLE></HEAD><BODY>', "\r\n";
  1086.     print $socket &links($cno, 'whois'), "\r\n";
  1087.     print $socket '<HR>', "\r\n";
  1088.     print $socket '<FORM ACTION="input" METHOD="', $method, '">', "\r\n";
  1089.     print $socket '<INPUT TYPE="text" NAME="nickname" SIZE="20">', "\r\n";
  1090.     print $socket '<INPUT TYPE="hidden" NAME="command" VALUE="whois">', "\r\n";
  1091.     print $socket '<INPUT TYPE="submit" VALUE="SEND">', "\r\n";
  1092.     print $socket '</FORM>', "\r\n";
  1093.     print $socket '</BODY></HTML>', "\r\n";
  1094.   }
  1095. }
  1096.  
  1097. sub links {
  1098.   local($cno, $cmd) = @_;
  1099.   local($socket, $ret);
  1100.   $socket = $'socket[$cno];
  1101.   $ret = '';
  1102.   foreach $item ('*', 'join', 'part', 'privmsg', 'topic', 'nick', 'kick', 'mode', 'invite', 'away', 'whois') {
  1103.     $ret .= '[';
  1104.     if ($item ne $cmd) {
  1105.       $ret .= '<A HREF="input?command=' .  $item . '">';
  1106.     }
  1107.     $ret .= "\U$item\E";
  1108.     if ($item ne $cmd) {
  1109.       $ret .= '</A>';
  1110.     }
  1111.     $ret .= ']';
  1112.   }
  1113.   return $ret;
  1114. }
  1115.  
  1116. sub privmsg {
  1117.   local($serverno, $to, $msg) = @_;
  1118.   &'s_print($serverno, '', 'PRIVMSG', $to, $msg);
  1119.   foreach $cno (&'array($'clientlist)) {
  1120.     next unless $'avail[$cno];
  1121.     next unless $'server[$cno] == $serverno;
  1122.     &'c_print($cno, &'user($cno), 'PRIVMSG', $to, $msg);
  1123.   }
  1124. }
  1125.  
  1126. sub quote {
  1127.   local($str) = @_;
  1128.   local($ret);
  1129.   $ret = &'jis_euc($str);
  1130.   $ret =~ s/\&/\&\;/g;
  1131.   $ret =~ s/\</\<\;/g;
  1132.   $ret =~ s/\>/\>\;/g;
  1133.   $ret =~ s/\"/\"\;/g;
  1134.   return &'euc_jis($ret);
  1135. }
  1136.  
  1137. sub encode {
  1138.   local($str) = @_;
  1139.   local($i, $c, $n, $ret);
  1140.   $ret = '';
  1141.   for ($i = 0; $i < length($str); $i++) {
  1142.     $c = substr($str, $i, 1);
  1143.     $n = ord($c);
  1144.     if ($n == 0x20) { 
  1145.       $ret .= '+';
  1146.     } elsif (index("<>\"#%{}|\\^~[]`;/?:@&=+", $c) != -1 || $n > 0x7e || $n < 0x20) {
  1147.       $ret .= sprintf('%%%02X', $n);
  1148.     } else {
  1149.       $ret .= $c;
  1150.     }
  1151.   }
  1152.   return $ret;
  1153. }
  1154.  
  1155. sub decode {
  1156.   local($str) = @_;
  1157.   local($i, $c, $ret);
  1158.   $ret = '';
  1159.   for ($i = 0; $i < length($str); $i++) {
  1160.     $c = substr($str, $i, 1);
  1161.     if ($c eq '%') {
  1162.       $ret .= pack('C', hex(substr($str, $i + 1, 2)));
  1163.       $i += 2;
  1164.     } elsif ($c eq '+') {
  1165.       $ret .= ' ';
  1166.     } else {
  1167.       $ret .= $c;
  1168.     }
  1169.   }
  1170.   return $ret;
  1171. }
  1172.  
  1173. sub base64 {
  1174.   local($str) = @_;
  1175.   local($i, $c, $n, $bit);
  1176.   $bit = '';
  1177.   for ($i = 0; $i < length($str); $i++) {
  1178.     $c = substr($str, $i, 1);
  1179.     next if $c eq '=';
  1180.     if (($n = index($BASE64, $c)) != -1) {
  1181.       $bit .= substr(unpack('B8', pack('C', $n)), -6);
  1182.     }
  1183.   }
  1184.   return pack('B*', substr($bit, 0, int(length($bit) / 8) * 8));
  1185. }
  1186.  
  1187. __END__
  1188. --><HTML><HEAD>
  1189. <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-2022-JP">
  1190. <LINK REV="made" HREF="mailto:hasegawa@agusa.nuie.nagoya-u.ac.jp">
  1191. <TITLE>sys/web.plm</TITLE></HEAD><BODY>
  1192.  
  1193. $B%*%s%i%$%s%I%-%e%a%s%H(B
  1194.  
  1195.  
  1196. <HR><H3>$BL>A0(B</H3>
  1197.  
  1198. sys/web.plm - Web$B%V%i%&%6$J$I$G(BIRC$B$r9T$&$?$a$N%$%s%?!<%U%'%$%9(B
  1199.  
  1200.  
  1201. <HR><H3>$B@bL@(B</H3>
  1202.  
  1203. HTTP$B%W%m%H%3%k$rMxMQ$9$k$3$H$G!"(BWeb$B%V%i%&%6$J$I$+$i(BIRC$B$r9T$$$^$9!#(B
  1204. $B%U%l!<%`$rMQ$$$FI=<($rJ,3d$7$F$$$k$N$G!"%U%l!<%`$KBP1~$7$?(B
  1205. Web$B%V%i%&%6$,I,MW$G$9!#(B
  1206.  
  1207. <HR><H3>$B%W%m%Q%F%#(B</H3>
  1208.  
  1209. <DL>
  1210. <DT>  sys.web.method {post|get}
  1211. </DT>
  1212. <DD>    $B%U%)!<%`$N%G!<%?$rAw?.$9$k$H$-$K;HMQ$9$k%a%=%C%I$r;XDj$7$^$9!#(B
  1213.         $B%G%U%)%k%H$G$O(Bget$B$K$J$C$F$$$^$9!#(B
  1214. </DD>
  1215. <DT>  sys.web.client* $B%[%9%H%^%9%/(B:$B%]!<%HHV9f(B $B%f!<%6L>(B:$B%Q%9%o!<%I(B
  1216. </DT>
  1217. <DD>    HTTP$B%W%m%H%3%k$K$h$C$FDL?.$r9T$&%]!<%H!"(B
  1218.         $B@\B32DG=$J%/%i%$%"%s%H$N%^%9%/$H!"MxMQ2DG=$J%f!<%6$r;XDj$7$^$9!#(B
  1219. </DD>
  1220. <DT>  sys.web.header $B$X%C%@(B
  1221. </DT>
  1222. <DD>    $B%m%0$N;~9o$N%U%)!<%^%C%H$r;XDj$7$^$9!#(B
  1223.         %$B$G$O$8$^$kJ8;z$,$"$k$H!"BP1~$9$k;~4V$KJQ49$5$l$^$9!#(B
  1224. </DD>
  1225. <DT>  sys.web.line $B9T?t(B
  1226. </DT>
  1227. <DD>    $B%a%C%;!<%8$N%m%0$r;D$99T?t$r;XDj$7$^$9!#%G%U%)%k%H$G$O(B50$B9T$G$9!#(B
  1228. </DD>
  1229. </DL>
  1230.  
  1231.  
  1232. <HR><H3>$B@_DjNc(B</H3>
  1233.  
  1234. <PRE>
  1235. + sys/web.plm
  1236. sys.web.method: get
  1237. sys.web.client: *.jp:8080 userid:passwd
  1238. sys.web.header: %H:%M
  1239. sys.web.line: 50
  1240. </PRE>
  1241.  
  1242. $B%]!<%HHV9f(B8080$B$G(BHTTP$B%W%m%H%3%k$r;HMQ$7$?DL?.$r9T$$$^$9!#(B
  1243. $B%f!<%6(BID$B$H$7$F!V(Buserid$B!W!"%Q%9%o!<%I$H$7$F!V(Bpasswd$B!W$r(B
  1244. $B;XDj$9$k$3$H$G@\B3$9$k$3$H$,$G$-$^$9!#(B
  1245. $B$?$@$7@\B32DG=$J$N$O@\B385$N%[%9%H$,!V(B*.jp$B!W$K%^%C%A$9$k>l9g$@$1$G$9!#(B
  1246.  
  1247. </BODY></HTML>
  1248.