[userv-utils] / ipif / udptunnel

#!/usr/bin/perl
# Encrypting VPN tunnel for use with userv-ipif.
#
# This comment is reference documentation.  See ipif/INSTALL for the
# installation instructions and setup tutorial.
#
# usage:
#  To make a tunnel between two machines `alice' and `bob',
#  on `alice', the active endpoint, run:
#
#   udptunnel
#        [ -l[<alice-command/arg>] ... .
#        | -e <encryption-mech>[/<encryption-parameter>...]
#        | -m   (`masquerade support': bob gets `Wait' instead of our addr/port)
#        | -d   (`dump keys': when no peer, spew keys rather than reading them;
#                we always send keys to our peer if there is one)
#        | -Dcrypto  (debug crypto - use with care, prints keys, packets &c on screen!)
#        | -f<path-to-udptunnel-forwarder>
#          ...
#        ]
#            <alice-phys-addr>,<alice-phys-port>
#            <bob-phys-addr>,<bob-phys-port>
#            <alice-virt-addr>,<bob-virt-addr>,<mtu>,<proto>
#            <keepalive>,<timeout>[,<reannounce>]
#            <alice-priv-nets> <bob-priv-nets>
#          [ <bob-command> [<bob-args> ...] ]
#
# This will run udptunnel-forwarder on alice, and use <bob-command>
# (usually an ssh invocation) to run udptunnel appropriately on bob.
# Key material will be generated by alice and fed to udptunnel on bob
# via <bob-command>'s stdin, and the physical address and port on bob
# will be (if so configured) returned via <bob-command>'s stdout.
#
# The tunnel will stay up until one of the subprocesses involved dies,
# or the keepalive timeout expires.  If you want the tunnel to remain
# up permanently, you must arrange to invoke it repeatedly (eg, from
# inittab).  See INSTALL.
#
# <proto> may be slip or cslip
#
# <mtu> will be the MTU of the tunnel interfaces; it is best if this
# is enough smaller than the path MTU between the physical interfaces
# that the encapsulated packets will fit without fragmentation.
#
# Any <..-addr> supplied to udptunnel may also be hostname; these will
# all be looked up on alice and IP addresses passed to bob.
#
# The `local' physical address and ports (ie, alice's own details),
# may have these special values:
#    `Any'       choose one ourselves and do not print it (the port chosen
#                will be supplied to bob)
#    `Print'     choose one ourselves and print both port and addr
#                (this is not usually useful specified directly; it's
#                used by udptunnel when it invokes itself on bob via
#                <bob-command>, to have its other self print the
#                relevant value.
#
# The `remote' physical address and port (ie, on alice, bob's details),
# may also have the special values:
#    `Command'   wait for <bob-command> to tell us the values (this is
#                usually the right choice on alice for at least the
#                port).  <bob-command> must be specified (ie, this
#                only makes sense on alice).
#    `Wait'      alice will wait to receive a packet from bob and use
#                whatever address and port it came from
#
# These special values are case-sensitive.  When alice runs udptunnel
# on bob they are automatically translated to appropriate other values
# in the arguments to bob's udptunnel.
#
# If <bob-command> is specified it should run udptunnel at the
# bob end; it will be invoked as
#    <bob-command> [ <bob-args> ... ]
#                  [ <-e arguments passed along> ]
#                    <bob-phys-addr'>,<bob-phys-port'>
#                    <alice-phys-addr'>,<alice-phys-port'>
#                    <bob-virt-addr>,<alice-virt-addr>,<mtu>,<proto>
#                    <keepalive>,<timeout>[,<reannounce>]
#                    <bob-priv-nets> <alice-priv-nets>
#
# If it was given Print for <bob-phys-foo'>, udptunnel's first stdout
# output will be the real <bob-phys-addr>,<bob-phys-port> pair.  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 key
# material will be fed into its stdin.  See the documentation in the
# mech-*.c files for details of the parameters.  udptunnel on alice
# will arrange to feed the keys fd of udptunnel-forwarder into the
# stdin of the udptunnel on bob.
#
# <bob-phys-foo'> is as follows:
#   <bob-phys-foo>       <bob-phys-foo'>
#    actual addr/port     that addr/port
#    `Command'            `Print'
#    `Wait'               `Any'
#
# <alice-phys-foo'> is as follows:
#   <alice-phys-foo>    <alice-phys-foo'>       <alice-phys-foo'>
#                       (-m not specified)      (-m specified)
#   actual addr/port     that addr/port       	 `Wait'
#   `Print'              the chosen address 	 `Wait'
#   `Any'                `Wait' for addr, 	 `Wait'
#                         chosen port for port
#
# In each case udptunnel will run userv ipif locally, as
#    userv root ipif <local-virt-addr>,<remote-virt-addr>,<mtu>,<proto>
#                    <remote-priv-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.  If your
# clocks are not sufficiently well synchronised, you could replace
# `-e nonce -e timestamp/...' with just `-e sequence'.  Do not just
# remove `-e timestamp/...'.

# Copyright 1996-2013 Ian Jackson <ijackson@chiark.greenend.org.uk>
# Copyright 1998 David Damerell <damerell@chiark.greenend.org.uk>
# Copyright 1999,2003
#    Chancellor Masters and Scholars of the University of Cambridge
# Copyright 2010 Tony Finch <fanf@dotat.at>
#
# 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 3 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, see http://www.gnu.org/licenses/.

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

@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;
if (m/^(\d+),(\d+)$/) {
    ($keepalive,$timeout,$reannounce)= ($1+0,$2+0,0);
    $ka_to_ra= "$keepalive,$timeout";
} elsif (m/^(\d+),(\d+),(\d+)$/) {
    ($keepalive,$timeout,$reannounce)= ($1+0,$2+0,$3);
	    "$keepalive,$timeout",
    $ka_to_ra= "$keepalive,$timeout,$reannounce";
} else {
    quit("keepalive,timeout missing or bad syntax");
}
$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' : $las eq 'Any' ? "Wait,$lpd" : $lapd,
	    "$rva,$lva,$mtu,$proto",
	    $ka_to_ra,
	    $rexn, $lexn);
    debug("remote command @rcmd");

    if ($rapcmd) {
	pipe(RAPREAD,RCMDREADSUB) or fail("pipe");
    }
    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;
	$_= '';
	while (!m/\n/) {
	    $!=0;
	    defined($nread= sysread(RAPREAD,$_,1,length))
		or fail("read from remote command");
	    if (!$nread) {
		close DUMPKEYS;
		close RAPREAD;
		waitpid $c_rcmd,0 or fail("wait for remote command");
		quit($? ? "remote command failed (code $?)" :
		     "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);

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