From: Daniel Kahn Gillmor Date: Fri, 12 Mar 2010 00:14:28 +0000 (-0500) Subject: added subprocess supervision to ease desktop integration X-Git-Tag: msva-perl/0.2~9 X-Git-Url: http://git.tremily.us/gitweb.cgi?a=commitdiff_plain;h=f6d7ecb156d682592bbfa49f1c1d18f14ba71aa1;p=monkeysphere-validation-agent.git added subprocess supervision to ease desktop integration --- diff --git a/Net/Server/MSVA.pm b/Net/Server/MSVA.pm new file mode 100644 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 +# +# 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 . + +{ 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 907fe28..ad494f4 100755 --- 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 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 +# Date: 2010-03-11 14:53:07-0500 + +dir=$(dirname "$0") +exec perl -wT -I"$dir" "$dir"/msva-perl "$@" +