home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.madoka.org
/
2014.12.ftp.madoka.org.tar
/
ftp.madoka.org
/
pub
/
plum
/
2.x
/
plum2_28_2.lzh
/
support
/
httpgate
< prev
next >
Wrap
Text File
|
1998-10-15
|
10KB
|
370 lines
#!/bin/perl -w
# $Id: httpgate,v 2.12 1998/10/06 04:22:26 hasegawa Exp $
# copyright (c)1998 pupu_j <hasegawa@agusa.nuie.nagoya-u.ac.jp>
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 = 4096;
$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');
$TIMEOUT = 3600;
&main(@ARGV);
sub main {
local(@args) = @_;
local($rout, $listenno, $nf);
if (@args < 1) {
&usage();
exit(1);
}
$listenno = &'listen($args[0], 0) || die "cannot listen port\n";
for (;;) {
$nf = select($rout = $'rin, undef, undef, undef);
die "error in select\n" if $nf < 0;
foreach $cno (&'array($httpclientlist)) {
if (vec($rout, $cno, 1)) {
&http_client($cno);
} elsif ($'access[$cno] - time() > $TIMEOUT) {
&http_close($cno);
}
}
foreach $cno (&'array($socketclientlist)) {
&socket_client($cno) if vec($rout, $cno, 1);
}
foreach $sno (&'array($socketserverlist)) {
&socket_server($sno) if vec($rout, $sno, 1);
}
foreach $lno (&'array($socketlistenlist)) {
if (vec($rout, $lno, 1)) {
&socket_accept($lno);
} elsif ($'access[$lno] - time() > $TIMEOUT) {
&'close($lno);
$socketlistenlist = &'remove($socketlistenlist, $lno);
&'close($peer[$lno]);
$httpclientlist = &'remove($httpclientlist, $peer[$lno]);
$peer[$peer[$lno]] = 0;
$peer[$lno] = 0;
}
}
&http_accept($listenno) if vec($rout, $listenno, 1);
}
}
sub http_client {
local($clientno) = @_;
local($tmp, $socket, $next, $rest, $method, $url, $lno, $sno, $host, $port);
$tmp = '';
if (sysread($'socket[$clientno], $tmp, $READSIZE)) {
if ($http[$clientno]) {
$socket = $'socket[$clientno];
$rbuf[$clientno] .= $tmp;
while ((($next, $rest) = split(/\r\n/, $rbuf[$clientno], 2)) == 2) {
$rbuf[$clientno] = $rest;
if ($next) {
$request[$clientno] = &'add($request[$clientno], $next);
} else {
($method, $url) = split(/\s+/, (&'array($request[$clientno]))[0]);
if ($method eq 'HEAD') {
$port = (split(/\//, $url))[1];
if ($lno = &'listen($port, 1)) {
print $socket 'HTTP/1.0 201 Created', "\r\n";
$host = (&'sockname($clientno))[1];
$port = (&'sockname($lno))[0];
print $socket 'Listen: ', $host, '/', $port, "\r\n";
print $socket "\r\n";
$peer[$clientno] = $lno;
$peer[$lno] = $clientno;
$socketlistenlist = &'add($socketlistenlist, $lno);
$request[$clientno] = '';
} else {
print $socket 'HTTP/1.0 403 Forbidden', "\r\n";
print $socket "\r\n";
&http_close($clientno);
last;
}
} elsif ($method eq 'POST') {
if ($peer[$clientno]) {
$http[$clientno] = 0;
$httpclientlist = &'remove($httpclientlist, $clientno);
} else {
($host, $port) = (split(/\//, $url))[1, 2];
if ($host && $port) {
if ($sno = &'connect($host, $port)) {
print $socket 'HTTP/1.0 204 No Content', "\r\n";
print $socket "\r\n";
$peer[$clientno] = $sno;
$peer[$sno] = $clientno;
$http[$clientno] = 0;
$socketserverlist = &'add($socketserverlist, $sno);
$socket = $'socket[$sno];
print $socket $rbuf[$clientno];
} else {
print $socket 'HTTP/1.0 404 Not Found', "\r\n";
print $socket "\r\n";
&http_close($clientno);
last;
}
} else {
print $socket 'HTTP/1.0 400 Bad Request', "\r\n";
print $socket "\r\n";
&http_close($clientno);
last;
}
}
} else {
print $socket 'HTTP/1.0 501 Not Implemented', "\r\n";
print $socket "\r\n";
&http_close($clientno);
last;
}
}
}
$rbuf[$clientno] = $next || '';
} else {
$socket = $'socket[$peer[$clientno]];
print $socket $tmp if fileno($socket);
}
} else {
&http_close($clientno);
}
}
sub socket_client {
local($clientno) = @_;
local($tmp, $socket);
$tmp = '';
if (sysread($'socket[$clientno], $tmp, $READSIZE)) {
$socket = $'socket[$peer[$clientno]];
print $socket $tmp if fileno($socket);
} else {
&'close($clientno);
$socketclientlist = &'remove($socketclientlist, $clientno);
&'close($peer[$clientno]);
$httpclientlist = &'remove($httpclientlist, $peer[$clientno]);
$peer[$peer[$clientno]] = 0;
$peer[$clientno] = 0;
}
}
sub http_close {
local($clientno) = @_;
&'close($clientno);
$httpclientlist = &'remove($httpclientlist, $clientno);
if ($peer[$clientno]) {
&'close($peer[$clientno]);
$socketlistenlist = &'remove($socketlistenlist, $peer[$clientno]);
$socketclientlist = &'remove($socketclientlist, $peer[$clientno]);
$socketserverlist = &'remove($socketserverlist, $peer[$clientno]);
$peer[$peer[$clientno]] = 0;
$peer[$clientno] = 0;
}
}
sub socket_server {
local($serverno) = @_;
local($tmp, $socket);
$tmp = '';
if (sysread($'socket[$serverno], $tmp, $READSIZE)) {
$socket = $'socket[$peer[$serverno]];
print $socket $tmp if fileno($socket);
} else {
&'close($serverno);
$socketserverlist = &'remove($socketserverlist, $serverno);
&'close($peer[$serverno]);
$httpclientlist = &'remove($httpclientlist, $peer[$serverno]);
$peer[$peer[$serverno]] = 0;
$peer[$serverno] = 0;
}
}
sub socket_accept {
local($listenno) = @_;
local($cno, $socket);
if ($cno = &'accept($listenno)) {
$socket = $'socket[$peer[$listenno]];
print $socket 'HTTP/1.0 202 Accepted', "\r\n";
print $socket "\r\n";
$peer[$cno] = $peer[$listenno];
$peer[$peer[$cno]] = $cno;
$socketclientlist = &'add($socketclientlist, $cno);
$httpclientlist = &'add($httpclientlist, $peer[$cno]);
$socket = $'socket[$cno];
print $socket $rbuf[$peer[$cno]];
}
&'close($listenno);
$socketlistenlist = &'remove($socketlistenlist, $listenno);
}
sub http_accept {
local($listenno) = @_;
local($cno);
if ($cno = &'accept($listenno)) {
$httpclientlist = &'add($httpclientlist, $cno);
$http[$cno] = 1;
$rbuf[$cno] = '';
$peer[$cno] = 0;
$request[$cno] = '';
}
}
sub usage {
print 'usage: perl httpgate <port>', "\n";
}
sub 'connect {
local($host, $port) = @_;
local($serverno, $socket, $ip, @addr, $name);
if ($host =~ /^\d+$/) {
$ip = $host;
} elsif ($host =~ /^[\d\.]+$/) {
@addr = split(/\./, $host);
$ip = unpack('N', pack('C4', @addr, 0, 0, 0));
} else {
$ip = unpack('N', (gethostbyname($host))[4] || "\0\0\0\0");
}
return 0 unless $ip;
$socket = '\'S' . ++$handle;
socket($socket, $PF_INET, $SOCK_STREAM, $PROTO) || return 0;
$name = pack($SOCKADDR, $AF_INET, $port, $ip);
connect($socket, $name) || 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, $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;
$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 'sockname {
local($no) = @_;
local($port, $ip, $host);
($port, $ip) = (unpack($SOCKADDR, getsockname($'socket[$no])))[1, 2];
$host = (gethostbyaddr(pack('N', $ip), $AF_INET))[0];
return ($port, $ip, $host);
}
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);
}