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=@_;
$self->log('info', "Did not find GnuPG configuration file while looking for keyserver '%s'\n", $gpgconf);
}
return undef;
-
}
# we need the version of GnuPG::Interface that knows about pubkey_data, etc:
use GnuPG::Interface 0.43;
- $VERSION = '0.9~pre';
+ $VERSION = '0.09_001';
my $gnupg = GnuPG::Interface::->new();
$gnupg->options->quiet(1);
return $logger->log(@_);
};
+ no warnings 'redefine';
sub new {
my $class = shift;
gnupg=>$gnupg,
logger=>$logger);
- my $uid_query=$validator->query(uid=>$uid,fpr=>$fpr, key=>$key );
+ 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 (scalar(@{$uid_query->{valid_keys}}) > 0) {
+ if (defined($uid_query->{valid_key})) {
$ret->{valid} = JSON::true;
$ret->{message} = sprintf('Successfully validated "%s" through the OpenPGP Web of Trust.', $uid);
} else {
$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)) || ($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();
+ }
+ $self->port($port);
}
- $self->port($port);
$self->{updatemonitor} = Crypt::Monkeysphere::MSVA::Monitor::->new($logger);
}
{ package Crypt::Monkeysphere::MSVA::Monitor;
+ use Module::Load::Conditional;
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->{findall} = $opts{findall} || 0;
$self->{context}=$opts{context} || 'ssh';
$self->{kspolicy}=$opts{kspolicy} || 'unlessvalid';
return $self;
return 0;
}
- sub query{
+ sub _tryquery {
my $self=shift;
- my %opts=@_;
+ 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 $uid=$opts{uid} || croak "uid argument is mandatory";
- my $fpr=$opts{fpr};
- my $key=$opts{key};
+ my $subvalid_keys = [];
- my $gpgquery = defined($fpr) ? '0x'.$fpr : '='.$uid;
+ 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 };
+ }
- my $ret= { valid_keys => [],
- subvalid_keys => [] };
+ sub lookup {
+ my $self=shift;
+ my %opts=@_;
- # setup variables
- my $lastloop = 0;
- my $foundvalid = 0;
+ 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} eq 'always') {
- if (defined $fpr) {
- $self->fetch_fpr($fpr);
+ if ($self->{kspolicy} ne 'never') {
+ if (defined($opts{fpr})) {
+ $self->fetch_fpr($opts{fpr});
} else {
- $self->fetch_uid($uid);
+ $self->fetch_uid($opts{uid});
}
- $lastloop = 1;
- } elsif ($self->{kspolicy} eq 'never') {
- $lastloop = 1;
}
+ return $self->_tryquery(uid => $opts{uid}, fpr => $opts{fpr}, key => $opts{key});
+ }
- while (1) {
- 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) && (!defined($fpr))) ||
- (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]$/) {
- $foundvalid = 1;
- $self->log('verbose', "...and is fully valid!\n");
- push(@{$ret->{valid_keys}},
- { fingerprint => $subkey->fingerprint, val => $validity });
- last unless($self->{findall});
- } else {
- $self->log('verbose', "...but is not fully valid (%s).\n",$validity);
- push(@{$ret->{subvalid_keys}},
- {fingerprint => $subkey->fingerprint, val => $validity }) if $lastloop;
- }
- }
- }
- }
- last if ($foundvalid);
- }
- if ($lastloop || $foundvalid) {
- last;
- } else {
- if (!$foundvalid) {
- if (defined $fpr) {
- $self->fetch_fpr($fpr);
- } else {
- $self->fetch_uid($uid);
- }
- }
- $lastloop = 1;
- }
+ 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
- return $ret;
+ =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;
use GnuPG::Interface;
use File::Temp qw(tempdir);
+ my $keyserver= $ENV{MSTEST_KEYSERVER} || 'hkp://pool.sks-keyservers.net';
+
my $fpr='762B57BB784206AD';
plan tests =>2;
$gnupg->options->hash_init(homedir=>$tempdir);
my $ks=new Crypt::Monkeysphere::Keyserver(gnupg=>$gnupg,
+ keyserver=>$keyserver,
loglevel=>'debug');
isa_ok($ks,'Crypt::Monkeysphere::Keyserver');
use strict;
+ my $keyserver= $ENV{MSTEST_KEYSERVER} || 'hkp://pool.sks-keyservers.net';
+
my $uid='David Bremner <david@tethera.net>';
plan tests =>2;
$gnupg->options->hash_init(homedir=>$tempdir);
my $ks=new Crypt::Monkeysphere::Keyserver(gnupg=>$gnupg,
+ keyserver=>$keyserver,
loglevel=>'debug');
isa_ok($ks,'Crypt::Monkeysphere::Keyserver');
--- /dev/null
+ # -*- 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:
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,
);
my $validator=new Crypt::Monkeysphere::Validator(gnupg=>$gnupg,
- loglevel=>'debug');
+ keyserver=>$keyserver,
+ loglevel=>'debug');
isa_ok($validator,'Crypt::Monkeysphere::Validator');
- my $return=$validator->query(uid=>$uid);
+ my $return=$validator->lookup(uid=>$uid,fpr=>'F8841978E8FA6FC65D3405155A5EA5837BD0B401');
- print Dumper($return);
+ print Dumper($return) if ($ENV{MSTEST_DEBUG});
- is(defined($return),1);
+ ok(defined($return->{valid_key}));
--- /dev/null
+ # -*- 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);
+
--- /dev/null
+ # -*- 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);
+ }
+
+
+
+
+
--- /dev/null
+ # -*- 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);
+ }
--- /dev/null
- perl run-tests.pl
+ To run all unit tests,
+
++ ./Build test
+
+ to run a subset,
+
+ perl run-tests.pl dir1 [dir2..]
--- /dev/null
+
+ 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
--- /dev/null
+ # 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
+
projects / monkeysphere-validation-agent.git / commitdiff