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