X-Git-Url: https://git.distorted.org.uk/~mdw/with-authinfo-kludge/blobdiff_plain/4ed4f0661074881f23bb25fd296e6dc9111de1ac..b149b79ed05457f69ac9f407d394f8ec35e41601:/with-authinfo-kludge diff --git a/with-authinfo-kludge b/with-authinfo-kludge index fae87b5..4317d8d 100755 --- a/with-authinfo-kludge +++ b/with-authinfo-kludge @@ -21,13 +21,7 @@ ### 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"; +my $VERSION = "0.1.0"; use strict; @@ -75,7 +69,7 @@ my $SESSDIR = undef; my %SERVMAP = (); my %CLIENT_NOIP = (); my %KIDMAP = (); -my $CLIENTKID = undef; +my $CLIENTKID = -1; ###-------------------------------------------------------------------------- ### Utilities. @@ -155,6 +149,13 @@ sub set_cloexec ($) { sysfail "failed to set close-on-exec: $!"; } +sub set_nonblock ($) { + my ($fh) = @_; + my $f = fcntl $fh, F_GETFL, 0 or sysfail "failed to get file flags: $!"; + fcntl $fh, F_SETFL, $f | O_NONBLOCK or + sysfail "failed to set non-blockingness: $!"; +} + sub lockedp ($) { my ($f) = @_; my $l = new File::FcntlLock; @@ -162,10 +163,30 @@ sub lockedp ($) { return $l->l_type != F_UNLCK; } +sub write_to_file ($$) { + my ($file, $contents) = @_; + my $new = "$file.new"; + open my $fh, ">", $new or sysfail "couldn't open `$new' for writing: $!"; + print $fh $contents; + $fh->flush && !$fh->error && close $fh + or sysfail "failed to write to `$new': $!"; + rename $new, $file or sysfail "failed to rename `$new' to `$file': $!"; +} + +my %OLDSIGS; +sub set_sighandler ($$) { + my ($sig, $handler) = @_; + unless (exists $OLDSIGS{$sig}) { $OLDSIGS{$sig} = $SIG{$sig}; } + $SIG{$sig} = $handler; +} + my $INKIDP = 0; sub myfork () { my $kid = fork; - if (defined $kid && !$kid) { $INKIDP = 1; } + if (defined $kid && !$kid) { + $INKIDP = 1; + for my $sig (keys %OLDSIGS) { $SIG{$sig} = $OLDSIGS{$sig}; } + } return $kid; } @@ -592,8 +613,11 @@ sub fix_server_config ($) { $s->{"_proxy_sockdir"} = undef; $s->{"_proxy_server"} = defined $s->{"via"} ? $s->{"sshbind"} : $s->{"remote"}; + $s->{"_proxy_server"} =~ s/:119$//; + $s->{"_proxy_server"} =~ s/^\[(.*)\]$/$1/; $s->{"_sshkid"} = undef; - $s->{"_ssh_master"} = undef; + $s->{"_ssh_stdin"} = undef; + $s->{"_ssh_stdout"} = undef; } sub hack_noip_envvar ($$) { @@ -628,7 +652,7 @@ sub server_listen ($) { for my $a (@{$s->{"_laddrs"}}) { socket my $sk, PF_UNIX, SOCK_STREAM, 0 or sysfail "failed to make Unix-domain socket: $!"; - set_cloexec $sk; + set_cloexec $sk; set_nonblock $sk; my $sa = "$SESSDIR/noip-client/$a"; bind $sk, sockaddr_un $sa or sysfail "failed to bind Unix-domain socket to `$sa': $!"; @@ -653,73 +677,87 @@ sub server_listen ($) { } $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. + ## 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' detaches OpenSSH from any 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). The `echo' will let us know that it's started + ## up, and the `read' will keep the tunnel open until we close our end, + ## which we do implicitly when we exit. inform " starting SSH tunnel"; - my @sshargs = ("ssh", "-L$sshbind:$remote"); + my @sshargs = ("ssh", "-L$sshbind:$remote", "-Snone"); $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; + push @sshargs, $via, < $server +set -e; echo started; read hunoz +EOF + pipe my $rin, my $win and pipe my $rout, my $wout + or sysfail "failed to create pipe: $!"; + set_cloexec $win; + set_cloexec $rout; set_nonblock $rout; 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: $!"; + open STDIN, "<&", $rin or sysfail "failed to dup pipe to stdin: $!"; + open STDOUT, "<&", $wout or sysfail "failed to dup pipe to stdout: $!"; hack_noip_env \%ssh_noip, $sockdir; exec @sshargs or sysfail "failed to exec SSH: $!"; } - close $rfd; + close $rin; + close $wout; $s->{"_sshkid"} = $kid; - $s->{"_ssh_pipe"} = $wfd; + $s->{"_ssh_stdin"} = $win; + $s->{"_ssh_stdout"} = $rout; $KIDMAP{$kid} = [$s, "SSH tunnel"]; + write_to_file "$SESSDIR/ssh-$server.pid", "$kid\n"; } } sub wait_for_ssh () { - inform "waiting for SSH tunnels to start..."; - my $delay = 0.1; - my $max = 10; - my $mult = 1.3; + my $rfd_in = ""; - 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; + ## Collect up all the `stdout' pipes. + my %fd = (); + SETUP: for my $s (values %S) { + next SETUP unless $s->{"_sshkid"}; + my $fd = fileno $s->{"_ssh_stdout"}; + vec($rfd_in, $fd, 1) = 1; + $fd{$fd} = [$s->{"_ssh_stdout"}, $s]; + } + unless (%fd) { + inform "no SSH tunnels to start"; + return; + } + + ## Wait for each of them to become readable, and try to read a thing. + ## Either we'll get a byte or EOF; either means that the respective tunnel + ## is as ready as it's ever going to be. + inform "waiting for SSH tunnels to start..."; + my $nbad = 0; + SELECT: while (%fd) { + my ($n, $t) = select my $rfd_out = $rfd_in, undef, undef, undef; + if ($n >= 0) { } + elsif ($! == EINTR) { next SELECT; } + else { sysfail "select failed: $!"; } + FD: for my $fd (keys %fd) { + next FD unless vec $rfd_out, $fd, 1; + my ($sk, $s) = @{$fd{$fd}}; + my $n = sysread $sk, my $hunoz, 128; + if (defined $n) { + vec($rfd_in, $fd, 1) = 0; + if ($n) { inform " tunnel to $s->{remote} started ok"; } + else { inform " tunnel to $s->{remote} FAILED"; $nbad++; } + delete $fd{$fd}; + } elsif ($! != EAGAIN && $! != EWOULDBLOCK) { + sysfail "failed to read from pipe: $!"; } } - 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; } + if ($nbad) { inform " tunnels started; $nbad FAILED"; } + else { inform " all tunnels started ok"; } } -$SIG{"CHLD"} = sub { +set_sighandler "CHLD", sub { KID: for (;;) { defined (my $kid = waitpid -1, WNOHANG) or sysfail "failed to reap child: $!"; @@ -761,20 +799,24 @@ sub run_client (@) { exec @args or sysfail "failed to exec `$prog': $!"; } $CLIENTKID = $kid; + write_to_file "$SESSDIR/client.pid", "$kid\n"; } sub accept_loop () { my $rfd_in = ""; for my $fd (keys %SERVMAP) { vec($rfd_in, $fd, 1) = 1; } - for (;;) { + SELECT: for (;;) { my ($n, $t) = select my $rfd_out = $rfd_in, undef, undef, undef; - $n >= 0 || $! == EINTR or sysfail "select failed: $!"; + if ($n >= 0) { } + elsif ($! == EINTR) { next SELECT; } + else { sysfail "select failed: $!"; } FD: for my $fd (keys %SERVMAP) { - next unless vec $rfd_out, $fd, 1; + next FD unless vec $rfd_out, $fd, 1; my ($s, $a, $sk) = @{$SERVMAP{$fd}}; my $nsk; unless (accept $nsk, $sk) { - moan "failed to accept new connection: $!"; + moan "failed to accept new connection: $!" + unless $! == EAGAIN || $! == EWOULDBLOCK; next FD; } set_cloexec $nsk;