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
Wrap
Text File
|
1999-03-24
|
4KB
|
162 lines
#!/bin/perl -w
# $Id: serverproxy,v 2.5 1999/01/20 15:07:17 hasegawa Exp $
# copyright (c)1997-1999 Yoshinori Hasegawa <hasegawa@madoka.org>
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 N 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';
$'rin = '';
$handle = 0;
$SIG{'PIPE'} = 'IGNORE' if &'exist(&'list(keys(%SIG)), 'PIPE');
&main(@ARGV);
sub main {
local(@args) = @_;
local($rout, $nf, $lno1, $lno2, $cno1, $cno2, $socket, $tmp);
if (@args < 2) {
&usage();
exit(1);
}
$lno1 = &'listen($args[0], 0) || die "cannot listen port\n";
$lno2 = &'listen($args[1], 0) || die "cannot listen port\n";
for (;;) {
$nf = select($rout = $'rin, undef, undef, undef);
die "error in select\n" if $nf < 0;
if (vec($rout, $lno1, 1)) {
if ($cno1 = &'accept($lno1)) {
if ($cno2) {
vec($'rin, $cno2, 1) = 1;
} else {
vec($'rin, $cno1, 1) = 0;
}
&'close($lno1);
}
}
if (vec($rout, $lno2, 1)) {
if ($cno2 = &'accept($lno2)) {
if ($cno1) {
vec($'rin, $cno1, 1) = 1;
} else {
vec($'rin, $cno2, 1) = 0;
}
&'close($lno2);
}
}
next unless $cno1;
next unless $cno2;
if (vec($rout, $cno1, 1)) {
$tmp = '';
if (sysread($'socket[$cno1], $tmp, $READSIZE)) {
$socket = $'socket[$cno2];
print $socket $tmp;
} else {
&'close($cno1);
&'close($cno2);
exit;
}
}
if (vec($rout, $cno2, 1)) {
$tmp = '';
if (sysread($'socket[$cno2], $tmp, $READSIZE)) {
$socket = $'socket[$cno1];
print $socket $tmp;
} else {
&'close($cno2);
&'close($cno1);
exit;
}
}
}
}
sub usage {
print 'usage: perl serverproxy <port> <port>', "\n";
}
sub 'listen {
local($port, $count) = @_;
local($listenno, $socket, $name);
$socket = '\'L' . ++$handle;
socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
if (defined($SOL_SOCKET) && defined($SO_REUSEADDR)) {
setsockopt($socket, $SOL_SOCKET, $SO_REUSEADDR, pack('l', 1));
}
$name = pack($SOCKADDR, $AF_INET, $port, unpack('N', $INADDR_ANY));
bind($socket, $name) || 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;
binmode($socket);
$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 'exist {
local($list, @items) = @_;
return 0 unless $list;
$list .= $NIL;
foreach $item (@items) {
return 1 if index("\L$list\E", $NIL . "\L$item\E" . $NIL) != -1;
}
return 0;
}
sub 'list {
local(@array) = @_;
return join($NIL, '', @array);
}