+#! /usr/bin/perl -w
+###
+### Adverbial modifier conferring AUTHINFO GENERIC support on NNTP clients
+###
+### (c) 2016 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This program is free software; you can redistribute it and/or modify
+### it under the terms of the GNU General Public License as published by
+### the Free Software Foundation; either version 2 of the License, or
+### (at your option) any later version.
+###
+### This program is distributed in the hope that it will be useful,
+### but WITHOUT ANY WARRANTY; without even the implied warranty of
+### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+### GNU General Public License for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with this program; if not, write to the Free Software Foundation,
+### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+## things to do
+##
+## split parsing and resolution of addresses
+## default port
+## pidfiles
+
+my $VERSION = "0.1.0~unfinished";
+
+use strict;
+
+###--------------------------------------------------------------------------
+### External modules.
+
+## Included batteries.
+use Fcntl qw(:mode);
+use File::stat;
+use Getopt::Long qw(:config gnu_compat bundling
+ require_order no_getopt_compat);
+use POSIX qw(:errno_h :fcntl_h :sys_wait_h);
+use Socket qw(/^[AP]F_/ /^SOCK_/ /^sockaddr_/
+ getaddrinfo /^AI_/ /^EAI_/
+ getnameinfo /^NI_/);
+use Sys::Hostname;
+
+## External batteries.
+use File::FcntlLock;
+
+###--------------------------------------------------------------------------
+### Configuration variables.
+
+## The global configuration.
+my %C = (
+ "rundir" => undef
+);
+
+## The per-server configuration.
+my %S;
+my %SPARAM = map { $_ => 1 }
+ "local", "nntpauth", "remote", "sshbind", "via";
+
+## Various facts we might discover.
+my $HOME = $ENV{"HOME"};
+(my $PROG = $0) =~ s:^.*/::;
+my $VERBOSE = 0;
+my $CONF = undef;
+my $TAG = undef;
+my $RUNDIR = undef;
+
+## Other bits of useful state.
+my @CLEANUP = ();
+my $SESSDIR = undef;
+my %SERVMAP = ();
+my %CLIENT_NOIP = ();
+my %KIDMAP = ();
+my $CLIENTKID = undef;
+
+###--------------------------------------------------------------------------
+### Utilities.
+
+my $BAD = 0;
+
+sub moan ($) {
+ my ($msg) = @_;
+ print STDERR "$PROG: $msg\n";
+}
+
+sub fail ($;$) {
+ my ($msg, $rc) = @_;
+ moan $msg;
+ exit ($rc // 1);
+}
+
+sub sysfail ($) {
+ my ($msg) = @_;
+ fail $msg, 16;
+}
+
+sub bad ($) {
+ my ($msg) = @_;
+ moan $msg;
+ $BAD = 1;
+}
+
+sub inform ($) {
+ my ($msg) = @_;
+ print STDERR "$PROG: ;; $msg\n" if $VERBOSE;
+}
+
+sub trim ($) {
+ my ($s) = @_;
+ $s =~ s/^\s+//;
+ $s =~ s/\s+$//;
+ return $s;
+}
+
+sub ensure_home () {
+ defined $HOME or fail "no home directory set";
+ return $HOME;
+}
+
+sub ensure_dir_exists ($$) {
+ my ($dir, $mode) = @_;
+ mkdir $dir, $mode or $! == EEXIST or
+ sysfail "failed to create directory `$dir': $!";
+}
+
+sub zap ($);
+sub zap ($) {
+ my ($f) = @_;
+ if (-d $f) {
+ my $d;
+ unless (opendir $d, $f) {
+ moan "failed to open directory `$d': $!";
+ return;
+ }
+ ENTRY: for (;;) {
+ defined (my $b = readdir $d) or last ENTRY;
+ next ENTRY if grep { $b eq $_ } ".", "..";
+ zap "$f/$b";
+ }
+ closedir $d;
+ rmdir $f or $! == ENOENT or moan "failed to zap directory `$f': $!";
+ } else {
+ unlink $f or $! == ENOENT or moan "failed to zap file thing `$f': $!";
+ }
+}
+
+sub set_cloexec ($) {
+ my ($fh) = @_;
+ my $f = fcntl $fh, F_GETFD, 0 or sysfail "failed to get per-fd flags: $!";
+ fcntl $fh, F_SETFD, $f | FD_CLOEXEC or
+ sysfail "failed to set close-on-exec: $!";
+}
+
+sub lockedp ($) {
+ my ($f) = @_;
+ my $l = new File::FcntlLock;
+ $l->lock($f, F_GETLK) or sysfail "couldn't read locking for `$f': $!";
+ return $l->l_type != F_UNLCK;
+}
+
+my $INKIDP = 0;
+sub myfork () {
+ my $kid = fork;
+ if (defined $kid && !$kid) { $INKIDP = 1; }
+ return $kid;
+}
+
+my $SEQ = 0;
+sub sequence () { return $SEQ++; }
+
+###--------------------------------------------------------------------------
+### Setting up the configuration.
+
+sub set_global_param ($$) {
+ my ($param, $value) = @_;
+ exists $C{$param} or fail "unknown global parameter `$param'";
+ $C{$param} = $value;
+}
+
+sub notice_server ($$) {
+ my ($server, $where) = @_;
+ inform "found server `$server' $where";
+ $S{$server} //= {};
+}
+
+sub set_server_param ($$$) {
+ my ($server, $param, $value) = @_;
+ $S{$server} or bad "unknown server `$param'";
+ $SPARAM{$param} or bad "unknown server parameter `$param'";
+ $S{$server}{$param} = $value;
+}
+
+sub chew_cli_server_configs (\@) {
+ my ($args) = @_;
+ my $server = undef;
+
+ ARG: for (;;) {
+ last ARG unless @$args;
+ my $arg = shift $args;
+ if ($arg eq "+") { last ARG; }
+ elsif ($arg =~ /^\+/) {
+ $server = substr $arg, 1;
+ notice_server $server, "on command line";
+ }
+ elsif (!defined $server or $arg !~ /^([^=]+)=(.*)$/)
+ { unshift @$args, $arg; last ARG; }
+ else { set_server_param $server, $1, $2; }
+ }
+}
+
+sub parse_config_file () {
+
+ ## If we already know what we're doing then forbid a configuration file as
+ ## well.
+ if (%S) {
+ return unless defined $CONF;
+ fail "servers defined on command-line; won't read config file too";
+ }
+
+ ## Search about to find a suitable configuration file.
+ my $cf;
+ my @confpath =
+ ($ENV{"XDG_CONFIG_HOME"} // ensure_home . "/.config",
+ split /:/, $ENV{"XDG_CONFIG_DIRS"} // "/etc/xdg");
+ inform "searching for a configuration file with tag `$TAG'...";
+ PATH: for my $dir (@confpath) {
+ for my $base ($TAG, "\@default") {
+ my $f = "$dir/with-authinfo-kludge/$base.conf";
+ if (open $cf, "<", $f) {
+ inform " found `$f'; search over";
+ $CONF = $f; last PATH;
+ } elsif ($! != ENOENT) {
+ bad "couldn't open `$f' for reading: $!";
+ } else {
+ inform " `$f' not found; search continues";
+ }
+ }
+ }
+
+ ## If we still don't have a configuration file then synthesize one from the
+ ## `$NNTPSERVER' variable.
+ unless ($CONF) {
+ my $server = $ENV{"NNTPSERVER"};
+ defined $server or fail "no `NNTPSERVER' defined in the environment";
+ inform "no config file found; synthesizing default";
+ notice_server $server, "in environment";
+ return;
+ }
+
+ ## Work through the configuration file setting up servers.
+ my $set_param = \&set_global_param;
+ while (<$cf>) {
+ next if /^\s*([#;]|$)/;
+ if (/^\s*\[(.+)\]\s*$/) {
+ my $head = trim $1;
+ if ($head eq "\@GLOBAL") { $set_param = \&set_global_param; }
+ else {
+ notice_server $head, "in config file";
+ $set_param = sub { set_server_param $head, $_[0], $_[1]; };
+ }
+ } elsif (/^([^=]+)=(.*)$/) { $set_param->(trim $1, trim $2); }
+ else { bad "$CONF:$.: couldn't parse configuration file line"; }
+ }
+ (!$cf->error and close $cf)
+ or sysfail "error reading configuration file `$CONF': $!";
+}
+
+sub format_value ($);
+sub format_value ($) {
+ my ($value) = @_;
+ if (!defined $value) { return "<undef>"; }
+ elsif (my $r = ref $value) {
+ if ($r eq "ARRAY") {
+ return "[" . join(", ", map { format_value $_ } @$value) . "]";
+ } elsif ($r eq "HASH") {
+ return "{ " .
+ join(", ", map { format_value $_ . " => " .
+ format_value $value->{$_} } sort keys %$value) .
+ " }";
+ } else {
+ return "<$r ref>";
+ }
+ } else { return "`$value'"; }
+}
+
+sub inform_param ($$) {
+ my ($param, $value) = @_;
+ inform " $param = " . format_value $value;
+}
+
+sub dump_configuration () {
+ inform "Global parameters...";
+ for my $p (sort keys %C) { inform_param $p, $C{$p}; }
+
+ for my $s (sort keys %S) {
+ inform "Server `$s' parameters...";
+ for my $p (sort keys $S{$s}) { inform_param $p, $S{$s}{$p}; }
+ }
+}
+
+###--------------------------------------------------------------------------
+### Managing the runtime directory.
+###
+### Truly told, this bit is probably the trickiest part of the program.
+
+## How long we allow for a new server directory to be set up.
+my $BIRTHTIME = 300;
+
+sub find_rundir () {
+
+ ## Maybe we've done all of this already.
+ defined $RUNDIR and return;
+
+ ## Find a suitable place to put things.
+ SEARCH: {
+ inform "searching for a suitable runtime directory...";
+
+ ## Maybe the user's configured a directory explicitly. (Maybe we still
+ ## have to arrange for this to exist.)
+ if (defined ($RUNDIR = $C{"rundir"})) {
+ inform "using runtime directory from configuration";
+ last SEARCH;
+ }
+
+ ## First attempt: use `$XDG_RUNTIME_DIR'.
+ if (defined (my $runhome = $ENV{"XDG_RUNTIME_DIR"})) {
+ inform "setting runtime directory from `XDG_RUNTIME_DIR'";
+ $RUNDIR = "$runhome/with-authinfo-kludge";
+ last SEARCH;
+ }
+
+ ## Second attempt: let's use /tmp, or whatever `$TMPDIR' is set.
+ my $tmpdir = $ENV{"TMPDIR"} // "/tmp";
+ inform "investigating putting runtime directory under tmpdir `$tmpdir'";
+ my $dir = "$tmpdir/with-authinfo-kludge-$>";
+ my $st = lstat $dir;
+ if (!$st && $! == ENOENT) {
+ mkdir $dir, 0700 or sysfail "failed to create directory `$dir': $!";
+ $st = lstat $dir;
+ inform "created `$dir'";
+ }
+ if (!-d $st) { inform "alas, `$dir' isn't a directory"; }
+ elsif ($st->uid != $>) { inform "alas, we don't own `$dir'"; }
+ elsif ($st->mode & 0077) { inform "alas, `$dir' has liberal perms"; }
+ else {
+ inform "accepting `$dir' as runtime directory";
+ $RUNDIR = $dir;
+ last SEARCH;
+ }
+
+ ## Third attempt: we'll use the XDG cache directory.
+ my $cachehome = $ENV{"XDG_CACHE_HOME"} // ensure_home . "/.cache";
+ ensure_dir_exists $cachehome, 0777;
+ my $host = hostname;
+ $RUNDIR = "$cachehome/with-authinfo-kludge.$host";
+ inform "last ditch: using `$RUNDIR' as runtime directory";
+ }
+
+ ## Make the runtime directory if it doesn't exist. Be paranoid here; users
+ ## can override if they really want. (Note that noip(1) is untweakably
+ ## picky about its socket directories, so this is less generous than it
+ ## looks.)
+ ensure_dir_exists $RUNDIR, 0700;
+ for my $d ("junk", "new") { ensure_dir_exists "$RUNDIR/$d", 0777; }
+}
+
+sub junk_rundir_thing ($$) {
+ my ($f, $what) = @_;
+ inform "junking $what `$f'";
+
+ ## Find a name to rename it to under the `junk' directory. Anyone can put
+ ## things in the `junk' directory, and anyone is allowed to delete them;
+ ## the only tricky bit is making sure the names don't collide.
+ my $junk;
+ NAME: for (;;) {
+ my $r = int rand 1000000;
+ $junk = "$RUNDIR/junk/j.$r";
+
+ ## It'll be OK if this fails because someone else has junked the file (in
+ ## which case we end happy), or if the target exists (in which case we
+ ## pick another and try again).
+ if (rename $f, $junk or ($! == ENOENT && !-e $f)) { last NAME; }
+ elsif ($! != EEXIST) { sysfail "couldn't rename `$f' to `$junk': $!"; }
+ }
+
+ return $junk;
+}
+
+sub clean_up_rundir () {
+ inform "cleaning up stale things from runtime directory";
+
+ ## Work through the things in the directory, making sure they're meant to
+ ## be there.
+ opendir my $dh, $RUNDIR or
+ sysfail "failed to open directory `$RUNDIR': $!";
+ ENTRY: for (;;) {
+ defined (my $base = readdir $dh) or last ENTRY;
+ next ENTRY if grep { $base eq $_ } ".", "..";
+ my $f = "$RUNDIR/$base";
+
+ ## If this thing isn't a directory then it shouldn't be there. Maybe a
+ ## later version of us put it there.
+ unless (-d $f) {
+ inform "found unexpected thing `$f' in runtime directory";
+ next ENTRY;
+ }
+
+ ## Maybe it's a standard thing that's meant to be here. We'll clean
+ ## those up later.
+ next ENTRY if grep { $base eq $_ } "junk", "new";
+
+ ## If the name doesn't have a `.' in it, then it's some other special
+ ## thing which we don't understand.
+ if ($base !~ /^s.*\.\d+/) {
+ inform "found unexpected special directory `$f' in runtime directory";
+ next ENTRY;
+ }
+
+ ## Otherwise, it's a session directory. If its lockfile isn't locked
+ ## then it's fair game.
+ my $lk = "$f/lock";
+ if (open my $fh, "<", $lk) {
+ my $ownedp = lockedp $fh;
+ close $fh or sysfail "couldn't close file, what's up with that?: $!";
+ if (!$ownedp) { junk_rundir_thing $f, "stale session dir"; }
+ } elsif ($! == ENOENT) {
+ junk_rundir_thing $f, "session dir without `lock' file";
+ } else {
+ moan "couldn't open `$lk' (found in runtime dir) for reading: $!";
+ inform "leaving `$f' alone";
+ }
+ }
+ closedir $dh;
+
+ ## Work through the things in the `new' directory.
+ my $thresh = time - $BIRTHTIME;
+ my $newdir = "$RUNDIR/new";
+ opendir $dh, $newdir or
+ sysfail "failed to open directory `$newdir': $!";
+ NEW: for (;;) {
+ defined (my $base = readdir $dh) or last NEW;
+ next NEW if grep { $base eq $_ } ".", "..";
+ my $f = "$newdir/$base";
+ unless (-d $f) {
+ inform "found unexepected nondirectory thing `$f' in nursery";
+ next NEW;
+ }
+ if ($base !~ /^n\.(\d+)\./) {
+ inform "found directory with unexpected name `$f' in nursery";
+ next NEW;
+ }
+ my $stamp = $1;
+ $stamp >= $thresh or junk_rundir_thing $f, "stillborn session directory";
+ }
+ closedir $dh;
+
+ ## Work through the things in the `junk' directory. Anyone can put things
+ ## in the `junk' directory, and anyone is allowed to delete them.
+ ## Therefore we can just zap everything in here. The `zap' function is
+ ## (somewhat) careful not to screw up if someone else is also zapping the
+ ## same thing.
+ my $junkdir = "$RUNDIR/junk";
+ opendir $dh, $junkdir or
+ sysfail "failed to open directory `$junkdir': $!";
+ NEW: for (;;) {
+ defined (my $base = readdir $dh) or last NEW;
+ next NEW if grep { $base eq $_ } ".", "..";
+ my $f = "$junkdir/$base";
+ zap $f;
+ }
+ closedir $dh;
+}
+
+sub make_session_dir () {
+ inform "making session directory for `$TAG'";
+
+ ## Make a new directory in the nursery. Only the creator of a nursery
+ ## directory is allowed to put things in it.
+ my $newdir = "$RUNDIR/new";
+ my $n;
+ NAME: for (;;) {
+ my $now = time;
+ my $r = int rand 1000000;
+ $n = "$newdir/n.$now.$$.$r";
+ if (mkdir $n, 0777) { last NAME; }
+ elsif ($! != EEXIST) { sysfail "failed to create `$n': $!"; }
+ }
+
+ ## Create the lockfile, and take out a lock.
+ open my $fh, ">", "$n/lock";
+ set_cloexec $fh;
+ my $l = File::FcntlLock->new(l_type => F_WRLCK,
+ l_whence => SEEK_SET,
+ l_start => 0,
+ l_len => 0);
+ $l->lock($fh, F_SETLK) or sysfail "failed to lock `$n/lock: $!";
+
+ ## Rename the directory into its proper place. We have already cleaned out
+ ## stale directories, and the target name has our PID in it, so it can't
+ ## exist any more unless something unfortunate has happened.
+ $SESSDIR = "$RUNDIR/s.$TAG.$$";
+ rename $n, $SESSDIR or sysfail "failed to rename `$n' to `$SESSDIR': $!";
+
+ ## Create some necessary things.
+ ensure_dir_exists "$SESSDIR/noip-client", 0700;
+}
+
+END {
+ zap junk_rundir_thing $SESSDIR, "cleanup on exit"
+ if !$INKIDP && defined $SESSDIR;
+}
+
+###--------------------------------------------------------------------------
+### Setting up a session.
+
+sub parse_address ($;$) {
+ my ($addr, $defport) = @_;
+ inform "parsing address `$addr'...";
+
+ my ($host, $port);
+ if ($addr =~ /^\[([^]]*)\]:(\d+)$/ || $addr =~ /^([^:]+):(\d+)$/)
+ { $host = $1; $port = $2; }
+ elsif (defined $defport) { $host = $addr; $port = $defport; }
+ else { fail "invalid address `$addr': missing port number"; }
+ inform " host = `$host'; port = $port";
+ return ($host, $port);
+}
+
+sub format_address ($$) {
+ my ($host, $port) = @_;
+ $host =~ /:/ and $host = "[$host]";
+ return "$host:$port";
+}
+
+sub canonify_address ($;$) {
+ my ($addr, $defport) = @_;
+ my ($host, $port) = parse_address $addr, $defport;
+ return format_address $host, $port;
+}
+
+sub resolve_parsed_address ($$) {
+ my ($host, $port) = @_;
+ inform "resolving host `$host', port $port";
+
+ my ($err, @a) = getaddrinfo $host, $port, { flags => AI_NUMERICSERV };
+ $err and fail "failed to resolve `$host': $err";
+
+ my @res;
+ my %seen;
+ for my $a (@a) {
+ ($err, $host, $port) =
+ getnameinfo $a->{addr}, NI_NUMERICHOST | NI_NUMERICSERV;
+ $err and sysfail "unexpectedly failed to convert addr to text: $err";
+ inform " resolved to $host $port";
+ my $r = format_address $host, $port;
+ unless ($seen{$r}) { push @res, $r; $seen{$r} = 1; }
+ }
+
+ return @res;
+}
+
+sub resolve_address ($;$) {
+ my ($addr, $defport) = @_;
+ my ($host, $port) = parse_address $addr, $defport;
+ return resolve_parsed_address $host, $port;
+}
+
+sub fix_server_config ($) {
+ my ($server) = @_;
+ my $s = $S{$server};
+
+ ## Keep the name. This is useful for diagnostics, but it's also important
+ ## for finding the right socket directory if we're doing SSH forwarding.
+ $s->{"_name"} = $server;
+
+ ## Sort out the various addresses.
+ my ($host, $port);
+ ($host, $port) = parse_address($s->{"local"} // $server, 119);
+ $s->{"local"} = format_address $host, $port;
+ $s->{"_laddrs"} = [resolve_parsed_address $host, $port];
+ $s->{"remote"} = canonify_address($s->{"remote"} // $server, 119);
+ ($host, $port) = parse_address($s->{"sshbind"} // "127.1.0.1", 1119);
+ $s->{"sshbind"} = format_address $host, $port;
+ $s->{"_sshaddrs"} = [resolve_parsed_address $host, $port];
+
+ ## Initialize other settings.
+ $s->{"_proxy_noip"} = undef;
+ $s->{"_proxy_sockdir"} = undef;
+ $s->{"_proxy_server"} = defined $s->{"via"} ?
+ $s->{"sshbind"} : $s->{"remote"};
+ $s->{"_sshkid"} = undef;
+ $s->{"_ssh_master"} = undef;
+}
+
+sub hack_noip_envvar ($$) {
+ my ($var, $val) = @_;
+ inform " hack env for noip: $var = `$val'";
+ $ENV{$var} = $val;
+}
+
+sub hack_noip_env ($$) {
+ my ($vars, $dir) = @_;
+ return unless $vars;
+
+ hack_noip_envvar "LD_PRELOAD",
+ "noip.so" .
+ (exists $ENV{"LD_PRELOAD"} ? ":" . $ENV{"LD_PRELOAD"} : "");
+ for my $k (keys %ENV) { delete $ENV{$k} if $k =~ /^NOIP_/; }
+ hack_noip_envvar "NOIP_CONFIG", "$RUNDIR/noip.conf.notexist";
+ hack_noip_envvar "NOIP_SOCKETDIR", $dir;
+ hack_noip_envvar "NOIP_DEBUG", $VERBOSE;
+ for my $acl ("REALBIND", "REALCONNECT") {
+ hack_noip_envvar "NOIP_$acl",
+ join ",", @{$vars->{$acl} // []}, "+any";
+ }
+}
+
+sub server_listen ($) {
+ my ($server) = @_;
+ my $s = $S{$server};
+
+ ## Set up the listening sockets for this server's addresses.
+ inform "set up sockets for `$server'";
+ for my $a (@{$s->{"_laddrs"}}) {
+ socket my $sk, PF_UNIX, SOCK_STREAM, 0
+ or sysfail "failed to make Unix-domain socket: $!";
+ set_cloexec $sk;
+ my $sa = "$SESSDIR/noip-client/$a";
+ bind $sk, sockaddr_un $sa
+ or sysfail "failed to bind Unix-domain socket to `$sa': $!";
+ listen $sk, 5 or sysfail "failed to listen on Unix-domain socket: $!";
+ $SERVMAP{fileno $sk} = [$s, $a, $sk];
+ inform " listening on $a";
+ push @{$CLIENT_NOIP{"REALCONNECT"}}, "-$a";
+ }
+
+ ## If we're forwarding via SSH then set that up too.
+ if (defined (my $via = $s->{"via"})) {
+ inform "set up SSH tunnel to `$server' via $via...";
+ my %ssh_noip = ();
+ my $sockdir = "$SESSDIR/noip-ssh.$server";
+ ensure_dir_exists $sockdir, 0700;
+ my $sshbind = $s->{"sshbind"};
+ my $remote = $s->{"remote"};
+ for my $a (@{$s->{"_sshaddrs"}}) {
+ push @{$ssh_noip{"REALBIND"}}, "-$a";
+ inform " listening on $a";
+ push @{$s->{"_proxy_noip"}{"REALCONNECT"}}, "-$a";
+ }
+ $s->{"_proxy_sockdir"} = $sockdir;
+
+ ## This is quite awful. The `-L' option sets up the tunnel that we
+ ## actually wanted. The `-v' makes SSH spew stuff to stdout, which might
+ ## be useful if you're debugging. The `-S' has two effects: firstly, it
+ ## detaches OpenSSH from any other control master things which might be
+ ## going on, because they tend to interfere with forwarding (and,
+ ## besides, the existing master won't be under the same noip
+ ## configuration); and, secondly, it causes OpenSSH to make a socket in a
+ ## place we know, so we can tell when it's actually ready. The `cat'
+ ## will keep the tunnel open until we close our end, which we don't do
+ ## until we exit.
+ inform " starting SSH tunnel";
+ my @sshargs = ("ssh", "-L$sshbind:$remote");
+ $VERBOSE and push @sshargs, "-v";
+ my $master = "$SESSDIR/ssh-master." . sequence;
+ push @sshargs, "-S$master", "-M";
+ $s->{"_ssh_master"} = $master;
+ push @sshargs, $via, "cat";
+ pipe my $rfd, my $wfd or sysfail "failed to create pipe: $!";
+ set_cloexec $wfd;
+ defined (my $kid = myfork) or sysfail "failed to fork: $!";
+ if (!$kid) {
+ open STDIN, "<&", $rfd or sysfail "failed to dup pipe to stdin: $!";
+ open STDOUT, ">", "/dev/null"
+ or sysfail "failed to redirect stdout to /dev/null: $!";
+ hack_noip_env \%ssh_noip, $sockdir;
+ exec @sshargs or sysfail "failed to exec SSH: $!";
+ }
+ close $rfd;
+ $s->{"_sshkid"} = $kid;
+ $s->{"_ssh_pipe"} = $wfd;
+ $KIDMAP{$kid} = [$s, "SSH tunnel"];
+ }
+}
+
+sub wait_for_ssh () {
+ inform "waiting for SSH tunnels to start...";
+ my $delay = 0.1;
+ my $max = 10;
+ my $mult = 1.3;
+
+ WAIT: for (;;) {
+ my $missing = 0;
+ KID: for my $kid (keys %KIDMAP) {
+ my ($s, $what) = @{$KIDMAP{$kid}};
+ next KID unless $kid == $s->{"_sshkid"};
+ if (-S $s->{"_ssh_master"}) {
+ inform " found socket from `$s->{_name}'";
+ } else {
+ inform " no socket yet from `$s->{_name}'";
+ $missing = 1;
+ }
+ }
+ unless ($missing) {
+ inform " all present and correct!";
+ last WAIT;
+ }
+ if ($delay > $max) {
+ inform " bored now; giving up";
+ last WAIT;
+ }
+ inform "waiting ${delay}s for stuff to happen...";
+ select undef, undef, undef, $delay;
+ $delay *= $mult;
+ }
+}
+
+$SIG{"CHLD"} = sub {
+ KID: for (;;) {
+ defined (my $kid = waitpid -1, WNOHANG)
+ or sysfail "failed to reap child: $!";
+ last KID if $kid <= 0;
+ my ($how, $rc);
+ if ($? == 0) {
+ $how = "exited successfully";
+ $rc = 0;
+ } elsif ($? & 0xff) {
+ my $sig = $? & 0x7f;
+ $how = "killed by signal $sig";
+ $how .= " (core dumped)" if $? & 0x80;
+ $rc = $sig | 0x80;
+ } else {
+ $rc = $? >> 8;
+ $how = "exited with status $rc";
+ }
+ if ($kid == $CLIENTKID) {
+ inform "client kid $how; shutting down";
+ exit $rc;
+ } elsif (exists $KIDMAP{$kid}) {
+ my ($s, $what) = @{$KIDMAP{$kid}};
+ inform "$what for server `$s->{_name}' collapsed ($how)";
+ delete $KIDMAP{$kid};
+ } else {
+ inform "unrecognized child $kid $how";
+ }
+ }
+};
+
+sub run_client (@) {
+ my (@args) = @_;
+
+ inform "starting client";
+ defined (my $kid = myfork) or sysfail "failed to fork: $!";
+ if (!$kid) {
+ hack_noip_env \%CLIENT_NOIP, "$SESSDIR/noip-client";
+ my $prog = $args[0];
+ exec @args or sysfail "failed to exec `$prog': $!";
+ }
+ $CLIENTKID = $kid;
+}
+
+sub accept_loop () {
+ my $rfd_in = "";
+ for my $fd (keys %SERVMAP) { vec($rfd_in, $fd, 1) = 1; }
+ for (;;) {
+ my ($n, $t) = select my $rfd_out = $rfd_in, undef, undef, undef;
+ $n >= 0 || $! == EINTR or sysfail "select failed: $!";
+ FD: for my $fd (keys %SERVMAP) {
+ next unless vec $rfd_out, $fd, 1;
+ my ($s, $a, $sk) = @{$SERVMAP{$fd}};
+ my $nsk;
+ unless (accept $nsk, $sk) {
+ moan "failed to accept new connection: $!";
+ next FD;
+ }
+ set_cloexec $nsk;
+ inform "incoming connection `$s->{_name}' to $a; starting proxy...";
+ defined (my $kid = myfork) or sysfail "failed to fork: $!";
+ if (!$kid) {
+ $ENV{"NNTPAUTH"} = $s->{"nntpauth"} if exists $s->{"nntpauth"};
+ hack_noip_env $s->{"_proxy_noip"}, $s->{"_proxy_sockdir"};
+ open STDIN, "<&", $nsk
+ or sysfail "failed to dup socket to kid stdin: $!";
+ open STDOUT, ">&", $nsk
+ or sysfail "failed to dup socket to kid stdin: $!";
+ inform "running proxy to `$s->{_proxy_server}'";
+ exec "authinfo-kludge", $s->{"_proxy_server"}
+ or sysfail "failed to exec `authinfo-kludge': $!";
+ }
+ $KIDMAP{$kid} = [$s, "proxy"];
+ }
+ }
+}
+
+###--------------------------------------------------------------------------
+### Main program.
+
+sub version (\*) {
+ my ($fh) = @_;
+ print $fh "$PROG, version $VERSION\n";
+}
+
+sub usage (\*) {
+ my ($fh) = @_;
+ print $fh <<EOF;
+usage: $PROG [-v] [-d DIR] [-f CONF] [-t TAG]
+ [ [+SERVER] [PARAM=VALUE ...] ...] [+]
+ COMMAND [ARGS ...]
+EOF
+}
+
+sub help () {
+ version *STDOUT;
+ print "\n";
+ usage *STDOUT;
+ print <<EOF;
+
+Command-line options:
+ -h, --help Show this help text.
+ -d, --rundir=DIR Use DIR to store runtime state.
+ -f, --config=FILE Read configuration from FILE.
+ -t, --tag=TAG Use TAG to identify this session.
+ -v, --verbose Emit running commentary to stderr.
+
+Server parameter summary:
+ local=ADDRESS Listen on ADDRESS for client connections.
+ nntpauth=AUTH-METHOD Set authentication method and arguments.
+ remote=ADDRESS Connect to server at ADDRESS.
+ sshbind=ADDRESS Use ADDRESS for local SSH tunnel endpoint.
+ via=SSH-HOST Use SSH to connect to remote server.
+
+See the manual page for full details.
+EOF
+}
+
+sub main () {
+ GetOptions
+ "h|help" => sub { help; exit 0; },
+ "version" => sub { version *STDOUT; exit 0; },
+ "d|rundir=s" => \$RUNDIR,
+ "f|config=s" => \$CONF,
+ "t|tag=s" => \$TAG,
+ "v|verbose" => \$VERBOSE
+ or $BAD = 1;
+ chew_cli_server_configs @ARGV;
+ if (@ARGV) {
+ (my $cmd = $ARGV[0]) =~ s:^.*/::;
+ $TAG //= $cmd;
+ } else {
+ $BAD = 1;
+ }
+ if ($BAD) { usage *STDERR; exit 1; }
+ parse_config_file;
+ for my $server (keys %S) { fix_server_config $server; }
+ dump_configuration if $VERBOSE;
+ find_rundir;
+ clean_up_rundir;
+ make_session_dir;
+ for my $server (keys %S) { server_listen $server; }
+ wait_for_ssh;
+ run_client @ARGV;
+ accept_loop;
+}
+
+main;
+
+###----- That's all, folks --------------------------------------------------
~mdw / with-authinfo-kludge / commitdiff