tunnel.pl

#!/usr/bin/perl -w
use strict;
$|++;

use IO::Socket::INET qw(CRLF);
use IO::Select;
use Getopt::Long;

$SIG{__WARN__} = sub {
  warn map "[".localtime()."] $_\n", (join "", @_) =~ /(.+)\n*/g;
};

## tunnel: port reflector and HTTPproxy tunnel connector
## usage:
## tunnel -lhost host:port -rhost host:port -connect host:port -timeout 30
## host:port are as in "perldoc IO::Socket::INET"
## lhost = listening socket (must be on local address)
## if local port is 0, next non-priv port is used (get from first output)
## [default is localhost:0]
## rhost = connect-to address [default is localhost:smtp for testing]
## connect = connect to rhost, then tunnel to more-remote host
## connect port should almost always be 443 or 563
## [default is do normal port reflection, not tunnel]
## timeout is for heartbeat only [default 30]
## -quiet means no msgs except errors
## -verbose means report connections/disconnections
## -verbose -verbose means also report bytes transferred

## for ssh tunneling through proxy, requires root on some outside box
## ssh @ A1 > inside @ A2 > httpproxy @ B:8080 > outsideroot @ C1 > sshd @ C2
## on C1 as root, tunnel -lh C1:443 -rh C2:22
## on A2, tunnel -lh A2:2222 -rh B:8080 -c C1:443
## on A1 at will, ssh A2 -p 2222 [other ssh parms, as if ssh C2]
## if 443 (https) is not available, try 563 (snews) as well
## on A2, use port 0 instead of 2222 to let O/S pick port
##    (but then you have to type the right port to ssh)

GetOptions(
           "lhost=s" => \ (my $LOCALHOST = "localhost:0"),
           "rhost=s", => \ (my $REMOTEHOST = "localhost:smtp"),
           "connect=s" => \ (my $CONNECT),
           "timeout=i" => \ (my $TIMEOUT = 30),
           "quiet+" => \ (my $QUIET = 0),
           "verbose+" => \ (my $VERBOSE = 0),
           "<>" => sub { $Getopt::Long::error++; warn "Unknown arg: $_[0]\n" },
           ) or die "see code for usage\n";

my $master = IO::Socket::INET->new
  (Listen => 5, Reuse => 1, LocalHost => $LOCALHOST)
  or die "Cannot create listen socket: $@";
warn "listening at ", $master->sockhost, ":", $master->sockport, "\n"
  if not $QUIET;

my $select = IO::Select->new($master);
while (1) {
  my @ready = $select->can_read($TIMEOUT);
  warn "ready is @ready", "\n"
    if not $QUIET and $VERBOSE > 1;
  redo unless @ready;           # heartbeat

  for (@ready) {
    if ($master eq $_) { # new connection
      my $slave = $master->accept;
      warn
        "connection from ", $slave->peerhost, ":",
        $slave->peerport, " at ", $slave, "\n"
          if not $QUIET and $VERBOSE > 0;
      ## open remote connection, and set up peering
      my $remote = IO::Socket::INET->new($REMOTEHOST)
        or (warn "Cannot connect to $REMOTEHOST: $!"), next;
      warn "connected to $remote\n"
        if not $QUIET and $VERBOSE > 0;
      $select->add($slave, $remote);
      $ {*$slave}{__Peer} = $remote;
      $ {*$remote}{__Peer} = $slave;
      if (defined $CONNECT) {
        print $remote "CONNECT $CONNECT HTTP/1.0", CRLF, CRLF;
        $ {*$remote}{__Buf} = "";
      }
    } else {
      warn "reading from $_\n"
        if not $QUIET and $VERBOSE > 1;
      my $peer = $ {*$_}{__Peer};       # get peer
      if ($_->sysread(my $buf, 8192) > 0) {
        if (exists $ {*$_}{__Buf}) { # stripping until blank line
          $ {*$_}{__Buf} .= $buf; # append to what we have
          if ($ {*$_}{__Buf} =~ s/^.*?\r?\n\r?\n//s) { # got it
            $buf = delete $ {*$_}{__Buf}; # back to normal
          } else {
            $buf = "";          # don't show anything yet
          }
        }
        warn "sending ", length($buf), " bytes to $peer\n"
          if not $QUIET and $VERBOSE > 1;
        $peer->print($buf);
      } else {                  # EOF
        warn "shutting down $_ and $peer\n"
          if not $QUIET and $VERBOSE > 0;
        $select->remove($_, $peer); # don't watch them
        $_->close;
        $peer->close;
      }
    }
  }
}