mdw@git.distorted.org.uk Git - userv-utils/blob - ipif/udptunnel

   1 #!/usr/bin/perl
   2 # Simple tunnel for userv-ipif tunnels.
   3 #
   4 # usage:
   5 #  udptunnel
   6 #        [ -l[<local-command/arg>] ... . ]
   7 #            <public-local-host/addr>,<public-local-port>
   8 #            <public-remote-host/addr>,<public-remote-port>
   9 #            <private-local-addr>,<private-remote-addr>,<mtu>,<proto>
  10 #            <keepalive>,<timeout>
  11 #            <extra-local-nets> <extra-remote-nets>
  12 #          [ <remote-command> [<remote-args> ...] ]
  13 #
  14 # <local-public-port> may be number or `print' or `silent'
  15 #
  16 # <remote-public-port> may number or `command', in which case
  17 # <remote-command> must be specified and should run udptunnel at the
  18 # remote end; it will be invoked as
  19 #    <remote-command> <public-remote-host/addr>,print
  20 #                     <public-local-addr>,<public-local-port>
  21 #                     <private-remote-addr>,<private-local-addr>,<mtu>,<proto>
  22 #                     <keepalive>,<timeout>
  23 #                     <extra-remote-nets> <extra-local-nets>
  24 #
  25 # udptunnel will userv ipif locally, as
  26 #    userv root ipif <private-local-addr>,<private-remote-addr>,<mtu>,<proto>
  27 #                    <extra-local-nets>
  28 # or, if -lc was given, userv root ipif is replaced with the argument(s) to
  29 # successive -lc options.
  30
  31 use Socket;
  32 use POSIX;
  33 use Fcntl;
  34
  35 $progname= $0; $progname =~ s,.*/,,;
  36 $|=1;
  37
  38 chomp($hostname= `uname -n`);
  39 $? and die "$progname: cannot get hostname (uname failed with code $?)\n";
  40
  41 sub quit ($) { die "$progname - $hostname: fatal error: $_[0]\n"; }
  42 sub debug ($) { print "$progname - $hostname: debug: $_[0]\n"; }
  43 sub fail ($) { quit("unexpected system call failure: $_[0]: $!\n"); }
  44 sub warning ($) { warn "$progname - $hostname: $_[0]\n"; }
  45
  46 sub eat_addr_port ($) {
  47     my ($x) = @_;
  48     @ARGV or quit("<host/addr>,<port> missing");
  49     $_= shift(@ARGV);
  50     $_ =~ m/^([^,]+)\,(\d+|$x)$/ or quit("$_: <host/addr>,<port> bad syntax");
  51     return ($1,$2);
  52 }
  53 sub conv_host_addr ($) {
  54     my ($s,$r) = @_;
  55     defined($r= inet_aton($s)) or quit("$s: cannot convert to address");
  56     return $r;
  57 }
  58 sub conv_port_number ($) {
  59     my ($s,$r) = @_;
  60     if ($s =~ m/\d/) {
  61         $r= $s+0;
  62         $r>0 && $r<65536 or quit("$s: port out of range");
  63     } else {
  64         $r= 0;
  65     }
  66     return $r;
  67 }
  68 sub show_addr_port ($) {
  69     my ($s,@s) = @_;
  70     @s= unpack_sockaddr_in($s);
  71     return inet_ntoa($s[1]).','.$s[0];
  72 }
  73
  74 @lcmd= ();
  75
  76 while ($ARGV[0] =~ m/^-/) {
  77     $_= shift @ARGV;
  78     last if $_ eq '--';
  79     if (s/^-l//) {
  80         push @lcmd,$_ if length;
  81         while (@ARGV && ($_= shift @ARGV) ne '-') { push @lcmd, $_; }
  82     } else {
  83         quit("unknown option \`$_'");
  84     }
  85 }
  86
  87 ($las,$lps)= eat_addr_port('print|silent');
  88 $la= conv_host_addr($las);
  89 $lp= conv_port_number($lps);
  90 $ls= pack_sockaddr_in $lp,$la;
  91
  92 ($ras,$rps)= eat_addr_port('command');
  93 $rp= conv_port_number($rps);
  94 $ra= $rps eq 'command' ? '' : conv_host_addr($ras);
  95
  96 $_= shift @ARGV;
  97 m/^([.0-9]+),([.0-9]+),(\d+),(slip|cslip)$/
  98     or quit("lvaddr,rvaddr,mtu,proto missing or bad syntax or proto not [c]slip");
  99 ($lva,$rva,$mtu,$proto) = ($1,$2,$3,$4);
 100
 101 $_= shift @ARGV;
 102 m/^(\d+),(\d+)$/ or quit("keepalive,timeout missing or bad syntax");
 103 ($keepalive,$timeout)= ($1,$2);
 104 $keepalive && ($timeout > $keepalive*2) or quit("timeout must be < 2*keepalive")
 105     if $timeout;
 106
 107 $lepn= shift @ARGV;
 108 $repn= shift @ARGV;
 109
 110 alarm($timeout);
 111
 112 defined($udp= getprotobyname('udp')) or fail("getprotobyname udp");
 113
 114 socket(L,PF_INET,SOCK_DGRAM,$udp) or fail("socket");
 115 bind(L,$ls) or quit("bind failed: $!");
 116 defined($ls= getsockname(L)) or fail("getsockname");
 117 $lsp= show_addr_port($ls);
 118
 119 if ($rps eq 'command') {
 120     quit("when using ,command for remote, must supply command") unless @ARGV;
 121     @rcmd= (@ARGV, "$ras,print", "$lsp", "$rva,$lva,$mtu,$proto",
 122             "$keepalive,$timeout", $repn, $lepn);
 123     debug("remote command @rcmd");
 124     defined($c= open C,"-|") or fail("fork for remote");
 125     if (!$c) {
 126         exec @rcmd; die "$progname: error: failed to execute $rcmd[0]: $!\n";
 127     }
 128     $_= <C>;
 129     if (!length) {
 130         close C;
 131         quit($? ? "remote command failed (code $?)" : "no details received from remote");
 132     }
 133     chomp;
 134     m/^([.0-9]+)\,(\d+)$/ or quit("invalid details from remote end ($_)");
 135     ($ras,$rps) = ($1,$2);
 136     $ra= conv_host_addr($ras);
 137     $rp= conv_port_number($rps);
 138     defined($c2= fork) or fail("fork for cat");
 139     if (!$c2) {
 140         open(STDIN,"<&C") or fail("redirect remote pipe to stdin");
 141         close C;
 142         exec "cat"; fail("execute cat");
 143     }
 144 } else {
 145     quit("when not using ,command for remote, must not supply command") if @ARGV;
 146 }
 147
 148 $rs= pack_sockaddr_in $rp,$ra;
 149 $rsp= show_addr_port($rs);
 150
 151 if ($lps eq 'print') { print($lsp,"\n") or quit("write port to stdout: $!"); }
 152
 153 @lcmd= qw(userv root ipif) unless @lcmd;
 154
 155 debug("using remote $rsp local $lsp");
 156 push @lcmd, ("$lva,$rva,$mtu,$proto",$lepn);
 157 debug("local command @lcmd");
 158
 159 pipe(UR,UW) or fail("up pipe");
 160 pipe(DR,DW) or fail("down pipe");
 161
 162 defined($c3= fork) or fail("fork for ipif");
 163 if (!$c3) {
 164     close UR; close DW;
 165     open(STDIN,"<&DR") or fail("reopen stdin for packets");
 166     open(STDOUT,">&UW") or fail("reopen stdout for packets");
 167     exec @lcmd;
 168     quit("cannot execute $lcmd[0]: $!");
 169 }
 170 close UW;
 171 close DR;
 172
 173 $upyet= 0;
 174 $downyet= 0;
 175
 176 $wantreadfds='';
 177 vec($wantreadfds,fileno(UR),1)= 1;
 178 vec($wantreadfds,fileno(L),1)= 1;
 179
 180 sub nonblock ($) {
 181     my ($fh,$fl) = @_;
 182     ($fl= fcntl($fh,F_GETFL,0)) or fail("nonblock F_GETFL");
 183     $fl |= O_NONBLOCK;
 184     fcntl($fh, F_SETFL, $fl) or fail("nonblock F_SETFL");
 185 }
 186
 187 nonblock('UR');
 188 nonblock('L');
 189
 190 $upbuf= '';
 191
 192 sub now () { my ($v); defined($v= time) or fail("get time"); return $v; }
 193 if ($keepalive) { $nextsendka= now(); }
 194
 195 for (;;) {
 196     if ($keepalive) {
 197         $now= now();
 198         $thistimeout= $nextsendka-$now;
 199         if ($thistimeout < 0) {
 200             defined(send L,"\300",0,$rs)
 201                 or warning("transmit keepalive error: $!");
 202             $nextsendka= $now+$keepalive;
 203             $thistimeout= $keepalive;
 204         }
 205     } else {
 206         $thistimeout= undef;
 207     }
 208     select($readfds=$wantreadfds,'','',$thistimeout);
 209     for (;;) {
 210         if (!defined($r= sysread(UR,$upbuf,$mtu*2+3,length($upbuf)))) {
 211             $! == EAGAIN || warning("tunnel endpoint read error: $!");
 212             last;
 213         }
 214         if (!$r) {
 215             quit "tunnel endpoint closed by system";
 216         }
 217         while (($p= index($upbuf,"\300")) >= 0) {
 218             if (!defined(send L,substr($upbuf,0,$p+1),0,$rs)) {
 219                 warning("transmit error: $!");
 220             } else {
 221                 if (!$upyet) {
 222                     $upyet= 1;
 223                     debug($downyet ? "tunnel open at this end" : "transmitting");
 224                 }
 225                 if ($keepalive) { $nextsendka= now()+$keepalive; }
 226             }
 227             $upbuf= substr($upbuf,$p+1);
 228         }
 229     }
 230     while (defined($rs_from= recv L,$downbuf,$mtu*2+3,0)) {
 231         $rsp_from= show_addr_port($rs_from);
 232         if ($rsp_from ne $rsp) {
 233             warning("got packet from incorrect peer $rsp_from");
 234             next;
 235         }
 236         if (!defined($r= syswrite(DW,$downbuf,length $downbuf))) {
 237             warning("tunnel endpoint write error: $!");
 238         } elsif ($r != length $downbuf) {
 239             warning("tunnel endpoint wrong write length");
 240         } else {
 241             if (!$downyet) {
 242                 $downyet= 1;
 243                 debug($upyet ? "tunnel open at this end" : "receiving");
 244             }
 245             alarm($timeout) if $timeout;
 246         }
 247     }
 248     $! == EAGAIN || warning("receive error: $!");
 249 }