1 # Monkeysphere Validation Agent, Perl version
2 # Copyright © 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net>
4 # This program is free software: you can redistribute it and/or modify
5 # it under the terms of the GNU General Public License as published by
6 # the Free Software Foundation, either version 3 of the License, or
7 # (at your option) any later version.
9 # This program is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 # GNU General Public License for more details.
14 # You should have received a copy of the GNU General Public License
15 # along with this program. If not, see <http://www.gnu.org/licenses/>.
17 { package Crypt::Monkeysphere::MSVA;
22 use parent qw(HTTP::Server::Simple::CGI);
24 use Regexp::Common qw /net/;
33 use Crypt::Monkeysphere::MSVA::MarginalUI;
34 use Crypt::Monkeysphere::MSVA::Logger;
35 use Crypt::Monkeysphere::MSVA::Monitor;
38 use POSIX qw(strftime);
39 # we need the version of GnuPG::Interface that knows about pubkey_data, etc:
40 use GnuPG::Interface 0.42.02;
44 my $gnupg = GnuPG::Interface->new();
45 $gnupg->options->quiet(1);
46 $gnupg->options->batch(1);
49 '/' => { handler => \&noop,
50 methods => { 'GET' => 1 },
52 '/reviewcert' => { handler => \&reviewcert,
53 methods => { 'POST' => 1 },
55 '/extracerts' => { handler => \&extracerts,
56 methods => { 'POST' => 1 },
60 my $default_keyserver = 'hkp://pool.sks-keyservers.net';
61 my $default_keyserver_policy = 'unlessvalid';
63 my $logger = Crypt::Monkeysphere::MSVA::Logger->new($ENV{MSVA_LOG_LEVEL});
68 my $rsa_decoder = Convert::ASN1->new;
69 $rsa_decoder->prepare(q<
78 return 'Net::Server::MSVA';
82 return $logger->log(@_);
89 if (exists $ENV{MSVA_PORT} and $ENV{MSVA_PORT} ne '') {
90 msvalog('debug', "MSVA_PORT set to %s\n", $ENV{MSVA_PORT});
91 $port = $ENV{MSVA_PORT} + 0;
92 die sprintf("not a reasonable port %d", $port) if (($port >= 65536) || $port <= 0);
94 # start the server on requested port
95 my $self = $class->SUPER::new($port);
96 if (! exists $ENV{MSVA_PORT}) {
97 # we can't pass port 0 to the constructor because it evaluates
98 # to false, so HTTP::Server::Simple just uses its internal
99 # default of 8080. But if we want to select an arbitrary open
100 # port, we *can* set it here.
104 $self->{allowed_uids} = {};
105 if (exists $ENV{MSVA_ALLOWED_USERS} and $ENV{MSVA_ALLOWED_USERS} ne '') {
106 msvalog('verbose', "MSVA_ALLOWED_USERS environment variable is set.\nLimiting access to specified users.\n");
107 foreach my $user (split(/ +/, $ENV{MSVA_ALLOWED_USERS})) {
108 my ($name, $passwd, $uid);
109 if ($user =~ /^[0-9]+$/) {
110 $uid = $user + 0; # force to integer
112 ($name,$passwd,$uid) = getpwnam($user);
115 msvalog('verbose', "Allowing access from user ID %d\n", $uid);
116 $self->{allowed_uids}->{$uid} = $user;
118 msvalog('error', "Could not find user '%d'; not allowing\n", $user);
122 # default is to allow access only to the current user
123 $self->{allowed_uids}->{POSIX::getuid()} = 'self';
126 bless ($self, $class);
133 return '200 OK', { available => JSON::true,
138 sub opensshpubkey2key {
140 # FIXME: do we care that the label matches the type of key?
141 my ($label, $prop) = split(/ +/, $data);
143 my $out = parse_rfc4716body($prop);
152 my $continuation = '';
153 my $state = 'outside';
154 foreach my $line (split(/\n/, $data)) {
155 last if ($state eq 'body' && $line eq '---- END SSH2 PUBLIC KEY ----');
156 if ($state eq 'outside' && $line eq '---- BEGIN SSH2 PUBLIC KEY ----') {
160 if ($state eq 'header') {
161 $line = $continuation.$line;
163 if ($line =~ /^(.*)\\$/) {
167 if (! ($line =~ /:/)) {
171 push(@goodlines, $line) if ($state eq 'body');
174 msvalog('debug', "Found %d lines of RFC4716 body:\n%s\n",
176 join("\n", @goodlines));
177 my $out = parse_rfc4716body(join('', @goodlines));
182 sub parse_rfc4716body {
184 $data = decode_base64($data) or return undef;
186 msvalog('debug', "key properties: %s\n", unpack('H*', $data));
188 while (length($data) > 4) {
189 my $size = unpack('N', substr($data, 0, 4));
190 msvalog('debug', "size: 0x%08x\n", $size);
191 return undef if (length($data) < $size + 4);
192 push(@{$out}, substr($data, 4, $size));
193 $data = substr($data, 4 + $size);
196 if ($out->[0] ne "ssh-rsa") {
197 return {error => 'Not an RSA key'};
200 if (scalar(@{$out}) != 3) {
201 return {error => 'Does not contain the right number of bigints for RSA'};
204 return { exponent => Math::BigInt->from_hex('0x'.unpack('H*', $out->[1])),
205 modulus => Math::BigInt->from_hex('0x'.unpack('H*', $out->[2])),
210 # return an arrayref of processes which we can detect that have the
211 # given socket open (the socket is specified with its inode)
212 sub getpidswithsocketinode {
215 # this appears to be how Linux symlinks open sockets in /proc/*/fd,
216 # as of at least 2.6.26:
217 my $socktarget = sprintf('socket:[%d]', $sockid);
221 if (opendir($procfs, '/proc')) {
222 foreach my $pid (grep { /^\d+$/ } readdir($procfs)) {
223 my $procdir = sprintf('/proc/%d', $pid);
226 if (opendir($procfds, sprintf('/proc/%d/fd', $pid))) {
227 foreach my $procfd (grep { /^\d+$/ } readdir($procfds)) {
228 my $fd = sprintf('/proc/%d/fd/%d', $pid, $procfd);
230 #my ($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($fd);
231 my $targ = readlink($fd);
233 if ($targ eq $socktarget);
243 # FIXME: this whole business is very linux-specific, i think. i
244 # wonder how to get this info in other OSes?
249 # return {uid => X, inode => Y}, meaning the numeric ID of the peer
250 # on the other end of $socket, "socket inode" identifying the peer's
251 # open network socket. each value could be undef if unknown.
252 sub get_client_info {
255 my $sock = IO::Socket->new_from_fd($socket, 'r');
256 # check SO_PEERCRED -- if this was a TCP socket, Linux
257 # might not be able to support SO_PEERCRED (even on the loopback),
258 # though apparently some kernels (Solaris?) are able to.
261 my $remotesocketinode;
262 my $socktype = $sock->sockopt(SO_TYPE) or die "could not get SO_TYPE info";
263 if (defined $socktype) {
264 msvalog('debug', "sockopt(SO_TYPE) = %d\n", $socktype);
266 msvalog('verbose', "sockopt(SO_TYPE) returned undefined.\n");
269 my $peercred = $sock->sockopt(SO_PEERCRED) or die "could not get SO_PEERCRED info";
270 my $client = $sock->peername();
271 my $family = sockaddr_family($client); # should be AF_UNIX (a.k.a. AF_LOCAL) or AF_INET
273 msvalog('verbose', "socket family: %d\nsocket type: %d\n", $family, $socktype);
276 # FIXME: on i386 linux, this appears to be three ints, according to
277 # /usr/include/linux/socket.h. What about other platforms?
278 my ($pid, $uid, $gid) = unpack('iii', $peercred);
280 msvalog('verbose', "SO_PEERCRED: pid: %u, uid: %u, gid: %u\n",
283 if ($pid != 0 && $uid != 0) { # then we can accept it:
286 # FIXME: can we get the socket inode as well this way?
289 # another option in Linux would be to parse the contents of
290 # /proc/net/tcp to find the uid of the peer process based on that
292 if (! defined $clientid) {
293 msvalog('verbose', "SO_PEERCRED failed, digging around in /proc/net/tcp\n");
295 if ($family == AF_INET) {
297 } elsif ($family == AF_INET6) {
300 if (defined $proto) {
301 if ($socktype == &SOCK_STREAM) {
302 $proto = 'tcp'.$proto;
303 } elsif ($socktype == &SOCK_DGRAM) {
304 $proto = 'udp'.$proto;
308 if (defined $proto) {
309 my ($port, $iaddr) = unpack_sockaddr_in($client);
310 my $iaddrstring = unpack("H*", reverse($iaddr));
311 msvalog('verbose', "Port: %04x\nAddr: %s\n", $port, $iaddrstring);
312 my $remmatch = lc(sprintf("%s:%04x", $iaddrstring, $port));
313 my $infofile = '/proc/net/'.$proto;
314 my $f = new IO::File;
315 if ( $f->open('< '.$infofile)) {
316 my @header = split(/ +/, <$f>);
317 my ($localaddrix, $uidix, $inodeix);
320 while ($ix <= $#header) {
321 $localaddrix = $ix - $skipcount if (lc($header[$ix]) eq 'local_address');
322 $uidix = $ix - $skipcount if (lc($header[$ix]) eq 'uid');
323 $inodeix = $ix - $skipcount if (lc($header[$ix]) eq 'inode');
324 $skipcount++ if (lc($header[$ix]) eq 'tx_queue') or (lc($header[$ix]) eq 'tr'); # these headers don't actually result in a new column during the data rows
327 if (!defined $localaddrix) {
328 msvalog('info', "Could not find local_address field in %s; unable to determine peer UID\n",
330 } elsif (!defined $uidix) {
331 msvalog('info', "Could not find uid field in %s; unable to determine peer UID\n",
333 } elsif (!defined $inodeix) {
334 msvalog('info', "Could not find inode field in %s; unable to determine peer network socket inode\n",
337 msvalog('debug', "local_address: %d; uid: %d\n", $localaddrix,$uidix);
338 while (my @line = split(/ +/,<$f>)) {
339 if (lc($line[$localaddrix]) eq $remmatch) {
340 if (defined $clientid) {
341 msvalog('error', "Warning! found more than one remote uid! (%s and %s\n", $clientid, $line[$uidix]);
343 $clientid = $line[$uidix];
344 $remotesocketinode = $line[$inodeix];
345 msvalog('info', "remote peer is uid %d (inode %d)\n",
346 $clientid, $remotesocketinode);
350 msvalog('error', "Warning! could not find peer information in %s. Not verifying.\n", $infofile) unless defined $clientid;
352 } else { # FIXME: we couldn't read the file. what should we
353 # do besides warning?
354 msvalog('info', "Could not read %s; unable to determine peer UID\n",
360 return { 'uid' => $clientid,
361 'inode' => $remotesocketinode };
368 # This is part of a spawned child process. We don't want the
369 # child process to destroy the update monitor when it terminates.
370 $self->{updatemonitor}->forget();
371 my $clientinfo = get_client_info(select);
372 my $clientuid = $clientinfo->{uid};
374 if (defined $clientuid) {
375 # test that this is an allowed user:
376 if (exists $self->{allowed_uids}->{$clientuid}) {
377 msvalog('verbose', "Allowing access from uid %d (%s)\n", $clientuid, $self->{allowed_uids}->{$clientuid});
379 msvalog('error', "MSVA client connection from uid %d, forbidden.\n", $clientuid);
380 printf("HTTP/1.0 403 Forbidden -- peer does not match local user ID\r\nContent-Type: text/plain\r\nDate: %s\r\n\r\nHTTP/1.1 403 Not Found -- peer does not match the local user ID. Are you sure the agent is running as the same user?\r\n",
381 strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time())),);
386 my $path = $cgi->path_info();
387 my $handler = $dispatch{$path};
389 if (ref($handler) eq "HASH") {
390 if (! exists $handler->{methods}->{$cgi->request_method()}) {
391 printf("HTTP/1.0 405 Method not allowed\r\nAllow: %s\r\nDate: %s\r\n",
392 join(', ', keys(%{$handler->{methods}})),
393 strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time())));
394 } elsif (ref($handler->{handler}) ne "CODE") {
395 printf("HTTP/1.0 500 Server Error\r\nDate: %s\r\n",
396 strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time())));
399 my $ctype = $cgi->content_type();
400 msvalog('verbose', "Got %s %s (Content-Type: %s)\n", $cgi->request_method(), $path, defined $ctype ? $ctype : '**none supplied**');
401 if (defined $ctype) {
402 my @ctypes = split(/; */, $ctype);
403 $ctype = shift @ctypes;
404 if ($ctype eq 'application/json') {
405 $data = from_json($cgi->param('POSTDATA'));
409 my ($status, $object) = $handler->{handler}($data, $clientinfo);
410 if (ref($object) eq 'HASH' &&
411 ! defined $object->{server}) {
412 $object->{server} = sprintf("MSVA-Perl %s", $VERSION);
415 my $ret = to_json($object);
416 msvalog('info', "returning: %s\n", $ret);
417 printf("HTTP/1.0 %s\r\nDate: %s\r\nContent-Type: application/json\r\n\r\n%s",
419 strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time())),
423 printf("HTTP/1.0 404 Not Found -- not handled by Monkeysphere validation agent\r\nContent-Type: text/plain\r\nDate: %s\r\n\r\nHTTP/1.0 404 Not Found -- the path:\r\n %s\r\nis not handled by the MonkeySphere validation agent.\r\nPlease try one of the following paths instead:\r\n\r\n%s\r\n",
424 strftime("%a, %d %b %Y %H:%M:%S %z", localtime(time())),
425 $path, ' * '.join("\r\n * ", keys %dispatch) );
433 if ($gpgkey->algo_num != 1) {
434 msvalog('verbose', "Monkeysphere only does RSA keys. This key is algorithm #%d\n", $gpgkey->algo_num);
436 if ($rsakey->{exponent}->bcmp($gpgkey->pubkey_data->[1]) == 0 &&
437 $rsakey->{modulus}->bcmp($gpgkey->pubkey_data->[0]) == 0) {
446 my @lines = split(/\n/, $pem);
449 foreach my $line (@lines) {
450 if ($line eq '-----END CERTIFICATE-----') {
453 push @goodlines, $line;
454 } elsif ($line eq '-----BEGIN CERTIFICATE-----') {
458 msvalog('debug', "%d lines of base64:\n%s\n", $#goodlines + 1, join("\n", @goodlines));
459 return decode_base64(join('', @goodlines));
465 my $cert = Crypt::X509->new(cert => $rawdata);
467 my $key = {error => 'I do not know what happened here'};
470 $key->{error} = sprintf("Error decoding X.509 certificate: %s", $cert->error);
472 msvalog('verbose', "cert subject: %s\n", $cert->subject_cn());
473 msvalog('verbose', "cert issuer: %s\n", $cert->issuer_cn());
474 msvalog('verbose', "cert pubkey algo: %s\n", $cert->PubKeyAlg());
475 msvalog('verbose', "cert pubkey: %s\n", unpack('H*', $cert->pubkey()));
477 if ($cert->PubKeyAlg() ne 'RSA') {
478 $key->{error} = sprintf('public key was algo "%s" (OID %s). MSVA.pl only supports RSA',
479 $cert->PubKeyAlg(), $cert->pubkey_algorithm);
481 msvalog('debug', "decoding ASN.1 pubkey\n");
482 $key = $rsa_decoder->decode($cert->pubkey());
483 if (! defined $key) {
484 msvalog('verbose', "failed to decode %s\n", unpack('H*', $cert->pubkey()));
485 $key = {error => 'failed to decode the public key'};
494 if ($data->{context} =~ /^(https|ssh)$/) {
495 $data->{context} = $1;
496 if ($data->{peer} =~ /^($RE{net}{domain})$/) {
498 return $data->{context}.'://'.$data->{peer};
503 sub get_keyserver_policy {
504 if (exists $ENV{MSVA_KEYSERVER_POLICY} and $ENV{MSVA_KEYSERVER_POLICY} ne '') {
505 if ($ENV{MSVA_KEYSERVER_POLICY} =~ /^(always|never|unlessvalid)$/) {
508 msvalog('error', "Not a valid MSVA_KEYSERVER_POLICY):\n %s\n", $ENV{MSVA_KEYSERVER_POLICY});
510 return $default_keyserver_policy;
514 # We should read from (first hit wins):
516 if (exists $ENV{MSVA_KEYSERVER} and $ENV{MSVA_KEYSERVER} ne '') {
517 if ($ENV{MSVA_KEYSERVER} =~ /^(((hkps?|finger|ldap):\/\/)?$RE{net}{domain})$/) {
520 msvalog('error', "Not a valid keyserver (from MSVA_KEYSERVER):\n %s\n", $ENV{MSVA_KEYSERVER});
523 # FIXME: some msva.conf or monkeysphere.conf file (system and user?)
525 # or else read from the relevant gnupg.conf:
527 if (exists $ENV{GNUPGHOME} and $ENV{GNUPGHOME} ne '') {
528 $gpghome = untaint($ENV{GNUPGHOME});
530 $gpghome = File::Spec->catfile(File::HomeDir->my_home, '.gnupg');
532 my $gpgconf = File::Spec->catfile($gpghome, 'gpg.conf');
535 my %gpgconfig = Config::General::ParseConfig($gpgconf);
536 if ($gpgconfig{keyserver} =~ /^(((hkps?|finger|ldap):\/\/)?$RE{net}{domain})$/) {
537 msvalog('debug', "Using keyserver %s from the GnuPG configuration file (%s)\n", $1, $gpgconf);
540 msvalog('error', "Not a valid keyserver (from gpg config %s):\n %s\n", $gpgconf, $gpgconfig{keyserver});
543 msvalog('error', "The GnuPG configuration file (%s) is not readable\n", $gpgconf);
546 msvalog('info', "Did not find GnuPG configuration file while looking for keyserver '%s'\n", $gpgconf);
549 # the default_keyserver
550 return $default_keyserver;
553 sub fetch_uid_from_keyserver {
556 my $cmd = IO::Handle->new();
557 my $out = IO::Handle->new();
558 my $nul = IO::File->new("< /dev/null");
560 my $ks = get_keyserver();
561 msvalog('debug', "start ks query to %s for UserID: %s\n", $ks, $uid);
562 my $pid = $gnupg->wrap_call
563 ( handles => GnuPG::Handles->new( command => $cmd, stdout => $out, stderr => $nul ),
564 command_args => [ '='.$uid ],
565 commands => [ '--keyserver',
567 qw( --no-tty --with-colons --search ) ]
569 while (my $line = $out->getline()) {
570 msvalog('debug', "from ks query: (%d) %s", $cmd->fileno, $line);
571 if ($line =~ /^info:(\d+):(\d+)/ ) {
572 $cmd->print(join(' ', ($1..$2))."\n");
573 msvalog('debug', 'to ks query: '.join(' ', ($1..$2))."\n");
577 # FIXME: can we do something to avoid hanging forever?
579 msvalog('debug', "ks query returns %d\n", POSIX::WEXITSTATUS($?));
584 my $clientinfo = shift;
585 return if !ref $data;
587 msvalog('verbose', "reviewing data...\n");
589 my $status = '200 OK';
590 my $ret = { valid => JSON::false,
591 message => 'Unknown failure',
594 my $uid = getuid($data);
596 msvalog('error', "invalid peer/context: %s/%s\n", $data->{context}, $data->{peer});
597 $ret->{message} = sprintf('invalid peer/context');
598 return $status, $ret;
600 msvalog('verbose', "context: %s\n", $data->{context});
601 msvalog('verbose', "peer: %s\n", $data->{peer});
604 if (lc($data->{pkc}->{type}) eq 'x509der') {
605 $key = der2key(join('', map(chr, @{$data->{pkc}->{data}})));
606 } elsif (lc($data->{pkc}->{type}) eq 'x509pem') {
607 $key = der2key(pem2der($data->{pkc}->{data}));
608 } elsif (lc($data->{pkc}->{type}) eq 'opensshpubkey') {
609 $key = opensshpubkey2key($data->{pkc}->{data});
610 } elsif (lc($data->{pkc}->{type}) eq 'rfc4716') {
611 $key = rfc47162key($data->{pkc}->{data});
613 $ret->{message} = sprintf("Don't know this public key carrier type: %s", $data->{pkc}->{type});
617 if (exists $key->{error}) {
618 $ret->{message} = $key->{error};
622 # make sure that the returned integers are Math::BigInts:
623 $key->{exponent} = Math::BigInt->new($key->{exponent}) unless (ref($key->{exponent}));
624 $key->{modulus} = Math::BigInt->new($key->{modulus}) unless (ref($key->{modulus}));
625 msvalog('debug', "pubkey info:\nmodulus: %s\nexponent: %s\n",
626 $key->{modulus}->as_hex(),
627 $key->{exponent}->as_hex(),
630 if ($key->{modulus}->copy()->blog(2) < 1000) {
631 $ret->{message} = sprintf('Public key size is less than 1000 bits (was: %d bits)', $key->{modulus}->copy()->blog(2));
633 $ret->{message} = sprintf('Failed to validate "%s" through the OpenPGP Web of Trust.', $uid);
636 if (defined $data->{keyserverpolicy} &&
637 $data->{keyserverpolicy} =~ /^(always|never|unlessvalid)$/) {
639 msvalog("verbose", "using requested keyserver policy: %s\n", $1);
641 $kspolicy = get_keyserver_policy();
643 msvalog('debug', "keyserver policy: %s\n", $kspolicy);
644 # needed because $gnupg spawns child processes
645 $ENV{PATH} = '/usr/local/bin:/usr/bin:/bin';
646 if ($kspolicy eq 'always') {
647 fetch_uid_from_keyserver($uid);
649 } elsif ($kspolicy eq 'never') {
654 # fingerprints of keys that are not fully-valid for this User ID, but match
655 # the key from the queried certificate:
656 my @subvalid_key_fprs;
659 foreach my $gpgkey ($gnupg->get_public_keys('='.$uid)) {
661 foreach my $tryuid ($gpgkey->user_ids) {
662 if ($tryuid->as_string eq $uid) {
663 $validity = $tryuid->validity;
666 # treat primary keys just like subkeys:
667 foreach my $subkey ($gpgkey, @{$gpgkey->subkeys}) {
668 my $primarymatch = keycomp($key, $subkey);
670 if ($subkey->usage_flags =~ /a/) {
671 msvalog('verbose', "key matches, and 0x%s is authentication-capable\n", $subkey->hex_id);
672 if ($validity =~ /^[fu]$/) {
674 msvalog('verbose', "...and it matches!\n");
675 $ret->{valid} = JSON::true;
676 $ret->{message} = sprintf('Successfully validated "%s" through the OpenPGP Web of Trust.', $uid);
678 push(@subvalid_key_fprs, { fpr => $subkey->fingerprint, val => $validity }) if $lastloop;
681 msvalog('verbose', "key matches, but 0x%s is not authentication-capable\n", $subkey->hex_id);
689 fetch_uid_from_keyserver($uid) if (!$foundvalid);
694 # only show the marginal UI if the UID of the corresponding
695 # key is not fully valid.
697 my $resp = Crypt::Monkeysphere::MSVA::MarginalUI->ask_the_user($gnupg,
700 getpidswithsocketinode($clientinfo->{inode}),
702 msvalog('info', "response: %s\n", $resp);
704 $ret->{valid} = JSON::true;
705 $ret->{message} = sprintf('Manually validated "%s" through the OpenPGP Web of Trust.', $uid);
709 return $status, $ret;
716 $self->spawn_master_subproc($server);
719 sub master_subprocess_died {
722 my $subproc_return = shift;
724 my $exitstatus = POSIX::WEXITSTATUS($subproc_return);
725 msvalog('verbose', "Subprocess %d terminated; exiting %d.\n", $self->{child_pid}, $exitstatus);
726 $server->set_exit_status($exitstatus);
727 $server->server_close();
735 msvalog('debug', "Subprocess %d terminated.\n", $pid);
737 if (exists $self->{updatemonitor} &&
738 defined $self->{updatemonitor}->getchildpid() &&
739 $self->{updatemonitor}->getchildpid() == $pid) {
740 my $exitstatus = POSIX::WEXITSTATUS($?);
741 msvalog('verbose', "Update monitoring process (%d) terminated with code %d.\n", $pid, $exitstatus);
742 if (0 == $exitstatus) {
743 msvalog('info', "Reloading MSVA due to update request.\n");
744 # sending self a SIGHUP:
747 msvalog('error', "Update monitoring process (%d) died unexpectedly with code %d.\nNo longer monitoring for updates; please send HUP manually.\n", $pid, $exitstatus);
748 # it died for some other weird reason; should we respawn it?
750 # FIXME: i'm worried that re-spawning would create a
751 # potentially abusive loop, if there are legit, repeatable
752 # reasons for the failure.
754 # $self->{updatemonitor}->spawn();
756 # instead, we'll just avoid trying to kill the next process with this PID:
757 $self->{updatemonitor}->forget();
759 } elsif (exists $self->{child_pid} &&
760 ($self->{child_pid} == 0 ||
761 $self->{child_pid} == $pid)) {
762 $self->master_subprocess_died($server, $?);
766 # use sparingly! We want to keep taint mode around for the data we
767 # get over the network. this is only here because we want to treat
768 # the command line arguments differently for the subprocess.
779 $server->{server}->{leave_children_open_on_hup} = 1;
781 my $socketcount = @{ $server->{server}->{sock} };
782 if ( $socketcount != 1 ) {
783 msvalog('error', "%d sockets open; should have been 1.\n", $socketcount);
784 $server->set_exit_status(10);
785 $server->server_close();
787 my $port = @{ $server->{server}->{sock} }[0]->sockport();
788 if ((! defined $port) || ($port < 1) || ($port >= 65536)) {
789 msvalog('error', "got nonsense port: %d.\n", $port);
790 $server->set_exit_status(11);
791 $server->server_close();
793 if ((exists $ENV{MSVA_PORT}) && (($ENV{MSVA_PORT} + 0) != $port)) {
794 msvalog('error', "Explicitly requested port %d, but got port: %d.", ($ENV{MSVA_PORT}+0), $port);
795 $server->set_exit_status(13);
796 $server->server_close();
799 $self->{updatemonitor} = Crypt::Monkeysphere::MSVA::Monitor->new($logger);
802 sub spawn_master_subproc {
806 if ((exists $ENV{MSVA_CHILD_PID}) && ($ENV{MSVA_CHILD_PID} ne '')) {
807 # this is most likely a re-exec.
808 msvalog('info', "This appears to be a re-exec, continuing with child pid %d\n", $ENV{MSVA_CHILD_PID});
809 $self->{child_pid} = $ENV{MSVA_CHILD_PID} + 0;
810 } elsif ($#ARGV >= 0) {
811 $self->{child_pid} = 0; # indicate that we are planning to fork.
812 # avoid ignoring SIGCHLD right before we fork.
815 while (defined($val = POSIX::waitpid(-1, POSIX::WNOHANG)) && $val > 0) {
816 $self->child_dies($val, $server);
820 if (! defined $fork) {
821 msvalog('error', "could not fork\n");
824 msvalog('debug', "Child process has PID %d\n", $fork);
825 $self->{child_pid} = $fork;
826 $ENV{MSVA_CHILD_PID} = $fork;
828 msvalog('verbose', "PID %d executing: \n", $$);
829 for my $arg (@ARGV) {
830 msvalog('verbose', " %s\n", $arg);
832 # untaint the environment for the subprocess
833 # see: https://labs.riseup.net/code/issues/2461
834 foreach my $e (keys %ENV) {
835 $ENV{$e} = untaint($ENV{$e});
839 push @args, untaint($_);
841 # restore default SIGCHLD handling:
842 $SIG{CHLD} = 'DEFAULT';
843 $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET} = sprintf('http://localhost:%d', $self->port);
844 exec(@args) or exit 111;
848 printf("MONKEYSPHERE_VALIDATION_AGENT_SOCKET=http://localhost:%d;\nexport MONKEYSPHERE_VALIDATION_AGENT_SOCKET;\n", $self->port);
849 # FIXME: consider daemonizing here to behave more like
850 # ssh-agent. maybe avoid backgrounding by setting
851 # MSVA_NO_BACKGROUND.
858 return '500 not yet implemented', { };