Crypt::OpenPGP::KeyRing - Key ring object

Crypt-OpenPGP documentation Contained in the Crypt-OpenPGP distribution.

Index

Code Index:

NAME

Top

Crypt::OpenPGP::KeyRing - Key ring object

SYNOPSIS

Top

    use Crypt::OpenPGP::KeyRing;

    my $ring = Crypt::OpenPGP::KeyRing->new( Filename => 'foo.ring' );

    my $key_id = '...';
    my $kb = $ring->find_keyblock_by_keyid($key_id);

DESCRIPTION

Top

Crypt::OpenPGP::KeyRing provides keyring management and key lookup for Crypt::OpenPGP. A KeyRing, in this case, does not necessarily have to be a keyring file; a KeyRing object is just a collection of key blocks, where each key block contains exactly one master key, zero or more subkeys, some user ID packets, some signatures, etc.

USAGE

Top

Crypt::OpenPGP::KeyRing->new( %arg )

Constructs a new Crypt::OpenPGP::KeyRing object and returns that object. This has the effect os hooking the object to a particular keyring, so that all subsequent methods called on the KeyRing object will use the data specified in the arguments to new.

%arg can contain:

* Data

A block of data specifying the serialized keyring, presumably as read in from a file on disk. This data can be either in binary form or in ASCII-armoured form; if the latter it will be unarmoured automatically.

This argument is optional.

* Filename

The path to a keyring file, or at least, a file containing a key (and perhaps other associated keyblock data). The data in this file can be either in binary form or in ASCII-armoured form; if the latter it will be unarmoured automatically.

This argument is optional.

$ring->find_keyblock_by_keyid($key_id)

Looks up the key ID $key_id in the keyring $ring. $key_id should be either a 4-octet or 8-octet string--it should not be a string of hexadecimal digits. If that is what you have, use pack to convert it to an octet string:

    pack 'H*', $hex_key_id

If a keyblock is found where the key ID of either the master key or subkey matches $key_id, that keyblock will be returned. The definition of "match" depends on the length of $key_id: if it is a 16-digit hex number, only exact matches will be returned; if it is an 8-digit hex number, any keyblocks containing keys whose last 8 hex digits match $key_id will be returned.

In scalar context, only the first keyblock found in the keyring is returned; in list context, all matching keyblocks are returned. In practice, duplicated key IDs are rare, particularly so if you specify the full 16 hex digits in $key_id.

Returns false on failure (undef in scalar context, an empty list in list context).

$ring->find_keyblock_by_uid($uid)

Given a string $uid, looks up all keyblocks with User ID packets matching the string $uid, including partial matches.

In scalar context, returns only the first keyblock with a matching user ID; in list context, returns all matching keyblocks.

Returns false on failure.

$ring->find_keyblock_by_index($index)

Given an index into a list of keyblocks $index, returns the keyblock (a Crypt::OpenPGP::KeyBlock object) at that index. Accepts negative indexes, so -1 will give you the last keyblock in the keyring.

AUTHOR & COPYRIGHTS

Top

Please see the Crypt::OpenPGP manpage for author, copyright, and license information.

Crypt-OpenPGP documentation Contained in the Crypt-OpenPGP distribution. 
package Crypt::OpenPGP::KeyRing;
use strict;

use Crypt::OpenPGP::Constants qw( PGP_PKT_USER_ID
                                  PGP_PKT_PUBLIC_KEY
                                  PGP_PKT_SECRET_KEY
                                  PGP_PKT_PUBLIC_SUBKEY
                                  PGP_PKT_SECRET_SUBKEY );
use Crypt::OpenPGP::Buffer;
use Crypt::OpenPGP::KeyBlock;
use Crypt::OpenPGP::PacketFactory;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );

sub new {
    my $class = shift;
    my $ring = bless { }, $class;
    $ring->init(@_);
}

sub init {
    my $ring = shift;
    my %param = @_;
    $ring->{_data} = $param{Data} || '';
    if (!$ring->{_data} && (my $file = $param{Filename})) {
        local *FH;
        open FH, $file or
            return (ref $ring)->error("Can't open keyring $file: $!");
        binmode FH;
        { local $/; $ring->{_data} = <FH> }
        close FH;
    }
    if ($ring->{_data} =~ /-----BEGIN/) {
        require Crypt::OpenPGP::Armour;
        my $rec = Crypt::OpenPGP::Armour->unarmour($ring->{_data}) or
            return (ref $ring)->error("Unarmour failed: " .
                Crypt::OpenPGP::Armour->errstr);
        $ring->{_data} = $rec->{Data};
    }
    $ring;
}

