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 / clientproxy < prev    next >
Text File  |  1999-03-24  |  3KB  |  135 lines
  1. #!/bin/perl -w
  2. # $Id: clientproxy,v 2.8 1999/01/20 14:56:23 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'))[2];
  29.  
  30. $AF_INET = eval '&AF_INET' || 2;
  31. $PF_INET = eval '&PF_INET' || 2;
  32. $SOCK_STREAM = eval '&SOCK_STREAM' || 1;
  33.  
  34. $'rin = '';
  35.  
  36. $handle = 0;
  37.  
  38. $SIG{'PIPE'} = 'IGNORE' if &'exist(&'list(keys(%SIG)), 'PIPE');
  39.  
  40. &main(@ARGV);
  41.  
  42. sub main {
  43.   local(@args) = @_;
  44.   local($rout, $nf, $sno1, $sno2, $socket, $tmp);
  45.   if (@args < 4) {
  46.     &usage();
  47.     exit(1);
  48.   }
  49.   $sno1 = &'connect($args[0], $args[1]) || die "cannot connect to server\n";
  50.   $sno2 = &'connect($args[2], $args[3]) || die "cannot connect to server\n";
  51.   for (;;) {
  52.     $nf = select($rout = $'rin, undef, undef, undef);
  53.     die "error in select\n" if $nf < 0;
  54.     if (vec($rout, $sno1, 1)) {
  55.       $tmp = '';
  56.       if (sysread($'socket[$sno1], $tmp, $READSIZE)) {
  57.         $socket = $'socket[$sno2];
  58.         print $socket $tmp;
  59.       } else {
  60.         &'close($sno1);
  61.         &'close($sno2);
  62.         exit;
  63.       }
  64.     }
  65.     if (vec($rout, $sno2, 1)) {
  66.       $tmp = '';
  67.       if (sysread($'socket[$sno2], $tmp, $READSIZE)) {
  68.         $socket = $'socket[$sno1];
  69.         print $socket $tmp;
  70.       } else {
  71.         &'close($sno2);
  72.         &'close($sno1);
  73.         exit;
  74.       }
  75.     }
  76.   }
  77. }
  78.  
  79. sub usage {
  80.   print 'usage: perl clientproxy <server> <port> <server> <port>', "\n";
  81. }
  82.  
  83. sub 'connect {
  84.   local($host, $port) = @_;
  85.   local($serverno, $socket, $ip, @addr, $name);
  86.   if ($host =~ /^\d+$/) {
  87.     $ip = $host;
  88.   } elsif ($host =~ /^[\d\.]+$/) {
  89.     @addr = split(/\./, $host);
  90.     $ip = unpack('N', pack('C4', @addr, 0, 0, 0));
  91.   } else {
  92.     $ip = unpack('N', (gethostbyname($host))[4] || "\0\0\0\0");
  93.   }
  94.   return 0 unless $ip;
  95.   $socket = '\'S' . ++$handle;
  96.   socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  97.   $name = pack($SOCKADDR, $AF_INET, $port, $ip);
  98.   connect($socket, $name) || return 0;
  99.   binmode($socket);
  100.   $serverno = fileno($socket);
  101.   vec($'rin, $serverno, 1) = 1;
  102.   $'socket[$serverno] = $socket;
  103.   select((select($socket), $| = 1)[0]);
  104.   return $serverno;
  105. }
  106.  
  107. sub 'close {
  108.   local($no) = @_;
  109.   close($'socket[$no]);
  110.   vec($'rin, $no, 1) = 0;
  111. }
  112.  
  113. sub 'exist {
  114.   local($list, @items) = @_;
  115.   return 0 unless $list;
  116.   $list .= $NIL;
  117.   foreach $item (@items) {
  118.     return 1 if index("\L$list\E", $NIL . "\L$item\E" . $NIL) != -1;
  119.   }
  120.   return 0;
  121. }
  122.  
  123. sub 'list {
  124.   local(@array) = @_;
  125.   return join($NIL, '', @array);
  126. }
  127.  
  128. sub 'array {
  129.   local($list) = @_;
  130.   return () unless $list;
  131.   $list = substr($list, 1);
  132.   return () unless $list;
  133.   return split(/$NIL/, $list);
  134. }
  135.