ipif/udptunnel

   1 #!/usr/bin/perl
   2 # Encrypting VPN tunnel for use with userv-ipif.
   3 #
   4 # This comment is reference documentation.  See ipif/INSTALL for the
   5 # installation instructions and setup tutorial.
   6 #
   7 # usage:
   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>] ... .
  13 #        | -e <encryption-mech>[/<encryption-parameter>...]
  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)
  17 #        | -Dcrypto  (debug crypto - use with care, prints keys, packets &c on screen!)
  18 #        | -f<path-to-udptunnel-forwarder>
  19 #          ...
  20 #        ]
  21 #            <alice-phys-addr>,<alice-phys-port>
  22 #            <bob-phys-addr>,<bob-phys-port>
  23 #            <alice-virt-addr>,<bob-virt-addr>,<mtu>,<proto>
  24 #            <keepalive>,<timeout>[,<reannounce>]
  25 #            <alice-priv-nets> <bob-priv-nets>
  26 #          [ <bob-command> [<bob-args> ...] ]
  27 #
  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.
  33 #
  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.
  38 #
  39 # <proto> may be slip or cslip
  40 #
  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)
 101 #   actual addr/port     that addr/port          `Wait'
 102 #   `Print'              the chosen address      `Wait'
 103 #   `Any'                `Wait' for addr,        `Wait'
 104 #                         chosen port for port
 105 #
 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>
 109 # or, if -l was given, userv root ipif is replaced with the argument(s)
 110 # following -l option(s) until `.'.
 111 #
 112 # udptunnel will also run udptunnel-forwarder with appropriate options.
 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)
 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/...'.
 124
 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>
 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
 133 # the Free Software Foundation; either version 3 of the License, or
 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
 142 # along with userv-utils; if not, see http://www.gnu.org/licenses/.
 143
 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"; }
 156 sub fail ($) { quit("unexpected system call failure: $_[0]: $!"); }
 157 sub warning ($) { warn "$progname - $hostname: $_[0]\n"; }
 158
 159 sub eat_addr_port ($) {
 160     my ($x) = @_;
 161     @ARGV or quit("<addr>,<port> missing");
 162     $_= shift(@ARGV);
 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)' : ''));
 168     return ($1,$2);
 169 }
 170 sub conv_host_addr ($) {
 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));
 179     return $r;
 180 }
 181 sub conv_port_number ($) {
 182     my ($s,$r) = @_;
 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");
 186     return $r;
 187 }
 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 ($) {
 194     my ($s,@s) = @_;
 195     @s= unpack_sockaddr_in($s);
 196     return $s[0];
 197 }
 198 sub show_addr_port ($) {
 199     my ($s) = @_;
 200     return show_addr($s).','.show_port($s);
 201 }
 202 sub arg_value ($$) {
 203     my ($val,$opt) = @_;
 204     $_= '-';
 205     return $val if length $val;
 206     @ARGV or quit("$opt needs value");
 207     return shift @ARGV;
 208 }
 209
 210 @lcmd= ();
 211 @encryption= ();
 212 $masq= 0;
 213 $dump= 0;
 214 $fcmd= 'udptunnel-forwarder';
 215 $xfwdopts= '';
 216
 217 while ($ARGV[0] =~ m/^-/) {
 218     $_= shift @ARGV;
 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');
 229             push @remoteopts, "-e$encrarg";
 230             @thisencryption= split m#/#, $encrarg;
 231             $thisencryption[0] =~ s/^/\|/;
 232             push @encryption, @thisencryption;
 233         } elsif (s/^-m/-/) {
 234             $masq= 1;
 235         } elsif (s/^-d/-/) {
 236             $dump= 1;
 237         } elsif (s/^-Dcrypto$/-/) {
 238             $xfwdopts.= 'K';
 239             push @remoteopts, '-Dcrypto';
 240         } else {
 241             quit("unknown option \`$_'");
 242         }
 243     }
 244 }
 245
 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');
 251 $la= conv_host_addr($las);
 252 $lp= conv_port_number($lps);
 253 $ls= pack_sockaddr_in $lp,$la;
 254
 255 ($ras,$rps)= eat_addr_port('Wait|Command');
 256 $ra= conv_host_addr($ras);
 257 $rp= conv_port_number($rps);
 258 $rs= pack_sockaddr_in $rp,$ra;
 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");
 263 ($lva,$rva,$mtu,$proto) = ($1,$2,$3,$4);
 264
 265 $_= shift @ARGV;
 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 }
 276 $keepalive && ($timeout > $keepalive*2) or quit("timeout must be < 2*keepalive")
 277     if $timeout;
 278
 279 # Variables \$[lr]exn
 280 # Local/Remote Extra Nets
 281 $lexn= shift @ARGV;
 282 $rexn= shift @ARGV;
 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");
 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');
 294
 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,
 312             @remoteopts,
 313             "$rad,$rpd",
 314             $masq ? 'Wait,Wait' : $las eq 'Any' ? "Wait,$lpd" : $lapd,
 315             "$rva,$lva,$mtu,$proto",
 316             $ka_to_ra,
 317             $rexn, $lexn);
 318     debug("remote command @rcmd");
 319
 320     if ($rapcmd) {
 321         pipe(RAPREAD,RCMDREADSUB) or fail("pipe");
 322     }
 323     pipe(RCMDWRITESUB,DUMPKEYS) or fail("pipe");
 324     defined($c_rcmd= fork) or fail("fork for remote");
 325     if (!$c_rcmd) {
 326         open STDIN, "<&RCMDWRITESUB" or fail("reopen stdin for remote command");
 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]");
 335     }
 336     close RCMDWRITESUB;
 337
 338     if ($rapcmd) {
 339         close RCMDREADSUB if $rapcmd;
 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);
 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");
 362             close DUMPKEYS;
 363             close L;
 364             exec "cat"; fail("execute cat");
 365         }
 366         close RAPREAD;
 367     }
 368 } elsif ($dump) {
 369     open DUMPKEYS, ">&STDOUT" or fail("reopen stdout for key material");
 370     $dump= 1;
 371 } else {
 372     open DUMPKEYS, "<&STDIN" or fail("reopen stdout for key material");
 373 }
 374
 375 $rs= pack_sockaddr_in $rp,$ra;
 376
 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 }
 384 @lcmd= qw(userv root ipif) unless @lcmd;
 385
 386 debug("using remote $rapd local $lapd");
 387 push @lcmd, ("$lva,$rva,$mtu,$proto",$lexn);
 388 debug("local command @lcmd.");
 389
 390 pipe(UR,UW) or fail("up pipe");
 391 pipe(DR,DW) or fail("down pipe");
 392
 393 defined($c_lcmd= fork) or fail("fork for local command");
 394 if (!$c_lcmd) {
 395     close UR; close DW;
 396     open(STDIN,"<&DR") or fail("reopen stdin for packets");
 397     open(STDOUT,">&UW") or fail("reopen stdout for packets");
 398     exec @lcmd;
 399     quit("cannot execute $lcmd[0]: $!");
 400 }
 401 close UW;
 402 close DR;
 403
 404 $xfwdopts.= 'w' if $dump;
 405
 406 @fcmd= ($fcmd, $xfwdopts,
 407         fileno(L), fileno(DW), fileno(UR), fileno(DUMPKEYS),
 408         $mtu, $keepalive, $timeout, $reannounce,
 409         @rapf,
 410         @encryption);
 411 debug("forwarding command @fcmd.");
 412
 413 defined($c_fwd= fork) or fail("fork for udptunnel-forwarder");
 414 if (!$c_fwd) {
 415     foreach $fd (qw(L DW UR DUMPKEYS)) {
 416         fcntl($fd, F_SETFD, 0) or fail("set no-close-on-exec $fd");
 417     }
 418     exec @fcmd; fail("cannot execute $fcmd[0]");
 419 }
 420
 421 close L;
 422 close DUMPKEYS;
 423 close UR;
 424 close DW;
 425
 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;
 430
 431 $estatus= 0;
 432
 433 while (keys %procs) {
 434     ($c= wait) >0 or
 435         fail("wait failed (expecting ". join('; ',keys %procs). ")");
 436     $status= $?;
 437     warning("unexpected child reaped: pid $c, code $status"), next
 438         unless exists $procs{$c};
 439     $str= $procs{$c};
 440     delete $procs{$c};
 441     $status ? warning("subprocess $str failed with code $status")
 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);
 445     }
 446     $estatus=1 unless $c == $c_catremdebug;
 447 }
 448
 449 debug("all processes terminated, exiting with status $estatus");
 450
 451 exit $estatus;