[userv-utils] / ipif / udptunnel

#!/usr/bin/perl
# Simple tunnel for userv-ipif tunnels.
#
# Example test invocation
#
#  ./udptunnel -e nonce -e timestamp/10/30 -e pkcs5/8 -e blowfish-cbcmac/128 -e blowfish-cbc/128 -m -f ./udptunnel-forwarder davenant,Any anarres,Command 172.30.206.1,172.30.206.2,1000,cslip 15,70 '' '' rsh anarres things/userv-utils/ipif/udptunnel -f things/userv-utils/ipif/udptunnel-forwarder
#
# usage:
#  udptunnel
#        [ -l[<local-command/arg>] ... .
#        | -e <encryption-mech>[/<encryption-parameter>...]
#        | -m   (`masquerade support': subcommand gets `Wait' instead of our addr/port)
#        | -d   (`dump keys': when no subcmd, spew keys rather than reading them;
#                we always send keys to our subcmd if there is one)
#        | -Dcrypto  (debug crypto - use with care, prints keys, packets &c on screen!)
#        | -f<path-to-udptunnel-forwarder>
#          ...
#        ]
#            <public-local-addr>,<public-local-port>
#            <public-remote-addr>,<public-remote-port>
#            <private-local-addr>,<private-remote-addr>,<mtu>,<proto>
#            <keepalive>,<timeout>
#            <extra-local-nets> <extra-remote-nets>
#          [ <remote-command> [<remote-args> ...] ]
#
# proto may be slip or cslip
#
# Any <..-addr> may also be hostname
#
# Local addr's and ports may also be:
#    `Print'     choose one ourselves and print both port and addr
#    `Any'       choose one ourselves and do not print it
# Remote addr's and ports may also be:
#    `Wait'      wait to receive a packet before assigning address
#    `Command'   run a subcommand and wait for it to tell us the values
# When any addr or port is `Command' then <remote-command> must be specified.
#
# If <remote-command> is specified it should run udptunnel at the
# remote end; it will be invoked as
#    <remote-command> [ <-e arguments passed along> ]
#                     <public-remote-addr'>,<public-remote-port'>
#                     <public-local-addr'>,<public-local-port'>
#                     <private-remote-addr>,<private-local-addr>,<mtu>,<proto>
#                     <keepalive>,<timeout>
#                     <extra-remote-nets> <extra-local-nets>
#

# If it was given Print for <public-remote-foo'>, this command's first
# stdout output should be the real
# <public-remote-addr>,<public-remote-port> pair (and of course this
# udptunnel's output will be).  It may then produce more stdout which,
# if any, will be forwarded to the local end's stdout as debugging info.
#
# After this, if any encryption was specified, the encryption
# parameters will be fed into its stdin.  See the documentation in the
# mech-*.c files for details of the parameters.  udptunnel will
# arrange to feed the keys fd of udptunnel-forwarder into the stdin of
# the remote command.
#
# <public-remote-foo'> is as follows:
#   <public-remote-foo>  <public-remote-foo'>
#   actual addr/port     that addr/port
#   `Command'            `Print'
#   `Wait'               `Any'
#
# <public-local-foo'> is as follows:
#   <public-local-foo>   <public-local-foo'>     <public-local-foo'>
#                        (-m not specified)      (-m specified)
#   actual addr/port     that addr/port       	 `Wait'
#   `Wait'               the chosen address 	 `Wait'
#   `Print'              the chosen address 	 `Wait'
#
# udptunnel will userv ipif locally, as
#    userv root ipif <private-local-addr>,<private-remote-addr>,<mtu>,<proto>
#                    <extra-local-nets>
# or, if -l was given, userv root ipif is replaced with the argument(s)
# following -l option(s) until `.'.
#
# udptunnel will also run udptunnel-forwarder with appropriate options
#
# recommended encryption parameters are:
#   -e nonce                            (prepend 32 bit counter)
#   -e timestamp/<max-skew>/<max-age>   (prepend 32 bit time_t, and check on receipt)
#   -e pkcs5/8                          (pad as per PKCS#5 to 8-byte boundary)
#   -e blowfish-cbcmac/128              (prepend CBC MAC with random IV and 128 bit key)
#   -e blowfish-cbc/128                 (encrypt with CBC, random IV and 128 bit key)
# where <max-skew> is perhaps 10 and <max-age> perhaps 30.

# Copyright (C) 1999-2000 Ian Jackson
#
# This is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with userv-utils; if not, write to the Free Software
# Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
# $Id$

use Socket;
use POSIX;
use Fcntl;