sub save {
    my $ring = shift;
    my @blocks = $ring->blocks;
    my $res = '';
    for my $block (@blocks) {
        $res .= $block->save;
    }
    $res;
}

sub read {
    my $ring = shift;
    return $ring->error("No data to read") unless $ring->{_data};
    my $buf = Crypt::OpenPGP::Buffer->new;
    $buf->append($ring->{_data});
    $ring->restore($buf);
    1;
}

sub restore {
    my $ring = shift;
    my($buf) = @_;
    $ring->{blocks} = [];
    my($kb);
    while (my $packet = Crypt::OpenPGP::PacketFactory->parse($buf)) {
        if (ref($packet) eq "Crypt::OpenPGP::Certificate" &&
            !$packet->is_subkey) {
            $kb = Crypt::OpenPGP::KeyBlock->new;
            $ring->add($kb);
        }
        $kb->add($packet) if $kb;
    }
}

sub add {
    my $ring = shift;
    my($entry) = @_;
    push @{ $ring->{blocks} }, $entry;
}

sub find_keyblock_by_keyid {
    my $ring = shift;
    my($key_id) = @_;
    my $ref = $ring->{by_keyid}{$key_id};
    unless ($ref) {
        my $len = length($key_id);
        my @kbs = $ring->find_keyblock(
            sub { substr($_[0]->key_id, -$len, $len) eq $key_id },
            [ PGP_PKT_PUBLIC_KEY, PGP_PKT_SECRET_KEY,
              PGP_PKT_PUBLIC_SUBKEY, PGP_PKT_SECRET_SUBKEY ], 1 );
        return unless @kbs;
        $ref = $ring->{by_keyid}{ $key_id } = \@kbs;
    }
    return wantarray ? @$ref : $ref->[0];
}

sub find_keyblock_by_uid {
    my $ring = shift;
    my($uid) = @_;
    $ring->find_keyblock(sub { $_[0]->id =~ /$uid/i },
        [ PGP_PKT_USER_ID ], 1 );
}

sub find_keyblock_by_index {
    my $ring = shift;
    my($index) = @_;
    ## XXX should not have to read entire keyring
    $ring->read;
    ($ring->blocks)[$index];
}

sub find_keyblock {
    my $ring = shift;
    my($test, $pkttypes, $multiple) = @_;
    $pkttypes ||= [];
    return $ring->error("No data to read") unless $ring->{_data};
    my $buf = Crypt::OpenPGP::Buffer->new_with_init($ring->{_data});
    my($last_kb_start_offset, $last_kb_start_cert, @kbs);
    while (my $pkt = Crypt::OpenPGP::PacketFactory->parse($buf,
                      [ PGP_PKT_SECRET_KEY, PGP_PKT_PUBLIC_KEY,
                        @$pkttypes ], $pkttypes)) {
        if (($pkt->{__unparsed} && ($pkt->{type} == PGP_PKT_SECRET_KEY ||
                                   $pkt->{type} == PGP_PKT_PUBLIC_KEY)) ||
            (ref($pkt) eq 'Crypt::OpenPGP::Certificate' && !$pkt->is_subkey)) {
            $last_kb_start_offset = $buf->offset;
            $last_kb_start_cert = $pkt;
        }
        next unless !$pkt->{__unparsed} && $test->($pkt);
        my $kb = Crypt::OpenPGP::KeyBlock->new;

        ## Rewind buffer; if start-cert is parsed, rewind to offset
        ## after start-cert--otherwise rewind before start-cert
        if ($last_kb_start_cert->{__unparsed}) {
            $buf->set_offset($last_kb_start_offset -
                $last_kb_start_cert->{__pkt_len});
            my $cert = Crypt::OpenPGP::PacketFactory->parse($buf);
            $kb->add($cert);
        } else {
            $buf->set_offset($last_kb_start_offset);
            $kb->add($last_kb_start_cert);
        }
        {
            my $off = $buf->offset;
            my $packet = Crypt::OpenPGP::PacketFactory->parse($buf);
            last unless $packet;
            $buf->set_offset($off),
                last if ref($packet) eq "Crypt::OpenPGP::Certificate" &&
                    !$packet->is_subkey;
            $kb->add($packet) if $kb;
            redo;
        }
        unless ($multiple) {
            return wantarray ? ($kb, $pkt) : $kb;
        } else {
            return $kb unless wantarray;
            push @kbs, $kb;
        }
    }
    @kbs;
}

sub blocks { $_[0]->{blocks} ? @{ $_[0]->{blocks} } : () }

1;
__END__