diff options
author | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
commit | 661c41a09e39a182865e0b51e34cc995a0dc96e8 (patch) | |
tree | 2f79bb1406e22fdcb2587be8ffda6c0c609d7932 /Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyServer.pm | |
parent | b645030efc22e13c2498a1522083634ab91b2de1 (diff) |
move tlperl.straw to tlperl
git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyServer.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyServer.pm | 153 |
1 files changed, 153 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyServer.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyServer.pm new file mode 100755 index 00000000000..a82f17f9616 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyServer.pm @@ -0,0 +1,153 @@ +package Crypt::OpenPGP::KeyServer; +use strict; + +use Crypt::OpenPGP; +use Crypt::OpenPGP::KeyRing; +use LWP::UserAgent; +use URI::Escape; + +use Crypt::OpenPGP::ErrorHandler; +use base qw( Crypt::OpenPGP::ErrorHandler ); + +sub new { + my $class = shift; + my $server = bless { }, $class; + $server->init(@_) + or return $class->error($server->errstr); + $server; +} + +sub init { + my $server = shift; + my %param = @_; + $server->{keyserver} = $param{Server} + or return $server->error("Need a keyserver ('Server')"); + $server->{keyserver} = 'http://' . $server->{keyserver} . ':11371' . + '/pks/lookup'; + $server->{include_revoked} = $param{IncludeRevoked} || 0; + $server; +} + + +sub find_keyblock_by_uid { + my $server = shift; + my($address) = @_; + my $ua = LWP::UserAgent->new; + $ua->agent('Crypt::OpenPGP/' . Crypt::OpenPGP->VERSION); + my $url = $server->{keyserver} . '?op=index&search=' . + uri_escape($address); + my $req = HTTP::Request->new(GET => $url); + my $res = $ua->request($req); + return $server->error("HTTP error: " . $res->status_line) + unless $res->is_success; + my $page = $res->content; + my @kb; + while ($page =~ m!(pub.*?>)!gs) { + my $line = $1; + next if index($line, "*** KEY REVOKED ***") != -1 && + !$server->{include_revoked}; + my($key_id) = $line =~ m!<a.*?>(.{8})</a>!g; + my $kb = $server->find_keyblock_by_keyid(pack 'H*', $key_id) or next; + push @kb, $kb; + } + @kb; +} + +sub find_keyblock_by_keyid { + my $server = shift; + my($key_id) = @_; + $key_id = unpack 'H*', $key_id; + my $ua = LWP::UserAgent->new; + $ua->agent('Crypt::OpenPGP/' . Crypt::OpenPGP->VERSION); + $key_id = substr($key_id, -8, 8); + my $url = $server->{keyserver} . '?op=get&search=0x' . $key_id; + my $req = HTTP::Request->new(GET => $url); + my $res = $ua->request($req); + return $server->error("HTTP error: " . $res->status_line) + unless $res->is_success; + my $page = $res->content; + my($key) = $page =~ /(-----BEGIN PGP PUBLIC KEY BLOCK-----.*?-----END PGP PUBLIC KEY BLOCK-----)/s; + return $server->error("No matching keys") unless $key; + my $ring = Crypt::OpenPGP::KeyRing->new( Data => $key ) + or return Crypt::OpenPGP::KeyRing->errstr; + $ring->find_keyblock_by_index(0); +} + +1; +__END__ + +=head1 NAME + +Crypt::OpenPGP::KeyServer - Interface to HKP keyservers + +=head1 SYNOPSIS + + use Crypt::OpenPGP::KeyServer; + + my $key_id = '...'; + my $server = Crypt::OpenPGP::KeyServer->new( + Server => 'wwwkeys.us.pgp.net' + ); + my $kb = $server->find_keyblock_by_keyid($key_id); + print $kb->primary_uid, "\n"; + my $cert = $kb->key; + + my @kbs = $server->find_keyblock_by_uid( 'foo@bar.com' ); + +=head1 DESCRIPTION + +I<Crypt::OpenPGP::KeyServer> is an interface to HKP keyservers; it provides +lookup by UID and by key ID. At the moment only HKP keyservers are +supported; future releases will likely support the NAI LDAP servers and +the email keyservers. + +=head1 USAGE + +=head2 Crypt::OpenPGP::KeyServer->new( %arg ) + +Constructs a new I<Crypt::OpenPGP::KeyServer> object and returns that +object. + +I<%arg> can contain: + +=over 4 + +=item * Server + +The hostname of the HKP keyserver. This is a required argument. You can get +a list of keyservers through + + % host -l pgp.net | grep wwwkeys + +=item * IncludeRevoked + +By default, revoked keys will be skipped when calling I<find_keyblock_by_uid>. +If you set I<IncludeRevoked> to C<1>, I<find_keyblock_by_keyid> will include +any revoked keys in the list of keys returned. + +=back + +=head2 $ring->find_keyblock_by_keyid($key_id) + +Looks up the key ID I<$key_id> in the keyring I<$ring>. For consistency +with the I<Crypt::OpenPGP::KeyRing::find_keyblock_by_keyid> interface, +I<$key_id> should be either a 4-octet or 8-octet string--it should +B<not> be a string of hexadecimal digits. If you have the hex key ID, use +I<pack> to convert it to an octet string: + + pack 'H*', $hex_key_id + +Returns false on failure. + +=head2 $ring->find_keyblock_by_uid($uid) + +Given a string I<$uid>, searches the keyserver for all keyblocks matching +the user ID I<$uid>, including partial matches. Returns all of the matching +keyblocks, the empty list on failure. + +=head1 AUTHOR & COPYRIGHTS + +Please see the Crypt::OpenPGP manpage for author, copyright, and +license information. + +=cut |