$progname= $0; $progname =~ s,.*/,,;
$|=1;

chomp($hostname= `uname -n`);
$? and die "$progname: cannot get hostname (uname failed with code $?)\n";

sub quit ($) { die "$progname - $hostname: fatal error: $_[0]\n"; }
sub debug ($) { print "$progname - $hostname: debug: $_[0]\n"; }
sub fail ($) { quit("unexpected system call failure: $_[0]: $!"); }
sub warning ($) { warn "$progname - $hostname: $_[0]\n"; }

sub eat_addr_port ($) {
    my ($x) = @_;
    @ARGV or quit("<addr>,<port> missing");
    $_= shift(@ARGV);
    (m/^$x,/i && m/^[a-z]/ || m/,$x$/i && m/,[a-z]/)
	and warning("$_: use Mixed Case for special values");
    m/^([0-9a-z][0-9a-z-+.]+|$x)\,(\d+|$x)$/
	or quit("$_: <host/addr>,<port> bad syntax".
		(m/[A-Z]/ ? ' (use lowercase for hostnames)' : ''));
    return ($1,$2);
}
sub conv_host_addr ($) {
    my ($s,$r,@h) = @_;
    return INADDR_ANY() if $s =~ m/^[A-Z][a-z]/;
    return $r if defined($r= inet_aton($s));
    @h= gethostbyname($s) or quit("$s: cannot get address");
    $h[2] eq &AF_INET or quit("$s: address is not IPv4");
    @h < 5 or quit("$s: name maps to no addresses");
    $r= $h[4];
    @h == 5 or warning("$s: name has several addresses, using ".inet_ntoa($r));
    return $r;
}
sub conv_port_number ($) {
    my ($s,$r) = @_;
    return 0 if $s =~ m/^[A-Z][a-z]/;
    $r= $s+0;
    $r>0 && $r<65536 or quit("$s: port out of range");
    return $r;
}
sub show_addr ($) {
    my ($s,@s) = @_;
    @s= unpack_sockaddr_in($s);
    return inet_ntoa($s[1]);
}
sub show_port ($) {
    my ($s,@s) = @_;
    @s= unpack_sockaddr_in($s);
    return $s[0];
}
sub show_addr_port ($) {
    my ($s) = @_;
    return show_addr($s).','.show_port($s);
}
sub arg_value ($$) {
    my ($val,$opt) = @_;
    $_= '-';
    return $val if length $val;
    @ARGV or quit("$opt needs value");
    return shift @ARGV;
}

$|=1;

@lcmd= ();
@encryption= ();
$masq= 0;
$dump= 0;
$fcmd= 'udptunnel-forwarder';
$xfwdopts= '';

while ($ARGV[0] =~ m/^-/) {
    $_= shift @ARGV;
    last if m/^--?$/;
    while (!m/^-$/) {
	if (s/^-l//) {
	    push @lcmd,$_ if length;
	    while (@ARGV && ($_= shift @ARGV) ne '.') { push @lcmd, $_; }
	    $_= '-'
	} elsif (s/^-f//) {
	    $fcmd= arg_value($_,'-f');
	} elsif (s/^-e//) {
	    $encrarg= arg_value($_,'-e');
	    push @remoteopts, "-e$encrarg";
	    @thisencryption= split m#/#, $encrarg;
	    $thisencryption[0] =~ s/^/\|/;
	    push @encryption, @thisencryption;
	} elsif (s/^-m/-/) {
	    $masq= 1;
	} elsif (s/^-d/-/) {
	    $dump= 1;
	} elsif (s/^-Dcrypto$/-/) {
	    $xfwdopts.= 'K';
	    push @remoteopts, '-Dcrypto';
	} else {
	    quit("unknown option \`$_'");
	}
    }
}

# Variables \$[lr]a?p?(|s|d|r)
# Local/Remote  Address&/Port
#    actualvalue/Specified/Displaypassdown/fromRemote/passtoForwarder
#
($las,$lps)= eat_addr_port('Print|Any');
$la= conv_host_addr($las);
$lp= conv_port_number($lps);
$ls= pack_sockaddr_in $lp,$la;

($ras,$rps)= eat_addr_port('Wait|Command');
$ra= conv_host_addr($ras);
$rp= conv_port_number($rps);
$rs= pack_sockaddr_in $rp,$ra;

$_= shift @ARGV;
m/^([.0-9]+),([.0-9]+),(\d+),(slip|cslip)$/
    or quit("lvaddr,rvaddr,mtu,proto missing or bad syntax or proto not [c]slip");
($lva,$rva,$mtu,$proto) = ($1,$2,$3,$4);

