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 / support / httpgate < prev    next >
Text File  |  1999-03-24  |  9KB  |  339 lines

  1. #!/bin/perl -w
  2. # $Id: httpgate,v 2.17 1999/01/20 15:00:02 hasegawa Exp $
  3. # copyright (c)1998-1999 Yoshinori Hasegawa <hasegawa@madoka.org>
  4.  
  5. if ($] < 5) {
  6.   foreach $inc (@INC) {
  7.     if (-r "$inc/sys/socket.ph") {
  8.       eval 'require "sys/socket.ph"';
  9.       $SOCKET = "$inc/sys/socket.ph" unless $@;
  10.       last;
  11.     }
  12.     if (-r "$inc/socket.ph") {
  13.       eval 'require "socket.ph"';
  14.       $SOCKET = "$inc/socket.ph" unless $@;
  15.       last;
  16.     }
  17.   }
  18. } else {
  19.   eval 'use Socket';
  20.   $SOCKET = 'Socket.pm' unless $@;
  21. }
  22.  
  23. $NIL = $;;
  24.  
  25. $READSIZE = 4096;
  26. $SOCKADDR = 'S n N x8';
  27.  
  28. $PROTO = (getprotobyname('tcp'))[2];
  29.  
  30. $AF_INET = eval '&AF_INET' || 2;
  31. $PF_INET = eval '&PF_INET' || 2;
  32. $SOCK_STREAM = eval '&SOCK_STREAM' || 1;
  33. $SOMAXCONN = eval '&SOMAXCONN' || 16;
  34. $INADDR_ANY = eval '&INADDR_ANY' || "\0\0\0\0";
  35. $SOL_SOCKET = eval '&SOL_SOCKET';
  36. $SO_REUSEADDR = eval '&SO_REUSEADDR';
  37.  
  38. $'rin = '';
  39.  
  40. $handle = 0;
  41.  
  42. $SIG{'PIPE'} = 'IGNORE' if &'exist(&'list(keys(%SIG)), 'PIPE');
  43.  
  44. $TIMEOUT = 3600;
  45.  
  46. &main(@ARGV);
  47.  
  48. sub main {
  49.   local(@args) = @_;
  50.   local($rout, $listenno, $nf);
  51.   if (@args < 1) {
  52.     &usage();
  53.     exit(1);
  54.   }
  55.   $listenno = &'listen($args[0], 0) || die "cannot listen port\n";
  56.   for (;;) {
  57.     $nf = select($rout = $'rin, undef, undef, undef);
  58.     die "error in select\n" if $nf < 0;
  59.     foreach $cno (&'array($socketclientlist)) {
  60.       if (vec($rout, $cno, 1)) {
  61.         &socket_client($cno);
  62.       }
  63.     }
  64.     foreach $cno (&'array($httpclientlist)) {
  65.       if (vec($rout, $cno, 1)) {
  66.         &http_client($cno);
  67.       } elsif ($'access[$cno] - time() > $TIMEOUT) {
  68.         &http_close($cno);
  69.       }
  70.     }
  71.     foreach $lno (&'array($socketlistenlist)) {
  72.       if (vec($rout, $lno, 1)) {
  73.         &socket_accept($lno);
  74.       } elsif ($'access[$lno] - time() > $TIMEOUT) {
  75.         &'close($lno);
  76.         $socketlistenlist = &'remove($socketlistenlist, $lno);
  77.         &'close($peer[$lno]);
  78.         $httpclientlist = &'remove($httpclientlist, $peer[$lno]);
  79.         $peer[$peer[$lno]] = 0;
  80.         $peer[$lno] = 0;
  81.       }
  82.     }
  83.     &http_accept($listenno) if vec($rout, $listenno, 1);
  84.   }
  85. }
  86.  
  87. sub socket_client {
  88.   local($cno) = @_;
  89.   local($tmp, $socket);
  90.   $tmp = '';
  91.   if (sysread($'socket[$cno], $tmp, $READSIZE)) {
  92.     $socket = $'socket[$peer[$cno]];
  93.     print $socket $tmp if fileno($socket);
  94.   } else {
  95.     &'close($cno);
  96.     &'close($peer[$cno]);
  97.     $socketclientlist = &'remove($socketclientlist, $cno, $peer[$cno]);
  98.     $peer[$peer[$cno]] = 0;
  99.     $peer[$cno] = 0;
  100.   }
  101. }
  102.  
  103. sub http_client {
  104.   local($clientno) = @_;
  105.   local($tmp, $socket, $next, $rest, $method, $url, $lno, $sno, $host, $port);
  106.   $tmp = '';
  107.   if (sysread($'socket[$clientno], $tmp, $READSIZE)) {
  108.     $socket = $'socket[$clientno];
  109.     $rbuf[$clientno] .= $tmp;
  110.     while ((($next, $rest) = split(/\r\n/, $rbuf[$clientno], 2)) == 2) {
  111.       $rbuf[$clientno] = $rest;
  112.       if ($next) {
  113.         $request[$clientno] = &'add($request[$clientno], $next);
  114.       } else {
  115.         ($method, $url) = split(/\s+/, (&'array($request[$clientno]))[0]);
  116.         if ($method eq 'HEAD') {
  117.           $port = (split(/\//, $url))[1];
  118.           if ($lno = &'listen($port, 1)) {
  119.             print $socket 'HTTP/1.0 201 Created', "\r\n";
  120.             $host = (&'sockname($clientno))[1];
  121.             $port = (&'sockname($lno))[0];
  122.             print $socket 'Listen: ', $host, '/', $port, "\r\n";
  123.             print $socket "\r\n";
  124.             $peer[$clientno] = $lno;
  125.             $peer[$lno] = $clientno;
  126.             $httpclientlist = &'remove($httpclientlist, $clientno);
  127.             $socketlistenlist = &'add($socketlistenlist, $lno);
  128.             vec($'rin, $clientno, 1) = 0;
  129.             $request[$clientno] = '';
  130.           } else {
  131.             print $socket 'HTTP/1.0 403 Forbidden', "\r\n";
  132.             print $socket "\r\n";
  133.             &http_close($clientno);
  134.             last;
  135.           }
  136.         } elsif ($method eq 'POST') {
  137.           if ($peer[$clientno]) {
  138.             $httpclientlist = &'remove($httpclientlist, $clientno);
  139.           } else {
  140.             ($host, $port) = (split(/\//, $url))[1, 2];
  141.             if ($host && $port) {
  142.               if ($sno = &'connect($host, $port)) {
  143.                 print $socket 'HTTP/1.0 204 No Content', "\r\n";
  144.                 print $socket "\r\n";
  145.                 $peer[$clientno] = $sno;
  146.                 $peer[$sno] = $clientno;
  147.                 $httpclientlist = &'remove($httpclientlist, $clientno);
  148.                 $socketclientlist = &'add($socketclientlist, $sno, $clientno);
  149.                 $socket = $'socket[$sno];
  150.                 print $socket $rbuf[$clientno];
  151.               } else {
  152.                 print $socket 'HTTP/1.0 404 Not Found', "\r\n";
  153.                 print $socket "\r\n";
  154.                 &http_close($clientno);
  155.                 last;
  156.               }
  157.             } else {
  158.               print $socket 'HTTP/1.0 400 Bad Request', "\r\n";
  159.               print $socket "\r\n";
  160.               &http_close($clientno);
  161.               last;
  162.             }
  163.           }
  164.         } else {
  165.           print $socket 'HTTP/1.0 501 Not Implemented', "\r\n";
  166.           print $socket "\r\n";
  167.           &http_close($clientno);
  168.           last;
  169.         }
  170.       }
  171.     }
  172.   } else {
  173.     &http_close($clientno);
  174.   }
  175. }
  176.  
  177. sub http_close {
  178.   local($clientno) = @_;
  179.   &'close($clientno);
  180.   $httpclientlist = &'remove($httpclientlist, $clientno);
  181.   if ($peer[$clientno]) {
  182.     &'close($peer[$clientno]);
  183.     $socketlistenlist = &'remove($socketlistenlist, $peer[$clientno]);
  184.     $peer[$peer[$clientno]] = 0;
  185.     $peer[$clientno] = 0;
  186.   }
  187. }
  188.  
  189. sub socket_accept {
  190.   local($listenno) = @_;
  191.   local($cno, $socket);
  192.   if ($cno = &'accept($listenno)) {
  193.     $socket = $'socket[$peer[$listenno]];
  194.     print $socket 'HTTP/1.0 202 Accepted', "\r\n";
  195.     print $socket "\r\n";
  196.     $peer[$cno] = $peer[$listenno];
  197.     $peer[$peer[$cno]] = $cno;
  198.     $socketclientlist = &'add($socketclientlist, $cno, $peer[$cno]);
  199.     vec($'rin, $peer[$cno], 1) = 1;
  200.     $socket = $'socket[$cno];
  201.     print $socket $rbuf[$peer[$cno]];
  202.     &'close($listenno);
  203.     $socketlistenlist = &'remove($socketlistenlist, $listenno);
  204.   }
  205. }
  206.  
  207. sub http_accept {
  208.   local($listenno) = @_;
  209.   local($cno);
  210.   if ($cno = &'accept($listenno)) {
  211.     $httpclientlist = &'add($httpclientlist, $cno);
  212.     $rbuf[$cno] = '';
  213.     $peer[$cno] = 0;
  214.     $request[$cno] = '';
  215.   }
  216. }
  217.  
  218. sub usage {
  219.   print 'usage: perl httpgate <port>', "\n";
  220. }
  221.  
  222. sub 'connect {
  223.   local($host, $port) = @_;
  224.   local($serverno, $socket, $ip, @addr, $name);
  225.   if ($host =~ /^\d+$/) {
  226.     $ip = $host;
  227.   } elsif ($host =~ /^[\d\.]+$/) {
  228.     @addr = split(/\./, $host);
  229.     $ip = unpack('N', pack('C4', @addr, 0, 0, 0));
  230.   } else {
  231.     $ip = unpack('N', (gethostbyname($host))[4] || "\0\0\0\0");
  232.   }
  233.   return 0 unless $ip;
  234.   $socket = '\'S' . ++$handle;
  235.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  236.   $name = pack($SOCKADDR, $AF_INET, $port, $ip);
  237.   connect($socket, $name) || return 0;
  238.   binmode($socket);
  239.   $serverno = fileno($socket);
  240.   vec($'rin, $serverno, 1) = 1;
  241.   $'socket[$serverno] = $socket;
  242.   select((select($socket), $| = 1)[0]);
  243.   $'access[$serverno] = time();
  244.   return $serverno;
  245. }
  246.  
  247. sub 'listen {
  248.   local($port, $count) = @_;
  249.   local($listenno, $socket, $name);
  250.   $socket = '\'L' . ++$handle;
  251.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  252.   if (defined($SOL_SOCKET) && defined($SO_REUSEADDR)) {
  253.     setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1));
  254.   }
  255.   $name = pack($SOCKADDR, $AF_INET, $port, unpack('N', $INADDR_ANY));
  256.   bind($socket, $name) || return 0;
  257.   listen($socket, $count || $SOMAXCONN) || return 0;
  258.   $listenno = fileno($socket);
  259.   vec($'rin, $listenno, 1) = 1;
  260.   $'socket[$listenno] = $socket;
  261.   select((select($socket), $| = 1)[0]);
  262.   $'access[$listenno] = time();
  263.   return $listenno;
  264. }
  265.  
  266. sub 'accept {
  267.   local($listenno) = @_;
  268.   local($clientno, $socket);
  269.   $socket = '\'C' . ++$handle;
  270.   accept($socket, $'socket[$listenno]) || return 0;
  271.   binmode($socket);
  272.   $clientno = fileno($socket);
  273.   vec($'rin, $clientno, 1) = 1;
  274.   $'socket[$clientno] = $socket;
  275.   select((select($socket), $| = 1)[0]);
  276.   $'access[$clientno] = time();
  277.   return $clientno;
  278. }
  279.  
  280. sub 'close {
  281.   local($no) = @_;
  282.   close($'socket[$no]);
  283.   vec($'rin, $no, 1) = 0;
  284. }
  285.  
  286. sub 'sockname {
  287.   local($no) = @_;
  288.   local($port, $ip, $host);
  289.   ($port, $ip) = (unpack($SOCKADDR, getsockname($'socket[$no])))[1, 2];
  290.   $host = (gethostbyaddr(pack('N', $ip), $AF_INET))[0];
  291.   return ($port, $ip, $host);
  292. }
  293.  
  294. sub 'add {
  295.   local($list, @items) = @_;
  296.   $list = '' unless $list;
  297.   foreach $item (@items) {
  298.     next if &'exist($list, $item);
  299.     $list .= $NIL . $item;
  300.   }
  301.   return $list;
  302. }
  303.  
  304. sub 'remove {
  305.   local($list, @items) = @_;
  306.   local($idx);
  307.   $list = '' unless $list;
  308.   $list .= $NIL;
  309.   foreach $item (@items) {
  310.     $idx = index("\L$list\E", $NIL . "\L$item\E" . $NIL);
  311.     next if $idx == -1;
  312.     substr($list, $idx, length($NIL . $item . $NIL)) = $NIL;
  313.   }
  314.   return substr($list, 0, length($list) - 1);
  315. }
  316.  
  317. sub 'exist {
  318.   local($list, @items) = @_;
  319.   return 0 unless $list;
  320.   $list .= $NIL;
  321.   foreach $item (@items) {
  322.     return 1 if index("\L$list\E", $NIL . "\L$item\E" . $NIL) != -1;
  323.   }
  324.   return 0;
  325. }
  326.  
  327. sub 'list {
  328.   local(@array) = @_;
  329.   return join($NIL, '', @array);
  330. }
  331.  
  332. sub 'array {
  333.   local($list) = @_;
  334.   return () unless $list;
  335.   $list = substr($list, 1);
  336.   return () unless $list;
  337.   return split(/$NIL/, $list);
  338. }
  339.