crypto debugging, and several bugfixes
[userv-utils] / ipif / udptunnel
1 #!/usr/bin/perl
2 # Simple tunnel for userv-ipif tunnels.
3 #
4 # usage:
5 # udptunnel
6 # [ -l[<local-command/arg>] ... .
7 # | -e <encryption-mech>[/<encryption-parameter>...]
8 # | -m (`masquerade support': subcommand gets `Wait' instead of our addr/port)
9 # | -d (`dump keys': when no subcmd, spew keys rather than reading them;
10 # we always send keys to our subcmd if there is one)
11 # | -Dcrypto (debug crypto - use with care, prints keys, packets &c on screen!)
12 # | -f<path-to-udptunnel-forwarder>
13 # ...
14 # ]
15 # <public-local-addr>,<public-local-port>
16 # <public-remote-addr>,<public-remote-port>
17 # <private-local-addr>,<private-remote-addr>,<mtu>,<proto>
18 # <keepalive>,<timeout>
19 # <extra-local-nets> <extra-remote-nets>
20 # [ <remote-command> [<remote-args> ...] ]
21 #
22 # proto may be slip or cslip
23 #
24 # Any <..-addr> may also be hostname
25 #
26 # Local addr's and ports may also be:
27 # `Print' choose one ourselves and print both port and addr
28 # `Any' choose one ourselves and do not print it
29 # Remote addr's and ports may also be:
30 # `Wait' wait to receive a packet before assigning address
31 # `Command' run a subcommand and wait for it to tell us the values
32 # When any addr or port is `Command' then <remote-command> must be specified.
33 #
34 # If <remote-command> is specified it should run udptunnel at the
35 # remote end; it will be invoked as
36 # <remote-command> [ <-e arguments passed along> ]
37 # <public-remote-addr'>,<public-remote-port'>
38 # <public-local-addr'>,<public-local-port'>
39 # <private-remote-addr>,<private-local-addr>,<mtu>,<proto>
40 # <keepalive>,<timeout>
41 # <extra-remote-nets> <extra-local-nets>
42 #
43
44 # If it was given Print for <public-remote-foo'>, this command's first
45 # stdout output should be the real
46 # <public-remote-addr>,<public-remote-port> pair (and of course this
47 # udptunnel's output will be). It may then produce more stdout which,
48 # if any, will be forwarded to the local end's stdout as debugging info.
49 #
50 # After this, if any encryption was specified, the encryption
51 # parameters will be fed into its stdin. See the documentation in the
52 # mech-*.c files for details of the parameters. udptunnel will
53 # arrange to feed the keys fd of udptunnel-forwarder into the stdin of
54 # the remote command.
55 #
56 # <public-remote-foo'> is as follows:
57 # <public-remote-foo> <public-remote-foo'>
58 # actual addr/port that addr/port
59 # `Command' `Print'
60 # `Wait' `Any'
61 #
62 # <public-local-foo'> is as follows:
63 # <public-local-foo> <public-local-foo'> <public-local-foo'>
64 # (-m not specified) (-m specified)
65 # actual addr/port that addr/port `Wait'
66 # `Wait' the chosen address `Wait'
67 # `Print' the chosen address `Wait'
68 #
69 # udptunnel will userv ipif locally, as
70 # userv root ipif <private-local-addr>,<private-remote-addr>,<mtu>,<proto>
71 # <extra-local-nets>
72 # or, if -l was given, userv root ipif is replaced with the argument(s)
73 # following -l option(s) until `.'.
74 #
75 # udptunnel will also run udptunnel-forwarder with appropriate options
76 #
77 # recommended encryption parameters are:
78 # -e nonce (prepend 32 bit counter)
79 # -e timestamp/<max-skew>/<max-age> (prepend 32 bit time_t, and check on receipt)
80 # -e pkcs5/8 (pad as per PKCS#5 to 8-byte boundary)
81 # -e blowfish-cbcmac/128 (prepend CBC MAC with random IV and 128 bit key)
82 # -e blowfish-cbc/128 (encrypt with CBC, random IV and 128 bit key)
83 # where <max-skew> is perhaps 10 and <max-age> perhaps 30.
84
85 # Copyright (C) 1999-2000 Ian Jackson
86 #
87 # This is free software; you can redistribute it and/or modify it
88 # under the terms of the GNU General Public License as published by
89 # the Free Software Foundation; either version 2 of the License, or
90 # (at your option) any later version.
91 #
92 # This program is distributed in the hope that it will be useful, but
93 # WITHOUT ANY WARRANTY; without even the implied warranty of
94 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
95 # General Public License for more details.
96 #
97 # You should have received a copy of the GNU General Public License
98 # along with userv-utils; if not, write to the Free Software
99 # Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
100 #
101 # $Id$
102
103 use Socket;
104 use POSIX;
105 use Fcntl;
106
107 $progname= $0; $progname =~ s,.*/,,;
108 $|=1;
109
110 chomp($hostname= `uname -n`);
111 $? and die "$progname: cannot get hostname (uname failed with code $?)\n";
112
113 sub quit ($) { die "$progname - $hostname: fatal error: $_[0]\n"; }
114 sub debug ($) { print "$progname - $hostname: debug: $_[0]\n"; }
115 sub fail ($) { quit("unexpected system call failure: $_[0]: $!"); }
116 sub warning ($) { warn "$progname - $hostname: $_[0]\n"; }
117
118 sub eat_addr_port ($) {
119 my ($x) = @_;
120 @ARGV or quit("<addr>,<port> missing");
121 $_= shift(@ARGV);
122 (m/^$x,/i && m/^[a-z]/ || m/,$x$/i && m/,[a-z]/)
123 and warning("$_: use Mixed Case for special values");
124 m/^([0-9a-z][0-9a-z-+.]+|$x)\,(\d+|$x)$/
125 or quit("$_: <host/addr>,<port> bad syntax".
126 (m/[A-Z]/ ? ' (use lowercase for hostnames)' : ''));
127 return ($1,$2);
128 }
129 sub conv_host_addr ($) {
130 my ($s,$r,@h) = @_;
131 return INADDR_ANY() if $s =~ m/^[A-Z][a-z]/;
132 return $r if defined($r= inet_aton($s));
133 @h= gethostbyname($s) or quit("$s: cannot get address");
134 $h[2] eq &AF_INET or quit("$s: address is not IPv4");
135 @h < 5 or quit("$s: name maps to no addresses");
136 $r= $h[4];
137 @h == 5 or warning("$s: name has several addresses, using ".inet_ntoa($r));
138 return $r;
139 }
140 sub conv_port_number ($) {
141 my ($s,$r) = @_;
142 return 0 if $s =~ m/^[A-Z][a-z]/;
143 $r= $s+0;
144 $r>0 && $r<65536 or quit("$s: port out of range");
145 return $r;
146 }
147 sub show_addr ($) {
148 my ($s,@s) = @_;
149 @s= unpack_sockaddr_in($s);
150 return inet_ntoa($s[1]);
151 }
152 sub show_port ($) {
153 my ($s,@s) = @_;
154 @s= unpack_sockaddr_in($s);
155 return $s[0];
156 }
157 sub show_addr_port ($) {
158 my ($s) = @_;
159 return show_addr($s).','.show_port($s);
160 }
161 sub arg_value ($$) {
162 my ($val,$opt) = @_;
163 $_= '-';
164 return $val if length $val;
165 @ARGV or quit("$opt needs value");
166 return shift @ARGV;
167 }
168
169 $|=1;
170
171 @lcmd= ();
172 @encryption= ();
173 $masq= 0;
174 $dump= 0;
175 $fcmd= 'udptunnel-forwarder';
176 $xfwdopts= '';
177
178 while ($ARGV[0] =~ m/^-/) {
179 $_= shift @ARGV;
180 last if m/^--?$/;
181 while (!m/^-$/) {
182 if (s/^-l//) {
183 push @lcmd,$_ if length;
184 while (@ARGV && ($_= shift @ARGV) ne '.') { push @lcmd, $_; }
185 $_= '-'
186 } elsif (s/^-f//) {
187 $fcmd= arg_value($_,'-f');
188 } elsif (s/^-e//) {
189 $encrarg= arg_value($_,'-e');
190 push @remoteopts, "-e$encrarg";
191 @thisencryption= split m#/#, $encrarg;
192 $thisencryption[0] =~ s/^/\!/;
193 push @encryption, @thisencryption;
194 } elsif (s/^-m/-/) {
195 $masq= 1;
196 } elsif (s/^-d/-/) {
197 $dump= 1;
198 } elsif (s/^-Dcrypto$/-/) {
199 $xfwdopts.= 'K';
200 push @remoteopts, '-Dcrypto';
201 } else {
202 quit("unknown option \`$_'");
203 }
204 }
205 }
206
207 # Variables \$[lr]a?p?(|s|d|r)
208 # Local/Remote Address&/Port
209 # actualvalue/Specified/Displaypassdown/fromRemote/passtoForwarder
210 #
211 ($las,$lps)= eat_addr_port('Print|Any');
212 $la= conv_host_addr($las);
213 $lp= conv_port_number($lps);
214 $ls= pack_sockaddr_in $lp,$la;
215
216 ($ras,$rps)= eat_addr_port('Wait|Command');
217 $ra= conv_host_addr($ras);
218 $rp= conv_port_number($rps);
219 $rs= pack_sockaddr_in $rp,$ra;
220
221 $_= shift @ARGV;
222 m/^([.0-9]+),([.0-9]+),(\d+),(slip|cslip)$/
223 or quit("lvaddr,rvaddr,mtu,proto missing or bad syntax or proto not [c]slip");
224 ($lva,$rva,$mtu,$proto) = ($1,$2,$3,$4);
225
226 $_= shift @ARGV;
227 m/^(\d+),(\d+)$/ or quit("keepalive,timeout missing or bad syntax");
228 ($keepalive,$timeout)= ($1,$2);
229 $keepalive && ($timeout > $keepalive*2) or quit("timeout must be < 2*keepalive")
230 if $timeout;
231
232 # Variables \$[lr]exn
233 # Local/Remote Extra Nets
234 $lexn= shift @ARGV;
235 $rexn= shift @ARGV;
236
237 defined($udp= getprotobyname('udp')) or fail("getprotobyname udp");
238
239 socket(L,PF_INET,SOCK_DGRAM,$udp) or fail("socket");
240 bind(L,$ls) or quit("bind failed: $!");
241 defined($ls= getsockname(L)) or fail("getsockname");
242 $lad= show_addr($ls);
243 $lpd= show_port($ls);
244 $lapd= "$lad,$lpd";
245
246 print "$lapd\n" or fail("print addr/port") if ($las eq 'Print' || $lps eq 'Print');
247
248 $rapcmd= ($ras eq 'Command' || $rps eq 'Command');
249 quit("need remote-command if Command for remote addr/port") if $rapcmd && !@ARGV;
250
251 sub xform_remote ($$) {
252 my ($showed,$spec) = @_;
253 return 'Print' if $spec eq 'Command';
254 return 'Any' if $spec eq 'Wait';
255 return $showed;
256 }
257
258 if (@ARGV) {
259 warning("-d specified with remote command, ignoring") if $dump;
260 $dump= 1;
261
262 $rad= xform_remote(show_addr($rs),$ras);
263 $rpd= xform_remote(show_port($rs),$rps);
264 @rcmd= (@ARGV,
265 @remoteopts,
266 "$rad,$rpd",
267 $masq ? 'Wait,Wait' : $lapd,
268 "$rva,$lva,$mtu,$proto",
269 "$keepalive,$timeout",
270 $rexn, $lexn);
271 debug("remote command @rcmd");
272
273 if ($rapcmd) {
274 pipe(RAPREAD,RCMDREADSUB) or fail("pipe");
275 select(RCMDREADSUB); $|=1; select(STDOUT);
276 }
277 pipe(RCMDWRITESUB,DUMPKEYS) or fail("pipe");
278 defined($c_rcmd= fork) or fail("fork for remote");
279 if (!$c_rcmd) {
280 open STDIN, "<&RCMDWRITESUB" or fail("reopen stdin for remote command");
281 open STDOUT, ">&RCMDREADSUB" or fail("reopen stdout for remote command")
282 if $rapcmd;
283 close RAPREAD if $rapcmd;
284 close DUMPKEYS;
285 close RCMDWRITESUB;
286 close RCMDREADSUB;
287 close L;
288 exec @rcmd; fail("failed to execute remote command $rcmd[0]");
289 }
290 close RCMDWRITESUB;
291
292 if ($rapcmd) {
293 close RCMDREADSUB if $rapcmd;
294 $!=0; $_= <RAPREAD>; $e="$!";
295
296 defined($c_catremdebug= fork) or fail("fork for cat remote debug");
297 if (!$c_catremdebug) {
298 open(STDIN,"<&RAPREAD") or fail("redirect remote debug");
299 close RAPREAD;
300 close DUMPKEYS;
301 close L;
302 exec "cat"; fail("execute cat");
303 }
304 close RAPREAD;
305
306 if (!length) {
307 close DUMPKEYS;
308 waitpid $c_rcmd,0 or fail("wait for remote command");
309 quit($? ? "remote command failed (code $?)" :
310 $e ? "read error from remote command: $e" :
311 "no details received from remote");
312 }
313 chomp;
314 m/^([.0-9]+)\,(\d+)$/ or quit("invalid details from remote end: \`$_'");
315 ($rar,$rpr) = ($1,$2);
316 $ra= conv_host_addr($rar);
317 $rp= conv_port_number($rpr);
318 }
319 } elsif ($dump) {
320 open DUMPKEYS, ">&STDOUT" or fail("reopen stdout for key material");
321 $dump= 1;
322 } else {
323 open DUMPKEYS, "<&STDIN" or fail("reopen stdout for key material");
324 }
325
326 $rs= pack_sockaddr_in $rp,$ra;
327
328 if ($ras eq 'Wait' || $rps eq 'Wait') {
329 @rapf= ('');
330 $rapd= ('Wait,Wait');
331 } else {
332 @rapf= (show_addr($rs), show_port($rs));
333 $rapd= show_addr_port($rs);
334 }
335 @lcmd= qw(userv root ipif) unless @lcmd;
336
337 debug("using remote $rapd local $lapd");
338 push @lcmd, ("$lva,$rva,$mtu,$proto",$lexn);
339 debug("local command @lcmd.");
340
341 pipe(UR,UW) or fail("up pipe");
342 pipe(DR,DW) or fail("down pipe");
343
344 defined($c_lcmd= fork) or fail("fork for local command");
345 if (!$c_lcmd) {
346 close UR; close DW;
347 open(STDIN,"<&DR") or fail("reopen stdin for packets");
348 open(STDOUT,">&UW") or fail("reopen stdout for packets");
349 exec @lcmd;
350 quit("cannot execute $lcmd[0]: $!");
351 }
352 close UW;
353 close DR;
354
355 $xfwdopts.= 'w' if $dump;
356
357 @fcmd= ($fcmd, $xfwdopts,
358 fileno(L), fileno(DW), fileno(UR), fileno(DUMPKEYS),
359 $mtu, $keepalive, $timeout,
360 @rapf,
361 @encryption);
362 debug("forwarding command @fcmd.");
363
364 defined($c_fwd= fork) or fail("fork for udptunnel-forwarder");
365 if (!$c_fwd) {
366 foreach $fd (qw(L DW UR DUMPKEYS)) {
367 fcntl($fd, F_SETFD, 0) or fail("set no-close-on-exec $fd");
368 }
369 exec @fcmd; fail("cannot execute $fcmd[0]");
370 }
371
372 close L;
373 close DUMPKEYS;
374 close UR;
375 close DW;
376
377 %procs= ($c_fwd, 'forwarder',
378 $c_lcmd, 'local command');
379 $procs{$c_rcmd}= 'remote command' if $c_rcmd;
380 $procs{$c_catremdebug}= 'debug cat' if $c_catremdebug;
381
382 $estatus= 0;
383
384 while (keys %procs) {
385 ($c= wait) >0 or
386 fail("wait failed (expecting ". join('; ',keys %procs). ")");
387 $status= $?;
388 warning("unexpected child reaped: pid $c, code $status"), next
389 unless exists $procs{$c};
390 $str= $procs{$c};
391 delete $procs{$c};
392 $status ? warning("subprocess $str failed with code $status")
393 : debug("subprocess $str finished");
394 if ($c==$c_lcmd || $c==$c_fwd || $c==$c_rcmd) {
395 kill 15, grep (exists $procs{$_}, $c_fwd, $c_rcmd);
396 }
397 $estatus=1 unless $c == $c_catremdebug;
398 }
399
400 debug("all processes terminated, exiting with status $estatus");
401
402 exit $estatus;