$_= shift @ARGV;
m/^(\d+),(\d+)$/ or quit("keepalive,timeout missing or bad syntax");
($keepalive,$timeout)= ($1,$2);
$keepalive && ($timeout > $keepalive*2) or quit("timeout must be < 2*keepalive")
    if $timeout;

# Variables \$[lr]exn
# Local/Remote Extra Nets
$lexn= shift @ARGV;
$rexn= shift @ARGV;

defined($udp= getprotobyname('udp')) or fail("getprotobyname udp");

socket(L,PF_INET,SOCK_DGRAM,$udp) or fail("socket");
bind(L,$ls) or quit("bind failed: $!");
defined($ls= getsockname(L)) or fail("getsockname");
$lad= show_addr($ls);
$lpd= show_port($ls);
$lapd= "$lad,$lpd";

print "$lapd\n" or fail("print addr/port") if ($las eq 'Print' || $lps eq 'Print');

$rapcmd= ($ras eq 'Command' || $rps eq 'Command');
quit("need remote-command if Command for remote addr/port") if $rapcmd && !@ARGV;

sub xform_remote ($$) {
    my ($showed,$spec) = @_;
    return 'Print' if $spec eq 'Command';
    return 'Any' if $spec eq 'Wait';
    return $showed;
}

if (@ARGV) {
    warning("-d specified with remote command, ignoring") if $dump;
    $dump= 1;
    
    $rad= xform_remote(show_addr($rs),$ras);
    $rpd= xform_remote(show_port($rs),$rps);
    @rcmd= (@ARGV,
	    @remoteopts,
	    "$rad,$rpd",
	    $masq ? 'Wait,Wait' : $lapd,
	    "$rva,$lva,$mtu,$proto",
	    "$keepalive,$timeout",
	    $rexn, $lexn);
    debug("remote command @rcmd");

    if ($rapcmd) {
	pipe(RAPREAD,RCMDREADSUB) or fail("pipe");
	select(RCMDREADSUB); $|=1; select(STDOUT);
    }
    pipe(RCMDWRITESUB,DUMPKEYS) or fail("pipe");
    defined($c_rcmd= fork) or fail("fork for remote");
    if (!$c_rcmd) {
	open STDIN, "<&RCMDWRITESUB" or fail("reopen stdin for remote command");
	open STDOUT, ">&RCMDREADSUB" or fail("reopen stdout for remote command")
	    if $rapcmd;
	close RAPREAD if $rapcmd;
	close DUMPKEYS;
	close RCMDWRITESUB;
	close RCMDREADSUB;
	close L;
	exec @rcmd; fail("failed to execute remote command $rcmd[0]");
    }
    close RCMDWRITESUB;
    
    if ($rapcmd) {
	close RCMDREADSUB if $rapcmd;
	$!=0; $_= <RAPREAD>; $e="$!";

	defined($c_catremdebug= fork) or fail("fork for cat remote debug");
	if (!$c_catremdebug) {
	    open(STDIN,"<&RAPREAD") or fail("redirect remote debug");
	    close RAPREAD;
	    close DUMPKEYS;
	    close L;
	    exec "cat"; fail("execute cat");
	}
	close RAPREAD;
	
	if (!length) {
	    close DUMPKEYS;
	    waitpid $c_rcmd,0 or fail("wait for remote command");
	    quit($? ? "remote command failed (code $?)" :
		 $e ? "read error from remote command: $e" :
		 "no details received from remote");
	}
	chomp;
	m/^([.0-9]+)\,(\d+)$/ or quit("invalid details from remote end: \`$_'");
	($rar,$rpr) = ($1,$2);
	$ra= conv_host_addr($rar);
	$rp= conv_port_number($rpr);
    }
} elsif ($dump) {
    open DUMPKEYS, ">&STDOUT" or fail("reopen stdout for key material");
    $dump= 1;
} else {
    open DUMPKEYS, "<&STDIN" or fail("reopen stdout for key material");
}

$rs= pack_sockaddr_in $rp,$ra;

if ($ras eq 'Wait' || $rps eq 'Wait') {
    @rapf= ('');
    $rapd= ('Wait,Wait');
} else {
    @rapf= (show_addr($rs), show_port($rs));
    $rapd= show_addr_port($rs);
}
@lcmd= qw(userv root ipif) unless @lcmd;

debug("using remote $rapd local $lapd");
push @lcmd, ("$lva,$rva,$mtu,$proto",$lexn);
debug("local command @lcmd.");

pipe(UR,UW) or fail("up pipe");
pipe(DR,DW) or fail("down pipe");

