Initial draft of udptunnel; coding finished, not yet compiled/tested.

diff --git a/ipif/udptunnel b/ipif/udptunnel
new file mode 100755 (executable)
index 0000000..1c022ba
--- /dev/null
+++ b/ipif/udptunnel
@@ -0,0 +1,209 @@
+#!/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>
+#                     <extra-local-nets>
+#
+# udptunnel will userv ipif locally, as
+#    userv 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_addr ($) {
+    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;
+
+$_= shift @ARGV;
+m/^(\d+),(\d+)$/ or quit("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') {
+    $lepn= shift @ARGV;
+    quit("when using ,command for remote, must supply command") unless @ARGV;
+    defined($c= open C,"-|") or fail("fork for remote");
+    if (!$c) {
+       push @ARGV, "$ras,print", "$lsp", "$rva,$lva,$mtu,$proto", $lepn;
+       debug("remote command @ARGV");
+       exec @ARGV; die "$progname: error: failed to execute $ARGV[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_addr($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);
+
+debug("using remote $rsp");
+
+if ($lps eq 'print') { print $lsp,"\n" or quit("write port to stdout: $!"); }
+
+debug("public address $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","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;
+vec($wantreadfds,fileno(L))= 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= '';
+
+for (;;) {
+    select($readfds=$wantreadfds,'','',undef);
+    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)) {
+               $upyet= 1;
+               debug($downyet ? "tunnel open" : "transmit channel open");
+           } else {
+               warning("transmit error: $!");
+           }
+           $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");
+           continue;
+       }
+       if (!defined($r= syswrite(DW,$downbuf,length $downbuf))) {
+           warning("tunnel endpoint write error: $!");
+       } else if ($r != length $downbuf) {
+           warning("tunnel endpoint wrong write length");
+       } else {
+           $downyet= 1;
+           debug($upyet ? "tunnel open" : "receive channel open");
+       }
+    }
+    $! == EAGAIN || warning("receive error: $!");
+}