Bugfixes.

[userv-utils] / ipif / udptunnel

#!/usr/bin/perl
# Simple tunnel for userv-ipif tunnels.
#
# usage:
#  udptunnel
#            <public-local-host/addr>,<public-local-port>
#            <public-remote-host/addr>,<public-remote-port>
#            <private-local-addr>,<private-remote-addr>,<mtu>,<proto>
#            <keepalive>,<timeout>
#            <extra-local-nets> <extra-remote-nets>
#          [ <remote-command> [<remote-args> ...] ]
#
# <local-public-port> may be number or `print' or `silent'
#
# <remote-public-port> may number or `command', in which case
# <remote-command> must be specified and should run udptunnel at the
# remote end; it will be invoked as
#    <remote-command> <public-remote-host/addr>,print
#                     <public-local-addr>,<public-local-port>
#                     <private-remote-addr>,<private-local-addr>,<mtu>,<proto>
#                     <keepalive>,<timeout>
#                     <extra-remote-nets> <extra-local-nets>
#
# udptunnel will userv ipif locally, as
#    userv root ipif <private-local-addr>,<private-remote-addr>,<mtu>,<proto>
#                    <extra-local-nets>

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]: $!\n"); }
sub warning ($) { warn "$progname - $hostname: $_[0]\n"; }

sub eat_addr_port ($) {
    my ($x) = @_;
    @ARGV or quit("<host/addr>,<port> missing");
    $_= shift(@ARGV);
    $_ =~ m/^([^,]+)\,(\d+|$x)$/ or quit("$_: <host/addr>,<port> bad syntax");
    return ($1,$2);
}
sub conv_host_addr ($) {
    my ($s,$r) = @_;
    defined($r= inet_aton($s)) or quit("$s: cannot convert to address");
    return $r;
}
sub conv_port_number ($) {
    my ($s,$r) = @_;
    if ($s =~ m/\d/) {
	$r= $s+0;
	$r>0 && $r<65536 or quit("$s: port out of range");
    } else {
	$r= 0;
    }
    return $r;
}
sub show_addr_port ($) {
    my ($s,@s) = @_;
    @s= unpack_sockaddr_in($s);
    return inet_ntoa($s[1]).','.$s[0];
}

($las,$lps)= eat_addr_port('print|silent');
$la= conv_host_addr($las);
$lp= conv_port_number($lps);
$ls= pack_sockaddr_in $lp,$la;

($ras,$rps)= eat_addr_port('command');
$rp= conv_port_number($rps);
$ra= $rps eq 'command' ? '' : conv_host_addr($ras);

$_= 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;

$lepn= shift @ARGV;
$repn= shift @ARGV;

alarm($timeout);

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");
$lsp= show_addr_port($ls);

if ($rps eq 'command') {
    quit("when using ,command for remote, must supply command") unless @ARGV;
    @rcmd= (@ARGV, "$ras,print", "$lsp", "$rva,$lva,$mtu,$proto",
	    "$keepalive,$timeout", $repn, $lepn);
    debug("remote command @rcmd");
    defined($c= open C,"-|") or fail("fork for remote");
    if (!$c) {
	exec @rcmd; die "$progname: error: failed to execute $rcmd[0]: $!\n";
    }
    $_= <C>;
    if (!length) {
	close C;
	quit($? ? "remote command failed (code $?)" : "no details received from remote");
    }
    chomp;
    m/^([.0-9]+)\,(\d+)$/ or quit("invalid details from remote end ($_)");
    ($ras,$rps) = ($1,$2);
    $ra= conv_host_addr($ras);
    $rp= conv_port_number($rps);
    defined($c2= fork) or fail("fork for cat");
    if (!$c2) {
	open(STDIN,"<&C") or fail("redirect remote pipe to stdin");
	close C;
	exec "cat"; fail("execute cat");
    }
} else {
    quit("when not using ,command for remote, must not supply command") if @ARGV;
}

$rs= pack_sockaddr_in $rp,$ra;
$rsp= show_addr_port($rs);

if ($lps eq 'print') { print($lsp,"\n") or quit("write port to stdout: $!"); }

debug("using remote $rsp local $lsp");

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

defined($c3= fork) or fail("fork for ipif");
if (!$c3) {
    close UR; close DW;
    open(STDIN,"<&DR") or fail("reopen stdin for packets");
    open(STDOUT,">&UW") or fail("reopen stdout for packets");
    exec "userv","root","ipif","$lva,$rva,$mtu,$proto",$lepn;
    quit("cannot execute userv ipif: $!");
}
close UW;
close DR;

$upyet= 0;
$downyet= 0;

$wantreadfds='';
vec($wantreadfds,fileno(UR),1)= 1;
vec($wantreadfds,fileno(L),1)= 1;

sub nonblock ($) {
    my ($fh,$fl) = @_;
    ($fl= fcntl($fh,F_GETFL,0)) or fail("nonblock F_GETFL");
    $fl |= O_NONBLOCK;
    fcntl($fh, F_SETFL, $fl) or fail("nonblock F_SETFL");
}

nonblock('UR');
nonblock('L');

$upbuf= '';

sub now () { my ($v); defined($v= time) or fail("get time"); return $v; }
if ($keepalive) { $nextsendka= now(); }

for (;;) {
    if ($keepalive) {
	$now= now();
	$timeout= $nextsendka-$now;
	if ($timeout < 0) {
	    defined(send L,"\300",0,$rs)
		or warning("transmit keepalive error: $!");
	    $nextsendka= $now+$keepalive;
	    $timeout= $keepalive;
	}
    } else {
	$timeout= undef;
    }
    select($readfds=$wantreadfds,'','',$timeout);
    for (;;) {
	if (!defined($r= sysread(UR,$upbuf,$mtu*2+3,length($upbuf)))) {
	    $! == EAGAIN || warning("tunnel endpoint read error: $!");
	    last;
	}
	if (!$r) {
	    quit "tunnel endpoint closed by system";
	}
	while (($p= index($upbuf,"\300")) >= 0) {
	    if (!defined(send L,substr($upbuf,0,$p),0,$rs)) {
		warning("transmit error: $!");
	    } elsif (!$upyet) {
		$upyet= 1;
		debug($downyet ? "tunnel open at this end" : "transmit channel open");
	    }
	    $upbuf= substr($upbuf+1,$p);
	}
    }
    while (defined($rs_from= recv L,$downbuf,$mtu*2+3,0)) {
	$rsp_from= show_addr_port($rs_from);
	if ($rsp_from ne $rsp) {
	    warning("got packet from incorrect peer $rsp_from");
	    next;
	}
	if (!defined($r= syswrite(DW,$downbuf,length $downbuf))) {
	    warning("tunnel endpoint write error: $!");
	} elsif ($r != length $downbuf) {
	    warning("tunnel endpoint wrong write length");
	} else {
	    if (!$downyet) {
		$downyet= 1;
		debug($upyet ? "tunnel open at this end" : "receive channel open");
	    }
	    alarm($timeout) if $timeout;
	}
    }
    $! == EAGAIN || warning("receive error: $!");
}