defined($c_lcmd= fork) or fail("fork for local command");
if (!$c_lcmd) {
    close UR; close DW;
    open(STDIN,"<&DR") or fail("reopen stdin for packets");
    open(STDOUT,">&UW") or fail("reopen stdout for packets");
    exec @lcmd;
    quit("cannot execute $lcmd[0]: $!");
}
close UW;
close DR;

$xfwdopts.= 'w' if $dump;

@fcmd= ($fcmd, $xfwdopts,
	fileno(L), fileno(DW), fileno(UR), fileno(DUMPKEYS),
	$mtu, $keepalive, $timeout,
	@rapf,
	@encryption);
debug("forwarding command @fcmd.");

defined($c_fwd= fork) or fail("fork for udptunnel-forwarder");
if (!$c_fwd) {
    foreach $fd (qw(L DW UR DUMPKEYS)) {
	fcntl($fd, F_SETFD, 0) or fail("set no-close-on-exec $fd");
    }
    exec @fcmd; fail("cannot execute $fcmd[0]");
}

close L;
close DUMPKEYS;
close UR;
close DW;

%procs= ($c_fwd, 'forwarder',
	 $c_lcmd, 'local command');
$procs{$c_rcmd}= 'remote command' if $c_rcmd;
$procs{$c_catremdebug}= 'debug cat' if $c_catremdebug;

$estatus= 0;

while (keys %procs) {
    ($c= wait) >0 or
	fail("wait failed (expecting ". join('; ',keys %procs). ")");
    $status= $?;
    warning("unexpected child reaped: pid $c, code $status"), next
	unless exists $procs{$c};
    $str= $procs{$c};
    delete $procs{$c};
    $status ? warning("subprocess $str failed with code $status")
	: debug("subprocess $str finished");
    if ($c==$c_lcmd || $c==$c_fwd || $c==$c_rcmd) {
	kill 15, grep (exists $procs{$_}, $c_fwd, $c_rcmd);
    }
    $estatus=1 unless $c == $c_catremdebug;
}

debug("all processes terminated, exiting with status $estatus");

exit $estatus;
Commit	Line	Data
46ab1c83	1	#!/usr/bin/perl
	2	# Simple tunnel for userv-ipif tunnels.
	3	#
8f1bfa81	4	# Example test invocation
	5	#
	6	# ./udptunnel -e nonce -e timestamp/10/30 -e pkcs5/8 -e blowfish-cbcmac/128 -e blowfish-cbc/128 -m -f ./udptunnel-forwarder davenant,Any anarres,Command 172.30.206.1,172.30.206.2,1000,cslip 15,70 '' '' rsh anarres things/userv-utils/ipif/udptunnel -f things/userv-utils/ipif/udptunnel-forwarder
	7	#
46ab1c83	8	# usage:
46ab1c83	9	# udptunnel
1fb3cba0	10	# [ -l[<local-command/arg>] ... .
9d4e63db	11	# \| -e <encryption-mech>[/<encryption-parameter>...]
	12	# \| -m (`masquerade support': subcommand gets `Wait' instead of our addr/port)
	13	# \| -d (`dump keys': when no subcmd, spew keys rather than reading them;
	14	# we always send keys to our subcmd if there is one)
09966b49	15	# \| -Dcrypto (debug crypto - use with care, prints keys, packets &c on screen!)
9d4e63db	16	# \| -f<path-to-udptunnel-forwarder>
1fb3cba0	17	# ...
	18	# ]
	19	# <public-local-addr>,<public-local-port>
	20	# <public-remote-addr>,<public-remote-port>
46ab1c83	21	# <private-local-addr>,<private-remote-addr>,<mtu>,<proto>
	22	# <keepalive>,<timeout>
	23	# <extra-local-nets> <extra-remote-nets>
	24	# [ <remote-command> [<remote-args> ...] ]
	25	#
9d4e63db	26	# proto may be slip or cslip
1fb3cba0	27	#
9d4e63db	28	# Any <..-addr> may also be hostname
1fb3cba0	29	#
9d4e63db	30	# Local addr's and ports may also be:
	31	# `Print' choose one ourselves and print both port and addr
	32	# `Any' choose one ourselves and do not print it
	33	# Remote addr's and ports may also be:
	34	# `Wait' wait to receive a packet before assigning address
	35	# `Command' run a subcommand and wait for it to tell us the values
	36	# When any addr or port is `Command' then <remote-command> must be specified.
