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 / serverproxy < prev   
Text File  |  1999-03-24  |  4KB  |  162 lines
  1. #!/bin/perl -w
  2. # $Id: serverproxy,v 2.5 1999/01/20 15:07:17 hasegawa Exp $
  3. # copyright (c)1997-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');
  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, $nf, $lno1, $lno2, $cno1, $cno2, $socket, $tmp);
  49.   if (@args < 2) {
  50.     &usage();
  51.     exit(1);
  52.   }
  53.   $lno1 = &'listen($args[0], 0) || die "cannot listen port\n";
  54.   $lno2 = &'listen($args[1], 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.     if (vec($rout, $lno1, 1)) {
  59.       if ($cno1 = &'accept($lno1)) {
  60.         if ($cno2) {
  61.           vec($'rin, $cno2, 1) = 1;
  62.         } else {
  63.           vec($'rin, $cno1, 1) = 0;
  64.         }
  65.         &'close($lno1);
  66.       }
  67.     }
  68.     if (vec($rout, $lno2, 1)) {
  69.       if ($cno2 = &'accept($lno2)) {
  70.         if ($cno1) {
  71.           vec($'rin, $cno1, 1) = 1;
  72.         } else {
  73.           vec($'rin, $cno2, 1) = 0;
  74.         }
  75.         &'close($lno2);
  76.       }
  77.     }
  78.     next unless $cno1;
  79.     next unless $cno2;
  80.     if (vec($rout, $cno1, 1)) {
  81.       $tmp = '';
  82.       if (sysread($'socket[$cno1], $tmp, $READSIZE)) {
  83.         $socket = $'socket[$cno2];
  84.         print $socket $tmp;
  85.       } else {
  86.         &'close($cno1);
  87.         &'close($cno2);
  88.         exit;
  89.       }
  90.     }
  91.     if (vec($rout, $cno2, 1)) {
  92.       $tmp = '';
  93.       if (sysread($'socket[$cno2], $tmp, $READSIZE)) {
  94.         $socket = $'socket[$cno1];
  95.         print $socket $tmp;
  96.       } else {
  97.         &'close($cno2);
  98.         &'close($cno1);
  99.         exit;
  100.       }
  101.     }
  102.   }
  103. }
  104.  
  105. sub usage {
  106.   print 'usage: perl serverproxy <port> <port>', "\n";
  107. }
  108.  
  109. sub 'listen {
  110.   local($port, $count) = @_;
  111.   local($listenno, $socket, $name);
  112.   $socket = '\'L' . ++$handle;
  113.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  114.   if (defined($SOL_SOCKET) && defined($SO_REUSEADDR)) {
  115.     setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1));
  116.   }
  117.   $name = pack($SOCKADDR, $AF_INET, $port, unpack('N', $INADDR_ANY));
  118.   bind($socket, $name) || return 0;
  119.   listen($socket, $count || $SOMAXCONN) || return 0;
  120.   $listenno = fileno($socket);
  121.   vec($'rin, $listenno, 1) = 1;
  122.   $'socket[$listenno] = $socket;
  123.   select((select($socket), $| = 1)[0]);
  124.   $'access[$listenno] = time();
  125.   return $listenno;
  126. }
  127.  
  128. sub 'accept {
  129.   local($listenno) = @_;
  130.   local($clientno, $socket);
  131.   $socket = '\'C' . ++$handle;
  132.   accept($socket, $'socket[$listenno]) || return 0;
  133.   binmode($socket);
  134.   $clientno = fileno($socket);
  135.   vec($'rin, $clientno, 1) = 1;
  136.   $'socket[$clientno] = $socket;
  137.   select((select($socket), $| = 1)[0]);
  138.   $'access[$clientno] = time();
  139.   return $clientno;
  140. }
  141.  
  142. sub 'close {
  143.   local($no) = @_;
  144.   close($'socket[$no]);
  145.   vec($'rin, $no, 1) = 0;
  146. }
  147.  
  148. sub 'exist {
  149.   local($list, @items) = @_;
  150.   return 0 unless $list;
  151.   $list .= $NIL;
  152.   foreach $item (@items) {
  153.     return 1 if index("\L$list\E", $NIL . "\L$item\E" . $NIL) != -1;
  154.   }
  155.   return 0;
  156. }
  157.  
  158. sub 'list {
  159.   local(@array) = @_;
  160.   return join($NIL, '', @array);
  161. }
  162.