ipif/udptunnel

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