#!/usr/bin/perl
#
# a versatile tcp tunnel inetd.  see help.
#
# (c)opyright 1999 by dan goldwater, dgold@zblob.com
#
# Updated by kevin wittmer in 2007 to support simple pattern matching

require 5.002;
use strict;
# use UU qw(uudecode uuencode);
use Socket;
use Getopt::Long;

# default options
my($opt_port) = 12333;
my($opt_srvport) = 23;    # the telnet port
my($opt_proxy);
my($opt_srv);
my($opt_help) = 0;
my($opt_debug) = 0;
my($opt_verbose) = 0;
my($opt_keepalive) = 0;
my($opt_human) = 0;
my($opt_enc) = 0;
my($opt_dec) = 0;
my($opt_uu) = 0;
my($opt_packetwait) = 0;
my($opt_inetd) = 0;
my($opt_pattern);

my($VERSTR) = "v1.3 04/01/07";
my($BUFSIZE) = 32768;

sub ProcessCommandLine() {
    my($num_opts) = scalar(@ARGV);
    my($err) = GetOptions("port:s", \$opt_port,
			  "srvport:s", \$opt_srvport,
			  "proxy:s", \$opt_proxy,
			  "srv:s", \$opt_srv,
			  "enc", \$opt_enc,
			  "dec", \$opt_dec,
			  "uu", \$opt_uu,
			  "inetd", \$opt_inetd,
			  "pattern:s", \$opt_pattern,
			  "pwait:f", \$opt_packetwait,
			  "keep|keepalive", \$opt_keepalive,
			  "human", \$opt_human,
			  "v|verbose=i", \$opt_verbose,
			  "h|help", \$opt_help,
			  "d|debug", \$opt_debug);

    if($num_opts < 1 || $err == 0 || $opt_help) {
	print(HelpUsage());
	exit(1);
    }

    if($opt_enc && $opt_dec) {
	print("may only specify one of: -enc -dec\n");
	exit(1);
    }

    print("*** tcptunnel $VERSTR ***\n");
    print("by dan goldwater   dgold\@zblob.com   (c)opyright 1999.\n");
    print("updated kevin wittmer   kevinwittme7 at hotmail\n");
    print("
options:
         server =        $opt_srv
         port =          $opt_port
         server port =   $opt_srvport
         proxy =         $opt_proxy
         encode =        $opt_enc
         decode =        $opt_dec
         uuencode =      $opt_uu
         inetd =         $opt_inetd
	 pattern =	 $opt_pattern
         packet wait =   $opt_packetwait
\n");
}

sub logmsg {
    print("$0 $$: @_ at ",scalar(localtime),"\n");
}

# filehandles: SERVER, CLIENT

# listen on socket for incoming connections
sub SetupServer() {
    if($opt_inetd) {
	# client input and output are stdin and stdout.
	# inetd handles forking and client connections.
	logmsg("server started in inetd mode");
	return;
    }

    my($port) = $opt_port;
    if($port =~ /\D/) {
      # get port number from /etc/services
      $port = getservbyname($port, 'tcp');
    }
    my($proto) = getprotobyname('tcp');
    unless($port) { die("no port!"); }
    
    socket(SERVER, PF_INET, SOCK_STREAM, $proto)
      or die("socket: $!");
    setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
      or die("setsockopt: $!");
    bind(SERVER, sockaddr_in($port, INADDR_ANY))
      or die("bind: $!");
    listen(SERVER, SOMAXCONN)
      or die("listen: $!");
    
    logmsg("server started on port $port");
    
    my($paddr);
    $SIG{CHLD} = \&REAPER;
    
    $paddr = accept(CLIENT, SERVER)
      or die("accept: $!");

    my $iaddr;
    ($port, $iaddr) = sockaddr_in($paddr);
    my($name) = gethostbyaddr($iaddr, AF_INET);
    
    logmsg("connection from $name [",inet_ntoa($iaddr),"] at port $port");
    # print(CLIENT "\nhello!\n");
}

# connect to remote server
sub SetupClient() {
    if($opt_human) {
      # server input and output are stdin and stdout
      logmsg("server started in human mode");
      return;
    }

    my($remote, $port, $iaddr, $paddr, $proto, $line, $buf);

    if($opt_proxy) {
	$remote = $opt_proxy;
    }
    else {
	$remote = $opt_srv;
    }
    logmsg("connecting to $remote");

    $port = $opt_srvport;
    if($port =~ /\D/) {
	# get port number from /etc/services
	$port = getservbyname($port, 'tcp');
    }
    $opt_debug && print("remote server port: $port\n");
    unless($port) { die("no port!"); }

    $iaddr = inet_aton($remote) or die("no host: $remote");
    $paddr = sockaddr_in($port, $iaddr);
    $proto = getprotobyname('tcp');
    socket(SOCK, PF_INET, SOCK_STREAM, $proto)
	or die("socket: $!");
    connect(SOCK, $paddr)
	or die("connect: $!");

    select(SOCK);
    $| = 1;
    select(STDOUT);

    unless($opt_proxy) {
	logmsg("connected");
	return;
    }

    #SOCK->autoflush();
    logmsg("connecting to ssh server");
    while(1) {
	$line = <SOCK>;
	print($line);
	if($line =~ /for help/) {
	    print(SOCK "\ntimeout 0\n");
	    print(SOCK "connect $opt_srv\n");
	}
	if($line =~ /Connected to $opt_srv/) {
	    logmsg("connected");
	    last;
	}
    }
}

# move data through the tunnel.  called when data is waiting
# at one end of the tunnel.  it moves the data to the other end.
# input: direction flag:  0 = client->server   1 = server->client
sub MoveData($) {
    my($s2c) = $_[0];
    my($buf1, $buf2, $buf3, $len1, $len2, $offset, $written);
    my($FH1, $FH2);
    my($decode) = 0;
    my($encode) = 0;

    if($s2c) {
	if($opt_human) { $FH1 = \*STDIN; }
	else {           $FH1 = \*SOCK;   }
	if($opt_inetd) { $FH2 = \*STDOUT; }
	else {           $FH2 = \*CLIENT; }
    }
    else {
	if($opt_inetd) { $FH1 = \*STDIN;  }
	else {           $FH1 = \*CLIENT; }
	if($opt_human) { $FH2 = \*STDOUT; }
	else {           $FH2 = \*SOCK;   }
    }

    if($opt_enc && $s2c || $opt_dec && !$s2c) {
	$decode = 1;
    }
    elsif($opt_enc && !$s2c || $opt_dec && $s2c) {
	$encode = 1;
    }

    $len1 = sysread($FH1, $buf1, $BUFSIZE, 0);
    $opt_debug && print(" read $len1 ");

    if($opt_verbose && $s2c) {
      if($opt_verbose == 2) {    # translate non-printable chars
	$buf3 = $buf1;
	$buf3 =~ tr/[\x9\xa\xd\x20-\x7e]/./cs;
	
	#if ($buf3 =~ /KB8VME|KB8DID|I-GATE/i)
	if ($buf3 =~ /$opt_pattern/i)
	{
	    print("\n<SERVER>\n$buf3");
	}
      }
      else {
	# print as-is
	if ($buf1 =~ /$opt_pattern/i)
	{
	    print("\n<SERVER>\n$buf1");
	}
      }
    }

    if($opt_verbose && !$s2c) {
      if($opt_verbose == 2) {    # translate non-printable chars
	$buf3 = $buf1;
	$buf3 =~ tr/[\x9\xa\xd\x20-\x7e]/./cs;
	
	if ($buf3 =~ /$opt_pattern/i)
	{
	    print("\n<CLIENT>\n$buf3");
	}

      }
      else {
	# print as-is
	if ($buf1 =~ /$opt_pattern/i)
	{
	    print("\n<CLIENT>\n$buf1");
	}	
      }	
    }

    if($len1 == 0) {
	# socket closed - terminate program
	return 0;
    }
    unless(defined($len1)) {
	if($! =~ /^Interrupted/) { next; }
	die("system read error: $!");
    }
    if(($len1 < 200) && !$s2c && $opt_packetwait) {
	# wait for more data
	my($rin);
	vec($rin, fileno($FH1), 1) = 1;
	select(undef, undef, undef, $opt_packetwait);
	select($rin, undef, undef, 0);
	if(vec($rin, fileno($FH1), 1)) {
	    $opt_debug && print("+ ");
	    $len2 = sysread($FH1, $buf2, $BUFSIZE, 0);
	    $opt_debug && print("$len2 ");
	    if($len2 == 0) {
		return 0;
	    }
	    unless(defined($len2)) {
		if($! =~ /^Interrupted/) { next; }
		die("system read error: $!");
	    }
	    $len1 += $len2;
	    $buf1 .= $buf2;
	    $buf2 = undef;
	    $len2 = undef;
	}
    }
    

    if($decode) {
	if($opt_uu) {
	    $buf2 = uudec($buf1);
	}
	else {
	    if($len2 % 2) {
		print("-E- read odd packet length!\n");
	    }
	    $buf2 = pack('h*', $buf1);
	}
	$len2 = length($buf2);
	$opt_debug && print(" dec ");
    }
    elsif($encode) {
	if($opt_uu) {
	    $buf2 = uuenc($buf1);
	}
	else {
	    $buf2 = unpack('h*', $buf1);
	}
	$len2 = length($buf2);
	$opt_debug && print(" enc ");
    }
    else {
	$buf2 = $buf1;
	$len2 = $len1;
    }

    #print("\n$buf1\n$buf2\n");

    $offset = 0;
    while($len2) {
	$written = syswrite($FH2, $buf2, $len2, $offset);
	$opt_debug && print(" wrote $written ");
	unless(defined($written)) {
	    die("system write error: $!\n");
	}
	$len2 -= $written;
	$offset += $written;
    }
    return 1;
}

# main processing function once connections are established
# alternately checks the client and server sockets to see if any
# data is waiting on them to be read.  if data is available, it calls
# the MoveData() function to move the data from one socket to the other.
sub TransferData() {
    my($rin, $rout, $blksize1, $blksize2, $nfound, $FH1, $FH2);

    # read from stdin if we are an inetd managed daemon, otherwise read
    # from the client socket which we created
    if($opt_inetd) { $FH1 = \*STDIN; }
    else {           $FH1 = \*CLIENT; }
    if($opt_human) { $FH2 = \*STDIN; }
    else {           $FH2 = \*SOCK; }

    $rin = "";
    #$rin = $win = $ein = "";
    vec($rin, fileno($FH2), 1) = 1;
    vec($rin, fileno($FH1), 1) = 1;

    # main processing loop.  stay here until a socket closes.
    while(1) {
	#$nfound = select($rout=$rin, $wout=$win, $eout=$ein, undef);
	$nfound = select($rout=$rin, undef, undef, undef);
	# print("nfound = $nfound\n");
	if(vec($rout, fileno($FH1), 1)) {
	    $opt_debug && print("client->server:  ");
	    unless(MoveData(0)) {
		logmsg("client closed connection");
		return;
	    }
	    $opt_debug && print(" done\n");
	}
	if(vec($rout, fileno($FH2), 1)) {
	    $opt_debug && print("server->client:  ");
	    unless(MoveData(1)) {
		logmsg("server closed connection");
		return;
	    }
	    $opt_debug && print(" done\n");
	}
    }
}

sub uuenc {
    my($data) = $_[0];
    #return "begin\n" . pack('u', $data) . "end\n";
    return pack('u', $data);
}

my($GOTDATA);

# faster uudecode - less buffer copies
# uuencoded data is in 1-line records of about 60 characters or less
# each. each record must be decoded individually, and an entire record
# is needed to decode that record.  when we get data from the socket,
# we will have some number of complete records plus up to one partial
# record.  we decode all the complete records immediately, and keep
# the partial record for later.  when more data arrives from the socket,
# we append to the partial record and then continue decoding as many
# complete records as we have.
sub uudec {
    my($indata) = $_[0];
    my($x, $y, $x1, $y1, $y2);
    my($line);

    my($unpacked, $d2);
    my($count) = 0;
    $GOTDATA .= $indata;
    $y2 = length($GOTDATA);

    while(1) {
	if($y2 == $count) {
	    $GOTDATA = undef;
	    return $unpacked;
	}

	$d2 = substr($GOTDATA, $count, 61);
	$y1 = int((((ord($d2) - 32) & 077) + 2) / 3) * 4 + 2;
	if($y1 != 62) {
	    $d2 = substr($GOTDATA, $count, $y1-1);
	}
	if($y2 < $count+$y1-1) {
	    # print(" short ");
	    $GOTDATA = substr($GOTDATA, $count);
	    return $unpacked;
	}
	$count += $y1;
	
	#print("\n<$d2>\n");
	#print(" y1=$y1  y2=$y2 ");
	if($d2 =~ /[a-z]/) {
	    print("-E- uudecode: lowercase found\n");
	}
	$x = int((((ord($d2) - 32) & 077) + 2) / 3);
	$y = int(length($d2) / 4);
	unless($x == $y) {
	    print("-E- uudecode: failed checksum\n");
	}
	$unpacked .= unpack('u', $d2);
    }
}

# slower uudecode - too many buffer copies.
sub uudec_foo {
    my($indata) = $_[0];
    my($data, $x, $y, $x1, $y1, $y2);
    my($line);

    my($unpacked, $d2);
    my($count) = 0;
    $GOTDATA .= $indata;
    my $y3 = length($GOTDATA);

    while(1) {
	$y2 = length($GOTDATA);
	if($y2 == 0) {
	    if($y3 != $count) {
		print("-E- $y3 $count\n");
	    }
	    return $unpacked;
	}
	$y1 = int((((ord($GOTDATA) - 32) & 077) + 2) / 3) * 4 + 2;
	
	if($y2 < $y1) {
	    # print(" short ");
	    return $unpacked;
	}
	
	$d2 = substr($GOTDATA, 0, $y1-1);
	$count += $y1;
	$GOTDATA = substr($GOTDATA, $y1);
	#print("\n$d2\n");
	
	#print(" y1=$y1  y2=$y2 ");
	#print(" $y1 ");
	if($d2 =~ /[a-z]/) {
	    print("-E- uudecode: lowercase found\n");
	}
	$x = int((((ord($d2) - 32) & 077) + 2) / 3);
	$y = int(length($d2) / 4);
	#    $x1 = ((ord($data) - 32) & 077) + 2;
	#    $y1 = int((((ord($data) - 32) & 077) + 2) / 3) * 4 + 2;
	#    print(" x=$x  y=$y  x1=$x1  y1=$y1");
	unless($x == $y) {
	    print("-E- uudecode: failed checksum\n");
	}
	$unpacked .= unpack('u', $d2);
    }
}

#################### MAIN #######################

sub CloseSockets() {
    close(SOCK);
    close(SERVER);
    unless($opt_inetd) {
	close(CLIENT);
    }
}

sub MainLoop() {
    SetupServer();
    SetupClient();
    TransferData();
    CloseSockets();
}

sub Main() {
    $| = 1;

    $SIG{INT} = \&CloseSockets;
    $SIG{TERM} = \&CloseSockets;

#    my($a, $b, $c, $d);
#    $c = 'hello world HELLO WORLD 1234(}{=`~_SN|\)';
#    $a = uuenc($c);
#    $b = uudec($a);
#    print("$a\n$b\n\n");
#    $a = unpack('h*', $c);
#    $b = pack('h*', $a);
#    print("$a\n$b\n\n");
#    $c = 'a';
#    $a = uuenc($c);
#    $b = uudec($a);
#    print("$a\n$b\n\n");
#    exit;

    ProcessCommandLine();
    if($opt_keepalive) {
      while(1) {
	MainLoop();
      }
    }
    else {
      MainLoop();
    }
    logmsg("exiting!");
}

Main();

#################################################

### uuencode references: ###
# package MIME::Decoder::UU
# package Convert::UU

##############################################


sub HelpUsage() {
    return("
Usage:
         tcptunnel [-srv <server> | -human] [-port <port> | -inetd]
                   [-enc | -dec] [-uu] [-srvport <port>] [-pwait <n>]
                   [-help] [-debug] [-verbose <N>] [-keepalive] [-proxy <proxy>]

    <srv>       name of server to connect to
    <srvport>   port on server or proxy to connect to.  default: $opt_srvport
    <port>      local port to listen for client, default: $opt_port
    <inetd>     run in inetd mode (client i/o is on stdin/stdout)
    <human>     you are the server (server i/o is on stdin/stdout)
    <proxy>     name of firewall proxy server.
    <enc>       client --> encode --> server
    <dec>       client --> decode --> server
    <uu>        use uuencode, not binary->hex
    <pwait>     wait n seconds to combine small packets into larger ones.
                use decimals, 0.1 is good.  default: $opt_packetwait
    <verbose>   print all data transmissions to stdout.  set to 1 or 2:
                -verbose 1    print all data as-is
                -verbose 2    translate non-printable characters to '.'
    <keepalive> restart after connection is closed (use ctrl-c to terminate)


A versatile tcp tunnel.  Uses:
- tunnelling through a firewall or proxy
- redirecting tcp connections to other ports or machines
- debugging tcp connections in-place
- packet sniffing


The tcptunnel listens on local port <port> and when
a connection is made it connects the other end of the tunnel as
follows:
a) With no proxy specified, it connects the other end
   to <srvport> on <srv>.
b) With a proxy, it connects to <srvport> on <proxy>.
   It then directs the proxy to telnet to <srv>, and
   then it connects the ends of the tunnel.


Example 1:
Debugging a web server <-> browser connection.  What to do:

browser <--> tunnel <--> web server

tcptunnel -srv www.foo.com -srvport 80 -port 7777 -verbose 2 -keepalive

in browser, hit port 7777 on the box where tcptunnel is running (either
localhost or the box with the web server)


Example 2:
A tunnel for SSH, which allows ssh to operate through a firewall
which only allows telnet connections and not SOCKS.  Furthermore,
the firewall responds to some escape sequences, so binary data
can't be sent without encoding it.  What to do:

ssh client <--> tunnel/enc <--> firewall <--> tunnel/dec <--> ssh server

The tunnel waits for an incoming connection from the ssh client,
then connects to the firewall's telnet service and instructs
it to telnet to the external server.  The external server also has
a tunnel, which picks up the firewall's telnet request and redirects
it to the ssh server.  the two tunnels encode/decode the binary traffic
also.

***** by dan goldwater (c)opyright 1999 *****
***** dgold\@zblob.com http://www.zblob.com *****
\n");
}