chiark - git - mdw - with-authinfo-kludge/blob - with-authinfo-kludge

   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
  24 my $VERSION = "0.1.0~unfinished";
  25
  26 use strict;
  27
  28 ###--------------------------------------------------------------------------
  29 ### External modules.
  30
  31 ## Included batteries.
  32 use Fcntl qw(:mode);
  33 use File::stat;
  34 use Getopt::Long qw(:config gnu_compat bundling
  35                     require_order no_getopt_compat);
  36 use POSIX qw(:errno_h :fcntl_h :sys_wait_h);
  37 use Socket qw(/^[AP]F_/ /^SOCK_/ /^sockaddr_/
  38               getaddrinfo /^AI_/ /^EAI_/
  39               getnameinfo /^NI_/);
  40 use Sys::Hostname;
  41
  42 ## External batteries.
  43 use File::FcntlLock;
  44
  45 ###--------------------------------------------------------------------------
  46 ### Configuration variables.
  47
  48 ## The global configuration.
  49 my %C = (
  50   "rundir" => undef
  51 );
  52
  53 ## The per-server configuration.
  54 my %S;
  55 my %SPARAM = map { $_ => 1 }
  56   "local", "nntpauth", "remote", "sshbind", "via";
  57
  58 ## Various facts we might discover.
  59 my $HOME = $ENV{"HOME"};
  60 (my $PROG = $0) =~ s:^.*/::;
  61 my $VERBOSE = 0;
  62 my $CONF = undef;
  63 my $TAG = undef;
  64 my $RUNDIR = undef;
  65
  66 ## Other bits of useful state.
  67 my @CLEANUP = ();
  68 my $SESSDIR = undef;
  69 my %SERVMAP = ();
  70 my %CLIENT_NOIP = ();
  71 my %KIDMAP = ();
  72 my $CLIENTKID = -1;
  73
  74 ###--------------------------------------------------------------------------
  75 ### Utilities.
  76
  77 my $BAD = 0;
  78
  79 sub moan ($) {
  80   my ($msg) = @_;
  81   print STDERR "$PROG: $msg\n";
  82 }
  83
  84 sub fail ($;$) {
  85   my ($msg, $rc) = @_;
  86   moan $msg;
  87   exit ($rc // 1);
  88 }
  89
  90 sub sysfail ($) {
  91   my ($msg) = @_;
  92   fail $msg, 16;
  93 }
  94
  95 sub bad ($) {
  96   my ($msg) = @_;
  97   moan $msg;
  98   $BAD = 1;
  99 }
 100
 101 sub inform ($) {
 102   my ($msg) = @_;
 103   print STDERR "$PROG: ;; $msg\n" if $VERBOSE;
 104 }
 105
 106 sub trim ($) {
 107   my ($s) = @_;
 108   $s =~ s/^\s+//;
 109   $s =~ s/\s+$//;
 110   return $s;
 111 }
 112
 113 sub ensure_home () {
 114   defined $HOME or fail "no home directory set";
 115   return $HOME;
 116 }
 117
 118 sub ensure_dir_exists ($$) {
 119   my ($dir, $mode) = @_;
 120   mkdir $dir, $mode or $! == EEXIST or
 121     sysfail "failed to create directory `$dir': $!";
 122 }
 123
 124 sub zap ($);
 125 sub 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
 145 sub 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
 152 sub 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
 159 sub 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
 166 sub 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
 176 my $INKIDP = 0;
 177 sub myfork () {
 178   my $kid = fork;
 179   if (defined $kid && !$kid) { $INKIDP = 1; }
 180   return $kid;
 181 }
 182
 183 my $SEQ = 0;
 184 sub sequence () { return $SEQ++; }
 185
 186 ###--------------------------------------------------------------------------
 187 ### Setting up the configuration.
 188
 189 sub set_global_param ($$) {
 190   my ($param, $value) = @_;
 191   exists $C{$param} or fail "unknown global parameter `$param'";
 192   $C{$param} = $value;
 193 }
 194
 195 sub notice_server ($$) {
 196   my ($server, $where) = @_;
 197   inform "found server `$server' $where";
 198   $S{$server} //= {};
 199 }
 200
 201 sub 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
 208 sub chew_cli_server_configs (\@) {
 209   my ($args) = @_;
 210   my $server = undef;
 211
 212   ARG: for (;;) {
 213     last ARG unless @$args;
 214     my $arg = shift @$args;
 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
 226 sub 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
 283 sub format_value ($);
 284 sub 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
 301 sub inform_param ($$) {
 302   my ($param, $value) = @_;
 303   inform "  $param = " . format_value $value;
 304 }
 305
 306 sub 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...";
 312     for my $p (sort keys %{$S{$s}}) { inform_param $p, $S{$s}{$p}; }
 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.
 322 my $BIRTHTIME = 300;
 323
 324 sub 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
 382 sub 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
 404 sub 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
 489 sub 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
 523 END {
 524   zap junk_rundir_thing $SESSDIR, "cleanup on exit"
 525     if !$INKIDP && defined $SESSDIR;
 526 }
 527
 528 ###--------------------------------------------------------------------------
 529 ### Setting up a session.
 530
 531 sub 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
 544 sub format_address ($$) {
 545   my ($host, $port) = @_;
 546   $host =~ /:/ and $host = "[$host]";
 547   return "$host:$port";
 548 }
 549
 550 sub canonify_address ($;$) {
 551   my ($addr, $defport) = @_;
 552   my ($host, $port) = parse_address $addr, $defport;
 553   return format_address $host, $port;
 554 }
 555
 556 sub 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
 577 sub resolve_address ($;$) {
 578   my ($addr, $defport) = @_;
 579   my ($host, $port) = parse_address $addr, $defport;
 580   return resolve_parsed_address $host, $port;
 581 }
 582
 583 sub 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"};
 606   $s->{"_proxy_server"} =~ s/:119$//;
 607   $s->{"_proxy_server"} =~ s/^\[(.*)\]$/$1/;
 608   $s->{"_sshkid"} = undef;
 609   $s->{"_ssh_stdin"} = undef;
 610   $s->{"_ssh_stdout"} = undef;
 611 }
 612
 613 sub hack_noip_envvar ($$) {
 614   my ($var, $val) = @_;
 615   inform "  hack env for noip: $var = `$val'";
 616   $ENV{$var} = $val;
 617 }
 618
 619 sub 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
 636 sub 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: $!";
 645     set_cloexec $sk; set_nonblock $sk;
 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
 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
 672     ## debugging.  The `-S' detaches OpenSSH from any control master things
 673     ## which might be going on, because they tend to interfere with
 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.
 678     inform "  starting SSH tunnel";
 679     my @sshargs = ("ssh", "-L$sshbind:$remote", "-Snone");
 680     $VERBOSE and push @sshargs, "-v";
 681     push @sshargs, $via, <<EOF;
 682 ## with-authinfo-kludge tunnel: $TAG -> $server
 683 set -e; echo started; read hunoz
 684 EOF
 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;
 689     defined (my $kid = myfork) or sysfail "failed to fork: $!";
 690     if (!$kid) {
 691       open STDIN, "<&", $rin or sysfail "failed to dup pipe to stdin: $!";
 692       open STDOUT, "<&", $wout or sysfail "failed to dup pipe to stdout: $!";
 693       hack_noip_env \%ssh_noip, $sockdir;
 694       exec @sshargs or sysfail "failed to exec SSH: $!";
 695     }
 696     close $rin;
 697     close $wout;
 698     $s->{"_sshkid"} = $kid;
 699     $s->{"_ssh_stdin"} = $win;
 700     $s->{"_ssh_stdout"} = $rout;
 701     $KIDMAP{$kid} = [$s, "SSH tunnel"];
 702     write_to_file "$SESSDIR/ssh-$server.pid", "$kid\n";
 703   }
 704 }
 705
 706 sub wait_for_ssh () {
 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.
 725   inform "waiting for SSH tunnels to start...";
 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: $!";
 743       }
 744     }
 745   }
 746   if ($nbad) { inform "  tunnels started; $nbad FAILED"; }
 747   else { inform "  all tunnels started ok"; }
 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
 781 sub 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;
 792   write_to_file "$SESSDIR/client.pid", "$kid\n";
 793 }
 794
 795 sub accept_loop () {
 796   my $rfd_in = "";
 797   for my $fd (keys %SERVMAP) { vec($rfd_in, $fd, 1) = 1; }
 798   SELECT: for (;;) {
 799     my ($n, $t) = select my $rfd_out = $rfd_in, undef, undef, undef;
 800     if ($n >= 0) { }
 801     elsif ($! == EINTR) { next SELECT; }
 802     else {  sysfail "select failed: $!"; }
 803     FD: for my $fd (keys %SERVMAP) {
 804       next FD unless vec $rfd_out, $fd, 1;
 805       my ($s, $a, $sk) = @{$SERVMAP{$fd}};
 806       my $nsk;
 807       unless (accept $nsk, $sk) {
 808         moan "failed to accept new connection: $!"
 809           unless $! == EAGAIN || $! == EWOULDBLOCK;
 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
 834 sub version (\*) {
 835   my ($fh) = @_;
 836   print $fh "$PROG, version $VERSION\n";
 837 }
 838
 839 sub usage (\*) {
 840   my ($fh) = @_;
 841   print $fh <<EOF;
 842 usage: $PROG [-v] [-d DIR] [-f CONF] [-t TAG]
 843         [ [+SERVER] [PARAM=VALUE ...] ...] [+]
 844         COMMAND [ARGS ...]
 845 EOF
 846 }
 847
 848 sub help () {
 849   version *STDOUT;
 850   print "\n";
 851   usage *STDOUT;
 852   print <<EOF;
 853
 854 Command-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
 861 Server 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
 868 See the manual page for full details.
 869 EOF
 870 }
 871
 872 sub 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
 901 main;
 902
 903 ###----- That's all, folks --------------------------------------------------