home *** CD-ROM | disk | FTP | other *** search
/ ftp.madoka.org / 2014.12.ftp.madoka.org.tar / ftp.madoka.org / pub / plum / 2.x / plum2_26_1.lzh / support / httpclient < prev    next >
Text File  |  1998-07-31  |  7KB  |  262 lines
  1. #!/bin/perl -w
  2. # $Id: httpclient,v 2.4 1998/07/31 09:40:14 hasegawa Exp $
  3. # copyright (c)1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
  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 = 1024;
  26. $SOCKADDR = 'S n a4 x8';
  27.  
  28. $PROTO = getprotobyname('tcp');
  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. $SO_KEEPALIVE = eval { &SO_KEEPALIVE };
  38.  
  39. $'rin = '';
  40.  
  41. $handle = 0;
  42.  
  43. $SIG{'PIPE'} = 'IGNORE' if &'exist(&'list(keys(%SIG)), 'PIPE');
  44.  
  45. &main(@ARGV);
  46.  
  47. sub main {
  48.   local(@args) = @_;
  49.   local($rout, $listenno, $nf, $slist, $clist);
  50.   if (scalar(@args) < 7) {
  51.     &usage();
  52.     exit(1);
  53.   }
  54.   $listenno = &'listen($args[6], 0) || die "cannot listen port\n";
  55.   for (;;) {
  56.     $nf = select($rout = $'rin, undef, undef, undef);
  57.     die "error in select\n" if $nf < 0;
  58.     foreach $cno (&'array($clist)) {
  59.       next unless vec($rout, $cno, 1);
  60.       &client_read($cno);
  61.     }
  62.     foreach $sno (&'array($slist)) {
  63.       next unless vec($rout, $sno, 1);
  64.       &server_read($sno);
  65.     }
  66.     if (vec($rout, $listenno, 1)) {
  67.       &listen_accept($listenno, $args[0], $args[1], $args[2], $args[3], $args[4], $args[5]);
  68.     }
  69.   }
  70. }
  71.  
  72. sub client_read {
  73.   local($cno) = @_;
  74.   local($tmp, $socket);
  75.   $tmp = '';
  76.   if (sysread($'socket[$cno], $tmp, $READSIZE)) {
  77.     $socket = $'socket[$peer[$cno]];
  78.     print $socket $tmp if fileno($socket);
  79.   } else {
  80.     &'close($cno);
  81.     $clist = &'remove($clist, $cno);
  82.     &'close($peer[$cno]);
  83.     $slist = &'remove($slist, $peer[$cno]);
  84.   }
  85. }
  86.  
  87. sub server_read {
  88.   local($sno) = @_;
  89.   local($tmp, $socket, $next, $rest, $stat);
  90.   $tmp = '';
  91.   if (sysread($'socket[$sno], $tmp, $READSIZE)) {
  92.     if ($http[$sno]) {
  93.       $socket = $'socket[$sno];
  94.       $rbuf[$sno] .= $tmp;
  95.       while ((($next, $rest) = split(/\r\n/, $rbuf[$sno], 2)) == 2) {
  96.         $rbuf[$sno] = $rest || '';
  97.         if ($next) {
  98.           $reply[$sno] = &'add($reply[$sno], $next);
  99.         } else {
  100.           $stat = (split(/\s+/, (&'array($reply[$sno]))[0]))[1];
  101.           if ($stat eq '204') {
  102.             $clist = &'add($clist, $peer[$sno]);
  103.             $http[$sno] = 0;
  104.             $socket = $'socket[$peer[$sno]];
  105.             print $socket $rbuf[$sno];  
  106.           } else {
  107.             &'close($sno);
  108.             $slist = &'remove($slist, $sno);
  109.             &'close($peer[$sno]);
  110.           }
  111.           last;
  112.         }
  113.       }
  114.       $rbuf[$sno] = $next || '';
  115.     } else {
  116.       $socket = $'socket[$peer[$sno]];
  117.       print $socket $tmp;
  118.     }
  119.   } else {
  120.     &'close($sno);
  121.     $slist = &'remove($slist, $sno);
  122.     &'close($peer[$sno]);
  123.     $clist = &'remove($clist, $peer[$sno]);
  124.   }
  125. }
  126.  
  127. sub listen_accept {
  128.   local($listenno, $phost, $pport, $ghost, $gport, $host, $port) = @_;
  129.   local($cno, $sno, $socket);
  130.   if ($cno = &'accept($listenno)) {
  131.     if ($sno = &'connect($phost, $pport)) {
  132.       $socket = $'socket[$sno];
  133.       print $socket "POST http://$ghost:$gport/$host/$port/ HTTP/1.0\r\n";
  134.       print $socket "\r\n";
  135.       $http[$sno] = 1;
  136.       $rbuf[$sno] = '';
  137.       $reply[$sno] = '';
  138.       $peer[$sno] = $cno;
  139.       $peer[$cno] = $sno;
  140.       $slist = &'add($slist, $sno);
  141.     } else {
  142.       &'close($cno);
  143.     }
  144.   }
  145. }
  146.  
  147. sub usage {
  148.   print 'usage: perl httpclient <proxy-host> <proxy-port> <gateway-host> <gateway-port> <host> <port> <listen-port>', "\n";
  149. }
  150.  
  151. sub 'connect {
  152.   local($host, $port) = @_;
  153.   local($serverno, $socket, $addr);
  154.   if ($host =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
  155.     $addr = pack('C4', $1, $2, $3, $4);
  156.   } elsif ($host =~ /^\d+$/) {
  157.     $addr = pack('N', $host);
  158.   } else {
  159.     $addr = (gethostbyname($host))[4];
  160.   }
  161.   return 0 unless $addr;
  162.   $socket = '\'S' . ++$handle;
  163.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  164.   connect($socket, pack($SOCKADDR, $AF_INET, $port, $addr)) || return 0;
  165.   $serverno = fileno($socket);
  166.   vec($'rin, $serverno, 1) = 1;
  167.   $'socket[$serverno] = $socket;
  168.   select((select($socket), $| = 1)[0]);
  169.   $'access[$serverno] = time();
  170.   return $serverno;
  171. }
  172.  
  173. sub 'listen {
  174.   local($port, $count) = @_;
  175.   local($listenno, $socket);
  176.   $socket = '\'L' . ++$handle;
  177.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  178.   if (defined($SOL_SOCKET)) {
  179.     setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1)) if defined($SO_REUSEADDR);
  180.     setsockopt($socket, $SOL_SOCKET, $SO_KEEPALIVE, pack('l', 1)) if defined($SO_KEEPALIVE);
  181.   }
  182.   bind($socket, pack($SOCKADDR, $AF_INET, $port, $INADDR_ANY)) || return 0;
  183.   listen($socket, $count || $SOMAXCONN) || return 0;
  184.   $listenno = fileno($socket);
  185.   vec($'rin, $listenno, 1) = 1;
  186.   $'socket[$listenno] = $socket;
  187.   select((select($socket), $| = 1)[0]);
  188.   $'access[$listenno] = time();
  189.   return $listenno;
  190. }
  191.  
  192. sub 'accept {
  193.   local($listenno) = @_;
  194.   local($clientno, $socket);
  195.   $socket = '\'C' . ++$handle;
  196.   accept($socket, $'socket[$listenno]) || return 0;
  197.   $clientno = fileno($socket);
  198.   vec($'rin, $clientno, 1) = 1;
  199.   $'socket[$clientno] = $socket;
  200.   select((select($socket), $| = 1)[0]);
  201.   $'access[$clientno] = time();
  202.   return $clientno;
  203. }
  204.  
  205. sub 'close {
  206.   local($no) = @_;
  207.   close($'socket[$no]);
  208.   vec($'rin, $no, 1) = 0;
  209. }
  210.  
  211. sub 'add {
  212.   local($list, @items) = @_;
  213.   $list = $NIL unless $list;
  214.   foreach $item (@items) {
  215.     next if &'exist($list, $item);
  216.     $list = $list . $item . $NIL;
  217.   }
  218.   $list = '' if $list eq $NIL;
  219.   return $list;
  220. }
  221.  
  222. sub 'remove {
  223.   local($list, @items) = @_;
  224.   local($idx);
  225.   $list = $NIL unless $list;
  226.   foreach $item (@items) {
  227.     $idx = index("\L$list\E", $NIL . "\L$item\E" . $NIL);
  228.     next if $idx == -1;
  229.     substr($list, $idx, length($NIL . $item . $NIL)) = $NIL;
  230.   }
  231.   $list = '' if $list eq $NIL;
  232.   return $list;
  233. }
  234.  
  235. sub 'exist {
  236.   local($list, @items) = @_;
  237.   return 0 unless $list;
  238.   foreach $item (@items) {
  239.     return 1 if index("\L$list\E", $NIL . "\L$item\E" . $NIL) != -1;
  240.   }
  241.   return 0;
  242. }
  243.  
  244. sub 'list {
  245.   local(@array) = @_;
  246.   local($list);
  247.   if (scalar(@array)) {
  248.     $list = $NIL . join($NIL, @array) . $NIL;
  249.   } else {
  250.     $list = '';
  251.   }
  252.   return $list;
  253. }
  254.  
  255. sub 'array {
  256.   local($list) = @_;
  257.   $list = $NIL unless $list;
  258.   return () if $list eq $NIL;
  259.   $list = substr($list, 1, length($list) - 2);
  260.   return split(/$NIL/, $list);
  261. }
  262.