46ab1c83	37	#
9d4e63db	38	# If <remote-command> is specified it should run udptunnel at the
46ab1c83	39	# remote end; it will be invoked as
9d4e63db	40	# <remote-command> [ <-e arguments passed along> ]
	41	# <public-remote-addr'>,<public-remote-port'>
	42	# <public-local-addr'>,<public-local-port'>
46ab1c83	43	# <private-remote-addr>,<private-local-addr>,<mtu>,<proto>
217afbe6	44	# <keepalive>,<timeout>
217afbe6	45	# <extra-remote-nets> <extra-local-nets>
46ab1c83	46	#
9d4e63db	47
	48	# If it was given Print for <public-remote-foo'>, this command's first
	49	# stdout output should be the real
	50	# <public-remote-addr>,<public-remote-port> pair (and of course this
	51	# udptunnel's output will be). It may then produce more stdout which,
	52	# if any, will be forwarded to the local end's stdout as debugging info.
	53	#
	54	# After this, if any encryption was specified, the encryption
	55	# parameters will be fed into its stdin. See the documentation in the
	56	# mech-*.c files for details of the parameters. udptunnel will
	57	# arrange to feed the keys fd of udptunnel-forwarder into the stdin of
	58	# the remote command.
	59	#
	60	# <public-remote-foo'> is as follows:
	61	# <public-remote-foo> <public-remote-foo'>
	62	# actual addr/port that addr/port
	63	# `Command' `Print'
	64	# `Wait' `Any'
	65	#
	66	# <public-local-foo'> is as follows:
	67	# <public-local-foo> <public-local-foo'> <public-local-foo'>
	68	# (-m not specified) (-m specified)
	69	# actual addr/port that addr/port `Wait'
	70	# `Wait' the chosen address `Wait'
	71	# `Print' the chosen address `Wait'
	72	#
46ab1c83	73	# udptunnel will userv ipif locally, as
217afbe6	74	# userv root ipif <private-local-addr>,<private-remote-addr>,<mtu>,<proto>
217afbe6	75	# <extra-local-nets>
9d4e63db	76	# or, if -l was given, userv root ipif is replaced with the argument(s)
	77	# following -l option(s) until `.'.
	78	#
	79	# udptunnel will also run udptunnel-forwarder with appropriate options
	80	#
	81	# recommended encryption parameters are:
	82	# -e nonce (prepend 32 bit counter)
	83	# -e timestamp/<max-skew>/<max-age> (prepend 32 bit time_t, and check on receipt)
	84	# -e pkcs5/8 (pad as per PKCS#5 to 8-byte boundary)
	85	# -e blowfish-cbcmac/128 (prepend CBC MAC with random IV and 128 bit key)
	86	# -e blowfish-cbc/128 (encrypt with CBC, random IV and 128 bit key)
	87	# where <max-skew> is perhaps 10 and <max-age> perhaps 30.
46ab1c83	88
9d4e63db	89	# Copyright (C) 1999-2000 Ian Jackson
caa68336	90	#
	91	# This is free software; you can redistribute it and/or modify it
	92	# under the terms of the GNU General Public License as published by
	93	# the Free Software Foundation; either version 2 of the License, or
	94	# (at your option) any later version.
	95	#
	96	# This program is distributed in the hope that it will be useful, but
	97	# WITHOUT ANY WARRANTY; without even the implied warranty of
	98	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	99	# General Public License for more details.
	100	#
	101	# You should have received a copy of the GNU General Public License
	102	# along with userv-utils; if not, write to the Free Software
	103	# Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
	104	#
	105	# $Id$
	106
46ab1c83	107	use Socket;
	108	use POSIX;
	109	use Fcntl;
	110
	111	$progname= $0; $progname =~ s,.*/,,;
	112	$\|=1;
	113
	114	chomp($hostname= `uname -n`);
	115	$? and die "$progname: cannot get hostname (uname failed with code $?)\n";
	116
	117	sub quit ($) { die "$progname - $hostname: fatal error: $_[0]\n"; }
	118	sub debug ($) { print "$progname - $hostname: debug: $_[0]\n"; }
