[Pkg-privacy-commits] [msva-perl] 88/356: added subprocess supervision to ease desktop integration
Ximin Luo
infinity0 at moszumanska.debian.org
Mon Aug 24 07:41:43 UTC 2015
This is an automated email from the git hooks/post-receive script.
infinity0 pushed a commit to branch debian
in repository msva-perl.
commit f6d7ecb156d682592bbfa49f1c1d18f14ba71aa1
Author: Daniel Kahn Gillmor <dkg at fifthhorseman.net>
Date: Thu Mar 11 19:14:28 2010 -0500
added subprocess supervision to ease desktop integration
---
Net/Server/MSVA.pm | 72 +++++++++++++++++++++++++++++++++++++++++++++++++++
msva-perl | 76 +++++++++++++++++++++++++++++++++++++++++++++++++-----
test-msva | 16 ++++++++++++
3 files changed, 157 insertions(+), 7 deletions(-)
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 <dkg at 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 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 <dkg at fifthhorseman.net>
+# Date: 2010-03-11 14:53:07-0500
+
+dir=$(dirname "$0")
+exec perl -wT -I"$dir" "$dir"/msva-perl "$@"
+
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-privacy/packages/msva-perl.git
More information about the Pkg-privacy-commits
mailing list