### 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
-##
-## pidfiles
-
-my $VERSION = "0.1.0~unfinished";
+my $VERSION = "0.1.0";
use strict;
my %SERVMAP = ();
my %CLIENT_NOIP = ();
my %KIDMAP = ();
-my $CLIENTKID = undef;
+my $CLIENTKID = -1;
###--------------------------------------------------------------------------
### Utilities.
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;
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;
}
$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 ($$) {
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': $!";
}
$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, <<EOF;
+## with-authinfo-kludge tunnel: $TAG -> $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: $!";
exec @args or sysfail "failed to exec `$prog': $!";
}
$CLIENTKID = $kid;
+ write_to_file "$SESSDIR/client.pid", "$kid\n";
}
sub accept_loop () {
my ($n, $t) = select my $rfd_out = $rfd_in, undef, undef, undef;
if ($n >= 0) { }
elsif ($! == EINTR) { next SELECT; }
- else { sysfail "select failed: $!"; }
+ 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;
~mdw / with-authinfo-kludge / blobdiff