9d4e63db	119	sub fail ($) { quit("unexpected system call failure: $_[0]: $!"); }
46ab1c83	120	sub warning ($) { warn "$progname - $hostname: $_[0]\n"; }
	121
	122	sub eat_addr_port ($) {
	123	my ($x) = @_;
1fb3cba0	124	@ARGV or quit("<addr>,<port> missing");
46ab1c83	125	$_= shift(@ARGV);
9d4e63db	126	(m/^$x,/i && m/^[a-z]/ \|\| m/,$x$/i && m/,[a-z]/)
	127	and warning("$_: use Mixed Case for special values");
	128	m/^([0-9a-z][0-9a-z-+.]+\|$x)\,(\d+\|$x)$/
	129	or quit("$_: <host/addr>,<port> bad syntax".
	130	(m/[A-Z]/ ? ' (use lowercase for hostnames)' : ''));
46ab1c83	131	return ($1,$2);
	132	}
	133	sub conv_host_addr ($) {
9d4e63db	134	my ($s,$r,@h) = @_;
	135	return INADDR_ANY() if $s =~ m/^[A-Z][a-z]/;
	136	return $r if defined($r= inet_aton($s));
	137	@h= gethostbyname($s) or quit("$s: cannot get address");
	138	$h[2] eq &AF_INET or quit("$s: address is not IPv4");
	139	@h < 5 or quit("$s: name maps to no addresses");
	140	$r= $h[4];
	141	@h == 5 or warning("$s: name has several addresses, using ".inet_ntoa($r));
46ab1c83	142	return $r;
46ab1c83	143	}
217afbe6	144	sub conv_port_number ($) {
46ab1c83	145	my ($s,$r) = @_;
9d4e63db	146	return 0 if $s =~ m/^[A-Z][a-z]/;
	147	$r= $s+0;
	148	$r>0 && $r<65536 or quit("$s: port out of range");
46ab1c83	149	return $r;
46ab1c83	150	}
9d4e63db	151	sub show_addr ($) {
	152	my ($s,@s) = @_;
	153	@s= unpack_sockaddr_in($s);
	154	return inet_ntoa($s[1]);
	155	}
	156	sub show_port ($) {
46ab1c83	157	my ($s,@s) = @_;
46ab1c83	158	@s= unpack_sockaddr_in($s);
9d4e63db	159	return $s[0];
	160	}
	161	sub show_addr_port ($) {
	162	my ($s) = @_;
	163	return show_addr($s).','.show_port($s);
46ab1c83	164	}
9d4e63db	165	sub arg_value ($$) {
0f4b558c	166	my ($val,$opt) = @_;
9d4e63db	167	$_= '-';
	168	return $val if length $val;
	169	@ARGV or quit("$opt needs value");
	170	return shift @ARGV;
	171	}
	172
	173	$\|=1;
46ab1c83	174
abe75cda	175	@lcmd= ();
9d4e63db	176	@encryption= ();
	177	$masq= 0;
	178	$dump= 0;
	179	$fcmd= 'udptunnel-forwarder';
09966b49	180	$xfwdopts= '';
abe75cda	181
	182	while ($ARGV[0] =~ m/^-/) {
	183	$_= shift @ARGV;
9d4e63db	184	last if m/^--?$/;
	185	while (!m/^-$/) {
	186	if (s/^-l//) {
	187	push @lcmd,$_ if length;
	188	while (@ARGV && ($_= shift @ARGV) ne '.') { push @lcmd, $_; }
	189	$_= '-'
	190	} elsif (s/^-f//) {
	191	$fcmd= arg_value($_,'-f');
	192	} elsif (s/^-e//) {
	193	$encrarg= arg_value($_,'-e');
0f4b558c	194	push @remoteopts, "-e$encrarg";
0f4b558c	195	@thisencryption= split m#/#, $encrarg;
ed509ebd	196	$thisencryption[0] =~ s/^/\\|/;
0f4b558c	197	push @encryption, @thisencryption;
9d4e63db	198	} elsif (s/^-m/-/) {
	199	$masq= 1;
	200	} elsif (s/^-d/-/) {
	201	$dump= 1;
09966b49	202	} elsif (s/^-Dcrypto$/-/) {
09966b49	203	$xfwdopts.= 'K';
0f4b558c	204	push @remoteopts, '-Dcrypto';
9d4e63db	205	} else {
	206	quit("unknown option \`$_'");
	207	}
abe75cda	208	}
	209	}
	210
9d4e63db	211	# Variables \$[lr]a?p?(\|s\|d\|r)
	212	# Local/Remote Address&/Port
	213	# actualvalue/Specified/Displaypassdown/fromRemote/passtoForwarder
	214	#
	215	($las,$lps)= eat_addr_port('Print\|Any');
46ab1c83	216	$la= conv_host_addr($las);
	217	$lp= conv_port_number($lps);
	218	$ls= pack_sockaddr_in $lp,$la;
	219
