Release 0.1.1.

[with-authinfo-kludge] / with-authinfo-kludge

diff --git a/with-authinfo-kludge b/with-authinfo-kludge
index 47660a4..d1bb048 100755 (executable)
--- a/with-authinfo-kludge
+++ b/with-authinfo-kludge
@@ -21,7 +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.
 
-my $VERSION = "0.1.0~unfinished";
+my $VERSION = "0.1.1";
 
 use strict;
 
@@ -33,7 +33,8 @@ use Fcntl qw(:mode);
 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_/);
@@ -69,6 +70,8 @@ my $SESSDIR = undef;
 my %SERVMAP = ();
 my %CLIENT_NOIP = ();
 my %KIDMAP = ();
+my $MYPGID = getpgrp;
+my $TTYFD = undef;
 my $CLIENTKID = -1;
 
 ###--------------------------------------------------------------------------
@@ -173,10 +176,20 @@ sub write_to_file ($$) {
   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;
 }
 
@@ -669,8 +682,8 @@ sub server_listen ($) {
 
     ## 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,
@@ -728,7 +741,7 @@ sub wait_for_ssh () {
     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}};
@@ -747,22 +760,58 @@ sub wait_for_ssh () {
   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) {
@@ -785,11 +834,13 @@ sub run_client (@) {
   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: $!";
     my $prog = $args[0];
     exec @args or sysfail "failed to exec `$prog': $!";
   }
   $CLIENTKID = $kid;
   write_to_file "$SESSDIR/client.pid", "$kid\n";
+  maybe_foreground_client;
 }
 
 sub accept_loop () {
@@ -799,7 +850,7 @@ 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}};