summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyRing.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyRing.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyRing.pm267
1 files changed, 267 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyRing.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyRing.pm
new file mode 100755
index 00000000000..6709ed47a77
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyRing.pm
@@ -0,0 +1,267 @@
+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__
+
+=head1 NAME
+
+Crypt::OpenPGP::KeyRing - Key ring object
+
+=head1 SYNOPSIS
+
+ 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);
+
+=head1 DESCRIPTION
+
+I<Crypt::OpenPGP::KeyRing> provides keyring management and key lookup
+for I<Crypt::OpenPGP>. A I<KeyRing>, in this case, does not necessarily
+have to be a keyring file; a I<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.
+
+=head1 USAGE
+
+=head2 Crypt::OpenPGP::KeyRing->new( %arg )
+
+Constructs a new I<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 I<KeyRing>
+object will use the data specified in the arguments to I<new>.
+
+I<%arg> can contain:
+
+=over 4
+
+=item * 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.
+
+=item * 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.
+
+=back
+
+=head2 $ring->find_keyblock_by_keyid($key_id)
+
+Looks up the key ID I<$key_id> in the keyring I<$ring>. I<$key_id>
+should be either a 4-octet or 8-octet string--it should I<not> be a
+string of hexadecimal digits. If that is what you have, use I<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 I<$key_id>, that keyblock will be returned. The
+definition of "match" depends on the length of I<$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 I<$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 I<$key_id>.
+
+Returns false on failure (C<undef> in scalar context, an empty list in
+list context).
+
+=head2 $ring->find_keyblock_by_uid($uid)
+
+Given a string I<$uid>, looks up all keyblocks with User ID packets
+matching the string I<$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.
+
+=head2 $ring->find_keyblock_by_index($index)
+
+Given an index into a list of keyblocks I<$index>, returns the keyblock
+(a I<Crypt::OpenPGP::KeyBlock> object) at that index. Accepts negative
+indexes, so C<-1> will give you the last keyblock in the keyring.
+
+=head1 AUTHOR & COPYRIGHTS
+
+Please see the Crypt::OpenPGP manpage for author, copyright, and
+license information.
+
+=cut