9d4e63db	220	($ras,$rps)= eat_addr_port('Wait\|Command');
9d4e63db	221	$ra= conv_host_addr($ras);
46ab1c83	222	$rp= conv_port_number($rps);
9d4e63db	223	$rs= pack_sockaddr_in $rp,$ra;
46ab1c83	224
	225	$_= shift @ARGV;
	226	m/^([.0-9]+),([.0-9]+),(\d+),(slip\|cslip)$/
	227	or quit("lvaddr,rvaddr,mtu,proto missing or bad syntax or proto not [c]slip");
217afbe6	228	($lva,$rva,$mtu,$proto) = ($1,$2,$3,$4);
46ab1c83	229
46ab1c83	230	$_= shift @ARGV;
217afbe6	231	m/^(\d+),(\d+)$/ or quit("keepalive,timeout missing or bad syntax");
217afbe6	232	($keepalive,$timeout)= ($1,$2);
46ab1c83	233	$keepalive && ($timeout > $keepalive2) or quit("timeout must be < 2keepalive")
	234	if $timeout;
	235
9d4e63db	236	# Variables \$[lr]exn
	237	# Local/Remote Extra Nets
	238	$lexn= shift @ARGV;
	239	$rexn= shift @ARGV;
46ab1c83	240
	241	defined($udp= getprotobyname('udp')) or fail("getprotobyname udp");
	242
	243	socket(L,PF_INET,SOCK_DGRAM,$udp) or fail("socket");
	244	bind(L,$ls) or quit("bind failed: $!");
	245	defined($ls= getsockname(L)) or fail("getsockname");
9d4e63db	246	$lad= show_addr($ls);
	247	$lpd= show_port($ls);
	248	$lapd= "$lad,$lpd";
	249
	250	print "$lapd\n" or fail("print addr/port") if ($las eq 'Print' \|\| $lps eq 'Print');
46ab1c83	251
9d4e63db	252	$rapcmd= ($ras eq 'Command' \|\| $rps eq 'Command');
	253	quit("need remote-command if Command for remote addr/port") if $rapcmd && !@ARGV;
	254
	255	sub xform_remote ($$) {
	256	my ($showed,$spec) = @_;
	257	return 'Print' if $spec eq 'Command';
	258	return 'Any' if $spec eq 'Wait';
	259	return $showed;
	260	}
	261
	262	if (@ARGV) {
	263	warning("-d specified with remote command, ignoring") if $dump;
	264	$dump= 1;
	265
	266	$rad= xform_remote(show_addr($rs),$ras);
	267	$rpd= xform_remote(show_port($rs),$rps);
	268	@rcmd= (@ARGV,
0f4b558c	269	@remoteopts,
9d4e63db	270	"$rad,$rpd",
	271	$masq ? 'Wait,Wait' : $lapd,
	272	"$rva,$lva,$mtu,$proto",
	273	"$keepalive,$timeout",
	274	$rexn, $lexn);
217afbe6	275	debug("remote command @rcmd");
9d4e63db	276
	277	if ($rapcmd) {
	278	pipe(RAPREAD,RCMDREADSUB) or fail("pipe");
	279	select(RCMDREADSUB); $\|=1; select(STDOUT);
46ab1c83	280	}
0f4b558c	281	pipe(RCMDWRITESUB,DUMPKEYS) or fail("pipe");
9d4e63db	282	defined($c_rcmd= fork) or fail("fork for remote");
9d4e63db	283	if (!$c_rcmd) {
0f4b558c	284	open STDIN, "<&RCMDWRITESUB" or fail("reopen stdin for remote command");
9d4e63db	285	open STDOUT, ">&RCMDREADSUB" or fail("reopen stdout for remote command")
	286	if $rapcmd;
	287	close RAPREAD if $rapcmd;
	288	close DUMPKEYS;
	289	close RCMDWRITESUB;
	290	close RCMDREADSUB;
	291	close L;
	292	exec @rcmd; fail("failed to execute remote command $rcmd[0]");
46ab1c83	293	}
9d4e63db	294	close RCMDWRITESUB;
	295
	296	if ($rapcmd) {
	297	close RCMDREADSUB if $rapcmd;
	298	$!=0; $_= <RAPREAD>; $e="$!";
	299
	300	defined($c_catremdebug= fork) or fail("fork for cat remote debug");
	301	if (!$c_catremdebug) {
	302	open(STDIN,"<&RAPREAD") or fail("redirect remote debug");
	303	close RAPREAD;
	304	close DUMPKEYS;
	305	close L;
	306	exec "cat"; fail("execute cat");
	307	}
	308	close RAPREAD;
	309
	310	if (!length) {
	311	close DUMPKEYS;
	312	waitpid $c_rcmd,0 or fail("wait for remote command");
	313	quit($? ? "remote command failed (code $?)" :
	314	$e ? "read error from remote command: $e" :
	315	"no details received from remote");
	316	}
	317	chomp;
	318	m/^([.0-9]+)\,(\d+)$/ or quit("invalid details from remote end: \`$_'");
	319	($rar,$rpr) = ($1,$2);
	320	$ra= conv_host_addr($rar);
	321	$rp= conv_port_number($rpr);
46ab1c83	322	}
9d4e63db	323	} elsif ($dump) {
	324	open DUMPKEYS, ">&STDOUT" or fail("reopen stdout for key material");
	325	$dump= 1;
46ab1c83	326	} else {
9d4e63db	327	open DUMPKEYS, "<&STDIN" or fail("reopen stdout for key material");
46ab1c83	328	}
	329
	330	$rs= pack_sockaddr_in $rp,$ra;
