Gecko [ www.vortexaion.com ]

Name	Size	Permission	Date
Key	[ DIR ]	drwxrwxrwx	2024-07-26 17:38
Signature	[ DIR ]	drwxrwxrwx	2024-07-26 17:38
Armour.pm	7.91 KB	-rw-rw-rw-	2015-08-16 15:28
Buffer.pm	2.11 KB	-rw-rw-rw-	2015-08-16 15:28
CFB.pm	2.73 KB	-rw-rw-rw-	2015-08-16 15:28
Certificate.pm	15.95 KB	-rw-rw-rw-	2015-08-16 15:28
Cipher.pm	5.92 KB	-rw-rw-rw-	2015-08-16 15:28
Ciphertext.pm	7.01 KB	-rw-rw-rw-	2015-08-16 15:28
Compressed.pm	4.92 KB	-rw-rw-rw-	2015-08-16 15:28
Config.pm	3.01 KB	-rw-rw-rw-	2015-08-16 15:28
Constants.pm	2.39 KB	-rw-rw-rw-	2015-08-16 15:28
Digest.pm	4.36 KB	-rw-rw-rw-	2015-08-16 15:28
ErrorHandler.pm	2.37 KB	-rw-rw-rw-	2015-08-16 15:28
Key.pm	6.11 KB	-rw-rw-rw-	2015-08-16 15:28
KeyBlock.pm	3.64 KB	-rw-rw-rw-	2015-08-16 15:28
KeyRing.pm	8.08 KB	-rw-rw-rw-	2015-08-16 15:28
KeyServer.pm	4.32 KB	-rw-rw-rw-	2015-08-16 15:28
MDC.pm	2.5 KB	-rw-rw-rw-	2015-08-16 15:28
Marker.pm	893 B	-rw-rw-rw-	2015-08-16 15:28
Message.pm	4.32 KB	-rw-rw-rw-	2015-08-16 15:28
OnePassSig.pm	1.46 KB	-rw-rw-rw-	2015-08-16 15:28
PacketFactory.pm	8.63 KB	-rw-rw-rw-	2015-08-16 15:28
Plaintext.pm	3.24 KB	-rw-rw-rw-	2015-08-16 15:28
S2k.pm	6.05 KB	-rw-rw-rw-	2015-08-16 15:28
SKSessionKey.pm	6.15 KB	-rw-rw-rw-	2015-08-16 15:28
SessionKey.pm	6.69 KB	-rw-rw-rw-	2015-08-16 15:28
Signature.pm	12.44 KB	-rw-rw-rw-	2015-08-16 15:28
Trust.pm	797 B	-rw-rw-rw-	2015-08-16 15:28
UserID.pm	2.03 KB	-rw-rw-rw-	2015-08-16 15:28
Util.pm	4.85 KB	-rw-rw-rw-	2015-08-16 15:28
Words.pm	11.23 KB	-rw-rw-rw-	2015-08-16 15:28

Rename

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.*?&gt;)!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