ftp.madoka.org/2014.12.ftp.madoka.org.tar/ftp.madoka.org/pub/plum/2.x/plum2_26_1.lzh/support/proxy

Text File | 1998-07-31 | 5KB | 199 lines

#!/bin/perl -w
# $Id: proxy,v 2.4 1998/07/31 09:39:52 hasegawa Exp $
# copyright (c)1997-1998 pupu_j <[e-mail]>

if ($] < 5) {
  foreach $inc (@INC) {
    if (-r "$inc/sys/socket.ph") {
      eval { require 'sys/socket.ph' };
      $SOCKET = "$inc/sys/socket.ph" unless $@;
      last;
    }
    if (-r "$inc/socket.ph") {
      eval { require 'socket.ph' };
      $SOCKET = "$inc/socket.ph" unless $@;
      last;
    }
  }
} else {
  eval 'use Socket';
  $SOCKET = 'Socket.pm' unless $@;
}

$NIL = $;;

$READSIZE = 1024;
$SOCKADDR = 'S n a4 x8';

$PROTO = getprotobyname('tcp');

$AF_INET = eval { &AF_INET } || 2;
$PF_INET = eval { &PF_INET } || 2;
$SOCK_STREAM = eval { &SOCK_STREAM } || 1;
$SOMAXCONN = eval { &SOMAXCONN } || 16;
$INADDR_ANY = eval { &INADDR_ANY } || "\0\0\0\0";
$SOL_SOCKET = eval { &SOL_SOCKET};
$SO_REUSEADDR = eval { &SO_REUSEADDR };
$SO_KEEPALIVE = eval { &SO_KEEPALIVE };

$'rin = '';

$handle = 0;

$SIG{'PIPE'} = 'IGNORE' if &'exist(&'list(keys(%SIG)), 'PIPE');

&main(@ARGV);

sub main {
  local(@args) = @_;
  local($slist, $rout, $nf, $sno, $cno, $lno, $socket, $tmp);
  if (@args < 3) {
    &usage();
    exit(1);
  }
  $lno = &'listen($args[2], 0) || die "cannot listen port\n";
  for (;;) {
    $nf = select($rout = $'rin, undef, undef, undef);
    die "error in select\n" if $nf < 0;
    foreach $no (&'array($slist)) {
      next unless vec($rout, $no, 1);
      $tmp = '';
      if (sysread($'socket[$no], $tmp, $READSIZE)) {
        $socket = $'socket[$peer[$no]];
        print $socket $tmp if fileno($socket);
      } else {
        &'close($no);
        &'close($peer[$no]);
        $slist = &'remove($slist, $no, $peer[$no]);
      }
    }
    if (vec($rout, $lno, 1)) {
      if ($cno = &'accept($lno)) {
        if ($sno = &'connect($args[0], $args[1])) {
          $peer[$sno] = $cno;
          $peer[$cno] = $sno;
          $slist = &'add($slist, $sno, $cno);
        } else {
          &'close($cno);
        }
      }
    }
  }
}

sub usage {
  print 'usage: perl proxy <server> <port> <listen-port>', "\n";
}

sub 'connect {
  local($host, $port) = @_;
  local($serverno, $socket, $addr);
  if ($host =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
    $addr = pack('C4', $1, $2, $3, $4);
  } elsif ($host =~ /^\d+$/) {
    $addr = pack('N', $host);
  } else {
    $addr = (gethostbyname($host))[4];
  }
  return 0 unless $addr;
  $socket = '\'S' . ++$handle;
  socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  connect($socket, pack($SOCKADDR, $AF_INET, $port, $addr)) || return 0;
  $serverno = fileno($socket);
  vec($'rin, $serverno, 1) = 1;
  $'socket[$serverno] = $socket;
  select((select($socket), $| = 1)[0]);
  $'access[$serverno] = time();
  return $serverno;
}

sub 'listen {
  local($port, $count) = @_;
  local($listenno, $socket);
  $socket = '\'L' . ++$handle;
  socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
  if (defined($SOL_SOCKET)) {
    setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1)) if defined($SO_REUSEADDR);
    setsockopt($socket, $SOL_SOCKET, $SO_KEEPALIVE, pack('l', 1)) if defined($SO_KEEPALIVE);
  }
  bind($socket, pack($SOCKADDR, $AF_INET, $port, $INADDR_ANY)) || return 0;
  listen($socket, $count || $SOMAXCONN) || return 0;
  $listenno = fileno($socket);
  vec($'rin, $listenno, 1) = 1;
  $'socket[$listenno] = $socket;
  select((select($socket), $| = 1)[0]);
  $'access[$listenno] = time();
  return $listenno;
}

sub 'accept {
  local($listenno) = @_;
  local($clientno, $socket);
  $socket = '\'C' . ++$handle;
  accept($socket, $'socket[$listenno]) || return 0;
  $clientno = fileno($socket);
  vec($'rin, $clientno, 1) = 1;
  $'socket[$clientno] = $socket;
  select((select($socket), $| = 1)[0]);
  $'access[$clientno] = time();
  return $clientno;
}

sub 'close {
  local($no) = @_;
  close($'socket[$no]);
  vec($'rin, $no, 1) = 0;
}

sub 'add {
  local($list, @items) = @_;
  $list = $NIL unless $list;
  foreach $item (@items) {
    next if &'exist($list, $item);
    $list = $list . $item . $NIL;
  }
  $list = '' if $list eq $NIL;
  return $list;
}

sub 'remove {
  local($list, @items) = @_;
  local($idx);
  $list = $NIL unless $list;
  foreach $item (@items) {
    $idx = index("\L$list\E", $NIL . "\L$item\E" . $NIL);
    next if $idx == -1;
    substr($list, $idx, length($NIL . $item . $NIL)) = $NIL;
  }
  $list = '' if $list eq $NIL;
  return $list;
}

sub 'exist {
  local($list, @items) = @_;
  return 0 unless $list;
  foreach $item (@items) {
    return 1 if index("\L$list\E", $NIL . "\L$item\E" . $NIL) != -1;
  }
  return 0;
}

sub 'list {
  local(@array) = @_;
  local($list);
  if (scalar(@array)) {
    $list = $NIL . join($NIL, @array) . $NIL;
  } else {
    $list = '';
  }
  return $list;
}

sub 'array {
  local($list) = @_;
  $list = $NIL unless $list;
  return () if $list eq $NIL;
  $list = substr($list, 1, length($list) - 2);
  return split(/$NIL/, $list);
}