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