#!/usr/local/bin/perl
;#
;# tcpconnect: make a connection to remote port by tcp
;#
;# Copyright (c) 1991,1992 Kazumasa Utashiro <utashiro@sra.co.jp>
;# Software Research Associates, Inc., Japan
;#
;; $rcsid = q$Id: tcpconnect,v 1.0 1995/02/08 11:05:19 utashiro Exp $;
;#
;# With this command, you can forward some specific protocol
;# on gateway machine which doesn't forward IP packet.
;#
;# Syntax:
;#	tcpconnect server[:service]
;#	tcpconnect server[:service] client
;#	tcpconnect server[:service] client server[:service] client ...
;#	tcpconnect -f config-file
;#
;# + If client is not specified or is '*', any client is allowed
;#   to connect.
;#
;# + Server is choosed on first-hit policy.  So, if there is '*'
;#   client at the first, remained servers will not be checked.
;#
;# + Same port number will be used when no server services is
;#   specified.
;#
;# + Client and server name can be symbolic hostname or IP
;#   address in dotted decimal notation.
;#
;# + Service name can be specified by symbolic name or port-number
;#
;# + Configuration file contains client and server pair on each line.
;#
;# OPTIONS:
;#	-gopher: Gopher server closes the connection when send port of
;#		 remote side is shuted down.  If option -gopher is
;#		 supplied, send port will not be shutdowned.  This is
;#		 ad hoc option and will be replaced someday.
;#
;# EXAMPLES:
;#
;# All SMTP connection is to be forwarded to mail-server:
;#
;#	smtp stream tcp nowait root /etc/tcpconnect tcpconnect mail-server
;#
;# NNTP connectioned is exchanged between A and B:
;#
;#	nntp stream tcp nowait root /etc/tcpconnect tcpconnect A B B A
;#
;# Simply connect a terminal to nntp server:
;#
;#	% tcpconnect nntp-server:nntp
;#

;# require 'sys/socket.ph';
unless (do 'sys/socket.ph') {
    #print "File sys/socket.ph is not found. Using default...\n";
    eval 'sub SOCK_STREAM {1;} sub AF_INET {2;} sub PF_INET {2;}';
}

while ($_ = $ARGV[0], /^-/) {
    shift;
    if (/-f$/)		{$configfile = shift || &usage;	next;}
    if (/-l$/)		{$logfile = shift || &usage;	next;}
    if (/-d(\d*)$/)	{$debug = $1||1;		next;}
    if (/-h/)		{&usage;			next;}
    # for gopher server
    if (/-gopher/)	{$dontshutdown = 1;		next;}
    &usage;
}

sub usage {
    $0 =~ s|.*/||;
    $* = 1;
    ($usage = <<"    EOF") =~ s/^    //g;
    Usage: $0 server[:service] [client] [server[:service] client ...]
           $0 -f config-file

    ($rcsid)
    EOF
    for (@_) { print "ERROR: $_", /\n$/ ? "" : "\n"; }
    print $usage;
    exit 1;
}

unless ($configfile) {
    @forwardlist = @ARGV;
} else {
    open(CONF, $configfile) || die("$configfile: $!\n");
    while(<CONF>) {
	chop;
	s/#.*$//;
	s/^\s+//;
	next if /^$/;
	push(@forwardlist, (split)[0,1]);
    }
    close(CONF);
}

$sockaddr='S n a4 x8';
($name, $aliases, $TCP) = getprotobyname('tcp');

chop($localname = `hostname`);

unless ($hersockaddr = getpeername(STDIN)) {
    $server = shift || &usage;
} else {
    ($family, $herport, $heraddr) = unpack($sockaddr, $hersockaddr);

    $mysockaddr = getsockname(STDIN);
    ($family, $myport, $myaddr) = unpack($sockaddr, $mysockaddr);

    &log("Connection from %s\n", &dotted($heraddr));
    CHECKADDR: {
	while (($server, $client) = splice(@forwardlist, 0, 2)) {
	    if (!defined($client) || $client eq '*') {
		$clientaddr = $mask = "\0\0\0\0";
	    } else {
		($client, $mask) = split(m|/|, $client);
		($clientaddr = &getaddr($client)) || next;
		if ($mask) {
		    vec($_, 0, 1) = 1 if 0; # yellow magic
		    $mask = ~&getaddr($mask);
		} else {
		    $mask = "\xff\xff\xff\xff";
		}
	    }
	    if ($clientaddr eq ($heraddr & $mask)) {
		$server = "$server:$myport" unless ($server =~ /:/);
		last CHECKADDR;
	    }
	}
	&log("Connection from %s was rejected.\n", &dotted($heraddr));
	exit 1;
    }
}

($servername, $serverport) = split(/:/, $server);
$serverport || &usage("No server port");

($serveraddr = &getaddr($servername)) || die "Unknown server $servername.\n";
$serverport = (getservbyname($serverport, 'tcp'))[2]
    unless $serverport =~ /^\d+$/;

$that = pack($sockaddr, &AF_INET, $serverport, $serveraddr);
socket(S, &PF_INET, &SOCK_STREAM, $TCP) || die "socket: $!\n";
connect(S, $that) || die "connect: $!\n";
select(S); $| = 1; select(stdout);

if ($child = fork) {
    &forward(S, STDOUT);
} else {
    &forward(STDIN, S);
}

exit(0);

sub forward {
    local($from, $to) = @_;
    select($from); $| = 1;
    select($to); $| = 1;
    if (-t $from) {
	eval "print $to \$_ while <$from>;";
    } else {
	eval "print $to \$_ while sysread($from, \$_, 4096);";
    }
    shutdown($from, 1);
    shutdown($to, 0) unless $dontshutdown;
}

sub getaddr {
    local($_) = @_;
    /^[0-9\.]+$/ ? pack("C4", split(/\./)) : (gethostbyname($_))[4];
}

sub dotted { join('.', unpack('C4', shift)); }

sub debug { printf STDERR @_ if $debug; }

sub log {
    &debug;
    return unless $logfile;
    open(LOG, ">>$logfile") || do { warn "$logfile: $!\n"; return; };
    printf LOG "%s ", do 'ctime.pl' .. 0 ? substr(&ctime(time), 4, 15) : time;
    printf LOG @_;
    close(LOG);
}