Your message dated Sat, 23 Feb 2013 10:59:30 +0100 with message-id <20130223095930.GN5761@radis.cristau.org> and subject line Re: Bug#686054: [monkeysphere] Bug#682518: Bug#677565: RC bugs in msva-perl has caused the Debian Bug report #686054, regarding pre-approval: msva-perl/0.8.1-1 to be marked as done. This means that you claim that the problem has been dealt with. If this is not the case it is now your responsibility to reopen the Bug report if necessary, and/or fix the problem forthwith. (NB: If you are a system administrator and have no idea what this message is talking about, this may indicate a serious mail system misconfiguration somewhere. Please contact owner@bugs.debian.org immediately.) -- 686054: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=686054 Debian Bug Tracking System Contact owner@bugs.debian.org with problems
--- Begin Message ---
- To: submit@bugs.debian.org
- Subject: unblock: msva-perl/0.9-1
- From: Daniel Kahn Gillmor <dkg@fifthhorseman.net>
- Date: Tue, 28 Aug 2012 00:29:42 -0400
- Message-id: <87r4qrtz9l.fsf@pip.fifthhorseman.net>
Package: release.debian.org Severity: normal User: release.debian.org@packages.debian.org Usertags: unblock Please unblock package msva-perl: unblock msva-perl/0.9-1 the new upstream version 0.9 fixes 3 RC bugs: 2 critical bugs: #682353 crashes my X11 session on upgrade #682518 login impossible with msva-perl installed and 1 grave bug: #677565 Insecure dependency in socket while running with -T switch I understand that this is a larger change than is usually asked for at this stage of the freeze, and apologize for the size of it. As mitigating factors, i offer the following observations: * 0.9 fails more gracefully than 0.8 did -- an agent that fails (for whatever reason) should now simply stop working instead of crashing the user's X11 session. * the wheezy versions of perl core and the modules depended on by msva-perl actively break msva-perl 0.8 in several ways. 0.9 works with these newer versions. * msva-perl has no reverse dependencies in debian, and only a single recommends, xul-ext-monkeysphere. debian/changelog: msva-perl (0.9-1) unstable; urgency=low * New Upstream version - tighter dependencies - daemon crash should no longer kill X11 session (Closes: #682353, #682518) - cleanup for newer versions of perl and modules (Closes: #677565, #642304) - binds explicitly to IPv4 loopback (Closes: #661939) - scanning for changes and prompting to reload off by default (Closes: #614313) * bumped Standards-Version to 3.9.3 (no changes needed) -- Daniel Kahn Gillmor <dkg@fifthhorseman.net> Wed, 25 Jul 2012 13:20:08 -0400 Full debdiff attached. Please let me know if you have any questions. Thanks for your work on the release-team! Regards, --dkgdiff -Nru msva-perl-0.8/Changelog msva-perl-0.9/Changelog --- msva-perl-0.8/Changelog 2010-12-20 16:11:39.000000000 -0500 +++ msva-perl-0.9/Changelog 2012-07-28 16:43:34.000000000 -0400 @@ -1,3 +1,35 @@ +msva-perl (0.9) upstream; + + [ Jameson Rollins ] + * Add "e-mail" context (checks for signing capability instead of + authentication) (closes MS #2688) + * Add "openpgp4fpr" pkc type for providing OpenPGP v4 fingerprint + * Add --version option to msva-query-agent + + [ David Bremner ] + * Code refactoring: + - Crypt::Monkeysphere::MSVA::Logger into Crypt::Monkeysphere::Logger + - new Crypt::Monkeysphere::Validator + - unit tests and unit test harness + + [ Daniel Kahn Gillmor ] + * Now depending on Crypt::X509 0.50 for pubkey components directly. + * Crypt::Monkeysphere::OpenPGP for helper functions in + packet generation and parsing. + * Parse and make use of X.509 PGPExtension if present in X.509 public + key carrier. + * Fix HUP server restart when used with Net::Server >= 0.99 + * Crypt::Monkeysphere::Keytrans has the start of some key/certificate + conversion routines. + * Fix socket detection when used with Net::Server >= 2.00, which + can bind to multiple sockets + * depend on Net::Server >= 2.00 + * change launcher approach -- daemon is now child process, so that + daemon failures won't kill X11 session + * scanning and prompting for changes is now optional (defaults to off) + + -- Daniel Kahn Gillmor <dkg@fifthhorseman.net> Wed, 25 Jul 2012 13:12:55 -0400 + msva-perl (0.8) upstream; * Minor bugfix release! diff -Nru msva-perl-0.8/Crypt/Monkeysphere/Keyserver.pm msva-perl-0.9/Crypt/Monkeysphere/Keyserver.pm --- msva-perl-0.8/Crypt/Monkeysphere/Keyserver.pm 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/Crypt/Monkeysphere/Keyserver.pm 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,156 @@ +package Crypt::Monkeysphere::Keyserver; +use IO::File; +use GnuPG::Handles; +use GnuPG::Interface; +use File::HomeDir; +use Config::General; +use Regexp::Common qw /net/; +use POSIX; + +use strict; +use warnings; +use parent qw(Crypt::Monkeysphere::Logger); +use Crypt::Monkeysphere::Util qw(untaint); + +our $default_keyserver='hkp://pool.sks-keyservers.net'; + +=pod + +=head2 new + +Create a new Crypt::Monkeysphere::Keyserver instance + +Arguments + Param hash, all optional. + + keyserver => URL + gnupg => GnuPG::Interface object + + (plus arguments for Crypt::Monkeysphere::Logger::new) + +=cut +sub new { + my $class=shift; + my %opts=@_; + + my $self=$class->SUPER::new($opts{loglevel} || 'info'); + + # gnupg should be initialized first, before figuring out + # what keyserver to use. + + $self->{gnupg} = $opts{gnupg} || new GnuPG::Interface(); + + $self->{keyserver} = $opts{keyserver} || $self->_get_keyserver(); + return $self; +} + +sub _get_keyserver{ + + my $self=shift; + + my $gpghome=$self->{gnupg}->options->homedir; + + if (!defined($gpghome)) { + if (exists $ENV{GNUPGHOME} and $ENV{GNUPGHOME} ne '') { + + # We might be running in taint mode, but we assume that is about + # data coming from the network, and that the local environment + # is generally trustworthy. + + $gpghome = untaint($ENV{GNUPGHOME}); + } else { + my $userhome=File::HomeDir->my_home; + if (defined($userhome)) { + $gpghome = File::Spec->catfile($userhome, '.gnupg'); + } + } + } + + if (defined $gpghome) { + return $self->_read_keyserver_from_gpg_conf($gpghome) || $default_keyserver; + } else { + return $default_keyserver; + } + +} + +sub _read_keyserver_from_gpg_conf() { + my $self=shift; + my $gpghome=shift; + + my $gpgconf = File::Spec->catfile($gpghome, 'gpg.conf'); + if (-f $gpgconf) { + if (-r $gpgconf) { + my %gpgconfig = Config::General::ParseConfig($gpgconf); + if ($gpgconfig{keyserver} =~ /^(((hkps?|hkpms|finger|ldap):\/\/)?$RE{net}{domain})$/) { + $self->log('debug', "Using keyserver %s from the GnuPG configuration file (%s)\n", $1, $gpgconf); + return $1; + } else { + $self->log('error', "Not a valid keyserver (from gpg config %s):\n %s\n", $gpgconf, $gpgconfig{keyserver}); + } + } else { + $self->log('error', "The GnuPG configuration file (%s) is not readable\n", $gpgconf); + } + } else { + $self->log('info', "Did not find GnuPG configuration file while looking for keyserver '%s'\n", $gpgconf); + } + return undef; +} + + +sub fetch_uid { + my $self= shift; + my $uid = shift || croak("uid argument mandatory"); + + my $ks=$self->{keyserver}; + my $gnupg=$self->{gnupg}; + + my $cmd = IO::Handle::->new(); + my $out = IO::Handle::->new(); + my $nul = IO::File::->new("< /dev/null"); + + $self->log('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 ), + command_args => [ '='.$uid ], + commands => [ '--keyserver', + $ks, + qw( --no-tty --with-colons --search ) ] + ); + while (my $line = $out->getline()) { + $self->log('debug', "from ks query: (%d) %s", $cmd->fileno, $line); + if ($line =~ /^info:(\d+):(\d+)/ ) { + $cmd->print(join(' ', ($1..$2))."\n"); + $self->log('debug', 'to ks query: '.join(' ', ($1..$2))."\n"); + last; + } + } + # FIXME: can we do something to avoid hanging forever? + waitpid($pid, 0); + $self->log('debug', "ks query returns %d\n", POSIX::WEXITSTATUS($?)); + } + +sub fetch_fpr { + my $self = shift; + my $fpr = shift || croak("fpr argument mandatory"); + + my $ks=$self->{keyserver}; + my $gnupg=$self->{gnupg}; + + my $cmd = IO::Handle::->new(); + my $nul = IO::File::->new("< /dev/null"); + + $self->log('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); + $self->log('debug', "ks query returns %d\n", POSIX::WEXITSTATUS($?)); +} + +1; diff -Nru msva-perl-0.8/Crypt/Monkeysphere/Keytrans.pm msva-perl-0.9/Crypt/Monkeysphere/Keytrans.pm --- msva-perl-0.8/Crypt/Monkeysphere/Keytrans.pm 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/Crypt/Monkeysphere/Keytrans.pm 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,112 @@ +package Crypt::Monkeysphere::Keytrans; + +use strict; +use warnings; +use Math::BigInt; +use Carp; +use MIME::Base64; + +use Exporter qw(import); +our @EXPORT_OK=qw(GnuPGKey_to_OpenSSH_pub GnuPGKey_to_OpenSSH_fpr); + + +# takes a Math::BigInt and returns it properly packed for openssh output. + +sub openssh_mpi_pack { + my $num = shift; + + my $val = $num->as_hex(); + $val =~ s/^0x//; + # ensure we've got an even multiple of 2 nybbles here. + $val = '0'.$val + if (length($val) % 2); + $val = pack('H*', $val); + # packed binary ones-complement representation of the value. + + my $mpilen = length($val); + + my $ret = pack('N', $mpilen); + + # if the first bit of the leading byte is high, we should include a + # 0 byte: + if (ord($val) & 0x80) { + $ret = pack('NC', $mpilen+1, 0); + } + + return $ret.$val; +} + +# this output is not base64-encoded yet. Pass it through +# encode_base64($output, '') if you want to make a file. + +sub openssh_rsa_pubkey_pack { + my ($modulus, $exponent) = @_; + + return openssh_mpi_pack(Math::BigInt->new('0x'.unpack('H*', "ssh-rsa"))). + openssh_mpi_pack($exponent). + openssh_mpi_pack($modulus); +} + +# calculate/print the fingerprint of an openssh-style keyblob: + +sub sshfpr { + my $keyblob = shift; + use Digest::MD5; + return join(':', map({unpack("H*", $_)} split(//, Digest::MD5::md5($keyblob)))); +} + +=pod + +=head2 GnuPGKey_to_OpenSSH_fpr + +Find the openssh compatible fingerprint of an (RSA) GnuPG::Key + +B<Note> you will need to add add bits and (RSA) to the string to +exactly match the output of ssh-keygen -l. + +=head3 Arguments + +key - GnuPG::Key object + +=cut + +sub GnuPGKey_to_OpenSSH_fpr { + my $key = shift; + + croak("not a GnuPG::Key!") + unless($key->isa('GnuPG::Key')); + + croak("Not an RSA key!") + unless $key->algo_num == 1; + + return sshfpr(openssh_rsa_pubkey_pack(@{$key->pubkey_data}), ''); +} + +=pod + +=head2 GnuPGKey_to_OpenSSH_pub + +Translate a GnuPG::Key to a string suitable for an OpenSSH .pub file + +B<Note> you will need to add "ssh-rsa " to the front to make OpenSSH +recognize it. + +=head3 Arguments + +key - GnuPG::Key object + +=cut + +sub GnuPGKey_to_OpenSSH_pub { + my $key = shift; + + croak("not a GnuPG::Key!") + unless($key->isa('GnuPG::Key')); + + croak("Not an RSA key!") + unless $key->algo_num == 1; + + return encode_base64(openssh_rsa_pubkey_pack(@{$key->pubkey_data}), ''); +} + +1; diff -Nru msva-perl-0.8/Crypt/Monkeysphere/Logger.pm msva-perl-0.9/Crypt/Monkeysphere/Logger.pm --- msva-perl-0.8/Crypt/Monkeysphere/Logger.pm 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/Crypt/Monkeysphere/Logger.pm 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,102 @@ +#---------------------------------------------------------------------- +# Monkeysphere Validation Agent, Perl version +# Marginal User Interface for reasonable prompting +# Copyright © 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net>, +# Matthew James Goins <mjgoins@openflows.com>, +# Jameson Graef Rollins <jrollins@finestructure.net>, +# Elliot Winard <enw@caveteen.com> +# +# 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 Crypt::Monkeysphere::Logger; + + use strict; + use warnings; + + # Net::Server log_level goes from 0 to 4 + # this is scaled to match. + my %loglevels = ( + 'silent' => 0, + 'quiet' => 0.25, + 'fatal' => 0.5, + 'error' => 1, + 'info' => 2, + 'verbose' => 3, + 'debug' => 4, + 'debug1' => 4, + 'debug2' => 5, + 'debug3' => 6, + ); + + sub log { + my $self = shift; + my $msglevel = shift; + + $msglevel = 'error' + if (! defined($msglevel)); + if ($loglevels{lc($msglevel)} <= $self->{loglevel}) { + printf STDERR @_; + } + }; + + sub get_log_level { + my $self = shift; + + return $self->{loglevel}; + } + sub set_log_level { + my $self = shift; + my $loglevel = shift; + my $logval = $loglevels{lc($loglevel)}; + + if (defined($logval)) { + $self->{loglevel} = $logval; + } else { + $self->log('error', "Invalid log level: '%s' (log level not changed)\n", $loglevel); + } + } + sub more_verbose { + my $self = shift; + my $increment = shift; + + $increment = 1 + if (!defined $increment); + $self->{loglevel} += $increment; + } + + # let the user test to see if we're noisier than this level + # directly: + sub is_logging_at { + my $self = shift; + my $qlevel = shift; + + return ($loglevels{lc($qlevel)} <= $self->{loglevel}); + } + + sub new { + my $class = shift; + my $loglevel = shift; + + my $self = {loglevel => $loglevels{defined($loglevel) ? lc($loglevel) : 'error'}}; + $self->{loglevel} = $loglevels{error} + if (!defined $self->{loglevel}); + + bless ($self, $class); + return $self; + } + + 1; +} diff -Nru msva-perl-0.8/Crypt/Monkeysphere/MSVA/Client.pm msva-perl-0.9/Crypt/Monkeysphere/MSVA/Client.pm --- msva-perl-0.8/Crypt/Monkeysphere/MSVA/Client.pm 2010-12-20 16:11:39.000000000 -0500 +++ msva-perl-0.9/Crypt/Monkeysphere/MSVA/Client.pm 2012-07-28 16:43:34.000000000 -0400 @@ -26,7 +26,7 @@ use strict; use warnings; use JSON; - use Crypt::Monkeysphere::MSVA::Logger; + use Crypt::Monkeysphere::Logger; use LWP::UserAgent; use HTTP::Request; use Module::Load::Conditional; @@ -36,6 +36,20 @@ $self->{logger}->log(@_); } + sub agent_info { + my $self = shift; + my $requesturl = $self->{socket} . '/'; + my $request = HTTP::Request->new('GET', $requesturl); + $self->log('debug', "Contacting MSVA at %s\n", $requesturl); + my $response = $self->{ua}->request($request); + my $status = $response->status_line; + my $ret; + if ($status eq '200 OK') { + $ret = from_json($response->content); + } + return $status, $ret; + } + sub query_agent { my $self = shift; my $context = shift; @@ -91,35 +105,12 @@ $self->log('debug', "pkctype: %s\n", $pkctype); my $transformed_data; - if ($pkctype eq 'x509der') { - if ($self->{logger}->is_logging_at('verbose')) { - if (Module::Load::Conditional::can_load('modules' => { 'Crypt::X509' => undef })) { - require Crypt::X509; - my $cert = Crypt::X509->new(cert => $pkcdata); - if ($cert->error) { - $self->log('error', "failed to parse this X.509 cert before sending it to the agent\n"); - } else { - $self->log('info', "x509der certificate loaded.\n"); - $self->log('verbose', "cert subject: %s\n", $cert->subject_cn()); - $self->log('verbose', "cert issuer: %s\n", $cert->issuer_cn()); - $self->log('verbose', "cert pubkey algo: %s\n", $cert->PubKeyAlg()); - $self->log('verbose', "cert pubkey: %s\n", unpack('H*', $cert->pubkey())); - } - } else { - $self->log('verbose', "X.509 cert going to agent but we cannot inspect it without Crypt::X509\n"); - } - } - # remap raw pkc data into numeric array + # remap raw der data into numeric array $transformed_data = [map(ord, split(//,$pkcdata))]; - } elsif ($pkctype eq 'x509pem' || - $pkctype eq 'opensshpubkey' || - $pkctype eq 'rfc4716' - ) { - $transformed_data = $pkcdata; } else { - $self->log('error', "unknown pkc type '%s'.\n", $pkctype); - }; + $transformed_data = $pkcdata; + } my $ret = { context => $context, @@ -143,9 +134,9 @@ my %args = @_; my $self = {}; - $self->{logger} = Crypt::Monkeysphere::MSVA::Logger->new($args{log_level}); + $self->{logger} = Crypt::Monkeysphere::Logger->new($args{log_level}); $self->{socket} = $args{socket}; - $self->{socket} = 'http://localhost:8901' + $self->{socket} = 'http://127.0.0.1:8901' if (! defined $self->{socket} or $self->{socket} eq ''); # create the user agent diff -Nru msva-perl-0.8/Crypt/Monkeysphere/MSVA/Logger.pm msva-perl-0.9/Crypt/Monkeysphere/MSVA/Logger.pm --- msva-perl-0.8/Crypt/Monkeysphere/MSVA/Logger.pm 2010-12-20 16:11:39.000000000 -0500 +++ msva-perl-0.9/Crypt/Monkeysphere/MSVA/Logger.pm 1969-12-31 19:00:00.000000000 -0500 @@ -1,100 +0,0 @@ -#---------------------------------------------------------------------- -# Monkeysphere Validation Agent, Perl version -# Marginal User Interface for reasonable prompting -# Copyright © 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net>, -# Matthew James Goins <mjgoins@openflows.com>, -# Jameson Graef Rollins <jrollins@finestructure.net>, -# Elliot Winard <enw@caveteen.com> -# -# 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 Crypt::Monkeysphere::MSVA::Logger; - - use strict; - use warnings; - - # Net::Server log_level goes from 0 to 4 - # this is scaled to match. - my %loglevels = ( - 'silent' => 0, - 'quiet' => 0.25, - 'fatal' => 0.5, - 'error' => 1, - 'info' => 2, - 'verbose' => 3, - 'debug' => 4, - 'debug1' => 4, - 'debug2' => 5, - 'debug3' => 6, - ); - - sub log { - my $self = shift; - my $msglevel = shift; - - if ($loglevels{lc($msglevel)} <= $self->{loglevel}) { - printf STDERR @_; - } - }; - - sub get_log_level { - my $self = shift; - - return $self->{loglevel}; - } - sub set_log_level { - my $self = shift; - my $loglevel = shift; - my $logval = $loglevels{lc($loglevel)}; - - if (defined($logval)) { - $self->{loglevel} = $logval; - } else { - $self->log('error', "Invalid log level: '%s' (log level not changed)\n", $loglevel); - } - } - sub more_verbose { - my $self = shift; - my $increment = shift; - - $increment = 1 - if (!defined $increment); - $self->{loglevel} += $increment; - } - - # let the user test to see if we're noisier than this level - # directly: - sub is_logging_at { - my $self = shift; - my $qlevel = shift; - - return ($loglevels{lc($qlevel)} <= $self->{loglevel}); - } - - sub new { - my $class = shift; - my $loglevel = shift; - - my $self = {loglevel => $loglevels{lc($loglevel)}}; - $self->{loglevel} = $loglevels{error} - if (!defined $self->{loglevel}); - - bless ($self, $class); - return $self; - } - - 1; -} diff -Nru msva-perl-0.8/Crypt/Monkeysphere/MSVA/MarginalUI.pm msva-perl-0.9/Crypt/Monkeysphere/MSVA/MarginalUI.pm --- msva-perl-0.8/Crypt/Monkeysphere/MSVA/MarginalUI.pm 2010-12-20 16:11:39.000000000 -0500 +++ msva-perl-0.9/Crypt/Monkeysphere/MSVA/MarginalUI.pm 2012-07-28 16:43:34.000000000 -0400 @@ -46,7 +46,8 @@ } foreach my $keyfpr (@subvalid_key_fprs) { - my $fprx = sprintf('0x%.40s', $keyfpr->{fpr}->as_hex_string()); + $keyfpr->{fingerprint}->as_hex_string() =~ /([[:xdigit:]]{0,40})/; + my $fprx = '0x' . $1; $logger->log('debug', "checking on %s\n", $fprx); foreach my $gpgkey ($gnupg->get_public_keys_with_sigs($fprx)) { $logger->log('debug', "found key %.40s\n", $gpgkey->fingerprint->as_hex_string); @@ -72,7 +73,7 @@ if ($cert->hex_id =~ /^([A-Fa-f0-9]{16})$/) { my $certid = $1; # disregard self-certifications (see MS # 2569): - if (lc($certid) eq lc(substr($keyfpr->{fpr}->as_hex_string(), -16))) { + if (lc($certid) eq lc(substr($keyfpr->{fingerprint}->as_hex_string(), -16))) { $logger->log('debug', "found self-sig 0x%.16s\n", $certid); next; } @@ -159,7 +160,7 @@ Peer's OpenPGP key fingerprint: 0x%.40s GnuPG calculated validity for the peer: %s", $uid, - $keyfpr->{fpr}->as_hex_string, + $keyfpr->{fingerprint}->as_hex_string, $keyfpr->{val}, ); # FIXME: what about revoked certifications? diff -Nru msva-perl-0.8/Crypt/Monkeysphere/MSVA/Monitor.pm msva-perl-0.9/Crypt/Monkeysphere/MSVA/Monitor.pm --- msva-perl-0.8/Crypt/Monkeysphere/MSVA/Monitor.pm 2010-12-20 16:11:39.000000000 -0500 +++ msva-perl-0.9/Crypt/Monkeysphere/MSVA/Monitor.pm 2012-07-28 16:43:34.000000000 -0400 @@ -23,6 +23,7 @@ { package Crypt::Monkeysphere::MSVA::Monitor; + use Module::Load::Conditional; use strict; use warnings; diff -Nru msva-perl-0.8/Crypt/Monkeysphere/MSVA.pm msva-perl-0.9/Crypt/Monkeysphere/MSVA.pm --- msva-perl-0.8/Crypt/Monkeysphere/MSVA.pm 2010-12-20 16:11:39.000000000 -0500 +++ msva-perl-0.9/Crypt/Monkeysphere/MSVA.pm 2012-07-28 16:43:34.000000000 -0400 @@ -22,9 +22,11 @@ use vars qw($VERSION); use parent qw(HTTP::Server::Simple::CGI); - require Crypt::X509; + + use Crypt::Monkeysphere::Validator; + + use Crypt::X509 0.50; use Regexp::Common qw /net/; - use Convert::ASN1; use MIME::Base64; use IO::Socket; use IO::File; @@ -33,15 +35,17 @@ use File::HomeDir; use Config::General; use Crypt::Monkeysphere::MSVA::MarginalUI; - use Crypt::Monkeysphere::MSVA::Logger; + use Crypt::Monkeysphere::Logger; + use Crypt::Monkeysphere::Util qw(untaint); use Crypt::Monkeysphere::MSVA::Monitor; + use Crypt::Monkeysphere::OpenPGP; use JSON; use POSIX qw(strftime); # we need the version of GnuPG::Interface that knows about pubkey_data, etc: - use GnuPG::Interface 0.42.02; + use GnuPG::Interface 0.43; - $VERSION = '0.8'; + $VERSION = '0.9~pre'; my $gnupg = GnuPG::Interface::->new(); $gnupg->options->quiet(1); @@ -59,23 +63,13 @@ }, ); - 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::Logger->new($ENV{MSVA_LOG_LEVEL}); sub logger { return $logger; } - my $rsa_decoder = Convert::ASN1::->new(); - $rsa_decoder->prepare(q< - - SEQUENCE { - modulus INTEGER, - exponent INTEGER - } - >); - sub net_server { return 'Net::Server::MSVA'; }; @@ -137,81 +131,6 @@ }; } - 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])), - } ; - } - - # return an arrayref of processes which we can detect that have the # given socket open (the socket is specified with its inode) sub getpidswithsocketinode { @@ -376,7 +295,7 @@ # This is part of a spawned child process. We don't want the # child process to destroy the update monitor when it terminates. - $self->{updatemonitor}->forget(); + $self->{updatemonitor}->forget() if exists $self->{updatemonitor} && defined $self->{updatemonitor}; my $clientinfo = get_client_info(select); my $clientuid = $clientinfo->{uid}; @@ -435,37 +354,69 @@ } } - sub keycomp { - my $rsakey = shift; - my $gpgkey = shift; - - if ($gpgkey->algo_num != 1) { - msvalog('verbose', "Monkeysphere only does RSA keys. This key is algorithm #%d\n", $gpgkey->algo_num); - } else { - if ($rsakey->{exponent}->bcmp($gpgkey->pubkey_data->[1]) == 0 && - $rsakey->{modulus}->bcmp($gpgkey->pubkey_data->[0]) == 0) { - return 1; + sub get_keyserver_policy { + if (exists $ENV{MSVA_KEYSERVER_POLICY} and $ENV{MSVA_KEYSERVER_POLICY} ne '') { + if ($ENV{MSVA_KEYSERVER_POLICY} =~ /^(always|never|unlessvalid)$/) { + return $1; } + msvalog('error', "Not a valid MSVA_KEYSERVER_POLICY):\n %s\n", $ENV{MSVA_KEYSERVER_POLICY}); } - return 0; + return $default_keyserver_policy; } - 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; + sub get_keyserver { + # We should read from (first hit wins): + # the environment + if (exists $ENV{MSVA_KEYSERVER} and $ENV{MSVA_KEYSERVER} ne '') { + 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}); } - msvalog('debug', "%d lines of base64:\n%s\n", $#goodlines + 1, join("\n", @goodlines)); - return decode_base64(join('', @goodlines)); + + # FIXME: some msva.conf or monkeysphere.conf file (system and user?) + + # let the keyserver routines choose. + return undef; + } + + +################################################## +## 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 { @@ -479,7 +430,7 @@ $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 issuer: %s\n", (defined $cert->issuer_cn() ? $cert->issuer_cn() : '<none>')); msvalog('verbose', "cert pubkey algo: %s\n", $cert->PubKeyAlg()); msvalog('verbose', "cert pubkey: %s\n", unpack('H*', $cert->pubkey())); @@ -488,95 +439,121 @@ $cert->PubKeyAlg(), $cert->pubkey_algorithm); } else { msvalog('debug', "decoding ASN.1 pubkey\n"); - $key = $rsa_decoder->decode($cert->pubkey()); + $key = $cert->pubkey_components(); if (! defined $key) { msvalog('verbose', "failed to decode %s\n", unpack('H*', $cert->pubkey())); $key = {error => 'failed to decode the public key'}; + } else { + # ensure these 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})); + + my $pgpext = $cert->PGPExtension(); + if (defined $pgpext) { + $key->{openpgp4fpr} = Crypt::Monkeysphere::OpenPGP::fingerprint($key, $pgpext); + msvalog('verbose', "OpenPGP Fingerprint (derived from X.509 cert): 0x%s\n", uc(unpack("H*", $key->{openpgp4fpr}))); + } } } } return $key; } - sub get_keyserver_policy { - if (exists $ENV{MSVA_KEYSERVER_POLICY} and $ENV{MSVA_KEYSERVER_POLICY} ne '') { - if ($ENV{MSVA_KEYSERVER_POLICY} =~ /^(always|never|unlessvalid)$/) { - return $1; + 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('error', "Not a valid MSVA_KEYSERVER_POLICY):\n %s\n", $ENV{MSVA_KEYSERVER_POLICY}); } - return $default_keyserver_policy; + msvalog('debug', "%d lines of base64:\n%s\n", $#goodlines + 1, join("\n", @goodlines)); + return decode_base64(join('', @goodlines)); } - sub get_keyserver { - # We should read from (first hit wins): - # the environment - if (exists $ENV{MSVA_KEYSERVER} and $ENV{MSVA_KEYSERVER} ne '') { - 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}); - } + sub opensshpubkey2key { + my $data = shift; + # FIXME: do we care that the label matches the type of key? + my ($label, $prop) = split(/ +/, $data); - # FIXME: some msva.conf or monkeysphere.conf file (system and user?) + my $out = parse_rfc4716body($prop); - # or else read from the relevant gnupg.conf: - my $gpghome; - if (exists $ENV{GNUPGHOME} and $ENV{GNUPGHOME} ne '') { - $gpghome = untaint($ENV{GNUPGHOME}); - } else { - $gpghome = File::Spec->catfile(File::HomeDir->my_home, '.gnupg'); - } - my $gpgconf = File::Spec->catfile($gpghome, 'gpg.conf'); - if (-f $gpgconf) { - if (-r $gpgconf) { - my %gpgconfig = Config::General::ParseConfig($gpgconf); - 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 { - msvalog('error', "Not a valid keyserver (from gpg config %s):\n %s\n", $gpgconf, $gpgconfig{keyserver}); + 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'; } - } else { - msvalog('error', "The GnuPG configuration file (%s) is not readable\n", $gpgconf); } - } else { - msvalog('info', "Did not find GnuPG configuration file while looking for keyserver '%s'\n", $gpgconf); + push(@goodlines, $line) if ($state eq 'body'); } - # the default_keyserver - return $default_keyserver; + 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 fetch_uid_from_keyserver { - my $uid = shift; + sub parse_rfc4716body { + my $data = shift; - my $cmd = IO::Handle::->new(); - my $out = IO::Handle::->new(); - my $nul = IO::File::->new("< /dev/null"); + return undef + unless defined($data); + $data = decode_base64($data) or return undef; - 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 ), - command_args => [ '='.$uid ], - commands => [ '--keyserver', - $ks, - qw( --no-tty --with-colons --search ) ] - ); - while (my $line = $out->getline()) { - msvalog('debug', "from ks query: (%d) %s", $cmd->fileno, $line); - if ($line =~ /^info:(\d+):(\d+)/ ) { - $cmd->print(join(' ', ($1..$2))."\n"); - msvalog('debug', 'to ks query: '.join(' ', ($1..$2))."\n"); - last; - } + 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); } - # FIXME: can we do something to avoid hanging forever? - waitpid($pid, 0); - msvalog('debug', "ks query returns %d\n", POSIX::WEXITSTATUS($?)); + + 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; @@ -589,8 +566,14 @@ message => 'Unknown failure', }; + # 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)$/) { + 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}); @@ -616,11 +599,12 @@ } my $prefix = $data->{context}.'://'; - if (defined $data->{peer}->{type} && + 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)$/) { + $data->{context} !~ /^(ike|smtp)$/)) { $prefix = ''; # clients can have any one-line User ID without NULL characters # and leading or trailing whitespace @@ -629,7 +613,7 @@ } 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; + return $status,$ret; } } elsif ($data->{peer}->{name} =~ /^($RE{net}{domain}(:[[:digit:]]+)?)$/) { $data->{peer}->{name} = $1; @@ -645,131 +629,95 @@ my $uid = $prefix.$data->{peer}->{name}; msvalog('verbose', "user ID: %s\n", $uid); - # check pkc type + # extract key or openpgp fingerprint from PKC + my $fpr; 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 { - $ret->{message} = sprintf("Don't know this public key carrier type: %s", $data->{pkc}->{type}); - return $status,$ret; - } - - if (exists $key->{error}) { - $ret->{message} = $key->{error}; - return $status,$ret; - } - - # 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) { - $ret->{message} = sprintf('Public key size is less than 1000 bits (was: %d bits)', $key->{modulus}->copy()->blog(2)); - } 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); + if (lc($data->{pkc}->{type}) eq 'openpgp4fpr') { + if ($data->{pkc}->{data} =~ /^(0x)?([[:xdigit:]]{40})$/) { + $data->{pkc}->{data} = uc($2); + $fpr = $data->{pkc}->{data}; } else { - $kspolicy = get_keyserver_policy(); + msvalog('error', "invalid OpenPGP v4 fingerprint: %s\n",$data->{pkc}->{data}); + $ret->{message} = sprintf("Invalid OpenPGP v4 fingerprint."); + return $status,$ret; } - 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; - } + } else { + # extract key from PKC + $key = pkcextractkey($data); + if (exists $key->{error}) { + $ret->{message} = $key->{error}; + return $status,$ret; } + $fpr = uc(unpack('H*', $key->{openpgp4fpr})) + if (exists $key->{openpgp4fpr}); + } + msvalog('verbose', "OpenPGP v4 fingerprint: %s\n",$fpr) + if defined $fpr; - # 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); - } + # 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'; + + $ret->{message} = sprintf('Failed to validate "%s" through the OpenPGP Web of Trust.', $uid); + + my $validator=new Crypt::Monkeysphere::Validator(kspolicy=>$kspolicy, + context=>$data->{context}, + keyserver=>get_keyserver(), + gnupg=>$gnupg, + logger=>$logger); + + my $uid_query=$validator->lookup(uid=>$uid,fpr=>$fpr,key=>$key); + + # only show the marginal UI if the UID of the corresponding + # key is not fully valid. + if (defined($uid_query->{valid_key})) { + $ret->{valid} = JSON::true; + $ret->{message} = sprintf('Successfully validated "%s" through the OpenPGP Web of Trust.', $uid); + } else { + my $resp = Crypt::Monkeysphere::MSVA::MarginalUI->ask_the_user($gnupg, + $uid, + $uid_query->{subvalid_keys}, + 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 { my $self = shift; my $server = shift; - $self->spawn_master_subproc($server); + $self->spawn_as_child($server); + } + + sub pre_accept_hook { + my $self = shift; + my $server = shift; + + $self->parent_changed($server) if (getppid() != $self->{parent_pid}); } - sub master_subprocess_died { + sub parent_changed { my $self = shift; my $server = shift; - my $subproc_return = shift; - my $exitstatus = POSIX::WEXITSTATUS($subproc_return); - msvalog('verbose', "Subprocess %d terminated; exiting %d.\n", $self->{child_pid}, $exitstatus); - $server->set_exit_status($exitstatus); + msvalog('verbose', "parent %d went away; exiting.\n", $self->{parent_pid}); + $server->set_exit_status(0); $server->server_close(); } @@ -802,22 +750,9 @@ # instead, we'll just avoid trying to kill the next process with this PID: $self->{updatemonitor}->forget(); } - } elsif (exists $self->{child_pid} && - ($self->{child_pid} == 0 || - $self->{child_pid} == $pid)) { - $self->master_subprocess_died($server, $?); } } - # 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 $server = shift; @@ -825,36 +760,41 @@ $server->{server}->{leave_children_open_on_hup} = 1; my $socketcount = @{ $server->{server}->{sock} }; - if ( $socketcount != 1 ) { - msvalog('error', "%d sockets open; should have been 1.\n", $socketcount); + # note: we're assuming here that if there are more than one socket + # open (e.g. IPv6 and IPv4, or multiple IP addresses of the same + # family), they all share the same port number as socket 0. + if ( $socketcount < 1 ) { + msvalog('error', "%d sockets open; should have been at least 1.\n", $socketcount); $server->set_exit_status(10); $server->server_close(); } - my $port = @{ $server->{server}->{sock} }[0]->sockport(); - if ((! defined $port) || ($port < 1) || ($port >= 65536)) { - msvalog('error', "got nonsense port: %d.\n", $port); - $server->set_exit_status(11); - $server->server_close(); - } - if ((exists $ENV{MSVA_PORT}) && (($ENV{MSVA_PORT} + 0) != $port)) { - msvalog('error', "Explicitly requested port %d, but got port: %d.", ($ENV{MSVA_PORT}+0), $port); - $server->set_exit_status(13); - $server->server_close(); + if (!defined($self->port) || $self->port == 0) { + my $port = @{ $server->{server}->{sock} }[0]->sockport(); + if (! defined($port)) { + msvalog('error', "got undefined port.\nRecording as 0.\n", $port); + $port = 0; + } elsif (($port < 1) || ($port >= 65536)) { + msvalog('error', "got nonsense port: %d.\nRecording as 0.\n", $port); + $port = 0; + } elsif ((exists $ENV{MSVA_PORT}) && (($ENV{MSVA_PORT} + 0) != $port)) { + msvalog('error', "Explicitly requested port %d, but got port: %d.", ($ENV{MSVA_PORT}+0), $port); + $server->set_exit_status(13); + $server->server_close(); + } + $self->port($port); } - $self->port($port); - $self->{updatemonitor} = Crypt::Monkeysphere::MSVA::Monitor::->new($logger); } - sub spawn_master_subproc { + sub spawn_as_child { my $self = shift; my $server = shift; - if ((exists $ENV{MSVA_CHILD_PID}) && ($ENV{MSVA_CHILD_PID} ne '')) { + if ((exists $ENV{MSVA_PARENT_PID}) && ($ENV{MSVA_PARENT_PID} ne '')) { # this is most likely a re-exec. - msvalog('info', "This appears to be a re-exec, continuing with child pid %d\n", $ENV{MSVA_CHILD_PID}); - $self->{child_pid} = $ENV{MSVA_CHILD_PID} + 0; - } elsif ($#ARGV >= 0) { - $self->{child_pid} = 0; # indicate that we are planning to fork. + msvalog('info', "This appears to be a re-exec, continuing with parent pid %d\n", $ENV{MSVA_PARENT_PID}); + $self->{parent_pid} = $ENV{MSVA_PARENT_PID} + 0; + } elsif ($#ARGV >= 0) { + $self->{parent_pid} = 0; # indicate that we are planning to fork. # avoid ignoring SIGCHLD right before we fork. $SIG{CHLD} = sub { my $val; @@ -862,20 +802,26 @@ $self->child_dies($val, $server); } }; + my $pid = $$; my $fork = fork(); if (! defined $fork) { msvalog('error', "could not fork\n"); } else { - if ($fork) { - msvalog('debug', "Child process has PID %d\n", $fork); - $self->{child_pid} = $fork; - $ENV{MSVA_CHILD_PID} = $fork; + if (! $fork) { + msvalog('debug', "daemon has PID %d, parent has PID %d\n", $$, $pid); + $self->{parent_pid} = $pid; + # ppid is set in Net::Server::Fork's post_configure; we're + # past post_configure by here, and we're about to change + # process IDs before assuming the role of a forking server, + # so we should set it properly: + $server->{server}->{ppid} = $$; + $ENV{MSVA_PARENT_PID} = $pid; } else { msvalog('verbose', "PID %d executing: \n", $$); for my $arg (@ARGV) { msvalog('verbose', " %s\n", $arg); } - # untaint the environment for the subprocess + # untaint the environment for the parent process # see: https://labs.riseup.net/code/issues/2461 foreach my $e (keys %ENV) { $ENV{$e} = untaint($ENV{$e}); @@ -886,16 +832,22 @@ } # restore default SIGCHLD handling: $SIG{CHLD} = 'DEFAULT'; - $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET} = sprintf('http://localhost:%d', $self->port); + $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET} = sprintf('http://127.0.0.1:%d', $self->port); exec(@args) or exit 111; } } } else { - printf("MONKEYSPHERE_VALIDATION_AGENT_SOCKET=http://localhost:%d;\nexport MONKEYSPHERE_VALIDATION_AGENT_SOCKET;\n", $self->port); + printf("MONKEYSPHERE_VALIDATION_AGENT_SOCKET=http://127.0.0.1:%d;\nexport MONKEYSPHERE_VALIDATION_AGENT_SOCKET;\n", $self->port); # FIXME: consider daemonizing here to behave more like # ssh-agent. maybe avoid backgrounding by setting # MSVA_NO_BACKGROUND. }; + if (exists $ENV{MSVA_MONITOR_CHANGES} && + $ENV{MSVA_MONITOR_CHANGES} eq 'true') { + $self->{updatemonitor} = Crypt::Monkeysphere::MSVA::Monitor::->new($logger); + } else { + msvalog('verbose', "Not monitoring for changes\n"); + } } sub extracerts { diff -Nru msva-perl-0.8/Crypt/Monkeysphere/OpenPGP.pm msva-perl-0.9/Crypt/Monkeysphere/OpenPGP.pm --- msva-perl-0.8/Crypt/Monkeysphere/OpenPGP.pm 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/Crypt/Monkeysphere/OpenPGP.pm 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,186 @@ +package Crypt::Monkeysphere::OpenPGP; + +use strict; +use warnings; + +use Math::BigInt; +use Digest::SHA; + +## WARNING! This entire module has an unstable API at the moment. +## Please do not rely on it, as it may change in the near future. + + +my $tables = { + # see RFC 4880 section 9.1 (ignoring deprecated algorithms for now) + asym_algos => { rsa => 1, + elgamal => 16, + dsa => 17, + }, + + # see RFC 4880 section 9.2 + ciphers => { plaintext => 0, + idea => 1, + tripledes => 2, + cast5 => 3, + blowfish => 4, + aes128 => 7, + aes192 => 8, + aes256 => 9, + twofish => 10, + }, + + # see RFC 4880 section 9.3 + compression => { uncompressed => 0, + zip => 1, + zlib => 2, + bzip2 => 3, + }, + + # see RFC 4880 section 9.4 + digests => { md5 => 1, + sha1 => 2, + ripemd160 => 3, + sha256 => 8, + sha384 => 9, + sha512 => 10, + sha224 => 11, + }, + + # see RFC 4880 section 5.2.3.21 + usage_flags => { certify => 0x01, + sign => 0x02, + encrypt_comms => 0x04, + encrypt_storage => 0x08, + encrypt => 0x0c, ## both comms and storage + split => 0x10, # the private key is split via secret sharing + authenticate => 0x20, + shared => 0x80, # more than one person holds the entire private key + }, + + # see RFC 4880 section 4.3 + packet_types => { pubkey_enc_session => 1, + sig => 2, + symkey_enc_session => 3, + onepass_sig => 4, + seckey => 5, + pubkey => 6, + sec_subkey => 7, + compressed_data => 8, + symenc_data => 9, + marker => 10, + literal => 11, + trust => 12, + uid => 13, + pub_subkey => 14, + uat => 17, + symenc_w_integrity => 18, + mdc => 19, + }, + + # see RFC 4880 section 5.2.1 + sig_types => { binary_doc => 0x00, + text_doc => 0x01, + standalone => 0x02, + generic_certification => 0x10, + persona_certification => 0x11, + casual_certification => 0x12, + positive_certification => 0x13, + subkey_binding => 0x18, + primary_key_binding => 0x19, + key_signature => 0x1f, + key_revocation => 0x20, + subkey_revocation => 0x28, + certification_revocation => 0x30, + timestamp => 0x40, + thirdparty => 0x50, + }, + + # see RFC 4880 section 5.2.3.23 + revocation_reasons => { no_reason_specified => 0, + key_superseded => 1, + key_compromised => 2, + key_retired => 3, + user_id_no_longer_valid => 32, + }, + + # see RFC 4880 section 5.2.3.1 + subpacket_types => { sig_creation_time => 2, + sig_expiration_time => 3, + exportable => 4, + trust_sig => 5, + regex => 6, + revocable => 7, + key_expiration_time => 9, + preferred_cipher => 11, + revocation_key => 12, + issuer => 16, + notation => 20, + preferred_digest => 21, + preferred_compression => 22, + keyserver_prefs => 23, + preferred_keyserver => 24, + primary_uid => 25, + policy_uri => 26, + usage_flags => 27, + signers_uid => 28, + revocation_reason => 29, + features => 30, + signature_target => 31, + embedded_signature => 32, + }, + + # bitstring (see RFC 4880 section 5.2.3.24) + features => { mdc => 0x01 + }, + + # bitstring (see RFC 4880 5.2.3.17) + keyserver_prefs => { nomodify => 0x80 + }, + }; + + +# takes a Math::BigInt, returns it formatted as OpenPGP MPI +# (RFC 4880 section 3.2) +sub mpi_pack { + my $num = shift; + + my $hex = $num->as_hex(); + $hex =~ s/^0x//; + # ensure we've got an even multiple of 2 nybbles here. + $hex = '0'.$hex + if (length($hex) % 2); + + my $val = pack('H*', $hex); + my $mpilen = length($val)*8; + +# this is a kludgy way to get the number of significant bits in the +# first byte: + my $bitsinfirstbyte = length(sprintf("%b", ord($val))); + + $mpilen -= (8 - $bitsinfirstbyte); + + return pack('n', $mpilen).$val; +} + +sub make_rsa_pub_key_body { + my $key = shift; + my $key_timestamp = shift; + + return + pack('CN', 4, $key_timestamp). + pack('C', $tables->{asym_algos}->{rsa}). + mpi_pack($key->{modulus}). + mpi_pack($key->{exponent}); +} + +sub fingerprint { + my $key = shift; + my $key_timestamp = shift; + + my $rsabody = make_rsa_pub_key_body($key, $key_timestamp); + + return Digest::SHA::sha1(pack('Cn', 0x99, length($rsabody)).$rsabody); +} + + +1; diff -Nru msva-perl-0.8/Crypt/Monkeysphere/Util.pm msva-perl-0.9/Crypt/Monkeysphere/Util.pm --- msva-perl-0.8/Crypt/Monkeysphere/Util.pm 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/Crypt/Monkeysphere/Util.pm 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,18 @@ +package Crypt::Monkeysphere::Util; + +use strict; +use warnings; + +use Exporter qw(import); +our @EXPORT_OK=qw(untaint); + + +# use sparingly! We want to keep taint mode around for the data we +# get over the network. +sub untaint { + my $x = shift; + $x =~ /^(.*)$/ ; + return $1; +} + +1; diff -Nru msva-perl-0.8/Crypt/Monkeysphere/Validator.pm msva-perl-0.9/Crypt/Monkeysphere/Validator.pm --- msva-perl-0.8/Crypt/Monkeysphere/Validator.pm 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/Crypt/Monkeysphere/Validator.pm 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,227 @@ +package Crypt::Monkeysphere::Validator; +use Carp; +use strict; +use warnings; + +use parent 'Crypt::Monkeysphere::Keyserver'; + +=pod + +=head2 new + +Create a new Crypt::Monkeysphere::Validator instance + +Arguments + + Param hash, all optional. + + context => 'e-mail|https|ssh|...' + control what counts as suitable user IDs and key capabilities. + + kspolicy => 'always|never|unlessvalid' + when to fetch keys and key updates from keyserver. + + (plus arguments for Crypt::Monkeysphere::{Keyserver,Logger}::new ) + +=head2 lookup + +Arguments + + Param hash. + + uid => (mandatory) OpenPGP User ID desired. + + fpr => fingerprint of the key to compare + + key => hash of pubkey parameters as Math::BigInt values + +one of either fpr or key must be supplied. + +Return Value + + Returns a hashref + + If the lookup succeeded, then the hashref has a key named + valid_key that points to a hashref { fingerprint => $fpr, val => + $validity }. + + If no fully-valid keys+userid were found, but some keys matched + with less-than-valid user IDs, then the hashref has a key named + subvalid_keys that points to an arrayref of { fingerprint => $fpr, + val => $validity } hashrefs. + +=cut + +sub new { + my $class=shift; + my %opts=@_; + + my $self=$class->SUPER::new(%opts); + + $self->{context}=$opts{context} || 'ssh'; + $self->{kspolicy}=$opts{kspolicy} || 'unlessvalid'; + return $self; +} + +sub test_capable { + my $self=shift; + my $subkey=shift; + + if ($self->{context} eq 'e-mail') { + if ($subkey->usage_flags =~ /s/) { + $self->log('verbose', "...and is signing-capable...\n"); + return 1; + } else { + $self->log('verbose', "...but is not signing-capable (%s).\n",$subkey->usage_flags); + } + } else { + if ($subkey->usage_flags =~ /a/) { + $self->log('verbose', "...and is authentication-capable...\n"); + return 1; + } else { + $self->log('verbose', "...but is not authentication-capable (%s).\n",$subkey->usage_flags); + } + } + return 0; +} + +sub _tryquery { + my $self=shift; + my %args=@_; + + my $uid=$args{uid} || croak "uid argument is mandatory"; + my $fpr=$args{fpr}; + my $key=$args{key}; + defined($fpr) || defined($key) || croak "Must supply either a fingerprint or a key"; + + my $subvalid_keys = []; + + my $gpgquery = defined($fpr) ? '0x'.$fpr : '='.$uid; + + foreach my $gpgkey ($self->{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) && $self->keycomp($key, $subkey)) || + (defined($fpr) && ($subkey->fingerprint->as_hex_string eq $fpr))) { + $self->log('verbose', "key 0x%s matches...\n",$subkey->hex_id); + if ($self->test_capable($subkey) ) { + if ($validity =~ /^[fu]$/) { + $self->log('verbose', "...and is fully valid!\n"); + # we have a key that matches with a valid userid -- no need to look further. + return {valid_key => { fingerprint => $subkey->fingerprint, val => $validity }}; + } else { + $self->log('verbose', "...but is not fully valid (%s).\n",$validity); + push(@{$subvalid_keys}, + {fingerprint => $subkey->fingerprint, val => $validity }); + } + } + } + } + } + return { subvalid_keys => $subvalid_keys }; +} + +sub lookup { + my $self=shift; + my %opts=@_; + + if ($self->{kspolicy} eq 'unlessvalid') { + my $ret = $self->_tryquery(uid => $opts{uid}, fpr => $opts{fpr}, key => $opts{key}); + return $ret + if exists($ret->{valid_key}); + }; + + if ($self->{kspolicy} ne 'never') { + if (defined($opts{fpr})) { + $self->fetch_fpr($opts{fpr}); + } else { + $self->fetch_uid($opts{uid}); + } + } + return $self->_tryquery(uid => $opts{uid}, fpr => $opts{fpr}, key => $opts{key}); +} + +sub valid_binding { + my $self = shift; + my $uid = shift; + my $gpgkey = shift; + + my $validity = '-'; + foreach my $tryuid ($gpgkey->user_ids) { + if ($tryuid->as_string eq $uid) { + return 1 + if $tryuid->validity =~ /^[fu]$/; + } + } + return 0; +} + +=pod + +=head2 findall + +Find all keys with appropriate capabilities and valid bindings to the given uid. + +=cut + +sub findall{ + my $self=shift; + my $uid=shift; + + $self->fetch_uid($uid) if ($self->{kspolicy} eq 'always'); + + my @keys = $self->_findall($uid); + + if (scalar(@keys) == 0 and $self->{kspolicy} eq 'unlessvalid'){ + $self->fetch_uid($uid); + @keys=$self->_findall($uid); + } + + return @keys; +} + +sub _findall { + my $self=shift; + my $uid=shift; + + my @keys; + my $x = 0; + + foreach my $gpgkey ($self->{gnupg}->get_public_keys('='.$uid)) { + if ($self->valid_binding($uid, $gpgkey)) { + foreach my $subkey ($gpgkey, @{$gpgkey->subkeys()}) { + if ($self->test_capable($subkey) ) { + $self->log('verbose', "key 0x%s is capable...\n",$subkey->hex_id); + + push(@keys, $subkey); + } + } + } + } + return @keys; +} + + +sub keycomp { + my $self=shift; + my $rsakey = shift; + my $gpgkey = shift; + + if ($gpgkey->algo_num != 1) { + my $self->log('verbose', "Monkeysphere only does RSA keys. This key is algorithm #%d\n", $gpgkey->algo_num); + } else { + if ($rsakey->{exponent}->bcmp($gpgkey->pubkey_data->[1]) == 0 && + $rsakey->{modulus}->bcmp($gpgkey->pubkey_data->[0]) == 0) { + return 1; + } + } + return 0; + } + +1; diff -Nru msva-perl-0.8/debian/changelog msva-perl-0.9/debian/changelog --- msva-perl-0.8/debian/changelog 2011-02-13 19:49:54.000000000 -0500 +++ msva-perl-0.9/debian/changelog 2012-07-28 16:44:56.000000000 -0400 @@ -1,3 +1,19 @@ +msva-perl (0.9-1) unstable; urgency=low + + * New Upstream version + - tighter dependencies + - daemon crash should no longer kill X11 session + (Closes: #682353, #682518) + - cleanup for newer versions of perl and modules + (Closes: #677565, #642304) + - binds explicitly to IPv4 loopback + (Closes: #661939) + - scanning for changes and prompting to reload off by default + (Closes: #614313) + * bumped Standards-Version to 3.9.3 (no changes needed) + + -- Daniel Kahn Gillmor <dkg@fifthhorseman.net> Wed, 25 Jul 2012 13:20:08 -0400 + msva-perl (0.8-2) unstable; urgency=low * Release into unstable. diff -Nru msva-perl-0.8/debian/control msva-perl-0.9/debian/control --- msva-perl-0.8/debian/control 2011-02-13 19:44:29.000000000 -0500 +++ msva-perl-0.9/debian/control 2012-07-28 16:44:36.000000000 -0400 @@ -6,20 +6,20 @@ Build-Depends: debhelper (>= 7.0), perl -Standards-Version: 3.9.1 +Standards-Version: 3.9.3 Homepage: http://web.monkeysphere.info/ Vcs-Git: git://git.monkeysphere.info/msva-perl Package: msva-perl Architecture: all Depends: - libcrypt-x509-perl, + libcrypt-x509-perl (>= 0.50), libconvert-asn1-perl, - libnet-server-perl, + libnet-server-perl (>= 2.00), libhttp-server-simple-perl, libjson-perl, libparent-perl, - libgnupg-interface-perl (>= 0.42.02), + libgnupg-interface-perl (>= 0.43), libregexp-common-perl, libfile-homedir-perl, libconfig-general-perl, @@ -30,7 +30,7 @@ liblinux-inotify2-perl, liburi-perl, libnet-ssleay-perl, - libio-socket-ssl-perl (>=1.37), + libio-socket-ssl-perl (>= 1.37), libwww-perl Suggests: liblwp-protocol-socks-perl diff -Nru msva-perl-0.8/debian/msva-perl.install msva-perl-0.9/debian/msva-perl.install --- msva-perl-0.8/debian/msva-perl.install 2011-02-13 19:44:29.000000000 -0500 +++ msva-perl-0.9/debian/msva-perl.install 2012-07-28 16:43:54.000000000 -0400 @@ -2,10 +2,7 @@ msva-query-agent usr/bin gpgkeys_hkpms usr/lib/gnupg Net/Server/MSVA.pm usr/share/perl5/Net/Server -Crypt/Monkeysphere/MSVA.pm usr/share/perl5/Crypt/Monkeysphere -Crypt/Monkeysphere/MSVA/Logger.pm usr/share/perl5/Crypt/Monkeysphere/MSVA -Crypt/Monkeysphere/MSVA/Monitor.pm usr/share/perl5/Crypt/Monkeysphere/MSVA -Crypt/Monkeysphere/MSVA/MarginalUI.pm usr/share/perl5/Crypt/Monkeysphere/MSVA -Crypt/Monkeysphere/MSVA/Client.pm usr/share/perl5/Crypt/Monkeysphere/MSVA +Crypt/Monkeysphere/*.pm usr/share/perl5/Crypt/Monkeysphere +Crypt/Monkeysphere/MSVA/*.pm usr/share/perl5/Crypt/Monkeysphere/MSVA monkeysphere-icon.png usr/share/pixmaps debian/70monkeysphere_use-validation-agent etc/X11/Xsession.d diff -Nru msva-perl-0.8/gpgkeys_hkpms msva-perl-0.9/gpgkeys_hkpms --- msva-perl-0.8/gpgkeys_hkpms 2010-12-20 16:11:39.000000000 -0500 +++ msva-perl-0.9/gpgkeys_hkpms 2012-07-28 16:43:34.000000000 -0400 @@ -17,7 +17,7 @@ { package Crypt::Monkeysphere::MSVA::HKPMS; use POSIX; - use Crypt::Monkeysphere::MSVA::Logger; + use Crypt::Monkeysphere::Logger; use Crypt::Monkeysphere::MSVA::Client; use Regexp::Common qw /net/; use Module::Load::Conditional; @@ -117,7 +117,9 @@ if (JSON::is_bool($ret->{valid}) && ($ret->{valid} eq 1)) { $self->{logger}->log('verbose', "Monkeysphere HKPMS Certificate validation succeeded:\n %s\n", $ret->{message}); } else { - $self->{logger}->log('error', "Monkeysphere HKPMS Certificate validation failed:\n %s\n", $ret->{message}); + my $m = '[undefined]'; + $m = $ret->{message} if (defined($ret->{message})); + $self->{logger}->log('error', "Monkeysphere HKPMS Certificate validation failed:\n %s\n", $m); } } @@ -262,7 +264,7 @@ } my $self = { config => { }, args => [ ], - logger => (defined($client) ? $client->{logger} : Crypt::Monkeysphere::MSVA::Logger::->new($default_log_level)), + logger => (defined($client) ? $client->{logger} : Crypt::Monkeysphere::Logger::->new($default_log_level)), cache => { }, client => $client, actually_check => 1, diff -Nru msva-perl-0.8/msva-perl msva-perl-0.9/msva-perl --- msva-perl-0.8/msva-perl 2010-12-20 16:11:39.000000000 -0500 +++ msva-perl-0.9/msva-perl 2012-07-28 16:43:34.000000000 -0400 @@ -22,7 +22,7 @@ use Crypt::Monkeysphere::MSVA; my $server = Crypt::Monkeysphere::MSVA->new(); -$server->run(host=>'localhost', +$server->run(host=>'127.0.0.1', log_level=> $server->logger->get_log_level(), user => POSIX::geteuid(), # explicitly choose regular user and group (avoids spew) group => POSIX::getegid(), @@ -114,6 +114,14 @@ specific query if no keys are already locally known to be valid for the requested peer. Default is 'unlessvalid'. +=item MSVA_MONITOR_CHANGES + +Under graphical environments such as X11, msva-perl is capable of +monitoring for changes in its underlying code and can prompt the user +to restart the daemon when some of the underlying code changes. +Setting this environmnt variable to 'true' enables this monitoring and +prompting behavior. Default is 'false'. + =back =head1 COMMUNICATION PROTOCOL DETAILS @@ -126,11 +134,11 @@ =head1 SECURITY CONSIDERATIONS -msva-perl deliberately binds to the loopback adapter (via named lookup -of "localhost") so that remote users do not get access to the daemon. -On systems (like Linux) which report ownership of TCP sockets in -/proc/net/tcp, msva-perl will refuse access from random users (see -MSVA_ALLOWED_USERS above). +msva-perl deliberately binds to the IPv4 loopback (on 127.0.0.1) so +that remote users do not get access to the daemon. On systems (like +Linux) which report ownership of TCP sockets in /proc/net/tcp, +msva-perl will refuse access from random users (see MSVA_ALLOWED_USERS +above). =head1 SEE ALSO diff -Nru msva-perl-0.8/msva-query-agent msva-perl-0.9/msva-query-agent --- msva-perl-0.8/msva-query-agent 2010-12-20 16:11:39.000000000 -0500 +++ msva-perl-0.9/msva-query-agent 2012-07-28 16:43:34.000000000 -0400 @@ -21,16 +21,46 @@ use Crypt::Monkeysphere::MSVA::Client; +sub usage { + my $name = shift; + + printf STDERR ("Usage: %s CONTEXT PEER PKC_TYPE [PEER_TYPE] < PKC_DATA + %s CONTEXT PEER PKC_TYPE PEER_TYPE PKC_DATA + %s --version +", $name, $name, $name); +} + my $context = shift; +if ((!defined($context)) || + $context eq '--help') { + usage($0); + exit (defined($context) ? 0 : 1); +} elsif ($context eq '--version') { + my $client = Crypt::Monkeysphere::MSVA::Client->new( + socket => $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET}, + log_level => $ENV{MSVA_LOG_LEVEL}, + ); + my ($status,$ret) = $client->agent_info(); + $client->log('verbose', "status: %s\n", $status); + if (defined $ret) { + printf("%s", $ret->{server}); + exit 0; + } + exit 1; +} + my $peer = shift; my $pkctype = shift; my $peertype = shift; +my $pkcdata = shift; -# load raw pkc data from stdin -my $pkcdata = do { - local $/; # slurp! - <STDIN>; -}; +if (!defined $pkcdata) { + # load raw pkc data from stdin + $pkcdata = do { + local $/; # slurp! + <STDIN>; + }; +} my $client = Crypt::Monkeysphere::MSVA::Client->new( socket => $ENV{MONKEYSPHERE_VALIDATION_AGENT_SOCKET}, @@ -39,15 +69,20 @@ my ($status,$ret) = $client->query_agent($context,$peer,$peertype,$pkctype,$pkcdata); -$client->log('info', "status: %s\n", $status); +$client->log('verbose', "status: %s\n", $status); if (defined $ret) { $client->log('info', "valid: %s\n", $ret->{valid}); $client->log('info', "server: %s\n", $ret->{server}); - printf("%s\n", $ret->{message}); - exit 0 - if ($ret->{valid}); + printf("%s", $ret->{message}); + if ($ret->{valid}) { + exit 0 + } else { + exit 1; + } +} else { + printf("%s", $status); + exit 100; } -exit 1; __END__ @@ -59,6 +94,10 @@ msva-query-agent CONTEXT PEER PKC_TYPE [PEER_TYPE] < /path/to/public_key_carrier +msva-query-agent CONTEXT PEER PKC_TYPE PEER_TYPE PKC_DATA + +msva-query-agent --version + =head1 ABSTRACT msva-query-agent validates certificates for a given use by querying a @@ -72,8 +111,7 @@ for the specified purpose. The agent's return message (if any) is emitted on stdout. -The first three command-line arguments are all required, supplied in -order, as follows: +The various arguments are: =over 4 @@ -90,17 +128,21 @@ =item PKC_TYPE The format of public key carrier data provided on standard input -(e.g. 'x509der', 'x509pem', 'opensshpubkey', 'rfc4716') - -=back - -The fourth argument is optional: - -=over 4 +(e.g. 'x509der', 'x509pem', 'opensshpubkey', 'rfc4716', 'openpgp4fpr') =item PEER_TYPE -The type of peer we are inquiring about (e.g. 'client', 'server') +The type of peer we are inquiring about (e.g. 'client', 'server', +'peer'). This argument is optional and defaults will be used (based +on CONTEXT) if it is not supplied. + +=item PKC_DATA + +This is the actual public key carrier data itself. If less than five +arguments are given, then the PKC_DATA is expected on stdin. If five +arguments are given, the fifth argument is interpreted as the +PKC_DATA. This is likely only useful for supplying an OpenPGP +fingerprint with the 'openpgp4fpr' type. =back @@ -118,7 +160,7 @@ =item MONKEYSPHERE_VALIDATION_AGENT_SOCKET Socket over which to query the validation agent. If unset, the -default value is 'http://localhost:8901'. +default value is 'http://127.0.0.1:8901'. =item MSVA_LOG_LEVEL diff -Nru msva-perl-0.8/Net/Server/MSVA.pm msva-perl-0.9/Net/Server/MSVA.pm --- msva-perl-0.8/Net/Server/MSVA.pm 2010-12-20 16:11:39.000000000 -0500 +++ msva-perl-0.9/Net/Server/MSVA.pm 2012-07-28 16:43:34.000000000 -0400 @@ -19,6 +19,7 @@ { package Net::Server::MSVA; use strict; use base qw(Net::Server::Fork); + use Net::Server 2.000 (); my $msva; # guarantee initial failure -- this will be cleared after we bind @@ -37,6 +38,11 @@ $msva->pre_loop_hook($self, @_); } + sub pre_accept_hook { + my $self = shift; + $msva->pre_accept_hook($self, @_); + } + sub set_exit_status { my $self = shift; $exit_status = shift; diff -Nru msva-perl-0.8/openpgp2x509 msva-perl-0.9/openpgp2x509 --- msva-perl-0.8/openpgp2x509 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/openpgp2x509 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,348 @@ +#!/usr/bin/perl + +# Author: Daniel Kahn Gillmor <dkg@fifthhorseman.net> +# Copyright: 2011 +# License: GPL-3+ + +# WARNING: This is very rough code! the interface WILL change +# dramatically. The only thing I can commit to keeping stable are the +# OIDs. + +# Use this code to take an OpenPGP certificate (pubkey) and emit a +# corresponding OpenPGP-validated X.509 certificate. + +# Usage: openpgp2x509 ssh://lair.fifthhorseman.net + +use strict; +use warnings; +use Crypt::X509 0.50; +use Math::BigInt; +use GnuPG::Interface 0.43; +use Regexp::Common qw /net/; +use MIME::Base64; + +my $cert = Crypt::X509::_init('Certificate'); +$cert->configure('encode' => { 'time' => 'raw' } ); +my $pgpe = Crypt::X509::_init('PGPExtension'); +$pgpe->configure('encode' => { 'time' => 'raw' } ); +my $rsapubkeyinfo = Crypt::X509::_init('RSAPubKeyInfo'); + +my $dntypes = { 'CN' => '2.5.4.3', # common name + 'emailAddress' => '1.2.840.113549.1.9.1', # e-mail address + 'C' => '2.5.4.6', # country + 'ST' => '2.5.4.8', # state + 'L' => '2.5.4.7', # locality + 'O' => '2.5.4.10', # organization + 'OU' => '2.5.4.11', # organization unit (often used as a comment) + }; + +my $algos = { + 'RSA' => '1.2.840.113549.1.1.1', + 'RSAwithMD2' => '1.2.840.113549.1.1.2', + 'RSAwithMD4' => '1.2.840.113549.1.1.3', + 'RSAwithMD5' => '1.2.840.113549.1.1.4', + 'RSAwithSHA1' => '1.2.840.113549.1.1.5', + 'OAEP' => '1.2.840.113549.1.1.6', + 'RSAwithSHA256' => '1.2.840.113549.1.1.11', + 'RSAwithSHA384' => '1.2.840.113549.1.1.12', + 'RSAwithSHA512' => '1.2.840.113549.1.1.13', + 'RSAwithSHA224' => '1.2.840.113549.1.1.14', + 'NullSignatureUseOpenPGP' => '1.3.6.1.4.1.37210.1.1', + 'OpenPGPCertificateEmbedded' => '1.3.6.1.4.1.37210.1.2', + + }; + +# NullSignatureUseOpenPGP: this X509 certificate is not +# self-verifiable. It must be verified by fetching certificate +# material from OpenPGP keyservers or from the user's private OpenPGP +# keyring. + +# The identity material and usage in the OpenPGP keyservers SHOULD be +# tested against the context in which the certificate is being used. +# If no context information is explicitly available to the +# implementation checking the certificate's validity, the +# implementation MUST assume that the context is the full set of +# possible contexts asserted by the X.509 material itself (is this +# doable?) + +# 0) certificate validity ambiguity -- X.509 certificates are +# generally considered to be entirely valid or entirely invalid. +# OpenPGP certificates can have some User IDs that are valid, and +# others that are not. If an implementation is asked to return a +# simple boolean response to a validity inquiry, without knowing +# the context in which the certificate was proposed for use, it +# MUST validate the full conjunction of all assertions made in the +# X.509 certificate itself in order to return "true". + + + +# OpenPGPCertificateEmbedded: the "signature" material in the X.509 +# certificate is actually a set of OpenPGP packets corresponding to a +# complete "transferable public key" as specified in +# https://tools.ietf.org/html/rfc4880#section-11.1 , in "raw" +# (non-ascii-armored) form. + +# If it were implemented, it would be the same as +# NullSignatureUseOpenPGP, but with the OpenPGP material transported +# in-band in addition. + +## NOTE: There is no implementation of the OpenPGPCertificateEmbedded, +## and maybe there never will be. Another approach would be to +## transmitting OpenPGP signature packets in the TLS channel itself, +## with an extension comparable to OCSP stapling. + +# the OpenPGPCertificateEmbedded concept has a few downsides: + +# 1) data duplication -- the X.509 Subject Public Key material is +# repeated (either in the primary key packet, or in one of the +# subkey packets). The X.509 Subject material (and any +# subjectAltNames) are also duplicated in the User ID packets. +# This increases the size of the certificate. It also creates +# potential inconsistencies. If the X.509 Subject Public Key +# material is not found found in the OpenPGP Transferable Public +# Key (either as a primary key or as a subkey), conforming +# implementations MUST reject the certificate. + +# 2) the requirement for out-of-band verification is not entirely +# removed, since conformant implementations may want to check the +# public keyservers for things like revocation certificates. + + + + +# this is a 5 followed by a 0. it fits into the "Parameters" section +# of an ASN.1 algorithmIdentifier object. what does this mean? +# I think it means the NULL type. +my $noparams = sprintf('%c%c', 5, 0); + +my $extensions = { 'PGPExtension' => '1.3.6.1.4.1.3401.8.1.1' }; + +my $gnupg = GnuPG::Interface::->new(); +$gnupg->options->quiet(1); +$gnupg->options->batch(1); + +sub err { + printf STDERR @_; +} + + +sub ts2Time { + my $ts = shift; + + if (!defined($ts)) { + # see https://tools.ietf.org/html/rfc5280#section-4.1.2.5 + return {'generalTime' => '99991231235959Z' }; + } else { + my ($sec,$min,$hour,$mday,$mon,$year) = gmtime($ts); + $year += 1900; + if (($year < 1950) || + ($year >= 2050)) { + return {'generalTime' => sprintf('%04d%02d%02d%02d%02d%02dZ', $year, $mon+1, $mday, $hour, $min, $sec) }; + } else { + return {'utcTime' => sprintf('%02d%02d%02d%02d%02d%02dZ', ($year%100), $mon+1, $mday, $hour, $min, $sec) }; + } + } +} + +sub ts2ISO8601 { + my $ts = shift; + $ts = time() + if (!defined($ts)); + my ($sec,$min,$hour,$mday,$mon,$year) = gmtime($ts); + $year += 1900; + return sprintf('%04d-%02d-%02dT%02d:%02d:%02dZ', $year, $mon+1, $mday, $hour, $min, $sec); +}; + +sub makeX509CertForUserID { + my $userid = shift; + my $hostname; + my $protocol; + my $emailaddress; + my $humanname; + my $subject; + my $ret = []; + + if ($userid =~ /^\s+/) { + err("We will not process User IDs with leading whitespace\n"); + return $ret; + } + if ($userid =~ /\s+$/) { + err("We will not process User IDs with trailing whitespace\n"); + return $ret; + } + if ($userid =~ /\n/) { + err("We will not process User IDs containing newlines\n"); + return $ret; + } + # FIXME: do we want to rule out any other forms of User ID? + + + if ($userid =~ /^(.*)\s+<([^><@\s]+\@$RE{net}{domain})>$/ ) { + # this is a typical/expected OpenPGP User ID. + $humanname = $1; + $emailaddress = $2; + $subject = [ + [ { + 'type' => $dntypes->{'CN'}, + 'value' => { + 'printableString' => $humanname, + }, + } ], + [ { + 'type' => $dntypes->{'emailAddress'}, + 'value' => { + 'ia5String' => $emailaddress, + }, + } ], + ]; + } elsif ($userid =~ /^(https|ssh|smtps?|ike|postgresql|imaps?|submission):\/\/($RE{net}{domain})$/) { + $protocol = $1; + $hostname = $2; + $subject = [ [ { + 'type' => $dntypes->{'CN'}, + 'value' => { + 'printableString' => $hostname + }, + } ] ]; + } else { + # what should we do here? Maybe we just assume this is a bare Human Name? + err("Assuming '%s' is a bare human name.\n", $userid); + $humanname = $userid; + } + + foreach my $gpgkey ($gnupg->get_public_keys('='.$userid)) { + my $validity = '-'; + my @sans; + foreach my $tryuid ($gpgkey->user_ids) { + if ($tryuid->as_string eq $userid) { + $validity = $tryuid->validity; + } + + if (defined($protocol) && + ($tryuid->validity =~ /^[fu]$/) && + ($tryuid =~ /^$protocol\:\/\/($RE{net}{domain})/ )) { + push(@sans, $2); + } + } + if ($validity !~ /^[fu]$/) { + err("key 0x%s only has validity %s for User ID '%s' (needs full or ultimate validity)\n", $gpgkey->fingerprint->as_hex_string, $validity, $userid); + next; + } + + # treat primary keys just like subkeys: + foreach my $subkey ($gpgkey, @{$gpgkey->subkeys}) { + if ($subkey->{algo_num} != 1) { + err("key 0x%s is algorithm %d (not RSA) -- we currently only handle RSA\n", $subkey->fingerprint->as_hex_string, $subkey->algo_num); + next; + } + # FIXME: reject/skip over revoked/expired keys. + + my $pubkey = { 'modulus' => @{$subkey->pubkey_data}[0], + 'exponent' => @{$subkey->pubkey_data}[1], + }; + my $vnotbefore = $subkey->creation_date; + + my $vnotafter = $subkey->expiration_date; + # expiration date should be the minimum of the primary key and the subkey: + if (!defined($vnotafter)) { + $vnotafter = $gpgkey->expiration_date; + } elsif (defined($gpgkey->expiration_date)) { + $vnotafter = $gpgkey->expiration_date + if ($gpgkey->expiration_date < $vnotafter); + } + + my $cnotbefore = ts2Time($vnotbefore); + my $cnotafter = ts2Time($vnotafter); + + my $pgpeval = $pgpe->encode({ 'version' => 0, 'keyCreation' => $cnotbefore }); + print $pgpe->{error} + if (!defined($pgpeval)); + + my $pubkeybitstring = $rsapubkeyinfo->encode($pubkey); + print $rsapubkeyinfo->{error} + if (!defined($pubkeybitstring)); + + my @extensions; + push(@extensions, { 'extnID' => $extensions->{'PGPExtension'}, + 'extnValue' => $pgpeval + }); + + # FIXME: base some keyUsage extensions on the type of User ID + # and on the usage flags of the key in question. + + # if 'a' is present + # if protocol =~ /^http|ssh|smtps?|postgresql|imaps?|submission$/ then set TLS server eKU + ??? + # if protocol eq 'ike' then ??? (ask micah) + # if protocol =~ /^smtps?$/ then set TLS client + ??? + # if defined($humanname) then set TLS client + ??? + + # if 'e' is present: + # ??? + + # if 's' is present: + # ??? + + # if 'c' is present: I think we should never specify CA:TRUE or + # CA:FALSE in these certificates, since (a) we do not expect + # these keys to actually be making X.509-style certifications, + # but (b) we also don't want to assert that they can't make + # any certifications whatsoever. + + + # FIXME: add subjectAltName that matches the type of information + # we believe we're working with (see the cert-id draft). + + # FIXME: if @sans is present, add them as subjectAltNames (do we + # want to do this? maybe this should be optional). + + + my $newcert = { + 'tbsCertificate' => { + 'version' => 2, # 0 == version 1, 1 == version 2, 2 == version 3 + # this is a convenient way to pass the fpr too. + 'serialNumber' => Math::BigInt->new('0x'.$subkey->fingerprint->as_hex_string), + 'subjectPublicKeyInfo' => { + 'algorithm' => { + 'parameters' => $noparams, + 'algorithm' => $algos->{'RSA'}, + }, + 'subjectPublicKey' => $pubkeybitstring, + }, + 'validity' => { + 'notAfter' => $cnotafter, + 'notBefore' => $cnotbefore, + }, + 'signature' => { # maybe we should make up our own "signature algorithm" here? + 'parameters' => $noparams, + 'algorithm' => $algos->{'NullSignatureUseOpenPGP'} + }, + 'subject' => { + 'rdnSequence' => $subject, + }, + 'issuer' => { + 'rdnSequence' => [ [ { + 'type' => $dntypes->{'OU'}, + 'value' => { 'printableString' => sprintf('Please check the OpenPGP keyservers for certification information. (certificate generated on %s)', ts2ISO8601(time())) }, + } ] ], + }, + 'extensions' => \@extensions, + }, + 'signature' => 'use OpenPGP', + 'signatureAlgorithm' => { + 'parameters' => $noparams, + 'algorithm' => $algos->{'NullSignatureUseOpenPGP'} + } + }; + + my $dd = $cert->encode($newcert); + + push(@{$ret}, $dd); + } + } + return $ret; +} + + +foreach $cert ( @{ makeX509CertForUserID($ARGV[0]) } ) { + printf("-----BEGIN CERTIFICATE-----\n%s-----END CERTIFICATE-----\n", encode_base64($cert)); +} diff -Nru msva-perl-0.8/tests/basic msva-perl-0.9/tests/basic --- msva-perl-0.8/tests/basic 2010-12-20 16:11:39.000000000 -0500 +++ msva-perl-0.9/tests/basic 2012-07-28 16:43:34.000000000 -0400 @@ -25,7 +25,7 @@ REPS=5 -CERTTYPES="x509pem x509der opensshpubkey rfc4716" +CERTTYPES="x509pem x509der opensshpubkey rfc4716 openpgp4fpr" printf "testing %d reps of simple/quick true/false:\n" "$REPS" for n in $(seq 1 "$REPS") ; do @@ -71,11 +71,21 @@ # translate X and Y's keys into OpenPGP cert for name in x y; do - PEM2OPENPGP_USAGE_FLAGS=authenticate pem2openpgp "https://${name}.example.net"; < "${WORKDIR}/sec/${name}.key" | gpg --import + uid="https://${name}.example.net"; + PEM2OPENPGP_USAGE_FLAGS=authenticate pem2openpgp "$uid" < "${WORKDIR}/sec/${name}.key" | gpg --import + # export fingerprint for openpgp4fpr + gpg --with-colons --fingerprint "=${uid}" | grep '^fpr:' | cut -d: -f10 > "${WORKDIR}/pkc/${name}.openpgp4fpr" done +# touch an empty openpgp4fpr file for z, who is not supposed to be in +# the monkeysphere at all, and therefore has no openpgp4fpr +touch "${WORKDIR}/pkc/z.openpgp4fpr" # and the same for the clients A and B for name in a b; do - PEM2OPENPGP_USAGE_FLAGS=authenticate pem2openpgp "${name} <${name}@example.net>" < "${WORKDIR}/sec/${name}.key" | gpg --import + uid="${name} <${name}@example.net>" + # make user keys 'a' and 's' capable + PEM2OPENPGP_USAGE_FLAGS=authenticate,sign pem2openpgp "$uid" < "${WORKDIR}/sec/${name}.key" | gpg --import + # export fingerprint for openpgp4fpr + gpg --with-colons --fingerprint "=${uid}" | grep '^fpr:' | cut -d: -f10 > "${WORKDIR}/pkc/${name}.openpgp4fpr" done runtests() { @@ -83,12 +93,14 @@ for name in x y z; do for ctype in $CERTTYPES; do ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "${name}.example.net" "${ctype}" < "${WORKDIR}/pkc/x.${ctype}" + echo done done # A shouldn't validate as A or B: for name in a b; do for ctype in $CERTTYPES; do ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "${name} <${name}@example.net>" "${ctype}" client < "${WORKDIR}/pkc/a.${ctype}" + echo done done @@ -99,29 +111,38 @@ echo "Testing bad data:" # it should fail if we pass it the wrong kind of data: ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https x.example.net "x509der" < "${WORKDIR}/pkc/x.x509pem" + echo ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https x.example.net "x509pem" < "${WORKDIR}/pkc/x.x509der" + echo echo "Done testing bad data." for ctype in $CERTTYPES; do # X should now validate as X "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https x.example.net "${ctype}" < "${WORKDIR}/pkc/x.${ctype}" + echo "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https 'a <a@example.net>' "${ctype}" client < "${WORKDIR}/pkc/a.${ctype}" + # also test "e-mail" context + "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent e-mail 'a <a@example.net>' "${ctype}" < "${WORKDIR}/pkc/a.${ctype}" # but X should not validate as Y or Z: for name in x y z; do ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "${name}.example.net" "${ctype}" < "${WORKDIR}/pkc/x.${ctype}" + echo done # and A shouldn't validate as B: ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "b <b@example.net>" "${ctype}" client < "${WORKDIR}/pkc/a.${ctype}" + echo # neither Y nor Z should validate as any of them: for src in y z; do for targ in x y z; do ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "${targ}.example.net" "${ctype}" < "${WORKDIR}/pkc/${src}.${ctype}" + echo done done # B should also still not validate as itself: ! "${srcdir}"/test-msva msva-perl "${srcdir}"/test-msva msva-query-agent https "b <b@example.net>" "${ctype}" client < "${WORKDIR}/pkc/b.${ctype}" + echo done } diff -Nru msva-perl-0.8/unit-tests/10.keyserver/10.gnupghome.t msva-perl-0.9/unit-tests/10.keyserver/10.gnupghome.t --- msva-perl-0.8/unit-tests/10.keyserver/10.gnupghome.t 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/10.keyserver/10.gnupghome.t 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,39 @@ +# -*- perl -*- +use Test::More; + +use Crypt::Monkeysphere::Keyserver; +use GnuPG::Interface; +use File::Temp qw(tempdir); +use strict; +use warnings; + +my $fpr='762B57BB784206AD'; +plan tests =>5; + +{ + + $ENV{HOME}='/nonexistant'; + my $ks = new Crypt::Monkeysphere::Keyserver(); + + isa_ok($ks,'Crypt::Monkeysphere::Keyserver'); + is($ks->{keyserver},$Crypt::Monkeysphere::Keyserver::default_keyserver); + +} + +my $tempdir = tempdir("/tmp/unitXXXXX", CLEANUP=> 1); +my $gnupg = new GnuPG::Interface(); +my $testks = 'hkp://keys.gnupg.net'; +$gnupg->options->hash_init(homedir=>$tempdir); + +is($gnupg->options->homedir,$tempdir); + +open GPGCONF, '>', "$tempdir/gpg.conf"; +print GPGCONF "keyserver $testks\n"; +close GPGCONF; + +my $ks=new Crypt::Monkeysphere::Keyserver(gnupg=>$gnupg, + loglevel=>'debug'); + +isa_ok($ks,'Crypt::Monkeysphere::Keyserver'); + +is($ks->{keyserver},$testks); diff -Nru msva-perl-0.8/unit-tests/10.keyserver/20.fetch_fpr.t msva-perl-0.9/unit-tests/10.keyserver/20.fetch_fpr.t --- msva-perl-0.8/unit-tests/10.keyserver/20.fetch_fpr.t 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/10.keyserver/20.fetch_fpr.t 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,29 @@ +# -*- perl -*- +use Test::More; + +use Crypt::Monkeysphere::Keyserver; +use GnuPG::Interface; +use File::Temp qw(tempdir); + +my $keyserver= $ENV{MSTEST_KEYSERVER} || 'hkp://pool.sks-keyservers.net'; + +my $fpr='762B57BB784206AD'; +plan tests =>2; + +my $tempdir = tempdir("unitXXXXX", CLEANUP=> 1); +my $gnupg = new GnuPG::Interface(); +$gnupg->options->hash_init(homedir=>$tempdir); + +my $ks=new Crypt::Monkeysphere::Keyserver(gnupg=>$gnupg, + keyserver=>$keyserver, + loglevel=>'debug'); + +isa_ok($ks,'Crypt::Monkeysphere::Keyserver'); + +$ks->fetch_fpr($fpr); + +is(scalar($gnupg->get_public_keys('0x'.$fpr)),1); + + + + diff -Nru msva-perl-0.8/unit-tests/10.keyserver/20.fetch_uid.t msva-perl-0.9/unit-tests/10.keyserver/20.fetch_uid.t --- msva-perl-0.8/unit-tests/10.keyserver/20.fetch_uid.t 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/10.keyserver/20.fetch_uid.t 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,34 @@ +# -*- perl -*- +use Test::More; + +use Crypt::Monkeysphere::Keyserver; +use GnuPG::Interface; +use File::Temp qw(tempdir); + +use strict; + +my $keyserver= $ENV{MSTEST_KEYSERVER} || 'hkp://pool.sks-keyservers.net'; + +my $uid='David Bremner <david@tethera.net>'; +plan tests =>2; + +my $tempdir = tempdir("unitXXXXX", CLEANUP=> 1); +my $gnupg = new GnuPG::Interface(); +$gnupg->options->hash_init(homedir=>$tempdir); + +my $ks=new Crypt::Monkeysphere::Keyserver(gnupg=>$gnupg, + keyserver=>$keyserver, + loglevel=>'debug'); + +isa_ok($ks,'Crypt::Monkeysphere::Keyserver'); + +$ks->fetch_uid($uid); + +my $count=0; +grep { $count += ($_ eq '784206AD') } + (map { $_->short_hex_id } ($gnupg->get_public_keys('='.$uid))); + +is($count,1); + + + diff -Nru msva-perl-0.8/unit-tests/20.validator/10.findall.t msva-perl-0.9/unit-tests/20.validator/10.findall.t --- msva-perl-0.8/unit-tests/20.validator/10.findall.t 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/20.validator/10.findall.t 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,38 @@ +# -*- perl -*- +use Test::More; + +use Crypt::Monkeysphere::Validator; +use GnuPG::Interface; +use File::Temp qw(tempdir); +use Data::Dumper; + +use strict; + + +my $gpgdir = $ENV{MSTEST_GNUPGHOME}; + +unless (defined $gpgdir && -d $gpgdir){ + plan skip_all => "Preseeded GPGHOME not found"; + goto end; +} + + +my $gnupg = new GnuPG::Interface(); +$gnupg->options->hash_init(homedir=>$gpgdir); + +my $validator=new Crypt::Monkeysphere::Validator(gnupg=>$gnupg, + kspolicy=>'never', + loglevel=>'debug'); + + +plan tests =>2; + +isa_ok($validator,'Crypt::Monkeysphere::Validator'); + +my $uid='Joe Tester <joe@example.net>'; + +my @keys=$validator->findall($uid); + +ok(scalar @keys >= 3); + +end: diff -Nru msva-perl-0.8/unit-tests/20.validator/20.lookup.t msva-perl-0.9/unit-tests/20.validator/20.lookup.t --- msva-perl-0.8/unit-tests/20.validator/20.lookup.t 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/20.validator/20.lookup.t 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,34 @@ +# -*- perl -*- +use Test::More; + +use Crypt::Monkeysphere::Validator; +use GnuPG::Interface; +use File::Temp qw(tempdir); +use Data::Dumper; + +use strict; + +my $uid='David Bremner <david@tethera.net>'; +plan tests =>2; + +my $keyserver= $ENV{MSTEST_KEYSERVER} || 'hkp://pool.sks-keyservers.net'; +my $tempdir = tempdir("unitXXXXX", CLEANUP=> 1); +my $gnupg = new GnuPG::Interface(); +$gnupg->options->hash_init(homedir=>$tempdir, + extra_args =>[ qw(--trusted-key 762B57BB784206AD)] + ); + +my $validator=new Crypt::Monkeysphere::Validator(gnupg=>$gnupg, + keyserver=>$keyserver, + loglevel=>'debug'); + +isa_ok($validator,'Crypt::Monkeysphere::Validator'); + +my $return=$validator->lookup(uid=>$uid,fpr=>'F8841978E8FA6FC65D3405155A5EA5837BD0B401'); + +print Dumper($return) if ($ENV{MSTEST_DEBUG}); + +ok(defined($return->{valid_key})); + + + diff -Nru msva-perl-0.8/unit-tests/30.fingerprints/fpr.t msva-perl-0.9/unit-tests/30.fingerprints/fpr.t --- msva-perl-0.8/unit-tests/30.fingerprints/fpr.t 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/30.fingerprints/fpr.t 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,18 @@ +# -*- perl -*- +use Test::More; + +use Crypt::Monkeysphere::OpenPGP; +use Data::Dumper; + +use strict; + +my $timestamp = 1299825212; +my $key = { modulus => Math::BigInt->new('0xcceb95c3c00b8a12c9de4829a803302f76549a50ee9b7ee58ee3a75ed1839d77d2f57b766e9954581d64eb5599ae98326a028831fbadad8065d63bc5a7b8d831e06d363fd9954f271fda1d746674b0ad6e8dff9fc5ddd4608bdf95760372f50897637a379079f3eb2544099a4511fc8af8e5992e15df8eac619b58a9970a3bdb'), + exponent => Math::BigInt->new('0x10001'), + }; +plan tests =>1; + +is(unpack('H*', Crypt::Monkeysphere::OpenPGP::fingerprint($key, $timestamp)),"10cc971bbbb37b9152e8e759a2882699b47c6497"); + + + diff -Nru msva-perl-0.8/unit-tests/40.keytrans/01.openssh_pack.t msva-perl-0.9/unit-tests/40.keytrans/01.openssh_pack.t --- msva-perl-0.8/unit-tests/40.keytrans/01.openssh_pack.t 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/40.keytrans/01.openssh_pack.t 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,21 @@ +# -*- perl -*- +use Test::More; + +use strict; +use warnings; + +use Crypt::Monkeysphere::Keytrans; +use MIME::Base64; +use File::Temp qw(tempdir); + +plan tests =>1; + +# this is dkg's ssh pubkey: +my $exp = Math::BigInt->new('0x10001'); +my $mod = Math::BigInt->new('0xBC358E82F23E5660301E5DBB370B42FD3EBAFE700B8E82F928798C0BA55DE5F96B984C2EA6D0BA67699E7777DA3FAF9CEA29A2030B81761603F8714E76AA2905A8DA2BAAFB19DEC147032E57585B6F4B3B1A4531942A1B3E635E1328AA50D98FA8CA7B2E64537CC26E0DE94F197A97854FE7C3B4F04F4FD96BCE8A311B2767CB0DB6E3A2D1871EE3B6B6309C0322EFCF9D3D30533575509B9A071C0C03A4B9C480D7B7E628BBF2A6714A54B5AA77F05CA7CDADD45A7C2C070DEB51F15122660B15919D7919A299E38D6BBD762C2E4BB306A0B506C7917DA3C0619E6116ADE290FDB35BA24D279212F24F097D1F70326B9207C27E536A29FEAA022504371CC01B'); +my $sshpubkey = 'AAAAB3NzaC1yc2EAAAADAQABAAABAQC8NY6C8j5WYDAeXbs3C0L9Prr+cAuOgvkoeYwLpV3l+WuYTC6m0LpnaZ53d9o/r5zqKaIDC4F2FgP4cU52qikFqNorqvsZ3sFHAy5XWFtvSzsaRTGUKhs+Y14TKKpQ2Y+oynsuZFN8wm4N6U8ZepeFT+fDtPBPT9lrzooxGydnyw2246LRhx7jtrYwnAMi78+dPTBTNXVQm5oHHAwDpLnEgNe35ii78qZxSlS1qnfwXKfNrdRafCwHDetR8VEiZgsVkZ15GaKZ441rvXYsLkuzBqC1BseRfaPAYZ5hFq3ikP2zW6JNJ5IS8k8JfR9wMmuSB8J+U2op/qoCJQQ3HMAb'; + +my $out = encode_base64(Crypt::Monkeysphere::Keytrans::openssh_rsa_pubkey_pack($mod, $exp), ''); + +is($out, $sshpubkey); + diff -Nru msva-perl-0.8/unit-tests/40.keytrans/10.openpgp2ssh.t msva-perl-0.9/unit-tests/40.keytrans/10.openpgp2ssh.t --- msva-perl-0.8/unit-tests/40.keytrans/10.openpgp2ssh.t 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/40.keytrans/10.openpgp2ssh.t 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,57 @@ +# -*- perl -*- +use Test::More; + +use Crypt::Monkeysphere::Keytrans qw(GnuPGKey_to_OpenSSH_pub); +use GnuPG::Interface; +use File::Temp qw(tempdir); + +plan tests => 1; + +my $tempdir = tempdir("unitXXXXX", CLEANUP => 1); +my $gnupg = new GnuPG::Interface(); +$gnupg->options->hash_init(homedir=>$tempdir); + +my $openpgpdata = " +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v1.4.11 (GNU/Linux) + +mI0ETa5YiwEEALJhsHgLEokvKM+d1oAAy+oaDywLWsbqzuCCqu5h9Hu7MYxeGmTA +tg8fXatgXEBUUe+e1i1aF94kTqcqcS5M+71ce2yHNyxl7U0pGVMOPiFiRVKK8x/7 +wE2LTaPHhskc8kkKrxoJMbXmn0Oq5wn8xLkidIsVE+AyQ+HbD9C7UAnhABEBAAG0 +NXRlc3Qga2V5IChETyBOT1QgVVNFISkgPHRlc3RAZXhhbXBsZS5uZXQ+IChJTlNF +Q1VSRSEpiL4EEwECACgFAk2uWIsCGwMFCQABUYAGCwkIBwMCBhUIAgkKCwQWAgMB +Ah4BAheAAAoJEEi/A6Yee54PGcID/iL1tRDgFnNaNNdEpChbjrWcoCIQOIw2VvYH +UJY3oiKPWv/f8NMOylFLBG9pjDUd96wkimUvAKccPDwuhwMQq+KTcDPZXm8AeeUX +IMHmPE33qqvifV9dFGlIGa4a3tmGjJvjhKmNSJGJWG9wRK3C2BrJdQVF9sk2FHXd +1nlddMRV +=MxOB +-----END PGP PUBLIC KEY BLOCK----- +"; + + +my $sshdata = "AAAAB3NzaC1yc2EAAAADAQABAAAAgQCyYbB4CxKJLyjPndaAAMvqGg8sC1rG6s7ggqruYfR7uzGMXhpkwLYPH12rYFxAVFHvntYtWhfeJE6nKnEuTPu9XHtshzcsZe1NKRlTDj4hYkVSivMf+8BNi02jx4bJHPJJCq8aCTG15p9DqucJ/MS5InSLFRPgMkPh2w/Qu1AJ4Q=="; + + +my $input = IO::Handle->new(); +my $output = IO::Handle->new(); +my $handles = GnuPG::Handles->new(stdin => $input, + stdout => $output, + stderr => $output); + +my $pid = $gnupg->import_keys(handles => $handles); + +$input->write($openpgpdata); +$input->close(); +waitpid($pid, 0); + +my @keys = $gnupg->get_public_keys(); + +foreach $key (@keys) { + my $output = GnuPGKey_to_OpenSSH_pub($key); + is($sshdata, $output); +} + + + + + diff -Nru msva-perl-0.8/unit-tests/40.keytrans/20.sshfpr.t msva-perl-0.9/unit-tests/40.keytrans/20.sshfpr.t --- msva-perl-0.8/unit-tests/40.keytrans/20.sshfpr.t 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/40.keytrans/20.sshfpr.t 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,52 @@ +# -*- perl -*- +use Test::More; + +use Crypt::Monkeysphere::Keytrans qw(GnuPGKey_to_OpenSSH_fpr); +use GnuPG::Interface; +use File::Temp qw(tempdir); + +plan tests => 1; + +my $tempdir = tempdir("unitXXXXX", CLEANUP => 1); +my $gnupg = new GnuPG::Interface(); +$gnupg->options->hash_init(homedir=>$tempdir); + +my $openpgpdata = " +-----BEGIN PGP PUBLIC KEY BLOCK----- +Version: GnuPG v1.4.11 (GNU/Linux) + +mI0ETa5YiwEEALJhsHgLEokvKM+d1oAAy+oaDywLWsbqzuCCqu5h9Hu7MYxeGmTA +tg8fXatgXEBUUe+e1i1aF94kTqcqcS5M+71ce2yHNyxl7U0pGVMOPiFiRVKK8x/7 +wE2LTaPHhskc8kkKrxoJMbXmn0Oq5wn8xLkidIsVE+AyQ+HbD9C7UAnhABEBAAG0 +NXRlc3Qga2V5IChETyBOT1QgVVNFISkgPHRlc3RAZXhhbXBsZS5uZXQ+IChJTlNF +Q1VSRSEpiL4EEwECACgFAk2uWIsCGwMFCQABUYAGCwkIBwMCBhUIAgkKCwQWAgMB +Ah4BAheAAAoJEEi/A6Yee54PGcID/iL1tRDgFnNaNNdEpChbjrWcoCIQOIw2VvYH +UJY3oiKPWv/f8NMOylFLBG9pjDUd96wkimUvAKccPDwuhwMQq+KTcDPZXm8AeeUX +IMHmPE33qqvifV9dFGlIGa4a3tmGjJvjhKmNSJGJWG9wRK3C2BrJdQVF9sk2FHXd +1nlddMRV +=MxOB +-----END PGP PUBLIC KEY BLOCK----- +"; + + +my $sshdata = "e6:b3:db:be:c6:5d:f7:65:f2:bb:6e:06:69:36:f5:e5"; + + +my $input = IO::Handle->new(); +my $output = IO::Handle->new(); +my $handles = GnuPG::Handles->new(stdin => $input, + stdout => $output, + stderr => $output); + +my $pid = $gnupg->import_keys(handles => $handles); + +$input->write($openpgpdata); +$input->close(); +waitpid($pid, 0); + +my @keys = $gnupg->get_public_keys(); + +foreach $key (@keys) { + my $output = GnuPGKey_to_OpenSSH_fpr($key); + is($sshdata, $output); +} diff -Nru msva-perl-0.8/unit-tests/keys.txt msva-perl-0.9/unit-tests/keys.txt --- msva-perl-0.8/unit-tests/keys.txt 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/keys.txt 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,47 @@ +# For use with gpg --batch --gen-key + +Key-Type: DSA +Key-Length: 1024 +Subkey-Type: ELG-E +Subkey-Length: 1024 +Name-Real: Joe Tester +Name-Email: joe@example.net +Expire-Date: 0 + +Key-Type: RSA +Key-Length: 2048 +Key-Usage: sign +Subkey-Type: RSA +Subkey-Length: 1024 +Subkey-Usage: auth +Name-Real: Joe Tester +Name-Email: joe@example.net +Expire-Date: 0 + +Key-Type: RSA +Key-Length: 2048 +Key-Usage: sign +Subkey-Type: RSA +Subkey-Length: 1024 +Subkey-Usage: sign +Name-Real: Joe Tester +Name-Email: joe@example.net +Expire-Date: 0 + +Key-Type: RSA +Key-Length: 2048 +Key-Usage: auth +Name-Real: Joe Tester +Name-Email: joe@example.net +Expire-Date: 0 + +Key-Type: RSA +Key-Length: 2048 +Key-Usage: encrypt +Subkey-Type: RSA +Subkey-Length: 1024 +Subkey-Usage: auth +Name-Real: Joe Tester +Name-Email: jojo@example.net +Expire-Date: 0 + diff -Nru msva-perl-0.8/unit-tests/README msva-perl-0.9/unit-tests/README --- msva-perl-0.8/unit-tests/README 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/README 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,7 @@ +To run all unit tests, + + perl run-tests.pl + +to run a subset, + + perl run-tests.pl dir1 [dir2..] diff -Nru msva-perl-0.8/unit-tests/run-tests.pl msva-perl-0.9/unit-tests/run-tests.pl --- msva-perl-0.8/unit-tests/run-tests.pl 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/run-tests.pl 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,59 @@ +#!/usr/bin/perl +use strict; + +use TAP::Harness; +use File::Find; +use FindBin; +use GnuPG::Interface; +use GnuPG::Handles; +use File::Temp qw(tempdir); + +my $BINDIR; +BEGIN { $BINDIR = $FindBin::Bin; } + + +{ +# Generate Keys from template file + + my $tempdir = tempdir("/tmp/test-gnupgXXXXX", CLEANUP=> 1); + my $gnupg = new GnuPG::Interface(); + $gnupg->options->hash_init(homedir=>$tempdir,batch=>1); + + my $GPGQR=''; + if (system qw(gpg --quick-random --version) ==0) { + $GPGQR='--quick-random'; + } elsif (system qw(gpg --debug-quick-random --version) ==0) { + $GPGQR='--debug-quick-random'; + } + + print STDERR "WARNING: no quick random option found. Tests may hang!\n" + unless(scalar $GPGQR); + + my $pid = $gnupg->wrap_call( commands=>[qw(--gen-key --batch),$GPGQR], + command_args=>[$BINDIR.'/keys.txt'], + handles=>new GnuPG::Handles() ); + waitpid $pid,0; + + $ENV{MSTEST_GNUPGHOME}=$tempdir; +} + +my @dirs = scalar(@ARGV) > 0 ? @ARGV : ($BINDIR); + +my @tests; + +sub wanted { + push (@tests,$File::Find::name) if -f && m/.*\.t$/; +} + +find(\&wanted, @dirs); + +@tests=sort @tests; + +print STDERR "found ",scalar(@tests)," tests\n"; + +my $harness = TAP::Harness->new( { verbosity => 1, + lib => [ $BINDIR.'/..'] }); + +$harness->runtests(@tests); + +1; diff -Nru msva-perl-0.8/unit-tests/TODO msva-perl-0.9/unit-tests/TODO --- msva-perl-0.8/unit-tests/TODO 1969-12-31 19:00:00.000000000 -0500 +++ msva-perl-0.9/unit-tests/TODO 2012-07-28 16:43:34.000000000 -0400 @@ -0,0 +1,8 @@ + +The following are currently not tested + +- subvalid keys for a userid +- multiple subkeys from the same primary key +- multiple uids on the same key + + -- David Bremner <bremner@debian.org>, Wed, 23 Mar 2011 20:40:14 -0300Attachment: pgpujtw6LUR7d.pgp
Description: PGP signature
--- End Message ---
--- Begin Message ---
- To: Jonathan Wiltshire <jmw@debian.org>, 686054-done@bugs.debian.org
- Cc: Daniel Kahn Gillmor <dkg@fifthhorseman.net>, intrigeri <intrigeri@debian.org>
- Subject: Re: Bug#686054: [monkeysphere] Bug#682518: Bug#677565: RC bugs in msva-perl
- From: Julien Cristau <jcristau@debian.org>
- Date: Sat, 23 Feb 2013 10:59:30 +0100
- Message-id: <20130223095930.GN5761@radis.cristau.org>
- In-reply-to: <20130219195401.GI10234@lupin.home.powdarrmonkey.net>
- References: <20130202131216.GD5458@urchin.earth.li> <20130202131921.GE5458@urchin.earth.li> <85txpu23ei.fsf@boum.org> <20130204182844.GX5458@urchin.earth.li> <511491C7.2000307@fifthhorseman.net> <85pq0bqi9o.fsf@boum.org> <51154C14.3000306@fifthhorseman.net> <20130219195401.GI10234@lupin.home.powdarrmonkey.net>
On Tue, Feb 19, 2013 at 19:54:01 +0000, Jonathan Wiltshire wrote: > On Fri, Feb 08, 2013 at 02:03:48PM -0500, Daniel Kahn Gillmor wrote: > > meanwhile, if anyone on the release team (cc'ed here) wants to give a > > review of the proposed debdiff, i would be happy to know if msva-perl > > 0.8.1-1 would be acceptable for t-p-u. > > Please go ahead. > Unblocked. Cheers, JulienAttachment: signature.asc
Description: Digital signature
--- End Message ---