46ab1c83	331
9d4e63db	332	if ($ras eq 'Wait' \|\| $rps eq 'Wait') {
	333	@rapf= ('');
	334	$rapd= ('Wait,Wait');
	335	} else {
	336	@rapf= (show_addr($rs), show_port($rs));
	337	$rapd= show_addr_port($rs);
	338	}
abe75cda	339	@lcmd= qw(userv root ipif) unless @lcmd;
abe75cda	340
9d4e63db	341	debug("using remote $rapd local $lapd");
	342	push @lcmd, ("$lva,$rva,$mtu,$proto",$lexn);
	343	debug("local command @lcmd.");
46ab1c83	344
	345	pipe(UR,UW) or fail("up pipe");
	346	pipe(DR,DW) or fail("down pipe");
	347
9d4e63db	348	defined($c_lcmd= fork) or fail("fork for local command");
9d4e63db	349	if (!$c_lcmd) {
46ab1c83	350	close UR; close DW;
217afbe6	351	open(STDIN,"<&DR") or fail("reopen stdin for packets");
217afbe6	352	open(STDOUT,">&UW") or fail("reopen stdout for packets");
abe75cda	353	exec @lcmd;
abe75cda	354	quit("cannot execute $lcmd[0]: $!");
46ab1c83	355	}
	356	close UW;
	357	close DR;
	358
09966b49	359	$xfwdopts.= 'w' if $dump;
	360
	361	@fcmd= ($fcmd, $xfwdopts,
	362	fileno(L), fileno(DW), fileno(UR), fileno(DUMPKEYS),
9d4e63db	363	$mtu, $keepalive, $timeout,
9d4e63db	364	@rapf,
9d4e63db	365	@encryption);
9d4e63db	366	debug("forwarding command @fcmd.");
46ab1c83	367
9d4e63db	368	defined($c_fwd= fork) or fail("fork for udptunnel-forwarder");
9d4e63db	369	if (!$c_fwd) {
0f4b558c	370	foreach $fd (qw(L DW UR DUMPKEYS)) {
9d4e63db	371	fcntl($fd, F_SETFD, 0) or fail("set no-close-on-exec $fd");
	372	}
	373	exec @fcmd; fail("cannot execute $fcmd[0]");
46ab1c83	374	}
46ab1c83	375
9d4e63db	376	close L;
	377	close DUMPKEYS;
	378	close UR;
	379	close DW;
46ab1c83	380
9d4e63db	381	%procs= ($c_fwd, 'forwarder',
	382	$c_lcmd, 'local command');
	383	$procs{$c_rcmd}= 'remote command' if $c_rcmd;
	384	$procs{$c_catremdebug}= 'debug cat' if $c_catremdebug;
46ab1c83	385
9d4e63db	386	$estatus= 0;
217afbe6	387
9d4e63db	388	while (keys %procs) {
	389	($c= wait) >0 or
	390	fail("wait failed (expecting ". join('; ',keys %procs). ")");
0f4b558c	391	$status= $?;
0f4b558c	392	warning("unexpected child reaped: pid $c, code $status"), next
9d4e63db	393	unless exists $procs{$c};
	394	$str= $procs{$c};
	395	delete $procs{$c};
0f4b558c	396	$status ? warning("subprocess $str failed with code $status")
9d4e63db	397	: debug("subprocess $str finished");
	398	if ($c==$c_lcmd \|\| $c==$c_fwd \|\| $c==$c_rcmd) {
	399	kill 15, grep (exists $procs{$_}, $c_fwd, $c_rcmd);
46ab1c83	400	}
9d4e63db	401	$estatus=1 unless $c == $c_catremdebug;
46ab1c83	402	}
9d4e63db	403
	404	debug("all processes terminated, exiting with status $estatus");
	405
	406	exit $estatus;