added subprocess supervision to ease desktop integration

diff --git a/Net/Server/MSVA.pm b/Net/Server/MSVA.pm
new file mode 100644 (file)
index 0000000..96657ca
--- /dev/null
+++ b/Net/Server/MSVA.pm
@@ -0,0 +1,72 @@
+#!/usr/bin/perl -wT
+
+# Net::Server implementation for Monkeysphere Validation Agent
+# Copyright © 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+{ package Net::Server::MSVA;
+  use strict;
+  use base qw(Net::Server::Fork);
+  use Net::Server::SIG qw(register_sig);
+
+  my $msva;
+  my $oldsighdlr;
+  my $exit_status = 0;
+
+  sub post_bind_hook {
+    my $self = shift;
+    $msva->post_bind_hook(@_);
+  }
+
+  sub set_exit_status {
+    my $self = shift;
+    $exit_status = shift;
+  }
+
+  # FIXME: this is an override of an undocumented interface of
+  # Net::Server.  it would be better to use a documented hook, if
+  # https://rt.cpan.org/Public/Bug/Display.html?id=55485 was resolved
+
+  sub delete_child {
+    my $self = shift;
+    my $pid = shift;
+
+    $msva->child_dies($pid, $self);
+    $self->SUPER::delete_child($pid, @_);
+  }
+
+  sub server_exit {
+    my $self = shift;
+    exit $exit_status;
+  }
+
+  sub run {
+    my $self = shift;
+    my $options = { @_ };
+
+#  check_for_dequeue=>10, max_dequeue=>1
+
+    if (exists $options->{msva}) {
+      $msva = $options->{msva};
+    };
+#    $oldsighdlr = $NET::Server::SIG::_SIG_SUB{CHLD};
+#    register_sig(USR2 => \&child_dies,
+#                 CHLD => \&child_dies);
+
+    $self->SUPER::run(@_);
+  }
+
+  1;
+}

diff --git a/msva-perl b/msva-perl
index 907fe28fa8a32ec01c0de11208bce1d8548df0d3..ad494f45565491f027ef3a2ae7563c7e473ea836 100755 (executable)
--- a/msva-perl
+++ b/msva-perl
@@ -19,8 +19,7 @@
 use warnings;
 use strict;
 
-{
-  package MSVA;
+{ package MSVA;
 
   use parent qw(HTTP::Server::Simple::CGI);
   require Crypt::X509;
@@ -29,7 +28,6 @@ use strict;
   use IO::Socket;
   use IO::File;
   use Socket;
-  use Net::Server::Fork;
 
   use JSON;
   use POSIX qw(strftime);
@@ -82,7 +80,7 @@ use strict;
   };
 
   sub net_server {
-    return 'Net::Server::Fork';
+    return 'Net::Server::MSVA';
   };
 
   sub new {
@@ -377,6 +375,57 @@ use strict;
     return $status, $ret;
   }
 
+  sub child_dies {
+    my $self = shift;
+    my $pid = shift;
+    my $server = shift;
+
+    if (exists $self->{child_pid} &&
+        $self->{child_pid} == $pid) {
+      my $exitstatus = POSIX::WEXITSTATUS($?);
+      msvalog('verbose', "Subprocess %d terminated; exiting %d.\n", $pid, $exitstatus);
+      $server->set_exit_status($exitstatus);
+      $server->server_close();
+    }
+  }
+
+  # use sparingly!  We want to keep taint mode around for the data we
+  # get over the network.  this is only here because we want to treat
+  # the command line arguments differently for the subprocess.
+  sub untaint {
+    my $x = shift;
+    $x =~ /^(.*)$/ ;
+    return $1;
+  }
+
+  sub post_bind_hook {
+    my $self = shift;
+
+    my $argcount = @ARGV;
+    if ($argcount) {
+      my $fork = fork();
+      if (! defined $fork) {
+        msvalog('error', "could not fork\n");
+      } else {
+        if ($fork) {
+          $self->{child_pid} = $fork;
+        } else {
+          msvalog('verbose', "Executing: \n");
+          for my $arg (@ARGV) {
+            msvalog('verbose', " %s\n", $arg);
+          }
+          $ENV{PATH} = untaint($ENV{PATH});
+          my @args;
+          foreach (@ARGV) {
+            push @args, untaint($_);
+          }
+          $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET} = sprintf('http://localhost:%d', $self->port);
+          exec(@args);
+        }
+      }
+    };
+  }
+
   sub extracerts {
     my $data = shift;
 
@@ -387,7 +436,7 @@ use strict;
 }
 
 my $server = MSVA->new();
-$server->run(host=>'localhost');
+$server->run(host=>'localhost', msva=>$server);
 __END__
 
 =head1 NAME
@@ -396,7 +445,7 @@ msva-perl - Perl implementation of a Monkeysphere Validation Agent
 
 =head1 SYNOPSIS
 
-  msva-perl
+  msva-perl [ COMMAND [ ARGS ... ] ]
 
 =head1 ABSTRACT
 
@@ -420,6 +469,19 @@ context.
 msva-perl relies on monkeysphere(1), which uses the user's OpenPGP web
 of trust to validate the peer's use of public keys.
 
+=head1 USAGE
+
+Launched with no arguments, msva-perl simply runs and listens forever.
+
+Launched with arguments, it sets up a listener, spawns a subprocess
+using the supplied command and arguments, but with the
+MONKEYSPHERE_VALIDATION_AGENT_SOCKET environment variable set to refer
+to its listener.  When the subprocess terminates, msva-perl tears down
+the listener and exits as well, returning the same value as the
+subprocess.
+
+This is a similar invocation pattern to that of ssh-agent(1).
+
 =head1 ENVIRONMENT VARIABLES
 
 msva-perl is configured by means of environment variables.
@@ -466,7 +528,7 @@ MSVA_ALLOWED_USERS above).
 
 =head1 SEE ALSO
 
-monkeysphere(1), monkeysphere(7)
+monkeysphere(1), monkeysphere(7), ssh-agent(1)
 
 =head1 BUGS AND FEEDBACK
 

diff --git a/test-msva b/test-msva
new file mode 100755 (executable)
index 0000000..3aff6bc
--- /dev/null
+++ b/test-msva
@@ -0,0 +1,16 @@
+#!/bin/sh
+
+# this script exists so that you can launch the msva-perl directly
+# from your development environment without having to install
+# anything.
+
+# it appears to be necessary because of some weirdness in how
+# HTTP::Server::Simple interacts with Net::Server -- otherwise, i
+# wouldn't need to shuffle all these files around.
+
+# Author: Daniel Kahn Gillmor <dkg@fifthhorseman.net>
+# Date: 2010-03-11 14:53:07-0500
+
+dir=$(dirname "$0")
+exec perl -wT -I"$dir" "$dir"/msva-perl "$@"
+