From 410898d04d295f0c50636c62321b0add81242e2a Mon Sep 17 00:00:00 2001 From: David Bremner Date: Sun, 6 Mar 2011 14:42:48 -0400 Subject: [PATCH] Add Keyserver class, and unit tests. This is really a repackaging of the functions fetch_fpr_from_keyserver and fetch_uid_from_keyserver from MSVA.pm, along with the part of get_keyserver from the same file that depends only on GnuPG, not on MSVA. --- Crypt/Monkeysphere/Keyserver.pm | 115 +++++++++++++++++++++++++++++++ unit-tests/keyserver/fetch_fpr.t | 26 +++++++ unit-tests/keyserver/fetch_uid.t | 31 +++++++++ 3 files changed, 172 insertions(+) create mode 100644 Crypt/Monkeysphere/Keyserver.pm create mode 100644 unit-tests/keyserver/fetch_fpr.t create mode 100644 unit-tests/keyserver/fetch_uid.t diff --git a/Crypt/Monkeysphere/Keyserver.pm b/Crypt/Monkeysphere/Keyserver.pm new file mode 100644 index 0000000..ff436eb --- /dev/null +++ b/Crypt/Monkeysphere/Keyserver.pm @@ -0,0 +1,115 @@ +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); + +our $default_keyserver='hkp://pool.sks-keyservers.net'; + +sub new { + my $class=shift; + my %opts=@_; + + my $self=$class->SUPER::new($opts{loglevel} || 'info'); + + $self->{keyserver} = $opts{keyserver} || $self->_get_keyserver(); + $self->{gnupg} = $opts{gnupg} || new GnuPG::Interface(); + return $self; +} + +sub _get_keyserver{ + + my $self=shift; + + 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})$/) { + $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 $default_keyserver; +} + + + +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 --git a/unit-tests/keyserver/fetch_fpr.t b/unit-tests/keyserver/fetch_fpr.t new file mode 100644 index 0000000..cbdef5e --- /dev/null +++ b/unit-tests/keyserver/fetch_fpr.t @@ -0,0 +1,26 @@ +# -*- perl -*- +use Test::More; + +use Crypt::Monkeysphere::Keyserver; +use GnuPG::Interface; +use File::Temp qw(tempdir); + +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, + loglevel=>'debug'); + +isa_ok($ks,'Crypt::Monkeysphere::Keyserver'); + +$ks->fetch_fpr($fpr); + +is(scalar($gnupg->get_public_keys('0x'.$fpr)),1); + + + + diff --git a/unit-tests/keyserver/fetch_uid.t b/unit-tests/keyserver/fetch_uid.t new file mode 100644 index 0000000..248cbda --- /dev/null +++ b/unit-tests/keyserver/fetch_uid.t @@ -0,0 +1,31 @@ +# -*- perl -*- +use Test::More; + +use Crypt::Monkeysphere::Keyserver; +use GnuPG::Interface; +use File::Temp qw(tempdir); + +use strict; + +my $uid='David Bremner '; +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, + 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); + + + -- 2.26.2