#!/bin/perl -w
# $Id: httpgate,v 2.17 1999/01/20 15:00:02 hasegawa Exp $
# copyright (c)1998-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 = 4096;
$SOCKADDR = 'S n N x8';

$PROTO = (getprotobyname('tcp'))[2];

$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($socketclientlist)) {
      if (vec($rout, $cno, 1)) {
        &socket_client($cno);
      }
    }
    foreach $cno (&'array($httpclientlist)) {
      if (vec($rout, $cno, 1)) {
        &http_client($cno);
      } elsif ($'access[$cno] - time() > $TIMEOUT) {
        &http_close($cno);
      }
    }
    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 socket_client {
  local($cno) = @_;
  local($tmp, $socket);
  $tmp = '';
  if (sysread($'socket[$cno], $tmp, $READSIZE)) {
    $socket = $'socket[$peer[$cno]];
    print $socket $tmp if fileno($socket);
  } else {
    &'close($cno);
    &'close($peer[$cno]);
    $socketclientlist = &'remove($socketclientlist, $cno, $peer[$cno]);
    $peer[$peer[$cno]] = 0;
    $peer[$cno] = 0;
  }
}

sub http_client {
  local($clientno) = @_;
  local($tmp, $socket, $next, $rest, $method, $url, $lno, $sno, $host, $port);
  $tmp = '';
  if (sysread($'socket[$clientno], $tmp, $READSIZE)) {
    $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;
            $httpclientlist = &'remove($httpclientlist, $clientno);
            $socketlistenlist = &'add($socketlistenlist, $lno);
            vec($'rin, $clientno, 1) = 0;
            $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]) {
            $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;
                $httpclientlist = &'remove($httpclientlist, $clientno);
                $socketclientlist = &'add($socketclientlist, $sno, $clientno);
                $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;
        }
      }
    }
  } else {
    &http_close($clientno);
  }
}

sub http_close {
  local($clientno) = @_;
  &'close($clientno);
  $httpclientlist = &'remove($httpclientlist, $clientno);
  if ($peer[$clientno]) {
    &'close($peer[$clientno]);
    $socketlistenlist = &'remove($socketlistenlist, $peer[$clientno]);
    $peer[$peer[$clientno]] = 0;
    $peer[$clientno] = 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, $peer[$cno]);
    vec($'rin, $peer[$cno], 1) = 1;
    $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);
    $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;
  binmode($socket);
  $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;
  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 '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 = '' unless $list;
  foreach $item (@items) {
    next if &'exist($list, $item);
    $list .= $NIL . $item;
  }
  return $list;
}

sub 'remove {
  local($list, @items) = @_;
  local($idx);
  $list = '' unless $list;
  $list .= $NIL;
  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;
  }
  return substr($list, 0, length($list) - 1);
}

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);
}

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