### 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.2";
use strict;
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 POSIX qw(:errno_h :fcntl_h :sys_wait_h
+ setpgid tcgetpgrp tcsetpgrp);
use Socket qw(/^[AP]F_/ /^SOCK_/ /^sockaddr_/
getaddrinfo /^AI_/ /^EAI_/
getnameinfo /^NI_/);
my %SERVMAP = ();
my %CLIENT_NOIP = ();
my %KIDMAP = ();
+my $MYPGID = getpgrp;
+my $TTYFD = undef;
my $CLIENTKID = -1;
###--------------------------------------------------------------------------
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;
}
## 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
+ ## 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,
$s->{"_ssh_stdin"} = $win;
$s->{"_ssh_stdout"} = $rout;
$KIDMAP{$kid} = [$s, "SSH tunnel"];
+ write_to_file "$SESSDIR/ssh-$server.pid", "$kid\n";
}
}
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 %fd) {
next FD unless vec $rfd_out, $fd, 1;
my ($sk, $s) = @{$fd{$fd}};
else { inform " all tunnels started ok"; }
}
-$SIG{"CHLD"} = sub {
+## Collect a file descriptor for the controlling terminal. It's totally not
+## a problem if this doesn't work: then we'll just live without the job
+## control stuff, which is fine because we only need it when terminals are
+## involved.
+$TTYFD = POSIX::open "/dev/tty", O_RDWR;
+
+sub maybe_foreground_client () {
+ ## If we're currently the foreground process group, then make the client be
+ ## the foreground instead.
+
+ if (defined $TTYFD && $MYPGID == tcgetpgrp $TTYFD) {
+ kill -CONT, $CLIENTKID
+ or sysfail "failed to wake client: $!";
+ tcsetpgrp $TTYFD, $CLIENTKID
+ or sysfail "failed to make client the foreground process group: $!";
+ }
+}
+
+sub maybe_stop_self () {
+ ## If the client is currently the foreground process group, then we should
+ ## background ourselves.
+
+ if (defined $TTYFD && $CLIENTKID == tcgetpgrp $TTYFD) {
+ kill -TSTP, $MYPGID
+ or sysfail "failed to suspend own process group: $!";
+ }
+}
+
+set_sighandler "CONT", sub {
+ maybe_foreground_client;
+};
+
+set_sighandler "CHLD", sub {
KID: for (;;) {
- defined (my $kid = waitpid -1, WNOHANG)
+ defined (my $kid = waitpid -1, WNOHANG | WUNTRACED)
or sysfail "failed to reap child: $!";
last KID if $kid <= 0;
+ my $st = ${^CHILD_ERROR_NATIVE};
my ($how, $rc);
- if ($? == 0) {
+ if (WIFEXITED($st) && WEXITSTATUS($st) == 0) {
$how = "exited successfully";
$rc = 0;
- } elsif ($? & 0xff) {
- my $sig = $? & 0x7f;
+ } elsif (WIFSTOPPED($st)) {
+ maybe_stop_self if $kid == $CLIENTKID;
+ next KID;
+ } elsif (WIFSIGNALED($st)) {
+ my $sig = WTERMSIG($st);
$how = "killed by signal $sig";
$how .= " (core dumped)" if $? & 0x80;
$rc = $sig | 0x80;
} else {
- $rc = $? >> 8;
+ $rc = WEXITSTATUS($st);
$how = "exited with status $rc";
}
if ($kid == $CLIENTKID) {
my (@args) = @_;
inform "starting client";
+ pipe my $r, my $w or sysfail "failed to create pipe: $!";
defined (my $kid = myfork) or sysfail "failed to fork: $!";
if (!$kid) {
hack_noip_env \%CLIENT_NOIP, "$SESSDIR/noip-client";
+ setpgid $$, $$ or sysfail "failed to set kid process group: $!";
+ close $w; close $r;
my $prog = $args[0];
exec @args or sysfail "failed to exec `$prog': $!";
}
+ close $w;
+ defined sysread $r, my $buf, 1
+ or sysfail "failed to read pipe: $!";
+ close $r;
$CLIENTKID = $kid;
+ write_to_file "$SESSDIR/client.pid", "$kid\n";
+ maybe_foreground_client;
}
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 FD unless vec $rfd_out, $fd, 1;
my ($s, $a, $sk) = @{$SERVMAP{$fd}};