with-authinfo-kludge: Fix a poorly formatted comment.
[with-authinfo-kludge] / with-authinfo-kludge
CommitLineData
e8e64c07
MW
1#! /usr/bin/perl -w
2###
3### Adverbial modifier conferring AUTHINFO GENERIC support on NNTP clients
4###
5### (c) 2016 Mark Wooding
6###
7
8###----- Licensing notice ---------------------------------------------------
9###
10### This program is free software; you can redistribute it and/or modify
11### it under the terms of the GNU General Public License as published by
12### the Free Software Foundation; either version 2 of the License, or
13### (at your option) any later version.
14###
15### This program is distributed in the hope that it will be useful,
16### but WITHOUT ANY WARRANTY; without even the implied warranty of
17### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18### GNU General Public License for more details.
19###
20### You should have received a copy of the GNU General Public License
21### along with this program; if not, write to the Free Software Foundation,
22### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
23
e8e64c07
MW
24my $VERSION = "0.1.0~unfinished";
25
26use strict;
27
28###--------------------------------------------------------------------------
29### External modules.
30
31## Included batteries.
32use Fcntl qw(:mode);
33use File::stat;
34use Getopt::Long qw(:config gnu_compat bundling
35 require_order no_getopt_compat);
36use POSIX qw(:errno_h :fcntl_h :sys_wait_h);
37use Socket qw(/^[AP]F_/ /^SOCK_/ /^sockaddr_/
38 getaddrinfo /^AI_/ /^EAI_/
39 getnameinfo /^NI_/);
40use Sys::Hostname;
41
42## External batteries.
43use File::FcntlLock;
44
45###--------------------------------------------------------------------------
46### Configuration variables.
47
48## The global configuration.
49my %C = (
50 "rundir" => undef
51);
52
53## The per-server configuration.
54my %S;
55my %SPARAM = map { $_ => 1 }
56 "local", "nntpauth", "remote", "sshbind", "via";
57
58## Various facts we might discover.
59my $HOME = $ENV{"HOME"};
60(my $PROG = $0) =~ s:^.*/::;
61my $VERBOSE = 0;
62my $CONF = undef;
63my $TAG = undef;
64my $RUNDIR = undef;
65
66## Other bits of useful state.
67my @CLEANUP = ();
68my $SESSDIR = undef;
69my %SERVMAP = ();
70my %CLIENT_NOIP = ();
71my %KIDMAP = ();
a3775340 72my $CLIENTKID = -1;
e8e64c07
MW
73
74###--------------------------------------------------------------------------
75### Utilities.
76
77my $BAD = 0;
78
79sub moan ($) {
80 my ($msg) = @_;
81 print STDERR "$PROG: $msg\n";
82}
83
84sub fail ($;$) {
85 my ($msg, $rc) = @_;
86 moan $msg;
87 exit ($rc // 1);
88}
89
90sub sysfail ($) {
91 my ($msg) = @_;
92 fail $msg, 16;
93}
94
95sub bad ($) {
96 my ($msg) = @_;
97 moan $msg;
98 $BAD = 1;
99}
100
101sub inform ($) {
102 my ($msg) = @_;
103 print STDERR "$PROG: ;; $msg\n" if $VERBOSE;
104}
105
106sub trim ($) {
107 my ($s) = @_;
108 $s =~ s/^\s+//;
109 $s =~ s/\s+$//;
110 return $s;
111}
112
113sub ensure_home () {
114 defined $HOME or fail "no home directory set";
115 return $HOME;
116}
117
118sub ensure_dir_exists ($$) {
119 my ($dir, $mode) = @_;
120 mkdir $dir, $mode or $! == EEXIST or
121 sysfail "failed to create directory `$dir': $!";
122}
123
124sub zap ($);
125sub zap ($) {
126 my ($f) = @_;
127 if (-d $f) {
128 my $d;
129 unless (opendir $d, $f) {
130 moan "failed to open directory `$d': $!";
131 return;
132 }
133 ENTRY: for (;;) {
134 defined (my $b = readdir $d) or last ENTRY;
135 next ENTRY if grep { $b eq $_ } ".", "..";
136 zap "$f/$b";
137 }
138 closedir $d;
139 rmdir $f or $! == ENOENT or moan "failed to zap directory `$f': $!";
140 } else {
141 unlink $f or $! == ENOENT or moan "failed to zap file thing `$f': $!";
142 }
143}
144
145sub set_cloexec ($) {
146 my ($fh) = @_;
147 my $f = fcntl $fh, F_GETFD, 0 or sysfail "failed to get per-fd flags: $!";
148 fcntl $fh, F_SETFD, $f | FD_CLOEXEC or
149 sysfail "failed to set close-on-exec: $!";
150}
151
38877c89
MW
152sub set_nonblock ($) {
153 my ($fh) = @_;
154 my $f = fcntl $fh, F_GETFL, 0 or sysfail "failed to get file flags: $!";
155 fcntl $fh, F_SETFL, $f | O_NONBLOCK or
156 sysfail "failed to set non-blockingness: $!";
157}
158
e8e64c07
MW
159sub lockedp ($) {
160 my ($f) = @_;
161 my $l = new File::FcntlLock;
162 $l->lock($f, F_GETLK) or sysfail "couldn't read locking for `$f': $!";
163 return $l->l_type != F_UNLCK;
164}
165
399b694f
MW
166sub write_to_file ($$) {
167 my ($file, $contents) = @_;
168 my $new = "$file.new";
169 open my $fh, ">", $new or sysfail "couldn't open `$new' for writing: $!";
170 print $fh $contents;
171 $fh->flush && !$fh->error && close $fh
172 or sysfail "failed to write to `$new': $!";
173 rename $new, $file or sysfail "failed to rename `$new' to `$file': $!";
174}
175
e8e64c07
MW
176my $INKIDP = 0;
177sub myfork () {
178 my $kid = fork;
179 if (defined $kid && !$kid) { $INKIDP = 1; }
180 return $kid;
181}
182
183my $SEQ = 0;
184sub sequence () { return $SEQ++; }
185
186###--------------------------------------------------------------------------
187### Setting up the configuration.
188
189sub set_global_param ($$) {
190 my ($param, $value) = @_;
191 exists $C{$param} or fail "unknown global parameter `$param'";
192 $C{$param} = $value;
193}
194
195sub notice_server ($$) {
196 my ($server, $where) = @_;
197 inform "found server `$server' $where";
198 $S{$server} //= {};
199}
200
201sub set_server_param ($$$) {
202 my ($server, $param, $value) = @_;
203 $S{$server} or bad "unknown server `$param'";
204 $SPARAM{$param} or bad "unknown server parameter `$param'";
205 $S{$server}{$param} = $value;
206}
207
208sub chew_cli_server_configs (\@) {
209 my ($args) = @_;
210 my $server = undef;
211
212 ARG: for (;;) {
213 last ARG unless @$args;
4ed4f066 214 my $arg = shift @$args;
e8e64c07
MW
215 if ($arg eq "+") { last ARG; }
216 elsif ($arg =~ /^\+/) {
217 $server = substr $arg, 1;
218 notice_server $server, "on command line";
219 }
220 elsif (!defined $server or $arg !~ /^([^=]+)=(.*)$/)
221 { unshift @$args, $arg; last ARG; }
222 else { set_server_param $server, $1, $2; }
223 }
224}
225
226sub parse_config_file () {
227
228 ## If we already know what we're doing then forbid a configuration file as
229 ## well.
230 if (%S) {
231 return unless defined $CONF;
232 fail "servers defined on command-line; won't read config file too";
233 }
234
235 ## Search about to find a suitable configuration file.
236 my $cf;
237 my @confpath =
238 ($ENV{"XDG_CONFIG_HOME"} // ensure_home . "/.config",
239 split /:/, $ENV{"XDG_CONFIG_DIRS"} // "/etc/xdg");
240 inform "searching for a configuration file with tag `$TAG'...";
241 PATH: for my $dir (@confpath) {
242 for my $base ($TAG, "\@default") {
243 my $f = "$dir/with-authinfo-kludge/$base.conf";
244 if (open $cf, "<", $f) {
245 inform " found `$f'; search over";
246 $CONF = $f; last PATH;
247 } elsif ($! != ENOENT) {
248 bad "couldn't open `$f' for reading: $!";
249 } else {
250 inform " `$f' not found; search continues";
251 }
252 }
253 }
254
255 ## If we still don't have a configuration file then synthesize one from the
256 ## `$NNTPSERVER' variable.
257 unless ($CONF) {
258 my $server = $ENV{"NNTPSERVER"};
259 defined $server or fail "no `NNTPSERVER' defined in the environment";
260 inform "no config file found; synthesizing default";
261 notice_server $server, "in environment";
262 return;
263 }
264
265 ## Work through the configuration file setting up servers.
266 my $set_param = \&set_global_param;
267 while (<$cf>) {
268 next if /^\s*([#;]|$)/;
269 if (/^\s*\[(.+)\]\s*$/) {
270 my $head = trim $1;
271 if ($head eq "\@GLOBAL") { $set_param = \&set_global_param; }
272 else {
273 notice_server $head, "in config file";
274 $set_param = sub { set_server_param $head, $_[0], $_[1]; };
275 }
276 } elsif (/^([^=]+)=(.*)$/) { $set_param->(trim $1, trim $2); }
277 else { bad "$CONF:$.: couldn't parse configuration file line"; }
278 }
279 (!$cf->error and close $cf)
280 or sysfail "error reading configuration file `$CONF': $!";
281}
282
283sub format_value ($);
284sub format_value ($) {
285 my ($value) = @_;
286 if (!defined $value) { return "<undef>"; }
287 elsif (my $r = ref $value) {
288 if ($r eq "ARRAY") {
289 return "[" . join(", ", map { format_value $_ } @$value) . "]";
290 } elsif ($r eq "HASH") {
291 return "{ " .
292 join(", ", map { format_value $_ . " => " .
293 format_value $value->{$_} } sort keys %$value) .
294 " }";
295 } else {
296 return "<$r ref>";
297 }
298 } else { return "`$value'"; }
299}
300
301sub inform_param ($$) {
302 my ($param, $value) = @_;
303 inform " $param = " . format_value $value;
304}
305
306sub dump_configuration () {
307 inform "Global parameters...";
308 for my $p (sort keys %C) { inform_param $p, $C{$p}; }
309
310 for my $s (sort keys %S) {
311 inform "Server `$s' parameters...";
4ed4f066 312 for my $p (sort keys %{$S{$s}}) { inform_param $p, $S{$s}{$p}; }
e8e64c07
MW
313 }
314}
315
316###--------------------------------------------------------------------------
317### Managing the runtime directory.
318###
319### Truly told, this bit is probably the trickiest part of the program.
320
321## How long we allow for a new server directory to be set up.
322my $BIRTHTIME = 300;
323
324sub find_rundir () {
325
326 ## Maybe we've done all of this already.
327 defined $RUNDIR and return;
328
329 ## Find a suitable place to put things.
330 SEARCH: {
331 inform "searching for a suitable runtime directory...";
332
333 ## Maybe the user's configured a directory explicitly. (Maybe we still
334 ## have to arrange for this to exist.)
335 if (defined ($RUNDIR = $C{"rundir"})) {
336 inform "using runtime directory from configuration";
337 last SEARCH;
338 }
339
340 ## First attempt: use `$XDG_RUNTIME_DIR'.
341 if (defined (my $runhome = $ENV{"XDG_RUNTIME_DIR"})) {
342 inform "setting runtime directory from `XDG_RUNTIME_DIR'";
343 $RUNDIR = "$runhome/with-authinfo-kludge";
344 last SEARCH;
345 }
346
347 ## Second attempt: let's use /tmp, or whatever `$TMPDIR' is set.
348 my $tmpdir = $ENV{"TMPDIR"} // "/tmp";
349 inform "investigating putting runtime directory under tmpdir `$tmpdir'";
350 my $dir = "$tmpdir/with-authinfo-kludge-$>";
351 my $st = lstat $dir;
352 if (!$st && $! == ENOENT) {
353 mkdir $dir, 0700 or sysfail "failed to create directory `$dir': $!";
354 $st = lstat $dir;
355 inform "created `$dir'";
356 }
357 if (!-d $st) { inform "alas, `$dir' isn't a directory"; }
358 elsif ($st->uid != $>) { inform "alas, we don't own `$dir'"; }
359 elsif ($st->mode & 0077) { inform "alas, `$dir' has liberal perms"; }
360 else {
361 inform "accepting `$dir' as runtime directory";
362 $RUNDIR = $dir;
363 last SEARCH;
364 }
365
366 ## Third attempt: we'll use the XDG cache directory.
367 my $cachehome = $ENV{"XDG_CACHE_HOME"} // ensure_home . "/.cache";
368 ensure_dir_exists $cachehome, 0777;
369 my $host = hostname;
370 $RUNDIR = "$cachehome/with-authinfo-kludge.$host";
371 inform "last ditch: using `$RUNDIR' as runtime directory";
372 }
373
374 ## Make the runtime directory if it doesn't exist. Be paranoid here; users
375 ## can override if they really want. (Note that noip(1) is untweakably
376 ## picky about its socket directories, so this is less generous than it
377 ## looks.)
378 ensure_dir_exists $RUNDIR, 0700;
379 for my $d ("junk", "new") { ensure_dir_exists "$RUNDIR/$d", 0777; }
380}
381
382sub junk_rundir_thing ($$) {
383 my ($f, $what) = @_;
384 inform "junking $what `$f'";
385
386 ## Find a name to rename it to under the `junk' directory. Anyone can put
387 ## things in the `junk' directory, and anyone is allowed to delete them;
388 ## the only tricky bit is making sure the names don't collide.
389 my $junk;
390 NAME: for (;;) {
391 my $r = int rand 1000000;
392 $junk = "$RUNDIR/junk/j.$r";
393
394 ## It'll be OK if this fails because someone else has junked the file (in
395 ## which case we end happy), or if the target exists (in which case we
396 ## pick another and try again).
397 if (rename $f, $junk or ($! == ENOENT && !-e $f)) { last NAME; }
398 elsif ($! != EEXIST) { sysfail "couldn't rename `$f' to `$junk': $!"; }
399 }
400
401 return $junk;
402}
403
404sub clean_up_rundir () {
405 inform "cleaning up stale things from runtime directory";
406
407 ## Work through the things in the directory, making sure they're meant to
408 ## be there.
409 opendir my $dh, $RUNDIR or
410 sysfail "failed to open directory `$RUNDIR': $!";
411 ENTRY: for (;;) {
412 defined (my $base = readdir $dh) or last ENTRY;
413 next ENTRY if grep { $base eq $_ } ".", "..";
414 my $f = "$RUNDIR/$base";
415
416 ## If this thing isn't a directory then it shouldn't be there. Maybe a
417 ## later version of us put it there.
418 unless (-d $f) {
419 inform "found unexpected thing `$f' in runtime directory";
420 next ENTRY;
421 }
422
423 ## Maybe it's a standard thing that's meant to be here. We'll clean
424 ## those up later.
425 next ENTRY if grep { $base eq $_ } "junk", "new";
426
427 ## If the name doesn't have a `.' in it, then it's some other special
428 ## thing which we don't understand.
429 if ($base !~ /^s.*\.\d+/) {
430 inform "found unexpected special directory `$f' in runtime directory";
431 next ENTRY;
432 }
433
434 ## Otherwise, it's a session directory. If its lockfile isn't locked
435 ## then it's fair game.
436 my $lk = "$f/lock";
437 if (open my $fh, "<", $lk) {
438 my $ownedp = lockedp $fh;
439 close $fh or sysfail "couldn't close file, what's up with that?: $!";
440 if (!$ownedp) { junk_rundir_thing $f, "stale session dir"; }
441 } elsif ($! == ENOENT) {
442 junk_rundir_thing $f, "session dir without `lock' file";
443 } else {
444 moan "couldn't open `$lk' (found in runtime dir) for reading: $!";
445 inform "leaving `$f' alone";
446 }
447 }
448 closedir $dh;
449
450 ## Work through the things in the `new' directory.
451 my $thresh = time - $BIRTHTIME;
452 my $newdir = "$RUNDIR/new";
453 opendir $dh, $newdir or
454 sysfail "failed to open directory `$newdir': $!";
455 NEW: for (;;) {
456 defined (my $base = readdir $dh) or last NEW;
457 next NEW if grep { $base eq $_ } ".", "..";
458 my $f = "$newdir/$base";
459 unless (-d $f) {
460 inform "found unexepected nondirectory thing `$f' in nursery";
461 next NEW;
462 }
463 if ($base !~ /^n\.(\d+)\./) {
464 inform "found directory with unexpected name `$f' in nursery";
465 next NEW;
466 }
467 my $stamp = $1;
468 $stamp >= $thresh or junk_rundir_thing $f, "stillborn session directory";
469 }
470 closedir $dh;
471
472 ## Work through the things in the `junk' directory. Anyone can put things
473 ## in the `junk' directory, and anyone is allowed to delete them.
474 ## Therefore we can just zap everything in here. The `zap' function is
475 ## (somewhat) careful not to screw up if someone else is also zapping the
476 ## same thing.
477 my $junkdir = "$RUNDIR/junk";
478 opendir $dh, $junkdir or
479 sysfail "failed to open directory `$junkdir': $!";
480 NEW: for (;;) {
481 defined (my $base = readdir $dh) or last NEW;
482 next NEW if grep { $base eq $_ } ".", "..";
483 my $f = "$junkdir/$base";
484 zap $f;
485 }
486 closedir $dh;
487}
488
489sub make_session_dir () {
490 inform "making session directory for `$TAG'";
491
492 ## Make a new directory in the nursery. Only the creator of a nursery
493 ## directory is allowed to put things in it.
494 my $newdir = "$RUNDIR/new";
495 my $n;
496 NAME: for (;;) {
497 my $now = time;
498 my $r = int rand 1000000;
499 $n = "$newdir/n.$now.$$.$r";
500 if (mkdir $n, 0777) { last NAME; }
501 elsif ($! != EEXIST) { sysfail "failed to create `$n': $!"; }
502 }
503
504 ## Create the lockfile, and take out a lock.
505 open my $fh, ">", "$n/lock";
506 set_cloexec $fh;
507 my $l = File::FcntlLock->new(l_type => F_WRLCK,
508 l_whence => SEEK_SET,
509 l_start => 0,
510 l_len => 0);
511 $l->lock($fh, F_SETLK) or sysfail "failed to lock `$n/lock: $!";
512
513 ## Rename the directory into its proper place. We have already cleaned out
514 ## stale directories, and the target name has our PID in it, so it can't
515 ## exist any more unless something unfortunate has happened.
516 $SESSDIR = "$RUNDIR/s.$TAG.$$";
517 rename $n, $SESSDIR or sysfail "failed to rename `$n' to `$SESSDIR': $!";
518
519 ## Create some necessary things.
520 ensure_dir_exists "$SESSDIR/noip-client", 0700;
521}
522
523END {
524 zap junk_rundir_thing $SESSDIR, "cleanup on exit"
525 if !$INKIDP && defined $SESSDIR;
526}
527
528###--------------------------------------------------------------------------
529### Setting up a session.
530
531sub parse_address ($;$) {
532 my ($addr, $defport) = @_;
533 inform "parsing address `$addr'...";
534
535 my ($host, $port);
536 if ($addr =~ /^\[([^]]*)\]:(\d+)$/ || $addr =~ /^([^:]+):(\d+)$/)
537 { $host = $1; $port = $2; }
538 elsif (defined $defport) { $host = $addr; $port = $defport; }
539 else { fail "invalid address `$addr': missing port number"; }
540 inform " host = `$host'; port = $port";
541 return ($host, $port);
542}
543
544sub format_address ($$) {
545 my ($host, $port) = @_;
546 $host =~ /:/ and $host = "[$host]";
547 return "$host:$port";
548}
549
550sub canonify_address ($;$) {
551 my ($addr, $defport) = @_;
552 my ($host, $port) = parse_address $addr, $defport;
553 return format_address $host, $port;
554}
555
556sub resolve_parsed_address ($$) {
557 my ($host, $port) = @_;
558 inform "resolving host `$host', port $port";
559
560 my ($err, @a) = getaddrinfo $host, $port, { flags => AI_NUMERICSERV };
561 $err and fail "failed to resolve `$host': $err";
562
563 my @res;
564 my %seen;
565 for my $a (@a) {
566 ($err, $host, $port) =
567 getnameinfo $a->{addr}, NI_NUMERICHOST | NI_NUMERICSERV;
568 $err and sysfail "unexpectedly failed to convert addr to text: $err";
569 inform " resolved to $host $port";
570 my $r = format_address $host, $port;
571 unless ($seen{$r}) { push @res, $r; $seen{$r} = 1; }
572 }
573
574 return @res;
575}
576
577sub resolve_address ($;$) {
578 my ($addr, $defport) = @_;
579 my ($host, $port) = parse_address $addr, $defport;
580 return resolve_parsed_address $host, $port;
581}
582
583sub fix_server_config ($) {
584 my ($server) = @_;
585 my $s = $S{$server};
586
587 ## Keep the name. This is useful for diagnostics, but it's also important
588 ## for finding the right socket directory if we're doing SSH forwarding.
589 $s->{"_name"} = $server;
590
591 ## Sort out the various addresses.
592 my ($host, $port);
593 ($host, $port) = parse_address($s->{"local"} // $server, 119);
594 $s->{"local"} = format_address $host, $port;
595 $s->{"_laddrs"} = [resolve_parsed_address $host, $port];
596 $s->{"remote"} = canonify_address($s->{"remote"} // $server, 119);
597 ($host, $port) = parse_address($s->{"sshbind"} // "127.1.0.1", 1119);
598 $s->{"sshbind"} = format_address $host, $port;
599 $s->{"_sshaddrs"} = [resolve_parsed_address $host, $port];
600
601 ## Initialize other settings.
602 $s->{"_proxy_noip"} = undef;
603 $s->{"_proxy_sockdir"} = undef;
604 $s->{"_proxy_server"} = defined $s->{"via"} ?
605 $s->{"sshbind"} : $s->{"remote"};
b1436e12
MW
606 $s->{"_proxy_server"} =~ s/:119$//;
607 $s->{"_proxy_server"} =~ s/^\[(.*)\]$/$1/;
e8e64c07 608 $s->{"_sshkid"} = undef;
b17683b0
MW
609 $s->{"_ssh_stdin"} = undef;
610 $s->{"_ssh_stdout"} = undef;
e8e64c07
MW
611}
612
613sub hack_noip_envvar ($$) {
614 my ($var, $val) = @_;
615 inform " hack env for noip: $var = `$val'";
616 $ENV{$var} = $val;
617}
618
619sub hack_noip_env ($$) {
620 my ($vars, $dir) = @_;
621 return unless $vars;
622
623 hack_noip_envvar "LD_PRELOAD",
624 "noip.so" .
625 (exists $ENV{"LD_PRELOAD"} ? ":" . $ENV{"LD_PRELOAD"} : "");
626 for my $k (keys %ENV) { delete $ENV{$k} if $k =~ /^NOIP_/; }
627 hack_noip_envvar "NOIP_CONFIG", "$RUNDIR/noip.conf.notexist";
628 hack_noip_envvar "NOIP_SOCKETDIR", $dir;
629 hack_noip_envvar "NOIP_DEBUG", $VERBOSE;
630 for my $acl ("REALBIND", "REALCONNECT") {
631 hack_noip_envvar "NOIP_$acl",
632 join ",", @{$vars->{$acl} // []}, "+any";
633 }
634}
635
636sub server_listen ($) {
637 my ($server) = @_;
638 my $s = $S{$server};
639
640 ## Set up the listening sockets for this server's addresses.
641 inform "set up sockets for `$server'";
642 for my $a (@{$s->{"_laddrs"}}) {
643 socket my $sk, PF_UNIX, SOCK_STREAM, 0
644 or sysfail "failed to make Unix-domain socket: $!";
38877c89 645 set_cloexec $sk; set_nonblock $sk;
e8e64c07
MW
646 my $sa = "$SESSDIR/noip-client/$a";
647 bind $sk, sockaddr_un $sa
648 or sysfail "failed to bind Unix-domain socket to `$sa': $!";
649 listen $sk, 5 or sysfail "failed to listen on Unix-domain socket: $!";
650 $SERVMAP{fileno $sk} = [$s, $a, $sk];
651 inform " listening on $a";
652 push @{$CLIENT_NOIP{"REALCONNECT"}}, "-$a";
653 }
654
655 ## If we're forwarding via SSH then set that up too.
656 if (defined (my $via = $s->{"via"})) {
657 inform "set up SSH tunnel to `$server' via $via...";
658 my %ssh_noip = ();
659 my $sockdir = "$SESSDIR/noip-ssh.$server";
660 ensure_dir_exists $sockdir, 0700;
661 my $sshbind = $s->{"sshbind"};
662 my $remote = $s->{"remote"};
663 for my $a (@{$s->{"_sshaddrs"}}) {
664 push @{$ssh_noip{"REALBIND"}}, "-$a";
665 inform " listening on $a";
666 push @{$s->{"_proxy_noip"}{"REALCONNECT"}}, "-$a";
667 }
668 $s->{"_proxy_sockdir"} = $sockdir;
669
b17683b0
MW
670 ## The `-L' option sets up the tunnel that we actually wanted. The `-v'
671 ## makes SSH spew stuff to stdout, which might be useful if you're
26f5de45
MW
672 ## debugging. The `-S' detaches OpenSSH from any control master things
673 ## which might be going on, because they tend to interfere with
b17683b0
MW
674 ## forwarding (and, besides, the existing master won't be under the same
675 ## noip configuration). The `echo' will let us know that it's started
676 ## up, and the `read' will keep the tunnel open until we close our end,
677 ## which we do implicitly when we exit.
e8e64c07 678 inform " starting SSH tunnel";
b17683b0 679 my @sshargs = ("ssh", "-L$sshbind:$remote", "-Snone");
e8e64c07 680 $VERBOSE and push @sshargs, "-v";
b17683b0
MW
681 push @sshargs, $via, <<EOF;
682## with-authinfo-kludge tunnel: $TAG -> $server
683set -e; echo started; read hunoz
684EOF
685 pipe my $rin, my $win and pipe my $rout, my $wout
686 or sysfail "failed to create pipe: $!";
687 set_cloexec $win;
688 set_cloexec $rout; set_nonblock $rout;
e8e64c07
MW
689 defined (my $kid = myfork) or sysfail "failed to fork: $!";
690 if (!$kid) {
b17683b0
MW
691 open STDIN, "<&", $rin or sysfail "failed to dup pipe to stdin: $!";
692 open STDOUT, "<&", $wout or sysfail "failed to dup pipe to stdout: $!";
e8e64c07
MW
693 hack_noip_env \%ssh_noip, $sockdir;
694 exec @sshargs or sysfail "failed to exec SSH: $!";
695 }
b17683b0
MW
696 close $rin;
697 close $wout;
e8e64c07 698 $s->{"_sshkid"} = $kid;
b17683b0
MW
699 $s->{"_ssh_stdin"} = $win;
700 $s->{"_ssh_stdout"} = $rout;
e8e64c07 701 $KIDMAP{$kid} = [$s, "SSH tunnel"];
399b694f 702 write_to_file "$SESSDIR/ssh-$server.pid", "$kid\n";
e8e64c07
MW
703 }
704}
705
706sub wait_for_ssh () {
b17683b0
MW
707 my $rfd_in = "";
708
709 ## Collect up all the `stdout' pipes.
710 my %fd = ();
711 SETUP: for my $s (values %S) {
712 next SETUP unless $s->{"_sshkid"};
713 my $fd = fileno $s->{"_ssh_stdout"};
714 vec($rfd_in, $fd, 1) = 1;
715 $fd{$fd} = [$s->{"_ssh_stdout"}, $s];
716 }
717 unless (%fd) {
718 inform "no SSH tunnels to start";
719 return;
720 }
721
722 ## Wait for each of them to become readable, and try to read a thing.
723 ## Either we'll get a byte or EOF; either means that the respective tunnel
724 ## is as ready as it's ever going to be.
e8e64c07 725 inform "waiting for SSH tunnels to start...";
b17683b0
MW
726 my $nbad = 0;
727 SELECT: while (%fd) {
728 my ($n, $t) = select my $rfd_out = $rfd_in, undef, undef, undef;
729 if ($n >= 0) { }
730 elsif ($! == EINTR) { next SELECT; }
731 else { sysfail "select failed: $!"; }
732 FD: for my $fd (keys %fd) {
733 next FD unless vec $rfd_out, $fd, 1;
734 my ($sk, $s) = @{$fd{$fd}};
735 my $n = sysread $sk, my $hunoz, 128;
736 if (defined $n) {
737 vec($rfd_in, $fd, 1) = 0;
738 if ($n) { inform " tunnel to $s->{remote} started ok"; }
739 else { inform " tunnel to $s->{remote} FAILED"; $nbad++; }
740 delete $fd{$fd};
741 } elsif ($! != EAGAIN && $! != EWOULDBLOCK) {
742 sysfail "failed to read from pipe: $!";
e8e64c07
MW
743 }
744 }
e8e64c07 745 }
b17683b0
MW
746 if ($nbad) { inform " tunnels started; $nbad FAILED"; }
747 else { inform " all tunnels started ok"; }
e8e64c07
MW
748}
749
750$SIG{"CHLD"} = sub {
751 KID: for (;;) {
752 defined (my $kid = waitpid -1, WNOHANG)
753 or sysfail "failed to reap child: $!";
754 last KID if $kid <= 0;
755 my ($how, $rc);
756 if ($? == 0) {
757 $how = "exited successfully";
758 $rc = 0;
759 } elsif ($? & 0xff) {
760 my $sig = $? & 0x7f;
761 $how = "killed by signal $sig";
762 $how .= " (core dumped)" if $? & 0x80;
763 $rc = $sig | 0x80;
764 } else {
765 $rc = $? >> 8;
766 $how = "exited with status $rc";
767 }
768 if ($kid == $CLIENTKID) {
769 inform "client kid $how; shutting down";
770 exit $rc;
771 } elsif (exists $KIDMAP{$kid}) {
772 my ($s, $what) = @{$KIDMAP{$kid}};
773 inform "$what for server `$s->{_name}' collapsed ($how)";
774 delete $KIDMAP{$kid};
775 } else {
776 inform "unrecognized child $kid $how";
777 }
778 }
779};
780
781sub run_client (@) {
782 my (@args) = @_;
783
784 inform "starting client";
785 defined (my $kid = myfork) or sysfail "failed to fork: $!";
786 if (!$kid) {
787 hack_noip_env \%CLIENT_NOIP, "$SESSDIR/noip-client";
788 my $prog = $args[0];
789 exec @args or sysfail "failed to exec `$prog': $!";
790 }
791 $CLIENTKID = $kid;
399b694f 792 write_to_file "$SESSDIR/client.pid", "$kid\n";
e8e64c07
MW
793}
794
795sub accept_loop () {
796 my $rfd_in = "";
797 for my $fd (keys %SERVMAP) { vec($rfd_in, $fd, 1) = 1; }
9b7b093f 798 SELECT: for (;;) {
e8e64c07 799 my ($n, $t) = select my $rfd_out = $rfd_in, undef, undef, undef;
9b7b093f
MW
800 if ($n >= 0) { }
801 elsif ($! == EINTR) { next SELECT; }
802 else { sysfail "select failed: $!"; }
e8e64c07 803 FD: for my $fd (keys %SERVMAP) {
e0b2f327 804 next FD unless vec $rfd_out, $fd, 1;
e8e64c07
MW
805 my ($s, $a, $sk) = @{$SERVMAP{$fd}};
806 my $nsk;
807 unless (accept $nsk, $sk) {
38877c89
MW
808 moan "failed to accept new connection: $!"
809 unless $! == EAGAIN || $! == EWOULDBLOCK;
e8e64c07
MW
810 next FD;
811 }
812 set_cloexec $nsk;
813 inform "incoming connection `$s->{_name}' to $a; starting proxy...";
814 defined (my $kid = myfork) or sysfail "failed to fork: $!";
815 if (!$kid) {
816 $ENV{"NNTPAUTH"} = $s->{"nntpauth"} if exists $s->{"nntpauth"};
817 hack_noip_env $s->{"_proxy_noip"}, $s->{"_proxy_sockdir"};
818 open STDIN, "<&", $nsk
819 or sysfail "failed to dup socket to kid stdin: $!";
820 open STDOUT, ">&", $nsk
821 or sysfail "failed to dup socket to kid stdin: $!";
822 inform "running proxy to `$s->{_proxy_server}'";
823 exec "authinfo-kludge", $s->{"_proxy_server"}
824 or sysfail "failed to exec `authinfo-kludge': $!";
825 }
826 $KIDMAP{$kid} = [$s, "proxy"];
827 }
828 }
829}
830
831###--------------------------------------------------------------------------
832### Main program.
833
834sub version (\*) {
835 my ($fh) = @_;
836 print $fh "$PROG, version $VERSION\n";
837}
838
839sub usage (\*) {
840 my ($fh) = @_;
841 print $fh <<EOF;
842usage: $PROG [-v] [-d DIR] [-f CONF] [-t TAG]
843 [ [+SERVER] [PARAM=VALUE ...] ...] [+]
844 COMMAND [ARGS ...]
845EOF
846}
847
848sub help () {
849 version *STDOUT;
850 print "\n";
851 usage *STDOUT;
852 print <<EOF;
853
854Command-line options:
855 -h, --help Show this help text.
856 -d, --rundir=DIR Use DIR to store runtime state.
857 -f, --config=FILE Read configuration from FILE.
858 -t, --tag=TAG Use TAG to identify this session.
859 -v, --verbose Emit running commentary to stderr.
860
861Server parameter summary:
862 local=ADDRESS Listen on ADDRESS for client connections.
863 nntpauth=AUTH-METHOD Set authentication method and arguments.
864 remote=ADDRESS Connect to server at ADDRESS.
865 sshbind=ADDRESS Use ADDRESS for local SSH tunnel endpoint.
866 via=SSH-HOST Use SSH to connect to remote server.
867
868See the manual page for full details.
869EOF
870}
871
872sub main () {
873 GetOptions
874 "h|help" => sub { help; exit 0; },
875 "version" => sub { version *STDOUT; exit 0; },
876 "d|rundir=s" => \$RUNDIR,
877 "f|config=s" => \$CONF,
878 "t|tag=s" => \$TAG,
879 "v|verbose" => \$VERBOSE
880 or $BAD = 1;
881 chew_cli_server_configs @ARGV;
882 if (@ARGV) {
883 (my $cmd = $ARGV[0]) =~ s:^.*/::;
884 $TAG //= $cmd;
885 } else {
886 $BAD = 1;
887 }
888 if ($BAD) { usage *STDERR; exit 1; }
889 parse_config_file;
890 for my $server (keys %S) { fix_server_config $server; }
891 dump_configuration if $VERBOSE;
892 find_rundir;
893 clean_up_rundir;
894 make_session_dir;
895 for my $server (keys %S) { server_listen $server; }
896 wait_for_ssh;
897 run_client @ARGV;
898 accept_loop;
899}
900
901main;
902
903###----- That's all, folks --------------------------------------------------