X-Git-Url: http://git.tremily.us/?a=blobdiff_plain;f=Crypt%2FMonkeysphere%2FMSVA.pm;h=f2bb7b1108f406dfd46ce014f579ab89f363e733;hb=bdafada8f59700c32e90504241752bcfb164ff77;hp=ee712361d7a0655a135a019044781f44f8fb482e;hpb=0249c28cc2c1ceb825682252275014a082ce1bd3;p=monkeysphere-validation-agent.git diff --git a/Crypt/Monkeysphere/MSVA.pm b/Crypt/Monkeysphere/MSVA.pm index ee71236..f2bb7b1 100755 --- a/Crypt/Monkeysphere/MSVA.pm +++ b/Crypt/Monkeysphere/MSVA.pm @@ -1,5 +1,6 @@ # Monkeysphere Validation Agent, Perl version -# Copyright © 2010 Daniel Kahn Gillmor +# Copyright © 2010 Daniel Kahn Gillmor , +# Jameson Rollins # # 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 @@ -18,6 +19,7 @@ use strict; use warnings; + use vars qw($VERSION); use parent qw(HTTP::Server::Simple::CGI); require Crypt::X509; @@ -39,9 +41,9 @@ # we need the version of GnuPG::Interface that knows about pubkey_data, etc: use GnuPG::Interface 0.42.02; - my $version = '0.1'; + $VERSION = '0.9~pre'; - my $gnupg = GnuPG::Interface->new(); + my $gnupg = GnuPG::Interface::->new(); $gnupg->options->quiet(1); $gnupg->options->batch(1); @@ -60,12 +62,12 @@ my $default_keyserver = 'hkp://pool.sks-keyservers.net'; my $default_keyserver_policy = 'unlessvalid'; - my $logger = Crypt::Monkeysphere::MSVA::Logger->new($ENV{MSVA_LOG_LEVEL}); + my $logger = Crypt::Monkeysphere::MSVA::Logger::->new($ENV{MSVA_LOG_LEVEL}); sub logger { return $logger; } - my $rsa_decoder = Convert::ASN1->new; + my $rsa_decoder = Convert::ASN1::->new(); $rsa_decoder->prepare(q< SEQUENCE { @@ -132,34 +134,18 @@ my $cgi = shift; return '200 OK', { available => JSON::true, protoversion => 1, - server => "MSVA-Perl ".$version }; + }; } - # returns an empty list if bad key found. - sub parse_openssh_pubkey { - my $data = shift; - my ($label, $prop) = split(/ +/, $data); - $prop = decode_base64($prop) or return (); - - msvalog('debug', "key properties: %s\n", unpack('H*', $prop)); - my @out; - while (length($prop) > 4) { - my $size = unpack('N', substr($prop, 0, 4)); - msvalog('debug', "size: 0x%08x\n", $size); - return () if (length($prop) < $size + 4); - push(@out, substr($prop, 4, $size)); - $prop = substr($prop, 4 + $size); - } - return () if ($label ne $out[0]); - return @out; - } - - # return an arrayref of processes which we can detect that have the # given socket open (the socket is specified with its inode) sub getpidswithsocketinode { my $sockid = shift; + if (! defined ($sockid)) { + msvalog('verbose', "No client socket ID to check. The MSVA is probably not running as a service.\n"); + return []; + } # this appears to be how Linux symlinks open sockets in /proc/*/fd, # as of at least 2.6.26: my $socktarget = sprintf('socket:[%d]', $sockid); @@ -200,7 +186,7 @@ sub get_client_info { my $socket = shift; - my $sock = IO::Socket->new_from_fd($socket, 'r'); + my $sock = IO::Socket::->new_from_fd($socket, 'r'); # check SO_PEERCRED -- if this was a TCP socket, Linux # might not be able to support SO_PEERCRED (even on the loopback), # though apparently some kernels (Solaris?) are able to. @@ -259,7 +245,7 @@ msvalog('verbose', "Port: %04x\nAddr: %s\n", $port, $iaddrstring); my $remmatch = lc(sprintf("%s:%04x", $iaddrstring, $port)); my $infofile = '/proc/net/'.$proto; - my $f = new IO::File; + my $f = IO::File::->new(); if ( $f->open('< '.$infofile)) { my @header = split(/ +/, <$f>); my ($localaddrix, $uidix, $inodeix); @@ -355,6 +341,11 @@ }; my ($status, $object) = $handler->{handler}($data, $clientinfo); + if (ref($object) eq 'HASH' && + ! defined $object->{server}) { + $object->{server} = sprintf("MSVA-Perl %s", $VERSION); + } + my $ret = to_json($object); msvalog('info', "returning: %s\n", $ret); printf("HTTP/1.0 %s\r\nDate: %s\r\nContent-Type: application/json\r\n\r\n%s", @@ -384,17 +375,6 @@ return 0; } - sub getuid { - my $data = shift; - if ($data->{context} =~ /^(https|ssh)$/) { - $data->{context} = $1; - if ($data->{peer} =~ /^($RE{net}{domain})$/) { - $data->{peer} = $1; - return $data->{context}.'://'.$data->{peer}; - } - } - } - sub get_keyserver_policy { if (exists $ENV{MSVA_KEYSERVER_POLICY} and $ENV{MSVA_KEYSERVER_POLICY} ne '') { if ($ENV{MSVA_KEYSERVER_POLICY} =~ /^(always|never|unlessvalid)$/) { @@ -409,7 +389,7 @@ # We should read from (first hit wins): # the environment if (exists $ENV{MSVA_KEYSERVER} and $ENV{MSVA_KEYSERVER} ne '') { - if ($ENV{MSVA_KEYSERVER} =~ /^(((hkps?|finger|ldap):\/\/)?$RE{net}{domain})$/) { + if ($ENV{MSVA_KEYSERVER} =~ /^(((hkps?|hkpms|finger|ldap):\/\/)?$RE{net}{domain})$/) { return $1; } msvalog('error', "Not a valid keyserver (from MSVA_KEYSERVER):\n %s\n", $ENV{MSVA_KEYSERVER}); @@ -428,7 +408,7 @@ if (-f $gpgconf) { if (-r $gpgconf) { my %gpgconfig = Config::General::ParseConfig($gpgconf); - if ($gpgconfig{keyserver} =~ /^(((hkps?|finger|ldap):\/\/)?$RE{net}{domain})$/) { + if ($gpgconfig{keyserver} =~ /^(((hkps?|hkpms|finger|ldap):\/\/)?$RE{net}{domain})$/) { msvalog('debug', "Using keyserver %s from the GnuPG configuration file (%s)\n", $1, $gpgconf); return $1; } else { @@ -445,17 +425,37 @@ return $default_keyserver; } + sub fetch_fpr_from_keyserver { + my $fpr = shift; + + my $cmd = IO::Handle::->new(); + my $nul = IO::File::->new("< /dev/null"); + + my $ks = get_keyserver(); + msvalog('debug', "start ks query to %s for fingerprint: %s\n", $ks, $fpr); + my $pid = $gnupg->wrap_call + ( handles => GnuPG::Handles::->new( command => $cmd, stdout => $nul, stderr => $nul ), + command_args => [ '0x'.$fpr ], + commands => [ '--keyserver', + $ks, + qw( --no-tty --recv-keys ) ] + ); + # FIXME: can we do something to avoid hanging forever? + waitpid($pid, 0); + msvalog('debug', "ks query returns %d\n", POSIX::WEXITSTATUS($?)); + } + sub fetch_uid_from_keyserver { my $uid = shift; - my $cmd = IO::Handle->new(); - my $out = IO::Handle->new(); - my $nul = IO::File->new("< /dev/null"); + my $cmd = IO::Handle::->new(); + my $out = IO::Handle::->new(); + my $nul = IO::File::->new("< /dev/null"); my $ks = get_keyserver(); msvalog('debug', "start ks query to %s for UserID: %s\n", $ks, $uid); my $pid = $gnupg->wrap_call - ( handles => GnuPG::Handles->new( command => $cmd, stdout => $out, stderr => $nul ), + ( handles => GnuPG::Handles::->new( command => $cmd, stdout => $out, stderr => $nul ), command_args => [ '='.$uid ], commands => [ '--keyserver', $ks, @@ -474,6 +474,169 @@ msvalog('debug', "ks query returns %d\n", POSIX::WEXITSTATUS($?)); } +################################################## +## PKC KEY EXTRACTION ############################ + + sub pkcextractkey { + my $data = shift; + my $key; + + if (lc($data->{pkc}->{type}) eq 'x509der') { + $key = der2key(join('', map(chr, @{$data->{pkc}->{data}}))); + } elsif (lc($data->{pkc}->{type}) eq 'x509pem') { + $key = der2key(pem2der($data->{pkc}->{data})); + } elsif (lc($data->{pkc}->{type}) eq 'opensshpubkey') { + $key = opensshpubkey2key($data->{pkc}->{data}); + } elsif (lc($data->{pkc}->{type}) eq 'rfc4716') { + $key = rfc47162key($data->{pkc}->{data}); + } else { + $key->{error} = sprintf("Don't know this public key carrier type: %s", $data->{pkc}->{type}); + } + + if (exists $key->{error}) { + return $key; + } + + # make sure that the returned integers are Math::BigInts: + $key->{exponent} = Math::BigInt::->new($key->{exponent}) unless (ref($key->{exponent})); + $key->{modulus} = Math::BigInt::->new($key->{modulus}) unless (ref($key->{modulus})); + msvalog('debug', "pubkey info:\nmodulus: %s\nexponent: %s\n", + $key->{modulus}->as_hex(), + $key->{exponent}->as_hex(), + ); + + if ($key->{modulus}->copy()->blog(2) < 1000) { + $key->{error} = sprintf('Public key size is less than 1000 bits (was: %d bits)', $key->{modulus}->copy()->blog(2)); + } + + return $key; + } + + sub der2key { + my $rawdata = shift; + + my $cert = Crypt::X509::->new(cert => $rawdata); + + my $key = {error => 'I do not know what happened here'}; + + if ($cert->error) { + $key->{error} = sprintf("Error decoding X.509 certificate: %s", $cert->error); + } else { + msvalog('verbose', "cert subject: %s\n", $cert->subject_cn()); + msvalog('verbose', "cert issuer: %s\n", $cert->issuer_cn()); + msvalog('verbose', "cert pubkey algo: %s\n", $cert->PubKeyAlg()); + msvalog('verbose', "cert pubkey: %s\n", unpack('H*', $cert->pubkey())); + + if ($cert->PubKeyAlg() ne 'RSA') { + $key->{error} = sprintf('public key was algo "%s" (OID %s). MSVA.pl only supports RSA', + $cert->PubKeyAlg(), $cert->pubkey_algorithm); + } else { + msvalog('debug', "decoding ASN.1 pubkey\n"); + $key = $rsa_decoder->decode($cert->pubkey()); + if (! defined $key) { + msvalog('verbose', "failed to decode %s\n", unpack('H*', $cert->pubkey())); + $key = {error => 'failed to decode the public key'}; + } + } + } + return $key; + } + + sub pem2der { + my $pem = shift; + my @lines = split(/\n/, $pem); + my @goodlines = (); + my $ready = 0; + foreach my $line (@lines) { + if ($line eq '-----END CERTIFICATE-----') { + last; + } elsif ($ready) { + push @goodlines, $line; + } elsif ($line eq '-----BEGIN CERTIFICATE-----') { + $ready = 1; + } + } + msvalog('debug', "%d lines of base64:\n%s\n", $#goodlines + 1, join("\n", @goodlines)); + return decode_base64(join('', @goodlines)); + } + + sub opensshpubkey2key { + my $data = shift; + # FIXME: do we care that the label matches the type of key? + my ($label, $prop) = split(/ +/, $data); + + my $out = parse_rfc4716body($prop); + + return $out; + } + + sub rfc47162key { + my $data = shift; + + my @goodlines; + my $continuation = ''; + my $state = 'outside'; + foreach my $line (split(/\n/, $data)) { + last if ($state eq 'body' && $line eq '---- END SSH2 PUBLIC KEY ----'); + if ($state eq 'outside' && $line eq '---- BEGIN SSH2 PUBLIC KEY ----') { + $state = 'header'; + next; + } + if ($state eq 'header') { + $line = $continuation.$line; + $continuation = ''; + if ($line =~ /^(.*)\\$/) { + $continuation = $1; + next; + } + if (! ($line =~ /:/)) { + $state = 'body'; + } + } + push(@goodlines, $line) if ($state eq 'body'); + } + + msvalog('debug', "Found %d lines of RFC4716 body:\n%s\n", + scalar(@goodlines), + join("\n", @goodlines)); + my $out = parse_rfc4716body(join('', @goodlines)); + + return $out; + } + + sub parse_rfc4716body { + my $data = shift; + + return undef + unless defined($data); + $data = decode_base64($data) or return undef; + + msvalog('debug', "key properties: %s\n", unpack('H*', $data)); + my $out = [ ]; + while (length($data) > 4) { + my $size = unpack('N', substr($data, 0, 4)); + msvalog('debug', "size: 0x%08x\n", $size); + return undef if (length($data) < $size + 4); + push(@{$out}, substr($data, 4, $size)); + $data = substr($data, 4 + $size); + } + + if ($out->[0] ne "ssh-rsa") { + return {error => 'Not an RSA key'}; + } + + if (scalar(@{$out}) != 3) { + return {error => 'Does not contain the right number of bigints for RSA'}; + } + + return { exponent => Math::BigInt->from_hex('0x'.unpack('H*', $out->[1])), + modulus => Math::BigInt->from_hex('0x'.unpack('H*', $out->[2])), + } ; + } + +## PKC KEY EXTRACTION ############################ +################################################## + sub reviewcert { my $data = shift; my $clientinfo = shift; @@ -486,123 +649,201 @@ message => 'Unknown failure', }; - my $uid = getuid($data); - if ($uid eq []) { - msvalog('error', "invalid peer/context: %s/%s\n", $data->{context}, $data->{peer}); - $ret->{message} = sprintf('invalid peer/context'); - return $status, $ret; + # check that there actually is key data + if ($data->{pkc}->{data} eq '') { + $ret->{message} = sprintf("Key data empty."); + return $status,$ret; + } + + # check context string + if ($data->{context} =~ /^(https|ssh|smtp|ike|postgresql|imaps|imap|submission|e-mail)$/) { + $data->{context} = $1; + } else { + msvalog('error', "invalid context: %s\n", $data->{context}); + $ret->{message} = sprintf("Invalid/unknown context: %s", $data->{context}); + return $status,$ret; } msvalog('verbose', "context: %s\n", $data->{context}); - msvalog('verbose', "peer: %s\n", $data->{peer}); - my $rawdata = join('', map(chr, @{$data->{pkc}->{data}})); - my $cert = Crypt::X509->new(cert => $rawdata); + # checkout peer string + # old-style just passed a string as a peer, rather than + # peer: { name: 'whatever', 'type': 'client' } + $data->{peer} = { name => $data->{peer} } + if (ref($data->{peer}) ne 'HASH'); - msvalog('verbose', "cert subject: %s\n", $cert->subject_cn()); - msvalog('verbose', "cert issuer: %s\n", $cert->issuer_cn()); - msvalog('verbose', "cert pubkey algo: %s\n", $cert->PubKeyAlg()); - msvalog('verbose', "cert pubkey: %s\n", unpack('H*', $cert->pubkey())); + if (defined($data->{peer}->{type})) { + if ($data->{peer}->{type} =~ /^(client|server|peer)$/) { + $data->{peer}->{type} = $1; + } else { + msvalog('error', "invalid peer type string: %s\n", $data->{peer}->{type}); + $ret->{message} = sprintf("Invalid peer type string: %s", $data->{peer}->{type}); + return $status,$ret; + } + } - if ($cert->PubKeyAlg() ne 'RSA') { - $ret->{message} = sprintf('public key was algo "%s" (OID %s). MSVA.pl only supports RSA', - $cert->PubKeyAlg(), $cert->pubkey_algorithm); + my $prefix = $data->{context}.'://'; + if ($data->{context} eq 'e-mail' || + (defined $data->{peer}->{type} && + $data->{peer}->{type} eq 'client' && + # ike and smtp clients are effectively other servers, so we'll + # exclude them: + $data->{context} !~ /^(ike|smtp)$/)) { + $prefix = ''; + # clients can have any one-line User ID without NULL characters + # and leading or trailing whitespace + if ($data->{peer}->{name} =~ /^([^[:space:]][^\n\0]*[^[:space:]]|[^\0[:space:]])$/) { + $data->{peer}->{name} = $1; + } else { + msvalog('error', "invalid client peer name string: %s\n", $data->{peer}->{name}); + $ret->{message} = sprintf("Invalid client peer name string: %s", $data->{peer}->{name}); + return $status,$ret; + } + } elsif ($data->{peer}->{name} =~ /^($RE{net}{domain}(:[[:digit:]]+)?)$/) { + $data->{peer}->{name} = $1; } else { - my $key = $rsa_decoder->decode($cert->pubkey()); - if ($key) { - # make sure that the returned integers are Math::BigInts: - $key->{exponent} = Math::BigInt->new($key->{exponent}) unless (ref($key->{exponent})); - $key->{modulus} = Math::BigInt->new($key->{modulus}) unless (ref($key->{modulus})); - msvalog('debug', "cert info:\nmodulus: %s\nexponent: %s\n", - $key->{modulus}->as_hex(), - $key->{exponent}->as_hex(), - ); - - if ($key->{modulus}->copy()->blog(2) < 1000) { # FIXME: this appears to be the full pubkey, including DER overhead - $ret->{message} = sprintf('public key size is less than 1000 bits (was: %d bits)', $cert->pubkey_size()); - } else { - $ret->{message} = sprintf('Failed to validate "%s" through the OpenPGP Web of Trust.', $uid); - my $lastloop = 0; - my $kspolicy; - if (defined $data->{keyserverpolicy} && - $data->{keyserverpolicy} =~ /^(always|never|unlessvalid)$/) { - $kspolicy = $1; - msvalog("verbose", "using requested keyserver policy: %s\n", $1); - } else { - $kspolicy = get_keyserver_policy(); - } - msvalog('debug', "keyserver policy: %s\n", $kspolicy); - # needed because $gnupg spawns child processes - $ENV{PATH} = '/usr/local/bin:/usr/bin:/bin'; - if ($kspolicy eq 'always') { - fetch_uid_from_keyserver($uid); - $lastloop = 1; - } elsif ($kspolicy eq 'never') { - $lastloop = 1; - } - my $foundvalid = 0; - - # fingerprints of keys that are not fully-valid for this User ID, but match - # the key from the queried certificate: - my @subvalid_key_fprs; - - while (1) { - foreach my $gpgkey ($gnupg->get_public_keys('='.$uid)) { - my $validity = '-'; - foreach my $tryuid ($gpgkey->user_ids) { - if ($tryuid->as_string eq $uid) { - $validity = $tryuid->validity; - } - } - # treat primary keys just like subkeys: - foreach my $subkey ($gpgkey, @{$gpgkey->subkeys}) { - my $primarymatch = keycomp($key, $subkey); - if ($primarymatch) { - if ($subkey->usage_flags =~ /a/) { - msvalog('verbose', "key matches, and 0x%s is authentication-capable\n", $subkey->hex_id); - if ($validity =~ /^[fu]$/) { - $foundvalid = 1; - msvalog('verbose', "...and it matches!\n"); - $ret->{valid} = JSON::true; - $ret->{message} = sprintf('Successfully validated "%s" through the OpenPGP Web of Trust.', $uid); - } else { - push(@subvalid_key_fprs, { fpr => $subkey->fingerprint, val => $validity }) if $lastloop; - } - } else { - msvalog('verbose', "key matches, but 0x%s is not authentication-capable\n", $subkey->hex_id); - } - } - } - } - if ($lastloop) { - last; - } else { - fetch_uid_from_keyserver($uid) if (!$foundvalid); - $lastloop = 1; - } - } + msvalog('error', "invalid peer name string: %s\n", $data->{peer}->{name}); + $ret->{message} = sprintf("Invalid peer name string: %s", $data->{peer}->{name}); + return $status,$ret; + } - # only show the marginal UI if the UID of the corresponding - # key is not fully valid. - if (!$foundvalid) { - my $resp = Crypt::Monkeysphere::MSVA::MarginalUI->ask_the_user($gnupg, - $uid, - \@subvalid_key_fprs, - getpidswithsocketinode($clientinfo->{inode}), - $logger); - msvalog('info', "response: %s\n", $resp); - if ($resp) { - $ret->{valid} = JSON::true; - $ret->{message} = sprintf('Manually validated "%s" through the OpenPGP Web of Trust.', $uid); - } - } - } + msvalog('verbose', "peer: %s\n", $data->{peer}->{name}); + + # generate uid string + my $uid = $prefix.$data->{peer}->{name}; + msvalog('verbose', "user ID: %s\n", $uid); + + # extract key or openpgp fingerprint from PKC + my $fpr; + my $key; + my $gpgquery; + if (lc($data->{pkc}->{type}) eq 'openpgp4fpr') { + if ($data->{pkc}->{data} =~ /^(0x)?([[:xdigit:]]{40})$/) { + $data->{pkc}->{data} = uc($2); + $fpr = $data->{pkc}->{data}; + msvalog('verbose', "OpenPGP v4 fingerprint: %s\n",$fpr); + } else { + msvalog('error', "invalid OpenPGP v4 fingerprint: %s\n",$data->{pkc}->{data}); + $ret->{message} = sprintf("Invalid OpenPGP v4 fingerprint."); + return $status,$ret; + } + $gpgquery = '0x'.$fpr; + } else { + # extract key from PKC + $key = pkcextractkey($data); + if (exists $key->{error}) { + $ret->{message} = $key->{error}; + return $status,$ret; + } + $gpgquery = '='.$uid; + } + + # setup variables + $ret->{message} = sprintf('Failed to validate "%s" through the OpenPGP Web of Trust.', $uid); + my $lastloop = 0; + my $foundvalid = 0; + + # determine keyserver policy + my $kspolicy; + if (defined $data->{keyserverpolicy} && + $data->{keyserverpolicy} =~ /^(always|never|unlessvalid)$/) { + $kspolicy = $1; + msvalog("verbose", "using requested keyserver policy: %s\n", $1); + } else { + $kspolicy = get_keyserver_policy(); + } + msvalog('debug', "keyserver policy: %s\n", $kspolicy); + # needed because $gnupg spawns child processes + $ENV{PATH} = '/usr/local/bin:/usr/bin:/bin'; + if ($kspolicy eq 'always') { + if (defined $fpr) { + fetch_fpr_from_keyserver($fpr); + } else { + fetch_uid_from_keyserver($uid); + } + $lastloop = 1; + } elsif ($kspolicy eq 'never') { + $lastloop = 1; + } + + # fingerprints of keys that are not fully-valid for this User ID, but match + # the key from the queried certificate: + my @subvalid_key_fprs; + + while (1) { + foreach my $gpgkey ($gnupg->get_public_keys($gpgquery)) { + my $validity = '-'; + foreach my $tryuid ($gpgkey->user_ids) { + if ($tryuid->as_string eq $uid) { + $validity = $tryuid->validity; + } + } + # treat primary keys just like subkeys: + foreach my $subkey ($gpgkey, @{$gpgkey->subkeys}) { + if ((defined($key) && keycomp($key, $subkey)) || + (defined($fpr) && ($subkey->fingerprint->as_hex_string eq $fpr))) { + my $iscapable = 0; + msvalog('verbose', "key 0x%s matches...\n",$subkey->hex_id); + if ($data->{context} eq 'e-mail') { + if ($subkey->usage_flags =~ /s/) { + $iscapable = 1; + msvalog('verbose', "...and is signing-capable...\n"); + } else { + msvalog('verbose', "...but is not signing-capable (%s).\n",$subkey->usage_flags); + } + } else { + if ($subkey->usage_flags =~ /a/) { + $iscapable = 1; + msvalog('verbose', "...and is authentication-capable...\n"); + } else { + msvalog('verbose', "...but is not authentication-capable (%s).\n",$subkey->usage_flags); + } + } + if ($iscapable) { + if ($validity =~ /^[fu]$/) { + $foundvalid = 1; + msvalog('verbose', "...and is fully valid!\n"); + $ret->{valid} = JSON::true; + $ret->{message} = sprintf('Successfully validated "%s" through the OpenPGP Web of Trust.', $uid); + last; + } else { + msvalog('verbose', "...but is not fully valid (%s).\n",$validity); + push(@subvalid_key_fprs, { fpr => $subkey->fingerprint, val => $validity }) if $lastloop; + } + } + } + } + last if ($foundvalid); + } + if ($lastloop || $foundvalid) { + last; } else { - msvalog('error', "failed to decode %s\n", unpack('H*', $cert->pubkey())); - $ret->{message} = sprintf('failed to decode the public key', $uid); + if (!$foundvalid) { + if (defined $fpr) { + fetch_fpr_from_keyserver($fpr); + } else { + fetch_uid_from_keyserver($uid); + } + } + $lastloop = 1; + } + } + + # only show the marginal UI if the UID of the corresponding + # key is not fully valid. + if (!$foundvalid) { + my $resp = Crypt::Monkeysphere::MSVA::MarginalUI->ask_the_user($gnupg, + $uid, + \@subvalid_key_fprs, + getpidswithsocketinode($clientinfo->{inode}), + $logger); + msvalog('info', "response: %s\n", $resp); + if ($resp) { + $ret->{valid} = JSON::true; + $ret->{message} = sprintf('Manually validated "%s" through the OpenPGP Web of Trust.', $uid); } } - return $status, $ret; + return $status,$ret; } sub pre_loop_hook { @@ -610,16 +851,6 @@ my $server = shift; $self->spawn_master_subproc($server); - if (exists $self->{child_pid} && - $self->{child_pid} != 0) { - my $val; - while (defined($val = POSIX::waitpid(-1, POSIX::WNOHANG)) && $val > 0) { - msvalog('debug', "waitpid on %d: got %d\n", $self->{child_pid}, $val); - if ($val == $self->{child_pid}) { - $self->master_subprocess_died($server, $?); - } - } - } } sub master_subprocess_died { @@ -702,7 +933,7 @@ $server->server_close(); } $self->port($port); - $self->{updatemonitor} = Crypt::Monkeysphere::MSVA::Monitor->new($logger); + $self->{updatemonitor} = Crypt::Monkeysphere::MSVA::Monitor::->new($logger); } sub spawn_master_subproc { @@ -716,7 +947,12 @@ } elsif ($#ARGV >= 0) { $self->{child_pid} = 0; # indicate that we are planning to fork. # avoid ignoring SIGCHLD right before we fork. - $SIG{CHLD} = 'DEFAULT'; + $SIG{CHLD} = sub { + my $val; + while (defined($val = POSIX::waitpid(-1, POSIX::WNOHANG)) && $val > 0) { + $self->child_dies($val, $server); + } + }; my $fork = fork(); if (! defined $fork) { msvalog('error', "could not fork\n");