3 ### Adverbial modifier conferring AUTHINFO GENERIC support on NNTP clients
5 ### (c) 2016 Mark Wooding
8 ###----- Licensing notice ---------------------------------------------------
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.
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.
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.
24 my $VERSION = "0.1.0";
28 ###--------------------------------------------------------------------------
31 ## Included batteries.
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_/
42 ## External batteries.
45 ###--------------------------------------------------------------------------
46 ### Configuration variables.
48 ## The global configuration.
53 ## The per-server configuration.
55 my %SPARAM = map { $_ => 1 }
56 "local", "nntpauth", "remote", "sshbind", "via";
58 ## Various facts we might discover.
59 my $HOME = $ENV{"HOME"};
60 (my $PROG = $0) =~ s
:^.*/::;
66 ## Other bits of useful state.
74 ###--------------------------------------------------------------------------
81 print STDERR
"$PROG: $msg\n";
103 print STDERR
"$PROG: ;; $msg\n" if $VERBOSE;
114 defined $HOME or fail
"no home directory set";
118 sub ensure_dir_exists
($$) {
119 my ($dir, $mode) = @_;
120 mkdir $dir, $mode or $! == EEXIST
or
121 sysfail
"failed to create directory `$dir': $!";
129 unless (opendir $d, $f) {
130 moan
"failed to open directory `$d': $!";
134 defined (my $b = readdir $d) or last ENTRY
;
135 next ENTRY
if grep { $b eq $_ } ".", "..";
139 rmdir $f or $! == ENOENT
or moan
"failed to zap directory `$f': $!";
141 unlink $f or $! == ENOENT
or moan
"failed to zap file thing `$f': $!";
145 sub set_cloexec
($) {
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: $!";
152 sub set_nonblock
($) {
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: $!";
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
;
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: $!";
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': $!";
177 sub set_sighandler
($$) {
178 my ($sig, $handler) = @_;
179 unless (exists $OLDSIGS{$sig}) { $OLDSIGS{$sig} = $SIG{$sig}; }
180 $SIG{$sig} = $handler;
186 if (defined $kid && !$kid) {
188 for my $sig (keys %OLDSIGS) { $SIG{$sig} = $OLDSIGS{$sig}; }
194 sub sequence
() { return $SEQ++; }
196 ###--------------------------------------------------------------------------
197 ### Setting up the configuration.
199 sub set_global_param
($$) {
200 my ($param, $value) = @_;
201 exists $C{$param} or fail
"unknown global parameter `$param'";
205 sub notice_server
($$) {
206 my ($server, $where) = @_;
207 inform
"found server `$server' $where";
211 sub set_server_param
($$$) {
212 my ($server, $param, $value) = @_;
213 $S{$server} or bad
"unknown server `$param'";
214 $SPARAM{$param} or bad
"unknown server parameter `$param'";
215 $S{$server}{$param} = $value;
218 sub chew_cli_server_configs
(\@
) {
223 last ARG
unless @
$args;
224 my $arg = shift @
$args;
225 if ($arg eq "+") { last ARG
; }
226 elsif ($arg =~ /^\+/) {
227 $server = substr $arg, 1;
228 notice_server
$server, "on command line";
230 elsif (!defined $server or $arg !~ /^([^=]+)=(.*)$/)
231 { unshift @
$args, $arg; last ARG
; }
232 else { set_server_param
$server, $1, $2; }
236 sub parse_config_file
() {
238 ## If we already know what we're doing then forbid a configuration file as
241 return unless defined $CONF;
242 fail
"servers defined on command-line; won't read config file too";
245 ## Search about to find a suitable configuration file.
248 ($ENV{"XDG_CONFIG_HOME"} // ensure_home
. "/.config",
249 split /:/, $ENV{"XDG_CONFIG_DIRS"} // "/etc/xdg");
250 inform
"searching for a configuration file with tag `$TAG'...";
251 PATH
: for my $dir (@confpath) {
252 for my $base ($TAG, "\@default") {
253 my $f = "$dir/with-authinfo-kludge/$base.conf";
254 if (open $cf, "<", $f) {
255 inform
" found `$f'; search over";
256 $CONF = $f; last PATH
;
257 } elsif ($! != ENOENT
) {
258 bad
"couldn't open `$f' for reading: $!";
260 inform
" `$f' not found; search continues";
265 ## If we still don't have a configuration file then synthesize one from the
266 ## `$NNTPSERVER' variable.
268 my $server = $ENV{"NNTPSERVER"};
269 defined $server or fail
"no `NNTPSERVER' defined in the environment";
270 inform
"no config file found; synthesizing default";
271 notice_server
$server, "in environment";
275 ## Work through the configuration file setting up servers.
276 my $set_param = \
&set_global_param
;
278 next if /^\s*([#;]|$)/;
279 if (/^\s*\[(.+)\]\s*$/) {
281 if ($head eq "\@GLOBAL") { $set_param = \
&set_global_param
; }
283 notice_server
$head, "in config file";
284 $set_param = sub { set_server_param
$head, $_[0], $_[1]; };
286 } elsif (/^([^=]+)=(.*)$/) { $set_param->(trim
$1, trim
$2); }
287 else { bad
"$CONF:$.: couldn't parse configuration file line"; }
289 (!$cf->error and close $cf)
290 or sysfail
"error reading configuration file `$CONF': $!";
293 sub format_value
($);
294 sub format_value
($) {
296 if (!defined $value) { return "<undef>"; }
297 elsif (my $r = ref $value) {
299 return "[" . join(", ", map { format_value
$_ } @
$value) . "]";
300 } elsif ($r eq "HASH") {
302 join(", ", map { format_value
$_ . " => " .
303 format_value
$value->{$_} } sort keys %$value) .
308 } else { return "`$value'"; }
311 sub inform_param
($$) {
312 my ($param, $value) = @_;
313 inform
" $param = " . format_value
$value;
316 sub dump_configuration
() {
317 inform
"Global parameters...";
318 for my $p (sort keys %C) { inform_param
$p, $C{$p}; }
320 for my $s (sort keys %S) {
321 inform
"Server `$s' parameters...";
322 for my $p (sort keys %{$S{$s}}) { inform_param
$p, $S{$s}{$p}; }
326 ###--------------------------------------------------------------------------
327 ### Managing the runtime directory.
329 ### Truly told, this bit is probably the trickiest part of the program.
331 ## How long we allow for a new server directory to be set up.
336 ## Maybe we've done all of this already.
337 defined $RUNDIR and return;
339 ## Find a suitable place to put things.
341 inform
"searching for a suitable runtime directory...";
343 ## Maybe the user's configured a directory explicitly. (Maybe we still
344 ## have to arrange for this to exist.)
345 if (defined ($RUNDIR = $C{"rundir"})) {
346 inform
"using runtime directory from configuration";
350 ## First attempt: use `$XDG_RUNTIME_DIR'.
351 if (defined (my $runhome = $ENV{"XDG_RUNTIME_DIR"})) {
352 inform
"setting runtime directory from `XDG_RUNTIME_DIR'";
353 $RUNDIR = "$runhome/with-authinfo-kludge";
357 ## Second attempt: let's use /tmp, or whatever `$TMPDIR' is set.
358 my $tmpdir = $ENV{"TMPDIR"} // "/tmp";
359 inform
"investigating putting runtime directory under tmpdir `$tmpdir'";
360 my $dir = "$tmpdir/with-authinfo-kludge-$>";
362 if (!$st && $! == ENOENT
) {
363 mkdir $dir, 0700 or sysfail
"failed to create directory `$dir': $!";
365 inform
"created `$dir'";
367 if (!-d
$st) { inform
"alas, `$dir' isn't a directory"; }
368 elsif ($st->uid != $>) { inform
"alas, we don't own `$dir'"; }
369 elsif ($st->mode & 0077) { inform
"alas, `$dir' has liberal perms"; }
371 inform
"accepting `$dir' as runtime directory";
376 ## Third attempt: we'll use the XDG cache directory.
377 my $cachehome = $ENV{"XDG_CACHE_HOME"} // ensure_home
. "/.cache";
378 ensure_dir_exists
$cachehome, 0777;
380 $RUNDIR = "$cachehome/with-authinfo-kludge.$host";
381 inform
"last ditch: using `$RUNDIR' as runtime directory";
384 ## Make the runtime directory if it doesn't exist. Be paranoid here; users
385 ## can override if they really want. (Note that noip(1) is untweakably
386 ## picky about its socket directories, so this is less generous than it
388 ensure_dir_exists
$RUNDIR, 0700;
389 for my $d ("junk", "new") { ensure_dir_exists
"$RUNDIR/$d", 0777; }
392 sub junk_rundir_thing
($$) {
394 inform
"junking $what `$f'";
396 ## Find a name to rename it to under the `junk' directory. Anyone can put
397 ## things in the `junk' directory, and anyone is allowed to delete them;
398 ## the only tricky bit is making sure the names don't collide.
401 my $r = int rand 1000000;
402 $junk = "$RUNDIR/junk/j.$r";
404 ## It'll be OK if this fails because someone else has junked the file (in
405 ## which case we end happy), or if the target exists (in which case we
406 ## pick another and try again).
407 if (rename $f, $junk or ($! == ENOENT
&& !-e
$f)) { last NAME
; }
408 elsif ($! != EEXIST
) { sysfail
"couldn't rename `$f' to `$junk': $!"; }
414 sub clean_up_rundir
() {
415 inform
"cleaning up stale things from runtime directory";
417 ## Work through the things in the directory, making sure they're meant to
419 opendir my $dh, $RUNDIR or
420 sysfail
"failed to open directory `$RUNDIR': $!";
422 defined (my $base = readdir $dh) or last ENTRY
;
423 next ENTRY
if grep { $base eq $_ } ".", "..";
424 my $f = "$RUNDIR/$base";
426 ## If this thing isn't a directory then it shouldn't be there. Maybe a
427 ## later version of us put it there.
429 inform
"found unexpected thing `$f' in runtime directory";
433 ## Maybe it's a standard thing that's meant to be here. We'll clean
435 next ENTRY
if grep { $base eq $_ } "junk", "new";
437 ## If the name doesn't have a `.' in it, then it's some other special
438 ## thing which we don't understand.
439 if ($base !~ /^s.*\.\d+/) {
440 inform
"found unexpected special directory `$f' in runtime directory";
444 ## Otherwise, it's a session directory. If its lockfile isn't locked
445 ## then it's fair game.
447 if (open my $fh, "<", $lk) {
448 my $ownedp = lockedp
$fh;
449 close $fh or sysfail
"couldn't close file, what's up with that?: $!";
450 if (!$ownedp) { junk_rundir_thing
$f, "stale session dir"; }
451 } elsif ($! == ENOENT
) {
452 junk_rundir_thing
$f, "session dir without `lock' file";
454 moan
"couldn't open `$lk' (found in runtime dir) for reading: $!";
455 inform
"leaving `$f' alone";
460 ## Work through the things in the `new' directory.
461 my $thresh = time - $BIRTHTIME;
462 my $newdir = "$RUNDIR/new";
463 opendir $dh, $newdir or
464 sysfail
"failed to open directory `$newdir': $!";
466 defined (my $base = readdir $dh) or last NEW
;
467 next NEW
if grep { $base eq $_ } ".", "..";
468 my $f = "$newdir/$base";
470 inform
"found unexepected nondirectory thing `$f' in nursery";
473 if ($base !~ /^n\.(\d+)\./) {
474 inform
"found directory with unexpected name `$f' in nursery";
478 $stamp >= $thresh or junk_rundir_thing
$f, "stillborn session directory";
482 ## Work through the things in the `junk' directory. Anyone can put things
483 ## in the `junk' directory, and anyone is allowed to delete them.
484 ## Therefore we can just zap everything in here. The `zap' function is
485 ## (somewhat) careful not to screw up if someone else is also zapping the
487 my $junkdir = "$RUNDIR/junk";
488 opendir $dh, $junkdir or
489 sysfail
"failed to open directory `$junkdir': $!";
491 defined (my $base = readdir $dh) or last NEW
;
492 next NEW
if grep { $base eq $_ } ".", "..";
493 my $f = "$junkdir/$base";
499 sub make_session_dir
() {
500 inform
"making session directory for `$TAG'";
502 ## Make a new directory in the nursery. Only the creator of a nursery
503 ## directory is allowed to put things in it.
504 my $newdir = "$RUNDIR/new";
508 my $r = int rand 1000000;
509 $n = "$newdir/n.$now.$$.$r";
510 if (mkdir $n, 0777) { last NAME
; }
511 elsif ($! != EEXIST
) { sysfail
"failed to create `$n': $!"; }
514 ## Create the lockfile, and take out a lock.
515 open my $fh, ">", "$n/lock";
517 my $l = File
::FcntlLock
->new(l_type
=> F_WRLCK
,
518 l_whence
=> SEEK_SET
,
521 $l->lock($fh, F_SETLK
) or sysfail
"failed to lock `$n/lock: $!";
523 ## Rename the directory into its proper place. We have already cleaned out
524 ## stale directories, and the target name has our PID in it, so it can't
525 ## exist any more unless something unfortunate has happened.
526 $SESSDIR = "$RUNDIR/s.$TAG.$$";
527 rename $n, $SESSDIR or sysfail
"failed to rename `$n' to `$SESSDIR': $!";
529 ## Create some necessary things.
530 ensure_dir_exists
"$SESSDIR/noip-client", 0700;
534 zap junk_rundir_thing
$SESSDIR, "cleanup on exit"
535 if !$INKIDP && defined $SESSDIR;
538 ###--------------------------------------------------------------------------
539 ### Setting up a session.
541 sub parse_address
($;$) {
542 my ($addr, $defport) = @_;
543 inform
"parsing address `$addr'...";
546 if ($addr =~ /^\[([^]]*)\]:(\d+)$/ || $addr =~ /^([^:]+):(\d+)$/)
547 { $host = $1; $port = $2; }
548 elsif (defined $defport) { $host = $addr; $port = $defport; }
549 else { fail
"invalid address `$addr': missing port number"; }
550 inform
" host = `$host'; port = $port";
551 return ($host, $port);
554 sub format_address
($$) {
555 my ($host, $port) = @_;
556 $host =~ /:/ and $host = "[$host]";
557 return "$host:$port";
560 sub canonify_address
($;$) {
561 my ($addr, $defport) = @_;
562 my ($host, $port) = parse_address
$addr, $defport;
563 return format_address
$host, $port;
566 sub resolve_parsed_address
($$) {
567 my ($host, $port) = @_;
568 inform
"resolving host `$host', port $port";
570 my ($err, @a) = getaddrinfo
$host, $port, { flags
=> AI_NUMERICSERV
};
571 $err and fail
"failed to resolve `$host': $err";
576 ($err, $host, $port) =
577 getnameinfo
$a->{addr
}, NI_NUMERICHOST
| NI_NUMERICSERV
;
578 $err and sysfail
"unexpectedly failed to convert addr to text: $err";
579 inform
" resolved to $host $port";
580 my $r = format_address
$host, $port;
581 unless ($seen{$r}) { push @res, $r; $seen{$r} = 1; }
587 sub resolve_address
($;$) {
588 my ($addr, $defport) = @_;
589 my ($host, $port) = parse_address
$addr, $defport;
590 return resolve_parsed_address
$host, $port;
593 sub fix_server_config
($) {
597 ## Keep the name. This is useful for diagnostics, but it's also important
598 ## for finding the right socket directory if we're doing SSH forwarding.
599 $s->{"_name"} = $server;
601 ## Sort out the various addresses.
603 ($host, $port) = parse_address
($s->{"local"} // $server, 119);
604 $s->{"local"} = format_address
$host, $port;
605 $s->{"_laddrs"} = [resolve_parsed_address
$host, $port];
606 $s->{"remote"} = canonify_address
($s->{"remote"} // $server, 119);
607 ($host, $port) = parse_address
($s->{"sshbind"} // "127.1.0.1", 1119);
608 $s->{"sshbind"} = format_address
$host, $port;
609 $s->{"_sshaddrs"} = [resolve_parsed_address
$host, $port];
611 ## Initialize other settings.
612 $s->{"_proxy_noip"} = undef;
613 $s->{"_proxy_sockdir"} = undef;
614 $s->{"_proxy_server"} = defined $s->{"via"} ?
615 $s->{"sshbind"} : $s->{"remote"};
616 $s->{"_proxy_server"} =~ s/:119$//;
617 $s->{"_proxy_server"} =~ s/^\[(.*)\]$/$1/;
618 $s->{"_sshkid"} = undef;
619 $s->{"_ssh_stdin"} = undef;
620 $s->{"_ssh_stdout"} = undef;
623 sub hack_noip_envvar
($$) {
624 my ($var, $val) = @_;
625 inform
" hack env for noip: $var = `$val'";
629 sub hack_noip_env
($$) {
630 my ($vars, $dir) = @_;
633 hack_noip_envvar
"LD_PRELOAD",
635 (exists $ENV{"LD_PRELOAD"} ?
":" . $ENV{"LD_PRELOAD"} : "");
636 for my $k (keys %ENV) { delete $ENV{$k} if $k =~ /^NOIP_/; }
637 hack_noip_envvar
"NOIP_CONFIG", "$RUNDIR/noip.conf.notexist";
638 hack_noip_envvar
"NOIP_SOCKETDIR", $dir;
639 hack_noip_envvar
"NOIP_DEBUG", $VERBOSE;
640 for my $acl ("REALBIND", "REALCONNECT") {
641 hack_noip_envvar
"NOIP_$acl",
642 join ",", @
{$vars->{$acl} // []}, "+any";
646 sub server_listen
($) {
650 ## Set up the listening sockets for this server's addresses.
651 inform
"set up sockets for `$server'";
652 for my $a (@
{$s->{"_laddrs"}}) {
653 socket my $sk, PF_UNIX
, SOCK_STREAM
, 0
654 or sysfail
"failed to make Unix-domain socket: $!";
655 set_cloexec
$sk; set_nonblock
$sk;
656 my $sa = "$SESSDIR/noip-client/$a";
657 bind $sk, sockaddr_un
$sa
658 or sysfail
"failed to bind Unix-domain socket to `$sa': $!";
659 listen $sk, 5 or sysfail
"failed to listen on Unix-domain socket: $!";
660 $SERVMAP{fileno $sk} = [$s, $a, $sk];
661 inform
" listening on $a";
662 push @
{$CLIENT_NOIP{"REALCONNECT"}}, "-$a";
665 ## If we're forwarding via SSH then set that up too.
666 if (defined (my $via = $s->{"via"})) {
667 inform
"set up SSH tunnel to `$server' via $via...";
669 my $sockdir = "$SESSDIR/noip-ssh.$server";
670 ensure_dir_exists
$sockdir, 0700;
671 my $sshbind = $s->{"sshbind"};
672 my $remote = $s->{"remote"};
673 for my $a (@
{$s->{"_sshaddrs"}}) {
674 push @
{$ssh_noip{"REALBIND"}}, "-$a";
675 inform
" listening on $a";
676 push @
{$s->{"_proxy_noip"}{"REALCONNECT"}}, "-$a";
678 $s->{"_proxy_sockdir"} = $sockdir;
680 ## The `-L' option sets up the tunnel that we actually wanted. The `-v'
681 ## makes SSH spew stuff to stdout, which might be useful if you're
682 ## debugging. The `-S' detaches OpenSSH from any control master things
683 ## which might be going on, because they tend to interfere with
684 ## forwarding (and, besides, the existing master won't be under the same
685 ## noip configuration). The `echo' will let us know that it's started
686 ## up, and the `read' will keep the tunnel open until we close our end,
687 ## which we do implicitly when we exit.
688 inform
" starting SSH tunnel";
689 my @sshargs = ("ssh", "-L$sshbind:$remote", "-Snone");
690 $VERBOSE and push @sshargs, "-v";
691 push @sshargs, $via, <<EOF;
692 ## with-authinfo-kludge tunnel: $TAG -> $server
693 set -e; echo started; read hunoz
695 pipe my $rin, my $win and pipe my $rout, my $wout
696 or sysfail
"failed to create pipe: $!";
698 set_cloexec
$rout; set_nonblock
$rout;
699 defined (my $kid = myfork
) or sysfail
"failed to fork: $!";
701 open STDIN
, "<&", $rin or sysfail
"failed to dup pipe to stdin: $!";
702 open STDOUT
, "<&", $wout or sysfail
"failed to dup pipe to stdout: $!";
703 hack_noip_env \
%ssh_noip, $sockdir;
704 exec @sshargs or sysfail
"failed to exec SSH: $!";
708 $s->{"_sshkid"} = $kid;
709 $s->{"_ssh_stdin"} = $win;
710 $s->{"_ssh_stdout"} = $rout;
711 $KIDMAP{$kid} = [$s, "SSH tunnel"];
712 write_to_file
"$SESSDIR/ssh-$server.pid", "$kid\n";
716 sub wait_for_ssh
() {
719 ## Collect up all the `stdout' pipes.
721 SETUP
: for my $s (values %S) {
722 next SETUP
unless $s->{"_sshkid"};
723 my $fd = fileno $s->{"_ssh_stdout"};
724 vec($rfd_in, $fd, 1) = 1;
725 $fd{$fd} = [$s->{"_ssh_stdout"}, $s];
728 inform
"no SSH tunnels to start";
732 ## Wait for each of them to become readable, and try to read a thing.
733 ## Either we'll get a byte or EOF; either means that the respective tunnel
734 ## is as ready as it's ever going to be.
735 inform
"waiting for SSH tunnels to start...";
737 SELECT
: while (%fd) {
738 my ($n, $t) = select my $rfd_out = $rfd_in, undef, undef, undef;
740 elsif ($! == EINTR
) { next SELECT
; }
741 else { sysfail
"select failed: $!"; }
742 FD
: for my $fd (keys %fd) {
743 next FD
unless vec $rfd_out, $fd, 1;
744 my ($sk, $s) = @
{$fd{$fd}};
745 my $n = sysread $sk, my $hunoz, 128;
747 vec($rfd_in, $fd, 1) = 0;
748 if ($n) { inform
" tunnel to $s->{remote} started ok"; }
749 else { inform
" tunnel to $s->{remote} FAILED"; $nbad++; }
751 } elsif ($! != EAGAIN
&& $! != EWOULDBLOCK
) {
752 sysfail
"failed to read from pipe: $!";
756 if ($nbad) { inform
" tunnels started; $nbad FAILED"; }
757 else { inform
" all tunnels started ok"; }
760 set_sighandler
"CHLD", sub {
762 defined (my $kid = waitpid -1, WNOHANG
)
763 or sysfail
"failed to reap child: $!";
764 last KID
if $kid <= 0;
765 my $st = ${^CHILD_ERROR_NATIVE
};
767 if (WIFEXITED
($st) && WEXITSTATUS
($st) == 0) {
768 $how = "exited successfully";
770 } elsif (WIFSIGNALED
($st)) {
771 my $sig = WTERMSIG
($st);
772 $how = "killed by signal $sig";
773 $how .= " (core dumped)" if $?
& 0x80;
776 $rc = WEXITSTATUS
($st);
777 $how = "exited with status $rc";
779 if ($kid == $CLIENTKID) {
780 inform
"client kid $how; shutting down";
782 } elsif (exists $KIDMAP{$kid}) {
783 my ($s, $what) = @
{$KIDMAP{$kid}};
784 inform
"$what for server `$s->{_name}' collapsed ($how)";
785 delete $KIDMAP{$kid};
787 inform
"unrecognized child $kid $how";
795 inform
"starting client";
796 defined (my $kid = myfork
) or sysfail
"failed to fork: $!";
798 hack_noip_env \
%CLIENT_NOIP, "$SESSDIR/noip-client";
800 exec @args or sysfail
"failed to exec `$prog': $!";
803 write_to_file
"$SESSDIR/client.pid", "$kid\n";
808 for my $fd (keys %SERVMAP) { vec($rfd_in, $fd, 1) = 1; }
810 my ($n, $t) = select my $rfd_out = $rfd_in, undef, undef, undef;
812 elsif ($! == EINTR
) { next SELECT
; }
813 else { sysfail
"select failed: $!"; }
814 FD
: for my $fd (keys %SERVMAP) {
815 next FD
unless vec $rfd_out, $fd, 1;
816 my ($s, $a, $sk) = @
{$SERVMAP{$fd}};
818 unless (accept $nsk, $sk) {
819 moan
"failed to accept new connection: $!"
820 unless $! == EAGAIN
|| $! == EWOULDBLOCK
;
824 inform
"incoming connection `$s->{_name}' to $a; starting proxy...";
825 defined (my $kid = myfork
) or sysfail
"failed to fork: $!";
827 $ENV{"NNTPAUTH"} = $s->{"nntpauth"} if exists $s->{"nntpauth"};
828 hack_noip_env
$s->{"_proxy_noip"}, $s->{"_proxy_sockdir"};
829 open STDIN
, "<&", $nsk
830 or sysfail
"failed to dup socket to kid stdin: $!";
831 open STDOUT
, ">&", $nsk
832 or sysfail
"failed to dup socket to kid stdin: $!";
833 inform
"running proxy to `$s->{_proxy_server}'";
834 exec "authinfo-kludge", $s->{"_proxy_server"}
835 or sysfail
"failed to exec `authinfo-kludge': $!";
837 $KIDMAP{$kid} = [$s, "proxy"];
842 ###--------------------------------------------------------------------------
847 print $fh "$PROG, version $VERSION\n";
853 usage: $PROG [-v] [-d DIR] [-f CONF] [-t TAG]
854 [ [+SERVER] [PARAM=VALUE ...] ...] [+]
865 Command-line options:
866 -h, --help Show this help text.
867 -d, --rundir=DIR Use DIR to store runtime state.
868 -f, --config=FILE Read configuration from FILE.
869 -t, --tag=TAG Use TAG to identify this session.
870 -v, --verbose Emit running commentary to stderr.
872 Server parameter summary:
873 local=ADDRESS Listen on ADDRESS for client connections.
874 nntpauth=AUTH-METHOD Set authentication method and arguments.
875 remote=ADDRESS Connect to server at ADDRESS.
876 sshbind=ADDRESS Use ADDRESS for local SSH tunnel endpoint.
877 via=SSH-HOST Use SSH to connect to remote server.
879 See the manual page for full details.
885 "h|help" => sub { help
; exit 0; },
886 "version" => sub { version
*STDOUT
; exit 0; },
887 "d|rundir=s" => \
$RUNDIR,
888 "f|config=s" => \
$CONF,
890 "v|verbose" => \
$VERBOSE
892 chew_cli_server_configs
@ARGV;
894 (my $cmd = $ARGV[0]) =~ s
:^.*/::;
899 if ($BAD) { usage
*STDERR
; exit 1; }
901 for my $server (keys %S) { fix_server_config
$server; }
902 dump_configuration
if $VERBOSE;
906 for my $server (keys %S) { server_listen
$server; }
914 ###----- That's all, folks --------------------------------------------------