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.1";
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 setpgid tcgetpgrp tcsetpgrp
);
38 use Socket
qw(/^[AP]F_/ /^SOCK_/ /^sockaddr_/
39 getaddrinfo
/^AI_/ /^EAI_/
43 ## External batteries.
46 ###--------------------------------------------------------------------------
47 ### Configuration variables.
49 ## The global configuration.
54 ## The per-server configuration.
56 my %SPARAM = map { $_ => 1 }
57 "local", "nntpauth", "remote", "sshbind", "via";
59 ## Various facts we might discover.
60 my $HOME = $ENV{"HOME"};
61 (my $PROG = $0) =~ s
:^.*/::;
67 ## Other bits of useful state.
77 ###--------------------------------------------------------------------------
84 print STDERR
"$PROG: $msg\n";
106 print STDERR
"$PROG: ;; $msg\n" if $VERBOSE;
117 defined $HOME or fail
"no home directory set";
121 sub ensure_dir_exists
($$) {
122 my ($dir, $mode) = @_;
123 mkdir $dir, $mode or $! == EEXIST
or
124 sysfail
"failed to create directory `$dir': $!";
132 unless (opendir $d, $f) {
133 moan
"failed to open directory `$d': $!";
137 defined (my $b = readdir $d) or last ENTRY
;
138 next ENTRY
if grep { $b eq $_ } ".", "..";
142 rmdir $f or $! == ENOENT
or moan
"failed to zap directory `$f': $!";
144 unlink $f or $! == ENOENT
or moan
"failed to zap file thing `$f': $!";
148 sub set_cloexec
($) {
150 my $f = fcntl $fh, F_GETFD
, 0 or sysfail
"failed to get per-fd flags: $!";
151 fcntl $fh, F_SETFD
, $f | FD_CLOEXEC
or
152 sysfail
"failed to set close-on-exec: $!";
155 sub set_nonblock
($) {
157 my $f = fcntl $fh, F_GETFL
, 0 or sysfail
"failed to get file flags: $!";
158 fcntl $fh, F_SETFL
, $f | O_NONBLOCK
or
159 sysfail
"failed to set non-blockingness: $!";
164 my $l = new File
::FcntlLock
;
165 $l->lock($f, F_GETLK
) or sysfail
"couldn't read locking for `$f': $!";
166 return $l->l_type != F_UNLCK
;
169 sub write_to_file
($$) {
170 my ($file, $contents) = @_;
171 my $new = "$file.new";
172 open my $fh, ">", $new or sysfail
"couldn't open `$new' for writing: $!";
174 $fh->flush && !$fh->error && close $fh
175 or sysfail
"failed to write to `$new': $!";
176 rename $new, $file or sysfail
"failed to rename `$new' to `$file': $!";
180 sub set_sighandler
($$) {
181 my ($sig, $handler) = @_;
182 unless (exists $OLDSIGS{$sig}) { $OLDSIGS{$sig} = $SIG{$sig}; }
183 $SIG{$sig} = $handler;
189 if (defined $kid && !$kid) {
191 for my $sig (keys %OLDSIGS) { $SIG{$sig} = $OLDSIGS{$sig}; }
197 sub sequence
() { return $SEQ++; }
199 ###--------------------------------------------------------------------------
200 ### Setting up the configuration.
202 sub set_global_param
($$) {
203 my ($param, $value) = @_;
204 exists $C{$param} or fail
"unknown global parameter `$param'";
208 sub notice_server
($$) {
209 my ($server, $where) = @_;
210 inform
"found server `$server' $where";
214 sub set_server_param
($$$) {
215 my ($server, $param, $value) = @_;
216 $S{$server} or bad
"unknown server `$param'";
217 $SPARAM{$param} or bad
"unknown server parameter `$param'";
218 $S{$server}{$param} = $value;
221 sub chew_cli_server_configs
(\@
) {
226 last ARG
unless @
$args;
227 my $arg = shift @
$args;
228 if ($arg eq "+") { last ARG
; }
229 elsif ($arg =~ /^\+/) {
230 $server = substr $arg, 1;
231 notice_server
$server, "on command line";
233 elsif (!defined $server or $arg !~ /^([^=]+)=(.*)$/)
234 { unshift @
$args, $arg; last ARG
; }
235 else { set_server_param
$server, $1, $2; }
239 sub parse_config_file
() {
241 ## If we already know what we're doing then forbid a configuration file as
244 return unless defined $CONF;
245 fail
"servers defined on command-line; won't read config file too";
248 ## Search about to find a suitable configuration file.
251 ($ENV{"XDG_CONFIG_HOME"} // ensure_home
. "/.config",
252 split /:/, $ENV{"XDG_CONFIG_DIRS"} // "/etc/xdg");
253 inform
"searching for a configuration file with tag `$TAG'...";
254 PATH
: for my $dir (@confpath) {
255 for my $base ($TAG, "\@default") {
256 my $f = "$dir/with-authinfo-kludge/$base.conf";
257 if (open $cf, "<", $f) {
258 inform
" found `$f'; search over";
259 $CONF = $f; last PATH
;
260 } elsif ($! != ENOENT
) {
261 bad
"couldn't open `$f' for reading: $!";
263 inform
" `$f' not found; search continues";
268 ## If we still don't have a configuration file then synthesize one from the
269 ## `$NNTPSERVER' variable.
271 my $server = $ENV{"NNTPSERVER"};
272 defined $server or fail
"no `NNTPSERVER' defined in the environment";
273 inform
"no config file found; synthesizing default";
274 notice_server
$server, "in environment";
278 ## Work through the configuration file setting up servers.
279 my $set_param = \
&set_global_param
;
281 next if /^\s*([#;]|$)/;
282 if (/^\s*\[(.+)\]\s*$/) {
284 if ($head eq "\@GLOBAL") { $set_param = \
&set_global_param
; }
286 notice_server
$head, "in config file";
287 $set_param = sub { set_server_param
$head, $_[0], $_[1]; };
289 } elsif (/^([^=]+)=(.*)$/) { $set_param->(trim
$1, trim
$2); }
290 else { bad
"$CONF:$.: couldn't parse configuration file line"; }
292 (!$cf->error and close $cf)
293 or sysfail
"error reading configuration file `$CONF': $!";
296 sub format_value
($);
297 sub format_value
($) {
299 if (!defined $value) { return "<undef>"; }
300 elsif (my $r = ref $value) {
302 return "[" . join(", ", map { format_value
$_ } @
$value) . "]";
303 } elsif ($r eq "HASH") {
305 join(", ", map { format_value
$_ . " => " .
306 format_value
$value->{$_} } sort keys %$value) .
311 } else { return "`$value'"; }
314 sub inform_param
($$) {
315 my ($param, $value) = @_;
316 inform
" $param = " . format_value
$value;
319 sub dump_configuration
() {
320 inform
"Global parameters...";
321 for my $p (sort keys %C) { inform_param
$p, $C{$p}; }
323 for my $s (sort keys %S) {
324 inform
"Server `$s' parameters...";
325 for my $p (sort keys %{$S{$s}}) { inform_param
$p, $S{$s}{$p}; }
329 ###--------------------------------------------------------------------------
330 ### Managing the runtime directory.
332 ### Truly told, this bit is probably the trickiest part of the program.
334 ## How long we allow for a new server directory to be set up.
339 ## Maybe we've done all of this already.
340 defined $RUNDIR and return;
342 ## Find a suitable place to put things.
344 inform
"searching for a suitable runtime directory...";
346 ## Maybe the user's configured a directory explicitly. (Maybe we still
347 ## have to arrange for this to exist.)
348 if (defined ($RUNDIR = $C{"rundir"})) {
349 inform
"using runtime directory from configuration";
353 ## First attempt: use `$XDG_RUNTIME_DIR'.
354 if (defined (my $runhome = $ENV{"XDG_RUNTIME_DIR"})) {
355 inform
"setting runtime directory from `XDG_RUNTIME_DIR'";
356 $RUNDIR = "$runhome/with-authinfo-kludge";
360 ## Second attempt: let's use /tmp, or whatever `$TMPDIR' is set.
361 my $tmpdir = $ENV{"TMPDIR"} // "/tmp";
362 inform
"investigating putting runtime directory under tmpdir `$tmpdir'";
363 my $dir = "$tmpdir/with-authinfo-kludge-$>";
365 if (!$st && $! == ENOENT
) {
366 mkdir $dir, 0700 or sysfail
"failed to create directory `$dir': $!";
368 inform
"created `$dir'";
370 if (!-d
$st) { inform
"alas, `$dir' isn't a directory"; }
371 elsif ($st->uid != $>) { inform
"alas, we don't own `$dir'"; }
372 elsif ($st->mode & 0077) { inform
"alas, `$dir' has liberal perms"; }
374 inform
"accepting `$dir' as runtime directory";
379 ## Third attempt: we'll use the XDG cache directory.
380 my $cachehome = $ENV{"XDG_CACHE_HOME"} // ensure_home
. "/.cache";
381 ensure_dir_exists
$cachehome, 0777;
383 $RUNDIR = "$cachehome/with-authinfo-kludge.$host";
384 inform
"last ditch: using `$RUNDIR' as runtime directory";
387 ## Make the runtime directory if it doesn't exist. Be paranoid here; users
388 ## can override if they really want. (Note that noip(1) is untweakably
389 ## picky about its socket directories, so this is less generous than it
391 ensure_dir_exists
$RUNDIR, 0700;
392 for my $d ("junk", "new") { ensure_dir_exists
"$RUNDIR/$d", 0777; }
395 sub junk_rundir_thing
($$) {
397 inform
"junking $what `$f'";
399 ## Find a name to rename it to under the `junk' directory. Anyone can put
400 ## things in the `junk' directory, and anyone is allowed to delete them;
401 ## the only tricky bit is making sure the names don't collide.
404 my $r = int rand 1000000;
405 $junk = "$RUNDIR/junk/j.$r";
407 ## It'll be OK if this fails because someone else has junked the file (in
408 ## which case we end happy), or if the target exists (in which case we
409 ## pick another and try again).
410 if (rename $f, $junk or ($! == ENOENT
&& !-e
$f)) { last NAME
; }
411 elsif ($! != EEXIST
) { sysfail
"couldn't rename `$f' to `$junk': $!"; }
417 sub clean_up_rundir
() {
418 inform
"cleaning up stale things from runtime directory";
420 ## Work through the things in the directory, making sure they're meant to
422 opendir my $dh, $RUNDIR or
423 sysfail
"failed to open directory `$RUNDIR': $!";
425 defined (my $base = readdir $dh) or last ENTRY
;
426 next ENTRY
if grep { $base eq $_ } ".", "..";
427 my $f = "$RUNDIR/$base";
429 ## If this thing isn't a directory then it shouldn't be there. Maybe a
430 ## later version of us put it there.
432 inform
"found unexpected thing `$f' in runtime directory";
436 ## Maybe it's a standard thing that's meant to be here. We'll clean
438 next ENTRY
if grep { $base eq $_ } "junk", "new";
440 ## If the name doesn't have a `.' in it, then it's some other special
441 ## thing which we don't understand.
442 if ($base !~ /^s.*\.\d+/) {
443 inform
"found unexpected special directory `$f' in runtime directory";
447 ## Otherwise, it's a session directory. If its lockfile isn't locked
448 ## then it's fair game.
450 if (open my $fh, "<", $lk) {
451 my $ownedp = lockedp
$fh;
452 close $fh or sysfail
"couldn't close file, what's up with that?: $!";
453 if (!$ownedp) { junk_rundir_thing
$f, "stale session dir"; }
454 } elsif ($! == ENOENT
) {
455 junk_rundir_thing
$f, "session dir without `lock' file";
457 moan
"couldn't open `$lk' (found in runtime dir) for reading: $!";
458 inform
"leaving `$f' alone";
463 ## Work through the things in the `new' directory.
464 my $thresh = time - $BIRTHTIME;
465 my $newdir = "$RUNDIR/new";
466 opendir $dh, $newdir or
467 sysfail
"failed to open directory `$newdir': $!";
469 defined (my $base = readdir $dh) or last NEW
;
470 next NEW
if grep { $base eq $_ } ".", "..";
471 my $f = "$newdir/$base";
473 inform
"found unexepected nondirectory thing `$f' in nursery";
476 if ($base !~ /^n\.(\d+)\./) {
477 inform
"found directory with unexpected name `$f' in nursery";
481 $stamp >= $thresh or junk_rundir_thing
$f, "stillborn session directory";
485 ## Work through the things in the `junk' directory. Anyone can put things
486 ## in the `junk' directory, and anyone is allowed to delete them.
487 ## Therefore we can just zap everything in here. The `zap' function is
488 ## (somewhat) careful not to screw up if someone else is also zapping the
490 my $junkdir = "$RUNDIR/junk";
491 opendir $dh, $junkdir or
492 sysfail
"failed to open directory `$junkdir': $!";
494 defined (my $base = readdir $dh) or last NEW
;
495 next NEW
if grep { $base eq $_ } ".", "..";
496 my $f = "$junkdir/$base";
502 sub make_session_dir
() {
503 inform
"making session directory for `$TAG'";
505 ## Make a new directory in the nursery. Only the creator of a nursery
506 ## directory is allowed to put things in it.
507 my $newdir = "$RUNDIR/new";
511 my $r = int rand 1000000;
512 $n = "$newdir/n.$now.$$.$r";
513 if (mkdir $n, 0777) { last NAME
; }
514 elsif ($! != EEXIST
) { sysfail
"failed to create `$n': $!"; }
517 ## Create the lockfile, and take out a lock.
518 open my $fh, ">", "$n/lock";
520 my $l = File
::FcntlLock
->new(l_type
=> F_WRLCK
,
521 l_whence
=> SEEK_SET
,
524 $l->lock($fh, F_SETLK
) or sysfail
"failed to lock `$n/lock: $!";
526 ## Rename the directory into its proper place. We have already cleaned out
527 ## stale directories, and the target name has our PID in it, so it can't
528 ## exist any more unless something unfortunate has happened.
529 $SESSDIR = "$RUNDIR/s.$TAG.$$";
530 rename $n, $SESSDIR or sysfail
"failed to rename `$n' to `$SESSDIR': $!";
532 ## Create some necessary things.
533 ensure_dir_exists
"$SESSDIR/noip-client", 0700;
537 zap junk_rundir_thing
$SESSDIR, "cleanup on exit"
538 if !$INKIDP && defined $SESSDIR;
541 ###--------------------------------------------------------------------------
542 ### Setting up a session.
544 sub parse_address
($;$) {
545 my ($addr, $defport) = @_;
546 inform
"parsing address `$addr'...";
549 if ($addr =~ /^\[([^]]*)\]:(\d+)$/ || $addr =~ /^([^:]+):(\d+)$/)
550 { $host = $1; $port = $2; }
551 elsif (defined $defport) { $host = $addr; $port = $defport; }
552 else { fail
"invalid address `$addr': missing port number"; }
553 inform
" host = `$host'; port = $port";
554 return ($host, $port);
557 sub format_address
($$) {
558 my ($host, $port) = @_;
559 $host =~ /:/ and $host = "[$host]";
560 return "$host:$port";
563 sub canonify_address
($;$) {
564 my ($addr, $defport) = @_;
565 my ($host, $port) = parse_address
$addr, $defport;
566 return format_address
$host, $port;
569 sub resolve_parsed_address
($$) {
570 my ($host, $port) = @_;
571 inform
"resolving host `$host', port $port";
573 my ($err, @a) = getaddrinfo
$host, $port, { flags
=> AI_NUMERICSERV
};
574 $err and fail
"failed to resolve `$host': $err";
579 ($err, $host, $port) =
580 getnameinfo
$a->{addr
}, NI_NUMERICHOST
| NI_NUMERICSERV
;
581 $err and sysfail
"unexpectedly failed to convert addr to text: $err";
582 inform
" resolved to $host $port";
583 my $r = format_address
$host, $port;
584 unless ($seen{$r}) { push @res, $r; $seen{$r} = 1; }
590 sub resolve_address
($;$) {
591 my ($addr, $defport) = @_;
592 my ($host, $port) = parse_address
$addr, $defport;
593 return resolve_parsed_address
$host, $port;
596 sub fix_server_config
($) {
600 ## Keep the name. This is useful for diagnostics, but it's also important
601 ## for finding the right socket directory if we're doing SSH forwarding.
602 $s->{"_name"} = $server;
604 ## Sort out the various addresses.
606 ($host, $port) = parse_address
($s->{"local"} // $server, 119);
607 $s->{"local"} = format_address
$host, $port;
608 $s->{"_laddrs"} = [resolve_parsed_address
$host, $port];
609 $s->{"remote"} = canonify_address
($s->{"remote"} // $server, 119);
610 ($host, $port) = parse_address
($s->{"sshbind"} // "127.1.0.1", 1119);
611 $s->{"sshbind"} = format_address
$host, $port;
612 $s->{"_sshaddrs"} = [resolve_parsed_address
$host, $port];
614 ## Initialize other settings.
615 $s->{"_proxy_noip"} = undef;
616 $s->{"_proxy_sockdir"} = undef;
617 $s->{"_proxy_server"} = defined $s->{"via"} ?
618 $s->{"sshbind"} : $s->{"remote"};
619 $s->{"_proxy_server"} =~ s/:119$//;
620 $s->{"_proxy_server"} =~ s/^\[(.*)\]$/$1/;
621 $s->{"_sshkid"} = undef;
622 $s->{"_ssh_stdin"} = undef;
623 $s->{"_ssh_stdout"} = undef;
626 sub hack_noip_envvar
($$) {
627 my ($var, $val) = @_;
628 inform
" hack env for noip: $var = `$val'";
632 sub hack_noip_env
($$) {
633 my ($vars, $dir) = @_;
636 hack_noip_envvar
"LD_PRELOAD",
638 (exists $ENV{"LD_PRELOAD"} ?
":" . $ENV{"LD_PRELOAD"} : "");
639 for my $k (keys %ENV) { delete $ENV{$k} if $k =~ /^NOIP_/; }
640 hack_noip_envvar
"NOIP_CONFIG", "$RUNDIR/noip.conf.notexist";
641 hack_noip_envvar
"NOIP_SOCKETDIR", $dir;
642 hack_noip_envvar
"NOIP_DEBUG", $VERBOSE;
643 for my $acl ("REALBIND", "REALCONNECT") {
644 hack_noip_envvar
"NOIP_$acl",
645 join ",", @
{$vars->{$acl} // []}, "+any";
649 sub server_listen
($) {
653 ## Set up the listening sockets for this server's addresses.
654 inform
"set up sockets for `$server'";
655 for my $a (@
{$s->{"_laddrs"}}) {
656 socket my $sk, PF_UNIX
, SOCK_STREAM
, 0
657 or sysfail
"failed to make Unix-domain socket: $!";
658 set_cloexec
$sk; set_nonblock
$sk;
659 my $sa = "$SESSDIR/noip-client/$a";
660 bind $sk, sockaddr_un
$sa
661 or sysfail
"failed to bind Unix-domain socket to `$sa': $!";
662 listen $sk, 5 or sysfail
"failed to listen on Unix-domain socket: $!";
663 $SERVMAP{fileno $sk} = [$s, $a, $sk];
664 inform
" listening on $a";
665 push @
{$CLIENT_NOIP{"REALCONNECT"}}, "-$a";
668 ## If we're forwarding via SSH then set that up too.
669 if (defined (my $via = $s->{"via"})) {
670 inform
"set up SSH tunnel to `$server' via $via...";
672 my $sockdir = "$SESSDIR/noip-ssh.$server";
673 ensure_dir_exists
$sockdir, 0700;
674 my $sshbind = $s->{"sshbind"};
675 my $remote = $s->{"remote"};
676 for my $a (@
{$s->{"_sshaddrs"}}) {
677 push @
{$ssh_noip{"REALBIND"}}, "-$a";
678 inform
" listening on $a";
679 push @
{$s->{"_proxy_noip"}{"REALCONNECT"}}, "-$a";
681 $s->{"_proxy_sockdir"} = $sockdir;
683 ## The `-L' option sets up the tunnel that we actually wanted. The `-v'
684 ## makes SSH spew stuff to stdout, which might be useful if you're
685 ## debugging. The `-S' detaches OpenSSH from any control master things
686 ## which might be going on, because they tend to interfere with
687 ## forwarding (and, besides, the existing master won't be under the same
688 ## noip configuration). The `echo' will let us know that it's started
689 ## up, and the `read' will keep the tunnel open until we close our end,
690 ## which we do implicitly when we exit.
691 inform
" starting SSH tunnel";
692 my @sshargs = ("ssh", "-L$sshbind:$remote", "-Snone");
693 $VERBOSE and push @sshargs, "-v";
694 push @sshargs, $via, <<EOF;
695 ## with-authinfo-kludge tunnel: $TAG -> $server
696 set -e; echo started; read hunoz
698 pipe my $rin, my $win and pipe my $rout, my $wout
699 or sysfail
"failed to create pipe: $!";
701 set_cloexec
$rout; set_nonblock
$rout;
702 defined (my $kid = myfork
) or sysfail
"failed to fork: $!";
704 open STDIN
, "<&", $rin or sysfail
"failed to dup pipe to stdin: $!";
705 open STDOUT
, "<&", $wout or sysfail
"failed to dup pipe to stdout: $!";
706 hack_noip_env \
%ssh_noip, $sockdir;
707 exec @sshargs or sysfail
"failed to exec SSH: $!";
711 $s->{"_sshkid"} = $kid;
712 $s->{"_ssh_stdin"} = $win;
713 $s->{"_ssh_stdout"} = $rout;
714 $KIDMAP{$kid} = [$s, "SSH tunnel"];
715 write_to_file
"$SESSDIR/ssh-$server.pid", "$kid\n";
719 sub wait_for_ssh
() {
722 ## Collect up all the `stdout' pipes.
724 SETUP
: for my $s (values %S) {
725 next SETUP
unless $s->{"_sshkid"};
726 my $fd = fileno $s->{"_ssh_stdout"};
727 vec($rfd_in, $fd, 1) = 1;
728 $fd{$fd} = [$s->{"_ssh_stdout"}, $s];
731 inform
"no SSH tunnels to start";
735 ## Wait for each of them to become readable, and try to read a thing.
736 ## Either we'll get a byte or EOF; either means that the respective tunnel
737 ## is as ready as it's ever going to be.
738 inform
"waiting for SSH tunnels to start...";
740 SELECT
: while (%fd) {
741 my ($n, $t) = select my $rfd_out = $rfd_in, undef, undef, undef;
743 elsif ($! == EINTR
) { next SELECT
; }
744 else { sysfail
"select failed: $!"; }
745 FD
: for my $fd (keys %fd) {
746 next FD
unless vec $rfd_out, $fd, 1;
747 my ($sk, $s) = @
{$fd{$fd}};
748 my $n = sysread $sk, my $hunoz, 128;
750 vec($rfd_in, $fd, 1) = 0;
751 if ($n) { inform
" tunnel to $s->{remote} started ok"; }
752 else { inform
" tunnel to $s->{remote} FAILED"; $nbad++; }
754 } elsif ($! != EAGAIN
&& $! != EWOULDBLOCK
) {
755 sysfail
"failed to read from pipe: $!";
759 if ($nbad) { inform
" tunnels started; $nbad FAILED"; }
760 else { inform
" all tunnels started ok"; }
763 ## Collect a file descriptor for the controlling terminal. It's totally not
764 ## a problem if this doesn't work: then we'll just live without the job
765 ## control stuff, which is fine because we only need it when terminals are
767 $TTYFD = POSIX
::open "/dev/tty", O_RDWR
;
769 sub maybe_foreground_client
() {
770 ## If we're currently the foreground process group, then make the client be
771 ## the foreground instead.
773 if (defined $TTYFD && $MYPGID == tcgetpgrp
$TTYFD) {
774 kill -CONT
, $CLIENTKID
775 or sysfail
"failed to wake client: $!";
776 tcsetpgrp
$TTYFD, $CLIENTKID
777 or sysfail
"failed to make client the foreground process group: $!";
781 sub maybe_stop_self
() {
782 ## If the client is currently the foreground process group, then we should
783 ## background ourselves.
785 if (defined $TTYFD && $CLIENTKID == tcgetpgrp
$TTYFD) {
787 or sysfail
"failed to suspend own process group: $!";
791 set_sighandler
"CONT", sub {
792 maybe_foreground_client
;
795 set_sighandler
"CHLD", sub {
797 defined (my $kid = waitpid -1, WNOHANG
| WUNTRACED
)
798 or sysfail
"failed to reap child: $!";
799 last KID
if $kid <= 0;
800 my $st = ${^CHILD_ERROR_NATIVE
};
802 if (WIFEXITED
($st) && WEXITSTATUS
($st) == 0) {
803 $how = "exited successfully";
805 } elsif (WIFSTOPPED
($st)) {
806 maybe_stop_self
if $kid == $CLIENTKID;
808 } elsif (WIFSIGNALED
($st)) {
809 my $sig = WTERMSIG
($st);
810 $how = "killed by signal $sig";
811 $how .= " (core dumped)" if $?
& 0x80;
814 $rc = WEXITSTATUS
($st);
815 $how = "exited with status $rc";
817 if ($kid == $CLIENTKID) {
818 inform
"client kid $how; shutting down";
820 } elsif (exists $KIDMAP{$kid}) {
821 my ($s, $what) = @
{$KIDMAP{$kid}};
822 inform
"$what for server `$s->{_name}' collapsed ($how)";
823 delete $KIDMAP{$kid};
825 inform
"unrecognized child $kid $how";
833 inform
"starting client";
834 pipe my $r, my $w or sysfail
"failed to create pipe: $!";
835 defined (my $kid = myfork
) or sysfail
"failed to fork: $!";
837 hack_noip_env \
%CLIENT_NOIP, "$SESSDIR/noip-client";
838 setpgid
$$, $$ or sysfail
"failed to set kid process group: $!";
841 exec @args or sysfail
"failed to exec `$prog': $!";
844 defined sysread $r, my $buf, 1
845 or sysfail
"failed to read pipe: $!";
848 write_to_file
"$SESSDIR/client.pid", "$kid\n";
849 maybe_foreground_client
;
854 for my $fd (keys %SERVMAP) { vec($rfd_in, $fd, 1) = 1; }
856 my ($n, $t) = select my $rfd_out = $rfd_in, undef, undef, undef;
858 elsif ($! == EINTR
) { next SELECT
; }
859 else { sysfail
"select failed: $!"; }
860 FD
: for my $fd (keys %SERVMAP) {
861 next FD
unless vec $rfd_out, $fd, 1;
862 my ($s, $a, $sk) = @
{$SERVMAP{$fd}};
864 unless (accept $nsk, $sk) {
865 moan
"failed to accept new connection: $!"
866 unless $! == EAGAIN
|| $! == EWOULDBLOCK
;
870 inform
"incoming connection `$s->{_name}' to $a; starting proxy...";
871 defined (my $kid = myfork
) or sysfail
"failed to fork: $!";
873 $ENV{"NNTPAUTH"} = $s->{"nntpauth"} if exists $s->{"nntpauth"};
874 hack_noip_env
$s->{"_proxy_noip"}, $s->{"_proxy_sockdir"};
875 open STDIN
, "<&", $nsk
876 or sysfail
"failed to dup socket to kid stdin: $!";
877 open STDOUT
, ">&", $nsk
878 or sysfail
"failed to dup socket to kid stdin: $!";
879 inform
"running proxy to `$s->{_proxy_server}'";
880 exec "authinfo-kludge", $s->{"_proxy_server"}
881 or sysfail
"failed to exec `authinfo-kludge': $!";
883 $KIDMAP{$kid} = [$s, "proxy"];
888 ###--------------------------------------------------------------------------
893 print $fh "$PROG, version $VERSION\n";
899 usage: $PROG [-v] [-d DIR] [-f CONF] [-t TAG]
900 [ [+SERVER] [PARAM=VALUE ...] ...] [+]
911 Command-line options:
912 -h, --help Show this help text.
913 -d, --rundir=DIR Use DIR to store runtime state.
914 -f, --config=FILE Read configuration from FILE.
915 -t, --tag=TAG Use TAG to identify this session.
916 -v, --verbose Emit running commentary to stderr.
918 Server parameter summary:
919 local=ADDRESS Listen on ADDRESS for client connections.
920 nntpauth=AUTH-METHOD Set authentication method and arguments.
921 remote=ADDRESS Connect to server at ADDRESS.
922 sshbind=ADDRESS Use ADDRESS for local SSH tunnel endpoint.
923 via=SSH-HOST Use SSH to connect to remote server.
925 See the manual page for full details.
931 "h|help" => sub { help
; exit 0; },
932 "version" => sub { version
*STDOUT
; exit 0; },
933 "d|rundir=s" => \
$RUNDIR,
934 "f|config=s" => \
$CONF,
936 "v|verbose" => \
$VERBOSE
938 chew_cli_server_configs
@ARGV;
940 (my $cmd = $ARGV[0]) =~ s
:^.*/::;
945 if ($BAD) { usage
*STDERR
; exit 1; }
947 for my $server (keys %S) { fix_server_config
$server; }
948 dump_configuration
if $VERBOSE;
952 for my $server (keys %S) { server_listen
$server; }
960 ###----- That's all, folks --------------------------------------------------