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,
--dkg
diff -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 -0300
Attachment:
pgpBwVKCoBafk.pgp
Description: PGP signature