KevinSchoenmayer/GseTDDUebungKCLR
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

215
database/perl/vendor/lib/Crypt/OpenPGP/Armour.pm vendored Normal file
View File

@@ -0,0 +1,215 @@
package Crypt::OpenPGP::Armour;
use strict;
use Crypt::OpenPGP;
use MIME::Base64;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub armour {
my $class = shift;
my %param = @_;
my $data = $param{Data} or
return $class->error("No Data to armour");
my $headers = $param{Headers} || {};
$headers->{Version} = Crypt::OpenPGP->version_string
unless $param{NoVersion};
my $head = join "\n", map { "$_: $headers->{$_}" } keys %$headers;
my $object = $param{Object} || 'MESSAGE';
(my $sdata = encode_base64($data, '')) =~ s!(.{1,64})!$1\n!g;
"-----BEGIN PGP $object-----\n" .
$head . "\n\n" .
$sdata .
'=' . $class->_checksum($data) .
"-----END PGP $object-----\n";
}
sub unarmour {
my $class = shift;
my($blob) = @_;
## Get rid of DOSish newlines.
$blob =~ s!\r!!g;
my($begin, $obj, $head, $data, $end) = $blob =~
m!(-----BEGIN ([^\n\-]+)-----)\n(.*?\n\n)?(.+)(-----END .*?-----)!s
or return $class->error("Unrecognizable armour");
unless ($data =~ s!=([^\n]+)$!!s) {
return $class->error("No checksum");
}
my $csum = $1;
$data = decode_base64($data);
(my $check = $class->_checksum($data)) =~ s!\n!!;
return $class->error("Bad checksum") unless $check eq $csum;
my %headers;
if ($head) {
%headers = map { split /: /, $_, 2 } grep { /\S/ } split /\n/, $head;
}
{ Data => $data,
Headers => \%headers,
Object => $obj }
}
sub _checksum {
my $class = shift;
my($data) = @_;
encode_base64(substr(pack('N', crc24($data)), 1));
}
{
my @CRC_TABLE;
use constant CRC24_INIT => 0xb704ce;
sub crc24 {
my @data = unpack 'C*', $_[0];
my $crc = CRC24_INIT;
for my $d (@data) {
$crc = ($crc << 8) ^ $CRC_TABLE[(($crc >> 16) ^ $d) & 0xff]
}
$crc & 0xffffff;
}
@CRC_TABLE = (
0x00000000, 0x00864cfb, 0x018ad50d, 0x010c99f6, 0x0393e6e1,
0x0315aa1a, 0x021933ec, 0x029f7f17, 0x07a18139, 0x0727cdc2,
0x062b5434, 0x06ad18cf, 0x043267d8, 0x04b42b23, 0x05b8b2d5,
0x053efe2e, 0x0fc54e89, 0x0f430272, 0x0e4f9b84, 0x0ec9d77f,
0x0c56a868, 0x0cd0e493, 0x0ddc7d65, 0x0d5a319e, 0x0864cfb0,
0x08e2834b, 0x09ee1abd, 0x09685646, 0x0bf72951, 0x0b7165aa,
0x0a7dfc5c, 0x0afbb0a7, 0x1f0cd1e9, 0x1f8a9d12, 0x1e8604e4,
0x1e00481f, 0x1c9f3708, 0x1c197bf3, 0x1d15e205, 0x1d93aefe,
0x18ad50d0, 0x182b1c2b, 0x192785dd, 0x19a1c926, 0x1b3eb631,
0x1bb8faca, 0x1ab4633c, 0x1a322fc7, 0x10c99f60, 0x104fd39b,
0x11434a6d, 0x11c50696, 0x135a7981, 0x13dc357a, 0x12d0ac8c,
0x1256e077, 0x17681e59, 0x17ee52a2, 0x16e2cb54, 0x166487af,
0x14fbf8b8, 0x147db443, 0x15712db5, 0x15f7614e, 0x3e19a3d2,
0x3e9fef29, 0x3f9376df, 0x3f153a24, 0x3d8a4533, 0x3d0c09c8,
0x3c00903e, 0x3c86dcc5, 0x39b822eb, 0x393e6e10, 0x3832f7e6,
0x38b4bb1d, 0x3a2bc40a, 0x3aad88f1, 0x3ba11107, 0x3b275dfc,
0x31dced5b, 0x315aa1a0, 0x30563856, 0x30d074ad, 0x324f0bba,
0x32c94741, 0x33c5deb7, 0x3343924c, 0x367d6c62, 0x36fb2099,
0x37f7b96f, 0x3771f594, 0x35ee8a83, 0x3568c678, 0x34645f8e,
0x34e21375, 0x2115723b, 0x21933ec0, 0x209fa736, 0x2019ebcd,
0x228694da, 0x2200d821, 0x230c41d7, 0x238a0d2c, 0x26b4f302,
0x2632bff9, 0x273e260f, 0x27b86af4, 0x252715e3, 0x25a15918,
0x24adc0ee, 0x242b8c15, 0x2ed03cb2, 0x2e567049, 0x2f5ae9bf,
0x2fdca544, 0x2d43da53, 0x2dc596a8, 0x2cc90f5e, 0x2c4f43a5,
0x2971bd8b, 0x29f7f170, 0x28fb6886, 0x287d247d, 0x2ae25b6a,
0x2a641791, 0x2b688e67, 0x2beec29c, 0x7c3347a4, 0x7cb50b5f,
0x7db992a9, 0x7d3fde52, 0x7fa0a145, 0x7f26edbe, 0x7e2a7448,
0x7eac38b3, 0x7b92c69d, 0x7b148a66, 0x7a181390, 0x7a9e5f6b,
0x7801207c, 0x78876c87, 0x798bf571, 0x790db98a, 0x73f6092d,
0x737045d6, 0x727cdc20, 0x72fa90db, 0x7065efcc, 0x70e3a337,
0x71ef3ac1, 0x7169763a, 0x74578814, 0x74d1c4ef, 0x75dd5d19,
0x755b11e2, 0x77c46ef5, 0x7742220e, 0x764ebbf8, 0x76c8f703,
0x633f964d, 0x63b9dab6, 0x62b54340, 0x62330fbb, 0x60ac70ac,
0x602a3c57, 0x6126a5a1, 0x61a0e95a, 0x649e1774, 0x64185b8f,
0x6514c279, 0x65928e82, 0x670df195, 0x678bbd6e, 0x66872498,
0x66016863, 0x6cfad8c4, 0x6c7c943f, 0x6d700dc9, 0x6df64132,
0x6f693e25, 0x6fef72de, 0x6ee3eb28, 0x6e65a7d3, 0x6b5b59fd,
0x6bdd1506, 0x6ad18cf0, 0x6a57c00b, 0x68c8bf1c, 0x684ef3e7,
0x69426a11, 0x69c426ea, 0x422ae476, 0x42aca88d, 0x43a0317b,
0x43267d80, 0x41b90297, 0x413f4e6c, 0x4033d79a, 0x40b59b61,
0x458b654f, 0x450d29b4, 0x4401b042, 0x4487fcb9, 0x461883ae,
0x469ecf55, 0x479256a3, 0x47141a58, 0x4defaaff, 0x4d69e604,
0x4c657ff2, 0x4ce33309, 0x4e7c4c1e, 0x4efa00e5, 0x4ff69913,
0x4f70d5e8, 0x4a4e2bc6, 0x4ac8673d, 0x4bc4fecb, 0x4b42b230,
0x49ddcd27, 0x495b81dc, 0x4857182a, 0x48d154d1, 0x5d26359f,
0x5da07964, 0x5cace092, 0x5c2aac69, 0x5eb5d37e, 0x5e339f85,
0x5f3f0673, 0x5fb94a88, 0x5a87b4a6, 0x5a01f85d, 0x5b0d61ab,
0x5b8b2d50, 0x59145247, 0x59921ebc, 0x589e874a, 0x5818cbb1,
0x52e37b16, 0x526537ed, 0x5369ae1b, 0x53efe2e0, 0x51709df7,
0x51f6d10c, 0x50fa48fa, 0x507c0401, 0x5542fa2f, 0x55c4b6d4,
0x54c82f22, 0x544e63d9, 0x56d11cce, 0x56575035, 0x575bc9c3,
0x57dd8538
);
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Armour - ASCII Armouring and Unarmouring
=head1 SYNOPSIS
use Crypt::OpenPGP::Armour;
my $armoured = Crypt::OpenPGP::Armour->armour(
Data => "foo bar baz",
Object => "FOO OBJECT",
Headers => {
Version => '0.57',
Comment => 'FooBar',
},
);
my $decoded = Crypt::OpenPGP::Armour->unarmour( $armoured ) or
die Crypt::OpenPGP::Armour->errstr;
=head1 DESCRIPTION
This module converts arbitrary-length strings of binary octets into
Base64-encoded ASCII messages suitable for transfer as text. It
also converts in the opposite direction, taking an armoured message
and returning the binary data, along with headers.
=head1 USAGE
=head2 Crypt::OpenPGP::Armour->armour( %args )
Converts arbitrary-length strings of binary octets in an encoded
message containing 4 parts: head and tail markers that identify the
type of content contained therein; a group of newline-separated
headers at the top of the message; Base64-encoded data; and a
Base64-encoded CRC24 checksum of the message body.
Returns I<undef> on failure, the encoded message on success. In the
case of failure call the class method I<errstr> to get the error
message.
I<%args> can contain:
=over 4
=item * Object
Specifies the type of object being armoured; the string C<PGP > (PGP
followed by a space) will be prepended to the value you pass in.
This argument is required.
=item * Data
The binary octets to be encoded as the body of the armoured message;
these octets will be encoded into ASCII using I<MIME::Base64>.
This argument is required.
=item * Headers
A reference to a hash containing key-value pairs, where the key is the
name of the header and the value the header value. These headers
are placed at the top of the encoded message in the form C<Header: Value>.
=item * NoVersion
Boolean flag; if true, then default Version header will not be added
to the armour.
=back
=head2 Crypt::OpenPGP::Armour->unarmour($message)
Decodes an ASCII-armoured message and returns a hash reference whose
keys are the arguments provided to I<armour>, above. Returns I<undef>
on failure (for example, if the checksum fails to match, or if the
message is in an incomprehensible format). In case of failure call
the class method I<errstr> to get the text of the error message.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

85
database/perl/vendor/lib/Crypt/OpenPGP/Buffer.pm vendored Normal file
View File

@@ -0,0 +1,85 @@
package Crypt::OpenPGP::Buffer;
use base qw( Data::Buffer );
use Crypt::OpenPGP::Util qw( bin2mp mp2bin bitsize );
sub get_big_int {
my $buf = shift;
my $bits = $buf->get_int16;
my $bytes = int(($bits + 7) / 8);
my $off = $buf->{offset};
$buf->{offset} += $bytes;
my $int = bin2mp($buf->bytes($off, $bytes));
return "$int";
}
sub put_big_int {
my $buf = shift;
my($n) = @_;
$buf->put_int16(bitsize($n));
$buf->put_bytes(mp2bin($n));
}
*get_mp_int = \&get_big_int;
*put_mp_int = \&put_big_int;
1;
__END__
=head1 NAME
Crypt::OpenPGP::Buffer - Binary in/out buffer
=head1 SYNOPSIS
use Crypt::OpenPGP::Buffer;
my $n = Math::BigInt->new( 1 );
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->put_big_int($n);
my $m = $buf->get_big_int;
=head1 DESCRIPTION
I<Crypt::OpenPGP::Buffer> subclasses the I<Data::Buffer> class to
provide binary in/out buffer capabilities for I<Crypt::OpenPGP>. In
addition to the standard I<Data::Buffer> methods, this class adds
methods to get and put multiple-precision integers (I<Math::BigInt>
objects).
A PGP multiple precision integer is stored in two pieces: a two-octet
scalar representing the length of the integer in bits, followed by
a string of octets that is a serialized representation of the integer.
=head1 USAGE
As I<Crypt::OpenPGP::Buffer> subclasses I<Data::Buffer> there is no
need to reproduce the entire documentation of the latter module. Thus
this usage section will include only the methods added by
I<Crypt::OpenPGP::Buffer>.
=head2 $buf->get_big_int
Grabs a multiple-precision integer from the buffer I<$buf> (starting
after the current offset position in the buffer) and returns that
integer.
I<get_mp_int()> is an alias for this method, for backwards
compatibility reasons.
=head2 $buf->put_big_int($n)
Serializes a multiple-precision integer into the buffer in the above
form (two-octet bitsize, string of octets).
I<put_mp_int()> is an alias for this method, for backwards
compatibility reasons.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

110
database/perl/vendor/lib/Crypt/OpenPGP/CFB.pm vendored Normal file
View File

@@ -0,0 +1,110 @@
# This code based slightly on the Systemics Crypt::CFB.
# Parts Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/)
# All rights reserved.
package Crypt::OpenPGP::CFB;
use strict;
sub new {
my $class = shift;
my $c = bless { }, $class;
$c->init(@_);
}
sub init {
my $c = shift;
my($cipher, $iv) = @_;
$c->{cipher} = $cipher;
$c->{blocksize} = $cipher->blocksize;
$c->{iv} = $iv || "\0" x $c->{blocksize};
$c;
}
sub sync { $_[0]->{unused} = '' }
sub encrypt {
my $c = shift;
my($data) = @_;
my $ret = '';
my $iv = $c->{iv};
my $out = $c->{unused} || '';
my $size = length $out;
while ( $data ne '' ) {
unless ($size) {
$out = $c->{cipher}->encrypt($iv);
$size = $c->{blocksize};
}
my $in = substr $data, 0, $size, '';
$size -= (my $got = length $in);
$iv .= ($in ^= substr $out, 0, $got, '');
substr $iv, 0, $got, '';
$ret .= $in;
}
$c->{unused} = $out;
$c->{iv} = $iv;
$ret;
}
sub decrypt {
my $c = shift;
my($data) = @_;
my $ret = '';
my $iv = $c->{iv};
my $out = $c->{unused} || '';
my $size = length $out;
while ( $data ne '' ) {
unless ($size) {
$out = $c->{cipher}->encrypt($iv);
$size = $c->{blocksize};
}
my $in = substr $data, 0, $size, '';
$size -= (my $got = length $in);
substr $iv .= $in, 0, $got, '';
$ret .= ($in ^= substr $out, 0, $got, '');
}
$c->{unused} = $out;
$c->{iv} = $iv;
$ret;
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::CFB - PGP Cipher Feedback Mode
=head1 SYNOPSIS
use Crypt::OpenPGP::CFB;
my $key = 'foo bar';
my $cipher = Crypt::Blowfish->new( $key ); # for example
my $cfb = Crypt::OpenPGP::CFB->new( $cipher );
my $plaintext = 'this is secret!';
my $ct = $cfb->encrypt( $plaintext );
my $pt = $cfb->decrypt( $ct );
=head1 DESCRIPTION
I<Crypt::OpenPGP::CFB> implements the variant of Cipher Feedback mode
that PGP uses in its encryption and decryption. The key difference
with PGP CFB is that the CFB state is resynchronized at each
encryption/decryption. This applies both when encrypting secret key
data and in symmetric encryption of standard encrypted data. More
differences are described in the OpenPGP RFC, in section 13.9
(OpenPGP CFB mode).
Typically you should never need to directly use I<Crypt::OpenPGP::CFB>;
I<Crypt::OpenPGP::Cipher> objects wrap around an instance of this
class and provide a uniform interface to symmetric ciphers. See
the documentation for that module for usage details.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

561
database/perl/vendor/lib/Crypt/OpenPGP/Certificate.pm vendored Normal file
View File

@@ -0,0 +1,561 @@
package Crypt::OpenPGP::Certificate;
use strict;
use Crypt::OpenPGP::S2k;
use Crypt::OpenPGP::Key::Public;
use Crypt::OpenPGP::Key::Secret;
use Crypt::OpenPGP::Buffer;
use Crypt::OpenPGP::Util qw( mp2bin bin2mp bitsize );
use Crypt::OpenPGP::Constants qw( DEFAULT_CIPHER
PGP_PKT_PUBLIC_KEY
PGP_PKT_PUBLIC_SUBKEY
PGP_PKT_SECRET_KEY
PGP_PKT_SECRET_SUBKEY );
use Crypt::OpenPGP::Cipher;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
{
my @PKT_TYPES = (
PGP_PKT_PUBLIC_KEY,
PGP_PKT_PUBLIC_SUBKEY,
PGP_PKT_SECRET_KEY,
PGP_PKT_SECRET_SUBKEY
);
sub pkt_type {
my $cert = shift;
$PKT_TYPES[ ($cert->{is_secret} << 1) | $cert->{is_subkey} ];
}
}
sub new {
my $class = shift;
my $cert = bless { }, $class;
$cert->init(@_);
}
sub init {
my $cert = shift;
my %param = @_;
if (my $key = $param{Key}) {
$cert->{version} = $param{Version} || 4;
$cert->{key} = $key;
$cert->{is_secret} = $key->is_secret;
$cert->{is_subkey} = $param{Subkey} || 0;
$cert->{timestamp} = time;
$cert->{pk_alg} = $key->alg_id;
if ($cert->{version} < 4) {
$cert->{validity} = $param{Validity} || 0;
$key->alg eq 'RSA' or
return (ref $cert)->error("Version 3 keys must be RSA");
}
$cert->{s2k} = Crypt::OpenPGP::S2k->new('Salt_Iter');
if ($cert->{is_secret}) {
$param{Passphrase} or
return (ref $cert)->error("Need a Passphrase to lock key");
$cert->{cipher} = $param{Cipher} || DEFAULT_CIPHER;
$cert->lock($param{Passphrase});
}
}
$cert;
}
sub type { $_[0]->{type} }
sub version { $_[0]->{version} }
sub timestamp { $_[0]->{timestamp} }
sub validity { $_[0]->{validity} }
sub pk_alg { $_[0]->{pk_alg} }
sub key { $_[0]->{key} }
sub is_secret { $_[0]->{key}->is_secret }
sub is_subkey { $_[0]->{is_subkey} }
sub is_protected { $_[0]->{is_protected} }
sub can_encrypt { $_[0]->{key}->can_encrypt }
sub can_sign { $_[0]->{key}->can_sign }
sub uid {
my $cert = shift;
$cert->{_uid} = shift if @_;
$cert->{_uid};
}
sub public_cert {
my $cert = shift;
return $cert unless $cert->is_secret;
my $pub = (ref $cert)->new;
for my $f (qw( version timestamp pk_alg is_subkey )) {
$pub->{$f} = $cert->{$f};
}
$pub->{validity} = $cert->{validity} if $cert->{version} < 4;
$pub->{key} = $cert->{key}->public_key;
$pub;
}
sub key_id {
my $cert = shift;
unless ($cert->{key_id}) {
if ($cert->{version} < 4) {
$cert->{key_id} = substr(mp2bin($cert->{key}->n), -8);
}
else {
$cert->{key_id} = substr($cert->fingerprint, -8);
}
}
$cert->{key_id};
}
sub key_id_hex { uc unpack 'H*', $_[0]->key_id }
sub fingerprint {
my $cert = shift;
unless ($cert->{fingerprint}) {
if ($cert->{version} < 4) {
my $dgst = Crypt::OpenPGP::Digest->new('MD5');
$cert->{fingerprint} =
$dgst->hash(mp2bin($cert->{key}->n) . mp2bin($cert->{key}->e));
}
else {
my $data = $cert->public_cert->save;
$cert->{fingerprint} = _gen_v4_fingerprint($data);
}
}
$cert->{fingerprint};
}
sub fingerprint_hex { uc unpack 'H*', $_[0]->fingerprint }
sub fingerprint_words {
require Crypt::OpenPGP::Words;
Crypt::OpenPGP::Words->encode($_[0]->fingerprint);
}
sub _gen_v4_fingerprint {
my($data) = @_;
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->put_int8(0x99);
$buf->put_int16(length $data);
$buf->put_bytes($data);
my $dgst = Crypt::OpenPGP::Digest->new('SHA1');
$dgst->hash($buf->bytes);
}
sub parse {
my $class = shift;
my($buf, $secret, $subkey) = @_;
my $cert = $class->new;
$cert->{is_secret} = $secret;
$cert->{is_subkey} = $subkey;
$cert->{version} = $buf->get_int8;
$cert->{timestamp} = $buf->get_int32;
if ($cert->{version} < 4) {
$cert->{validity} = $buf->get_int16;
}
$cert->{pk_alg} = $buf->get_int8;
my $key_class = 'Crypt::OpenPGP::Key::' . ($secret ? 'Secret' : 'Public');
my $key = $cert->{key} = $key_class->new($cert->{pk_alg}) or
return $class->error("Key creation failed: " . $key_class->errstr);
my @pub = $key->public_props;
for my $e (@pub) {
$key->$e($buf->get_mp_int);
}
if ($cert->{version} >= 4) {
my $data = $buf->bytes(0, $buf->offset);
$cert->{fingerprint} = _gen_v4_fingerprint($data);
}
if ($secret) {
$cert->{cipher} = $buf->get_int8;
if ($cert->{cipher}) {
$cert->{is_protected} = 1;
if ($cert->{cipher} == 255 || $cert->{cipher} == 254) {
$cert->{sha1check} = $cert->{cipher} == 254;
$cert->{cipher} = $buf->get_int8;
$cert->{s2k} = Crypt::OpenPGP::S2k->parse($buf);
}
else {
$cert->{s2k} = Crypt::OpenPGP::S2k->new('Simple');
$cert->{s2k}->set_hash('MD5');
}
$cert->{iv} = $buf->get_bytes(8);
}
if ($cert->{is_protected}) {
if ($cert->{version} < 4) {
$cert->{encrypted} = {};
my @sec = $key->secret_props;
for my $e (@sec) {
my $h = $cert->{encrypted}{"${e}h"} = $buf->get_bytes(2);
$cert->{encrypted}{"${e}b"} =
$buf->get_bytes(int((unpack('n', $h)+7)/8));
}
$cert->{csum} = $buf->get_int16;
}
else {
$cert->{encrypted} =
$buf->get_bytes($buf->length - $buf->offset);
}
}
else {
my @sec = $key->secret_props;
for my $e (@sec) {
$key->$e($buf->get_mp_int);
}
}
}
$cert;
}
sub save {
my $cert = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->put_int8($cert->{version});
$buf->put_int32($cert->{timestamp});
if ($cert->{version} < 4) {
$buf->put_int16($cert->{validity});
}
$buf->put_int8($cert->{pk_alg});
my $key = $cert->{key};
my @pub = $key->public_props;
for my $e (@pub) {
$buf->put_mp_int($key->$e());
}
if ($cert->{key}->is_secret) {
if ($cert->{cipher}) {
$buf->put_int8(255);
$buf->put_int8($cert->{cipher});
$buf->append($cert->{s2k}->save);
$buf->put_bytes($cert->{iv});
if ($cert->{version} < 4) {
my @sec = $key->secret_props;
for my $e (@sec) {
$buf->put_bytes($cert->{encrypted}{"${e}h"});
$buf->put_bytes($cert->{encrypted}{"${e}b"});
}
$buf->put_int16($cert->{csum});
}
else {
$buf->put_bytes($cert->{encrypted});
}
}
else {
my @sec = $key->secret_props;
for my $e (@sec) {
$key->$e($buf->get_mp_int);
}
}
}
$buf->bytes;
}
sub v3_checksum {
my $cert = shift;
my $k = $cert->{encrypted};
my $sum = 0;
my @sec = $cert->{key}->secret_props;
for my $e (@sec) {
$sum += unpack '%16C*', $k->{"${e}h"};
$sum += unpack '%16C*', $k->{"${e}b"};
}
$sum & 0xFFFF;
}
sub unlock {
my $cert = shift;
return 1 unless $cert->{is_secret} && $cert->{is_protected};
my($passphrase) = @_;
my $cipher = Crypt::OpenPGP::Cipher->new($cert->{cipher}) or
return $cert->error( Crypt::OpenPGP::Cipher->errstr );
my $key = $cert->{s2k}->generate($passphrase, $cipher->keysize);
$cipher->init($key, $cert->{iv});
my @sec = $cert->{key}->secret_props;
if ($cert->{version} < 4) {
my $k = $cert->{encrypted};
my $r = {};
for my $e (@sec) {
$r->{$e} = $k->{"${e}b"};
$k->{"${e}b"} = $cipher->decrypt($r->{$e});
}
unless ($cert->{csum} == $cert->v3_checksum) {
$k->{"${_}b"} = $r->{$_} for @sec;
return $cert->error("Bad checksum");
}
for my $e (@sec) {
$cert->{key}->$e(bin2mp($k->{"${e}b"}));
}
unless ($cert->{key}->check) {
$k->{"${_}b"} = $r->{$_} for @sec;
return $cert->error("p*q != n");
}
}
else {
my $decrypted = $cipher->decrypt($cert->{encrypted});
if ($cert->{sha1check}) {
my $dgst = Crypt::OpenPGP::Digest->new('SHA1');
my $csum = substr $decrypted, -20, 20, '';
unless ($dgst->hash($decrypted) eq $csum) {
return $cert->error("Bad SHA-1 hash");
}
} else {
my $csum = unpack "n", substr $decrypted, -2, 2, '';
my $gen_csum = unpack '%16C*', $decrypted;
unless ($csum == $gen_csum) {
return $cert->error("Bad simple checksum");
}
}
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->append($decrypted);
for my $e (@sec) {
$cert->{key}->$e( $buf->get_mp_int );
}
}
$cert->{is_protected} = 0;
1;
}
sub lock {
my $cert = shift;
return if !$cert->{is_secret} || $cert->{is_protected};
my($passphrase) = @_;
my $cipher = Crypt::OpenPGP::Cipher->new($cert->{cipher});
my $sym_key = $cert->{s2k}->generate($passphrase, $cipher->keysize);
$cert->{iv} = Crypt::OpenPGP::Util::get_random_bytes(8);
$cipher->init($sym_key, $cert->{iv});
my @sec = $cert->{key}->secret_props;
if ($cert->{version} < 4) {
my $k = $cert->{encrypted} = {};
my $key = $cert->key;
for my $e (@sec) {
$k->{"${e}b"} = mp2bin($key->$e());
$k->{"${e}h"} = pack 'n', bitsize($key->$e());
}
$cert->{csum} = $cert->v3_checksum;
for my $e (@sec) {
$k->{"${e}b"} = $cipher->encrypt( $k->{"${e}b"} );
}
}
else {
my $buf = Crypt::OpenPGP::Buffer->new;
for my $e (@sec) {
$buf->put_mp_int($cert->{key}->$e());
}
my $cnt = $buf->bytes;
$cnt .= pack 'n', unpack '%16C*', $cnt;
$cert->{encrypted} = $cipher->encrypt($cnt);
}
$cert->{is_protected} = 1;
1;
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Certificate - PGP Key certificate
=head1 SYNOPSIS
use Crypt::OpenPGP::Certificate;
my $dsa_secret_key = Crypt::OpenPGP::Key::Secret->new( 'DSA' );
my $cert = Crypt::OpenPGP::Certificate->new(
Key => $dsa_secret_key,
Version => 4,
Passphrase => 'foobar',
);
my $serialized = $cert->save;
# Unlock the locked certificate (using the passphrase from above)
$cert->unlock( 'foobar' );
=head1 DESCRIPTION
I<Crypt::OpenPGP::Certificate> encapsulates a PGP key certificate
for any underlying public-key algorithm, for public and secret keys,
and for master keys and subkeys. All of these scenarios are handled
by the same I<Certificate> class.
A I<Crypt::OpenPGP::Certificate> object wraps around a
I<Crypt::OpenPGP::Key> object; the latter implements all public-key
algorithm-specific functionality, while the certificate layer
manages some meta-data about the key, as well as the mechanisms
for locking and unlocking a secret key (using a passphrase).
=head1 USAGE
=head2 Crypt::OpenPGP::Certificate->new( %arg )
Constructs a new PGP key certificate object and returns that object.
If no arguments are provided in I<%arg>, the certificate is empty;
this is used in I<parse>, for example, to construct an empty object,
then fill it with the data in the buffer.
I<%arg> can contain:
=over 4
=item * Key
The public/secret key object, an object of type I<Crypt::OpenPGP::Key>.
This argument is required (for a non-empty certificate).
=item * Version
The certificate packet version, as defined in the OpenPGP RFC. The
two valid values are C<3> and C<4>.
This argument is optional; if not provided the default is to produce
version C<4> certificates. You may wish to override this for
compatibility with older versions of PGP.
=item * Subkey
A boolean flag: if true, indicates that this certificate is a subkey,
not a master key.
This argument is optional; the default value is C<0>.
=item * Validity
The number of days that this certificate is valid. This argument only
applies when creating a version 3 certificate; version 4 certificates
hold this information in a signature.
This argument is optional; the default value is C<0>, which means that
the certificate never expires.
=item * Passphrase
If you are creating a certificate for a secret key--indicated by whether
or not the I<Key> (above) is a secret key--you will need to lock it
(that is, encrypt the secret part of the key). The string provided in
I<Passphrase> is used as the passphrase to lock the key.
This argument is required if the certificate holds a secret key.
=item * Cipher
Specifies the symmetric cipher to use when locking (encrypting) the
secret part of a secret key. Valid values are any supported symmetric
cipher names, which can be found in I<Crypt::OpenPGP::Cipher>.
This argument is optional; if not specified, C<DES3> is used.
=back
=head2 $cert->save
Serializes the I<Crypt::OpenPGP::Certificate> object I<$cert> into a
string of octets, suitable for saving in a keyring file.
=head2 Crypt::OpenPGP::Certificate->parse($buffer)
Given I<$buffer>, a I<Crypt::OpenPGP::Buffer> object holding (or with
offset point to) a certificate packet, returns a new object of type
I<Crypt::OpenPGP::Certificate>, initialized with the data from the
buffer.
=head2 $cert->lock($passphrase)
Locks the secret key data by encrypting that data with I<$passphrase>.
Returns true on success, C<undef> on failure; in the case of failure
call I<errstr> to get the error message.
=head2 $cert->unlock($passphrase)
Uses the passphrase I<$passphrase> to unlock (decrypt) the secret
part of the key.
Returns true on success, C<undef> on failure; in the case of failure
call I<errstr> to get the error message.
=head2 $cert->fingerprint
Returns the key fingerprint as an octet string.
=head2 $cert->fingerprint_hex
Returns the key fingerprint as a hex string.
=head2 $cert->fingerprint_words
Returns the key fingerprint as a list of English words, where each word
represents one octet from the fingerprint. See I<Crypt::OpenPGP::Words>
for more details about the encoding.
=head2 $cert->key_id
Returns the key ID.
=head2 $cert->key_id_hex
Returns the key ID as a hex string.
=head2 $cert->key
Returns the algorithm-specific portion of the certificate, the public
or secret key object (an object of type I<Crypt::OpenPGP::Key>).
=head2 $cert->public_cert
Returns a public version of the certificate, with a public key. If
the certificate was already public, the same certificate is returned;
if it was a secret certificate, a new I<Crypt::OpenPGP::Certificate>
object is created, and the secret key is made into a public version
of the key.
=head2 $cert->version
Returns the version of the certificate (C<3> or C<4>).
=head2 $cert->timestamp
Returns the creation date and time (in epoch time).
=head2 $cert->validity
Returns the number of days that the certificate is valid for version
3 keys.
=head2 $cert->is_secret
Returns true if the certificate holds a secret key, false otherwise.
=head2 $cert->is_protected
Returns true if the certificate is locked, false otherwise.
=head2 $cert->is_subkey
Returns true if the certificate is a subkey, false otherwise.
=head2 $cert->can_encrypt
Returns true if the public key algorithm for the certificate I<$cert>
can perform encryption/decryption, false otherwise.
=head2 $cert->can_sign
Returns true if the public key algorithm for the certificate I<$cert>
can perform signing/verification, false otherwise.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

232
database/perl/vendor/lib/Crypt/OpenPGP/Cipher.pm vendored Normal file
View File

@@ -0,0 +1,232 @@
package Crypt::OpenPGP::Cipher;
use strict;
use Crypt::OpenPGP::CFB;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
use vars qw( %ALG %ALG_BY_NAME );
%ALG = (
1 => 'IDEA',
2 => 'DES3',
3 => 'CAST5',
4 => 'Blowfish',
7 => 'Rijndael',
8 => 'Rijndael192',
9 => 'Rijndael256',
10 => 'Twofish',
);
%ALG_BY_NAME = map { $ALG{$_} => $_ } keys %ALG;
sub new {
my $class = shift;
my $alg = shift;
$alg = $ALG{$alg} || $alg;
return $class->error("Unsupported cipher algorithm '$alg'")
unless $alg =~ /^\D/;
my $pkg = join '::', $class, $alg;
my $ciph = bless { __alg => $alg,
__alg_id => $ALG_BY_NAME{$alg} }, $pkg;
my $impl_class = $ciph->crypt_class;
my @classes = ref($impl_class) eq 'ARRAY' ? @$impl_class : ($impl_class);
for my $c (@classes) {
eval "use $c;";
$ciph->{__impl} = $c, last unless $@;
}
return $class->error("Error loading cipher implementation for " .
"'$alg': no implementations installed.")
unless $ciph->{__impl};
$ciph->init(@_);
}
sub init {
my $ciph = shift;
my($key, $iv) = @_;
if ($key) {
my $class = $ciph->{__impl};
## Make temp variable, because Rijndael checks SvPOK, which
## doesn't seem to like a value that isn't a variable?
my $tmp = substr $key, 0, $ciph->keysize;
my $c = $class->new($tmp);
$ciph->{cipher} = Crypt::OpenPGP::CFB->new($c, $iv);
}
$ciph;
}
sub encrypt { $_[0]->{cipher}->encrypt($_[1]) }
sub decrypt { $_[0]->{cipher}->decrypt($_[1]) }
sub sync { $_[0]->{cipher}->sync }
sub alg { $_[0]->{__alg} }
sub alg_id {
return $_[0]->{__alg_id} if ref($_[0]);
$ALG_BY_NAME{$_[1]} || $_[1];
}
sub supported {
my $class = shift;
my %s;
for my $cid (keys %ALG) {
my $cipher = $class->new($cid);
$s{$cid} = $cipher->alg if $cipher;
}
\%s;
}
package Crypt::OpenPGP::Cipher::IDEA;
use strict;
use base qw( Crypt::OpenPGP::Cipher );
sub init {
my $ciph = shift;
my($key, $iv) = @_;
if ($key) {
my $c = IDEA->new(substr($key, 0, $ciph->keysize));
$ciph->{cipher} = Crypt::OpenPGP::CFB->new($c, $iv);
}
$ciph;
}
sub crypt_class { 'Crypt::IDEA' }
sub keysize { 16 }
sub blocksize { 8 }
package Crypt::OpenPGP::Cipher::Blowfish;
use strict;
use base qw( Crypt::OpenPGP::Cipher );
sub crypt_class { 'Crypt::Blowfish' }
sub keysize { 16 }
sub blocksize { 8 }
package Crypt::OpenPGP::Cipher::DES3;
use strict;
use base qw( Crypt::OpenPGP::Cipher );
sub crypt_class { 'Crypt::DES_EDE3' }
sub keysize { 24 }
sub blocksize { 8 }
package Crypt::OpenPGP::Cipher::CAST5;
use strict;
use base qw( Crypt::OpenPGP::Cipher );
sub crypt_class { 'Crypt::CAST5_PP' }
sub keysize { 16 }
sub blocksize { 8 }
package Crypt::OpenPGP::Cipher::Twofish;
use strict;
use base qw( Crypt::OpenPGP::Cipher );
sub crypt_class { 'Crypt::Twofish' }
sub keysize { 32 }
sub blocksize { 16 }
package Crypt::OpenPGP::Cipher::Rijndael;
use strict;
use base qw( Crypt::OpenPGP::Cipher );
sub crypt_class { 'Crypt::Rijndael' }
sub keysize { 16 }
sub blocksize { 16 }
package Crypt::OpenPGP::Cipher::Rijndael192;
use strict;
use base qw( Crypt::OpenPGP::Cipher );
sub crypt_class { 'Crypt::Rijndael' }
sub keysize { 24 }
sub blocksize { 16 }
package Crypt::OpenPGP::Cipher::Rijndael256;
use strict;
use base qw( Crypt::OpenPGP::Cipher );
sub crypt_class { 'Crypt::Rijndael' }
sub keysize { 32 }
sub blocksize { 16 }
1;
__END__
=head1 NAME
Crypt::OpenPGP::Cipher - PGP symmetric cipher factory
=head1 SYNOPSIS
use Crypt::OpenPGP::Cipher;
my $alg = 'Rijndael';
my $cipher = Crypt::OpenPGP::Cipher->new( $alg );
my $plaintext = 'foo bar';
my $ct = $cipher->encrypt($plaintext);
my $pt = $cipher->decrypt($ct);
=head1 DESCRIPTION
I<Crypt::OpenPGP::Cipher> is a factory class for PGP symmetric ciphers.
All cipher objects are subclasses of this class and share a common
interface; when creating a new cipher object, the object is blessed
into the subclass to take on algorithm-specific functionality.
A I<Crypt::OpenPGP::Cipher> object is a wrapper around a
I<Crypt::OpenPGP::CFB> object, which in turn wraps around the actual
cipher implementation (eg. I<Crypt::Blowfish> for a Blowfish cipher).
This allows all ciphers to share a common interface and a simple
instantiation method.
=head1 USAGE
=head2 Crypt::OpenPGP::Cipher->new($cipher)
Creates a new symmetric cipher object of type I<$cipher>; I<$cipher>
can be either the name of a cipher (in I<Crypt::OpenPGP> parlance) or
the numeric ID of the cipher (as defined in the OpenPGP RFC). Using
a cipher name is recommended, for the simple reason that it is easier
to understand quickly (not everyone knows the cipher IDs).
Valid cipher names are: C<IDEA>, C<DES3>, C<Blowfish>, C<Rijndael>,
C<Rijndael192>, C<Rijndael256>, C<Twofish>, and C<CAST5>.
Returns the new cipher object on success. On failure returns C<undef>;
the caller should check for failure and call the class method I<errstr>
if a failure occurs. A typical reason this might happen is an
unsupported cipher name or ID.
=head2 $cipher->encrypt($plaintext)
Encrypts the plaintext I<$plaintext> and returns the encrypted text
(ie. ciphertext). The encryption is done in CFB mode using the
underlying cipher implementation.
=head2 $cipher->decrypt($ciphertext)
Decrypts the ciphertext I<$ciphertext> and returns the plaintext. The
decryption is done in CFB mode using the underlying cipher
implementation.
=head2 $cipher->alg
Returns the name of the cipher algorithm (as listed above in I<new>).
=head2 $cipher->alg_id
Returns the numeric ID of the cipher algorithm.
=head2 $cipher->blocksize
Returns the blocksize of the cipher algorithm (in bytes).
=head2 $cipher->keysize
Returns the keysize of the cipher algorithm (in bytes).
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

221
database/perl/vendor/lib/Crypt/OpenPGP/Ciphertext.pm vendored Normal file
View File

@@ -0,0 +1,221 @@
package Crypt::OpenPGP::Ciphertext;
use strict;
use Crypt::OpenPGP::Util;
use Crypt::OpenPGP::Cipher;
use Crypt::OpenPGP::Constants qw( DEFAULT_CIPHER
PGP_PKT_ENCRYPTED
PGP_PKT_ENCRYPTED_MDC );
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
use constant MDC_TRAILER => chr(0xd3) . chr(0x14);
sub pkt_type { $_[0]->{is_mdc} ? PGP_PKT_ENCRYPTED_MDC : PGP_PKT_ENCRYPTED }
sub new {
my $class = shift;
my $enc = bless { }, $class;
$enc->init(@_);
}
sub init {
my $enc = shift;
my %param = @_;
if ((my $key = $param{SymKey}) && (my $data = $param{Data})) {
$enc->{is_mdc} = $param{MDC} || 0;
$enc->{version} = 1;
my $alg = $param{Cipher} || DEFAULT_CIPHER;
my $cipher = Crypt::OpenPGP::Cipher->new($alg, $key);
my $bs = $cipher->blocksize;
my $pad = Crypt::OpenPGP::Util::get_random_bytes($bs);
$pad .= substr $pad, -2, 2;
$enc->{ciphertext} = $cipher->encrypt($pad);
$cipher->sync unless $enc->{is_mdc};
$enc->{ciphertext} .= $cipher->encrypt($data);
if ($enc->{is_mdc}) {
require Crypt::OpenPGP::MDC;
my $mdc = Crypt::OpenPGP::MDC->new(
Data => $pad . $data . MDC_TRAILER );
my $mdc_buf = Crypt::OpenPGP::PacketFactory->save($mdc);
$enc->{ciphertext} .= $cipher->encrypt($mdc_buf);
}
}
$enc;
}
sub parse {
my $class = shift;
my($buf, $is_mdc) = @_;
my $enc = $class->new;
$enc->{is_mdc} = $is_mdc;
if ($is_mdc) {
$enc->{version} = $buf->get_int8;
}
$enc->{ciphertext} = $buf->get_bytes($buf->length - $buf->offset);
$enc;
}
sub save {
my $enc = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
if ($enc->{is_mdc}) {
$buf->put_int8($enc->{version});
}
$buf->put_bytes($enc->{ciphertext});
$buf->bytes;
}
sub display {
my $enc = shift;
my $str = ":encrypted data packet:\n" .
" length: " . length($enc->{ciphertext}) . "\n";
if ($enc->{is_mdc}) {
$str .= " is_mdc: $enc->{version}\n";
}
$str;
}
sub decrypt {
my $enc = shift;
my($key, $sym_alg) = @_;
my $cipher = Crypt::OpenPGP::Cipher->new($sym_alg, $key) or
return $enc->error( Crypt::OpenPGP::Cipher->errstr );
my $padlen = $cipher->blocksize + 2;
my $pt = $enc->{prefix} =
$cipher->decrypt(substr $enc->{ciphertext}, 0, $padlen);
return $enc->error("Bad checksum")
unless substr($pt, -4, 2) eq substr($pt, -2, 2);
$cipher->sync unless $enc->{is_mdc};
$pt = $cipher->decrypt(substr $enc->{ciphertext}, $padlen);
if ($enc->{is_mdc}) {
my $mdc_buf = Crypt::OpenPGP::Buffer->new_with_init(substr $pt,-22,22);
$pt = substr $pt, 0, -22;
my $mdc = Crypt::OpenPGP::PacketFactory->parse($mdc_buf);
return $enc->error("Encrypted MDC packet without MDC")
unless $mdc && ref($mdc) eq 'Crypt::OpenPGP::MDC';
require Crypt::OpenPGP::Digest;
my $dgst = Crypt::OpenPGP::Digest->new('SHA1');
my $hash = $dgst->hash($enc->{prefix} . $pt . chr(0xd3) . chr(0x14));
return $enc->error("SHA-1 hash of plaintext does not match MDC body")
unless $mdc->digest eq $hash;
}
$pt;
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Ciphertext - Encrypted data packet
=head1 SYNOPSIS
use Crypt::OpenPGP::Ciphertext;
my $key_data = 'f' x 64; ## Not a very good key :)
my $ct = Crypt::OpenPGP::Ciphertext->new(
Data => "foo bar baz",
SymKey => $key_data,
);
my $serialized = $ct->save;
my $buffer = Crypt::OpenPGP::Buffer->new;
my $ct2 = Crypt::OpenPGP::Ciphertext->parse( $buffer );
my $data = $ct->decrypt( $key_data );
=head1 DESCRIPTION
I<Crypt::OpenPGP::Ciphertext> implements symmetrically encrypted data
packets, providing both encryption and decryption functionality. Both
standard encrypted data packets and encrypted-MDC (modification
detection code) packets are supported by this class. In the first case,
the encryption used in the packets is a variant on standard CFB mode,
and is described in the OpenPGP RFC, in section 13.9 (OpenPGP CFB mode).
In the second case (encrypted-MDC packets), the encryption is performed
in standard CFB mode, without the special resync used in PGP's CFB.
=head1 USAGE
=head2 Crypt::OpenPGP::Ciphertext->new( %arg )
Creates a new symmetrically encrypted data packet object and returns
that object. If there are no arguments in I<%arg>, the object is
created with an empty data container; this is used, for example, in
I<parse> (below), to create an empty packet which is then filled from
the data in the buffer.
If you wish to initialize a non-empty object, I<%arg> can contain:
=over 4
=item * Data
A block of octets that make up the plaintext data to be encrypted.
This argument is required (for a non-empty object).
=item * SymKey
The symmetric cipher key: a string of octets that make up the key data
of the symmetric cipher key. This should be at least long enough for
the key length of your chosen cipher (see I<Cipher>, below), or, if
you have not specified a cipher, at least 64 bytes (to allow for
long cipher key sizes).
This argument is required (for a non-empty object).
=item * Cipher
The name (or ID) of a supported PGP cipher. See I<Crypt::OpenPGP::Cipher>
for a list of valid cipher names.
This argument is optional; by default I<Crypt::OpenPGP::Cipher> will
use C<DES3>.
=item * MDC
When set to a true value, encrypted texts will use encrypted MDC
(modification detection code) packets instead of standard encrypted data
packets. These are a newer form of encrypted data packets that
are followed by a C<SHA-1> hash of the plaintext data. This prevents
attacks that modify the encrypted text by using a message digest to
detect changes.
By default I<MDC> is set to C<0>, and encrypted texts use standard
encrypted data packets. Set it to a true value to turn on MDC packets.
=back
=head2 $ct->save
Returns the block of ciphertext created in I<new> (assuming that you
created a non-empty packet by specifying some data; otherwise returns
an empty string).
=head2 Crypt::OpenPGP::Ciphertext->parse($buffer)
Given I<$buffer>, a I<Crypt::OpenPGP::Buffer> object holding (or
with offset pointing to) a symmetrically encrypted data packet, returns
a new I<Crypt::OpenPGP::Ciphertext> object, initialized with the
ciphertext in the buffer.
=head2 $ct->decrypt($key, $alg)
Decrypts the ciphertext in the I<Crypt::OpenPGP::Ciphertext> object
and returns the plaintext. I<$key> is the encryption key, and I<$alg>
is the name (or ID) of the I<Crypt::OpenPGP::Cipher> type used to
encrypt the message. Obviously you can't just guess at these
parameters; this method (along with I<parse>, above) is best used along
with the I<Crypt::OpenPGP::SessionKey> object, which holds an encrypted
version of the key and cipher algorithm.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

178
database/perl/vendor/lib/Crypt/OpenPGP/Compressed.pm vendored Normal file
View File

@@ -0,0 +1,178 @@
package Crypt::OpenPGP::Compressed;
use strict;
use Compress::Zlib;
use Crypt::OpenPGP::Buffer;
use Crypt::OpenPGP::Constants qw( DEFAULT_COMPRESS );
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
use vars qw( %ALG %ALG_BY_NAME );
%ALG = ( 1 => 'ZIP', 2 => 'Zlib' );
%ALG_BY_NAME = map { $ALG{$_} => $_ } keys %ALG;
sub alg {
return $_[0]->{__alg} if ref($_[0]);
$ALG{$_[1]} || $_[1];
}
sub alg_id {
return $_[0]->{__alg_id} if ref($_[0]);
$ALG_BY_NAME{$_[1]} || $_[1];
}
sub new {
my $comp = bless { }, shift;
$comp->init(@_);
}
sub init {
my $comp = shift;
my %param = @_;
if (my $data = $param{Data}) {
my $alg = $param{Alg} || DEFAULT_COMPRESS;
$alg = $ALG{$alg} || $alg;
$comp->{__alg} = $alg;
$comp->{__alg_id} = $ALG_BY_NAME{$alg};
my %args;
if ($comp->{__alg_id} == 1) {
%args = (-WindowBits => -13, -MemLevel => 8);
}
my($d, $status, $compressed);
($d, $status) = deflateInit(\%args);
return (ref $comp)->error("Zlib deflateInit error: $status")
unless $status == Compress::Zlib::Z_OK();
{
my($output, $out);
($output, $status) = $d->deflate($data);
last unless $status == Compress::Zlib::Z_OK();
($out, $status) = $d->flush();
last unless $status == Compress::Zlib::Z_OK();
$compressed = $output . $out;
}
return (ref $comp)->error("Zlib deflation error: $status")
unless defined $compressed;
$comp->{data} = $compressed;
}
$comp;
}
sub parse {
my $class = shift;
my($buf) = @_;
my $comp = $class->new;
$comp->{__alg_id} = $buf->get_int8;
$comp->{__alg} = $ALG{ $comp->{__alg_id} };
$comp->{data} = $buf->get_bytes($buf->length - $buf->offset);
$comp;
}
sub save {
my $comp = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->put_int8($comp->{__alg_id});
$buf->put_bytes($comp->{data});
$buf->bytes;
}
sub decompress {
my $comp = shift;
my %args;
if ($comp->{__alg_id} == 1) {
%args = (-WindowBits => -13);
}
my($i, $status, $out);
($i, $status) = inflateInit(\%args);
return $comp->error("Zlib inflateInit error: $status")
unless $status == Compress::Zlib::Z_OK();
($out, $status) = $i->inflate($comp->{data});
return $comp->error("Zlib inflate error: $status")
unless defined $out;
$out;
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Compressed - Compressed data packets
=head1 SYNOPSIS
use Crypt::OpenPGP::Compressed;
my $data = 'serialized openpgp packets';
my $cdata = Crypt::OpenPGP::Compressed->new( Data => $data );
my $serialized = $cdata->save;
=head1 DESCRIPTION
I<Crypt::OpenPGP::Compressed> implements compressed data packets,
providing both compression and decompression functionality, for all
supported compression algorithms (C<Zlib> and C<ZIP>). This class
uses I<Compress::Zlib> for all compression/decompression needs for
both algorithms: C<ZIP> is simply C<Zlib> with a different setting
for the I<WindowBits> parameter.
Decompressing a compressed data packet should always yield a stream
of valid PGP packets (which you can then parse using
I<Crypt::OpenPGP::PacketFactory>). Similarly, when compressing a
packet the input data should be a stream of packets.
=head1 USAGE
=head2 Crypt::OpenPGP::Compressed->new( %arg )
Creates a new compressed data packet object and returns that object.
If there are no arguments in I<%arg>, the object is created with an
empty compressed data container; this is used, for example, in
I<parse> (below), to create an empty packet which is then filled with
the data in the buffer.
If you wish to initialize a non-empty object, I<%arg> can contain:
=over 4
=item * Data
A block of octets that make up the data that you wish to compress.
As mentioned above, the data to compress should always be a stream
of valid PGP packets (saved using I<Crypt::OpenPGP::PacketFactory::save>).
This argument is required (for a non-empty object).
=item * Alg
The name (or ID) of a supported PGP compression algorithm. Valid
names are C<Zlib> and C<ZIP>.
This argument is optional; by default I<Crypt::OpenPGP::Compressed> will
use C<ZIP>.
=back
=head2 $cdata->save
Returns the serialized compressed data packet, which consists of
a one-octet compression algorithm ID, followed by the compressed
data.
=head2 Crypt::OpenPGP::Compressed->parse($buffer)
Given I<$buffer>, a I<Crypt::OpenPGP::Buffer> object holding (or with
offset pointing to) a compressed data packet, returns a new
I<Crypt::OpenPGP::Compressed> object, initialized with the data from
the buffer.
=head2 $cdata->decompress
Decompresses the compressed data in the I<Crypt::OpenPGP::Compressed>
object I<$cdata> and returns the decompressed data.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

109
database/perl/vendor/lib/Crypt/OpenPGP/Config.pm vendored Normal file
View File

@@ -0,0 +1,109 @@
package Crypt::OpenPGP::Config;
use strict;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub new {
my $class = shift;
my $cfg = bless { o => { @_ } }, $class;
$cfg;
}
sub get { $_[0]->{o}{ $_[1] } }
sub set {
my $cfg = shift;
my($key, $val) = @_;
$cfg->{o}{$key} = $val;
}
{
my %STANDARD = (
str => \&_set_str,
bool => \&_set_bool,
);
sub read_config {
my $cfg = shift;
my($compat, $cfg_file) = @_;
my $class = join '::', __PACKAGE__, $compat;
my $directives = $class->directives;
local(*FH, $_, $/);
$/ = "\n";
open FH, $cfg_file or
return $cfg->error("Error opening file '$cfg_file': $!");
while (<FH>) {
chomp;
next if !/\S/ || /^#/;
if (/^\s*([^\s=]+)(?:(?:(?:\s*=\s*)|\s+)(.*))?/) {
my($key, $val) = ($1, $2);
my $ref = $directives->{lc $key};
next unless $ref;
my $code = ref($ref->[0]) eq 'CODE' ? $ref->[0] :
$STANDARD{$ref->[0]};
$code->($cfg, $ref->[1], $val);
}
}
close FH;
}
}
sub _set_str { $_[0]->{o}{$_[1]} = $_[2] }
{
my %BOOL = ( off => 0, on => 1 );
sub _set_bool {
my($cfg, $key, $val) = @_;
$val = 1 unless defined $val;
$val = $BOOL{$val} || $val;
$cfg->{o}{$key} = $val;
}
}
package Crypt::OpenPGP::Config::GnuPG;
sub directives {
{
armor => [ 'bool', 'Armour' ],
'default-key' => [ 'str', 'DefaultKey' ],
recipient => [ 'str', 'Recipient' ],
'default-recipient' => [ 'str', 'DefaultRecipient' ],
'default-recipient-self' => [ 'bool', 'DefaultSelfRecipient' ],
'encrypt-to' => [ 'str', 'Recipient' ],
verbose => [ 'bool', 'Verbose' ],
textmode => [ 'bool', 'TextMode' ],
keyring => [ 'str', 'PubRing' ],
'secret-keyring' => [ 'str', 'SecRing' ],
'cipher-algo' => [ \&_set_cipher ],
'digest-algo' => [ 'str', 'Digest' ],
'compress-algo' => [ \&_set_compress ],
}
}
{
my %Ciphers = (
'3DES' => 'DES3', BLOWFISH => 'Blowfish',
RIJNDAEL => 'Rijndael', RIJNDAEL192 => 'Rijndael192',
RIJNDAEL256 => 'Rijndael256', TWOFISH => 'Twofish',
CAST5 => 'CAST5',
);
sub _set_cipher { $_[0]->{o}{Cipher} = $Ciphers{$_[2]} }
my %Compress = ( 1 => 'ZIP', 2 => 'Zlib' );
sub _set_compress { $_[0]->{o}{Compress} = $Compress{$_[2]} }
}
package Crypt::OpenPGP::Config::PGP2;
sub directives {
{
armor => [ 'bool', 'Armour' ],
compress => [ 'bool', 'Compress' ],
encrypttoself => [ 'bool', 'EncryptToSelf' ],
myname => [ 'str', 'DefaultSelfRecipient' ],
pubring => [ 'str', 'PubRing' ],
secring => [ 'str', 'SecRing' ],
}
}
package Crypt::OpenPGP::Config::PGP5;
*directives = \&Crypt::OpenPGP::Config::PGP2::directives;
1;

113
database/perl/vendor/lib/Crypt/OpenPGP/Constants.pm vendored Normal file
View File

@@ -0,0 +1,113 @@
package Crypt::OpenPGP::Constants;
use strict;
use vars qw( %CONSTANTS );
%CONSTANTS = (
'PGP_PKT_PUBKEY_ENC' => 1,
'PGP_PKT_SIGNATURE' => 2,
'PGP_PKT_SYMKEY_ENC' => 3,
'PGP_PKT_ONEPASS_SIG' => 4,
'PGP_PKT_SECRET_KEY' => 5,
'PGP_PKT_PUBLIC_KEY' => 6,
'PGP_PKT_SECRET_SUBKEY' => 7,
'PGP_PKT_COMPRESSED' => 8,
'PGP_PKT_ENCRYPTED' => 9,
'PGP_PKT_MARKER' => 10,
'PGP_PKT_PLAINTEXT' => 11,
'PGP_PKT_RING_TRUST' => 12,
'PGP_PKT_USER_ID' => 13,
'PGP_PKT_PUBLIC_SUBKEY' => 14,
'PGP_PKT_ENCRYPTED_MDC' => 18,
'PGP_PKT_MDC' => 19,
'DEFAULT_CIPHER' => 2,
'DEFAULT_DIGEST' => 2,
'DEFAULT_COMPRESS' => 1,
);
use vars qw( %TAGS );
my %RULES = (
'^PGP_PKT' => 'packet',
);
for my $re (keys %RULES) {
$TAGS{ $RULES{$re} } = [ grep /$re/, keys %CONSTANTS ];
}
sub import {
my $class = shift;
my @to_export;
my @args = @_;
for my $item (@args) {
push @to_export,
$item =~ s/^:// ? @{ $TAGS{$item} } : $item;
}
no strict 'refs';
my $pkg = caller;
for my $con (@to_export) {
warn __PACKAGE__, " does not export the constant '$con'"
unless exists $CONSTANTS{$con};
*{"${pkg}::$con"} = sub () { $CONSTANTS{$con} }
}
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Constants - Exportable constants
=head1 DESCRIPTION
I<Crypt::OpenPGP::Constants> provides a list of common and useful
constants for use in I<Crypt::OpenPGP>.
=head1 USAGE
None of the constants are exported by default; you have to ask for
them explicitly. Some of the constants are grouped into bundles that
you can grab all at once; alternatively you can just take the
individual constants, one by one.
If you wish to import a group, your I<use> statement should look
something like this:
use Crypt::OpenPGP::Constants qw( :group );
Here are the groups:
=over 4
=item * packet
All of the I<PGP_PKT_*> constants. These are constants that define
packet types.
=back
Other exportable constants, not belonging to a group, are:
=over 4
=item * DEFAULT_CIPHER
=item * DEFAULT_DIGEST
=item * DEFAULT_COMPRESS
Default cipher, digest, and compression algorithms, to be used if no
specific cipher, digest, or compression algorithm is otherwise
specified.
=back
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

196
database/perl/vendor/lib/Crypt/OpenPGP/Digest.pm vendored Normal file
View File

@@ -0,0 +1,196 @@
package Crypt::OpenPGP::Digest;
use strict;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
use vars qw( %ALG %ALG_BY_NAME );
%ALG = (
1 => 'MD5',
2 => 'SHA1',
3 => 'RIPEMD160',
8 => 'SHA256',
9 => 'SHA384',
10 => 'SHA512',
11 => 'SHA224',
);
%ALG_BY_NAME = map { $ALG{$_} => $_ } keys %ALG;
sub new {
my $class = shift;
my $alg = shift;
$alg = $ALG{$alg} || $alg;
return $class->error("Unsupported digest algorithm '$alg'")
unless $alg =~ /^\D/;
my $pkg = join '::', $class, $alg;
my $dig = bless { __alg => $alg,
__alg_id => $ALG_BY_NAME{$alg} }, $pkg;
$dig->init(@_);
}
sub init { $_[0] }
sub hash { $_[0]->{md}->($_[1]) }
sub alg {
return $_[0]->{__alg} if ref($_[0]);
$ALG{$_[1]} || $_[1];
}
sub alg_id {
return $_[0]->{__alg_id} if ref($_[0]);
$ALG_BY_NAME{$_[1]} || $_[1];
}
sub supported {
my $class = shift;
my %s;
for my $did (keys %ALG) {
my $digest = $class->new($did);
$s{$did} = $digest->alg if $digest;
}
\%s;
}
package Crypt::OpenPGP::Digest::MD5;
use strict;
use base qw( Crypt::OpenPGP::Digest );
sub init {
my $dig = shift;
require Digest::MD5;
$dig->{md} = \&Digest::MD5::md5;
$dig;
}
package Crypt::OpenPGP::Digest::SHA1;
use strict;
use base qw( Crypt::OpenPGP::Digest );
sub init {
my $dig = shift;
require Digest::SHA;
$dig->{md} = \&Digest::SHA::sha1;
$dig;
}
package Crypt::OpenPGP::Digest::RIPEMD160;
use strict;
use base qw( Crypt::OpenPGP::Digest );
sub init {
my $dig = shift;
require Crypt::RIPEMD160;
$dig->{md} = sub { Crypt::RIPEMD160->hash($_[0]) };
$dig;
}
package Crypt::OpenPGP::Digest::SHA224;
use strict;
use base qw( Crypt::OpenPGP::Digest );
sub init {
my $dig = shift;
require Digest::SHA;
$dig->{md} = \&Digest::SHA::sha224;
$dig;
}
package Crypt::OpenPGP::Digest::SHA256;
use strict;
use base qw( Crypt::OpenPGP::Digest );
sub init {
my $dig = shift;
require Digest::SHA;
$dig->{md} = \&Digest::SHA::sha256;
$dig;
}
package Crypt::OpenPGP::Digest::SHA384;
use strict;
use base qw( Crypt::OpenPGP::Digest );
sub init {
my $dig = shift;
require Digest::SHA;
$dig->{md} = \&Digest::SHA::sha384;
$dig;
}
package Crypt::OpenPGP::Digest::SHA512;
use strict;
use base qw( Crypt::OpenPGP::Digest );
sub init {
my $dig = shift;
require Digest::SHA;
$dig->{md} = \&Digest::SHA::sha512;
$dig;
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Digest - PGP message digest factory
=head1 SYNOPSIS
use Crypt::OpenPGP::Digest;
my $alg = 'SHA1';
my $dgst = Crypt::OpenPGP::Digest->new( $alg );
my $data = 'foo bar';
my $hashed_data = $dgst->hash($data);
=head1 DESCRIPTION
I<Crypt::OpenPGP::Digest> is a factory class for PGP message digest
objects. All digest objects are subclasses of this class and share a
common interface; when creating a new digest object, the object is
blessed into the subclass to take on algorithm-specific functionality.
A I<Crypt::OpenPGP::Digest> object wraps around a function reference
providing the actual digest implementation (eg. I<Digest::MD::md5> for
an MD5 digest). This allows all digest objects to share a common
interface and a simple instantiation method.
=head1 USAGE
=head2 Crypt::OpenPGP::Digest->new($digest)
Creates a new message digest object of type I<$digest>; I<$digest> can
be either the name of a digest algorithm (in I<Crypt::OpenPGP>
parlance) or the numeric ID of the algorithm (as defined in the
OpenPGP RFC). Using an algorithm name is recommended, for the simple
reason that it is easier to understand quickly (not everyone knows
the algorithm IDs).
Valid digest names are: C<MD5>, C<SHA1>, and C<RIPEMD160>.
Returns the new digest object on success. On failure returns C<undef>;
the caller should check for failure and call the class method I<errstr>
if a failure occurs. A typical reason this might happen is an
unsupported digest name or ID.
=head2 $dgst->hash($data)
Creates a message digest hash of the data I<$data>, a string of
octets, and returns the digest.
=head2 $dgst->alg
Returns the name of the digest algorithm (as listed above in I<new>).
=head2 $dgst->alg_id
Returns the numeric ID of the digest algorithm.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

92
database/perl/vendor/lib/Crypt/OpenPGP/ErrorHandler.pm vendored Normal file
View File

@@ -0,0 +1,92 @@
package Crypt::OpenPGP::ErrorHandler;
use strict;
use vars qw( $ERROR );
sub new { bless {}, shift }
sub error {
my $msg = $_[1];
$msg .= "\n" unless $msg =~ /\n$/;
if (ref($_[0])) {
$_[0]->{_errstr} = $msg;
} else {
$ERROR = $msg;
}
return;
}
sub errstr { ref($_[0]) ? $_[0]->{_errstr} : $ERROR }
1;
__END__
=head1 NAME
Crypt::OpenPGP::ErrorHandler - Crypt::OpenPGP error handling
=head1 SYNOPSIS
package Foo;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub class_method {
my $class = shift;
# Stuff happens...
return $class->error("Help!");
}
sub object_method {
my $obj = shift;
# Stuff happens...
return $obj->error("I am no more");
}
package main;
Foo->class_method or die Foo->errstr;
my $foo = Foo->new;
$foo->object_method or die $foo->errstr;
=head1 DESCRIPTION
I<Crypt::OpenPGP::ErrorHandler> provides an error-handling mechanism
for all I<Crypt::OpenPGP> modules/classes. It is meant to be used as
a base class for classes that wish to use its error-handling methods:
derived classes use its two methods, I<error> and I<errstr>, to
communicate error messages back to the calling program.
On failure (for whatever reason), a subclass should call I<error>
and return to the caller; I<error> itself sets the error message
internally, then returns C<undef>. This has the effect of the method
that failed returning C<undef> to the caller. The caller should
check for errors by checking for a return value of C<undef>, and
in this case should call I<errstr> to get the value of the error
message. Note that calling I<errstr> when an error has not occurred
is undefined behavior and will I<rarely> do what you want.
As demonstrated in the I<SYNOPSIS> (above), I<error> and I<errstr> work
both as class methods and as object methods.
=head1 USAGE
=head2 Class->error($message)
=head2 $object->error($message)
Sets the error message for either the class I<Class> or the object
I<$object> to the message I<$message>. Returns C<undef>.
=head2 Class->errstr
=head2 $object->errstr
Accesses the last error message set in the class I<Class> or the
object I<$object>, respectively, and returns that error message.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

236
database/perl/vendor/lib/Crypt/OpenPGP/Key.pm vendored Normal file
View File

@@ -0,0 +1,236 @@
package Crypt::OpenPGP::Key;
use strict;
use Carp qw( confess );
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
use vars qw( %ALG %ALG_BY_NAME );
%ALG = (
1 => 'RSA',
16 => 'ElGamal',
17 => 'DSA',
);
%ALG_BY_NAME = map { $ALG{$_} => $_ } keys %ALG;
sub new {
my $class = shift;
my $alg = shift;
$alg = $ALG{$alg} || $alg;
my $pkg = join '::', $class, $alg;
eval "use $pkg;";
return $class->error("Unsupported algorithm '$alg': $@") if $@;
my @valid = $pkg->all_props;
my %valid = map { $_ => 1 } @valid;
my $key = bless { __valid => \%valid, __alg => $alg,
__alg_id => $ALG_BY_NAME{$alg} }, $pkg;
$key->init(@_);
}
sub keygen {
my $class = shift;
my $alg = shift;
$alg = $ALG{$alg} || $alg;
my $pkg = join '::', __PACKAGE__, 'Public', $alg;
eval "use $pkg;";
return $class->error("Unsupported algorithm '$alg': $@") if $@;
my($pub_data, $sec_data) = $pkg->keygen(@_);
return $class->error("Key generation failed: " . $class->errstr)
unless $pub_data && $sec_data;
my $pub_pkg = join '::', __PACKAGE__, 'Public';
my $pub = $pub_pkg->new($alg, $pub_data);
my $sec_pkg = join '::', __PACKAGE__, 'Secret';
my $sec = $sec_pkg->new($alg, $sec_data);
($pub, $sec);
}
sub init { $_[0] }
sub check { 1 }
sub alg { $_[0]->{__alg} }
sub alg_id { $_[0]->{__alg_id} }
sub size { 0 }
sub bytesize { int(($_[0]->size + 7) / 8) }
sub public_key { }
sub is_secret { 0 }
sub can_encrypt { 0 }
sub can_sign { 0 }
sub DESTROY { }
use vars qw( $AUTOLOAD );
sub AUTOLOAD {
my $key = shift;
(my $meth = $AUTOLOAD) =~ s/.*:://;
confess "Can't call method $meth on Key $key"
unless $key->{__valid}{$meth};
$key->{key_data}->$meth(@_);
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Key - OpenPGP key factory
=head1 SYNOPSIS
use Crypt::OpenPGP::Key;
my($pub, $sec) = Crypt::OpenPGP::Key->keygen('DSA', Size => 1024);
use Crypt::OpenPGP::Key::Public;
my $pubkey = Crypt::OpenPGP::Key::Public->new('DSA');
use Crypt::OpenPGP::Key::Secret;
my $seckey = Crypt::OpenPGP::Key::Secret->new('RSA');
=head1 DESCRIPTION
I<Crypt::OpenPGP::Key> provides base class functionality for all
I<Crypt::OpenPGP> public and secret keys. It functions as a factory
class for key generation and key instantiation.
The only time you will ever use I<Crypt::OpenPGP::Key> directly is
to generate a key-pair; in all other scenarios--for example, when
instantiating a new key object--you should use either
I<Crypt::OpenPGP::Key::Public> or I<Crypt::OpenPGP::Key::Secret>,
depending on whether the key is public or secret, respectively.
=head1 KEY GENERATION
=head2 Crypt::OpenPGP::Key->keygen( $type, %arg )
Generates a new key-pair of public key algorithm I<$type>. Returns
a public and a secret key, each blessed into the appropriate
implementation class. Returns an empty list on failure, in which case
you should call the class method I<errstr> to determine the error.
Valid values for type are C<DSA>, C<RSA>, and C<ElGamal>.
I<%arg> can contain:
=over 4
=item * Size
Bitsize of the key to be generated. This should be an even integer;
there is no low end currently set, but for the sake of security
I<Size> should be at least 1024 bits.
This is a required argument.
=item * Verbosity
Set to a true value to enable a status display during key generation;
since key generation is a relatively length process, it is helpful
to have an indication that some action is occurring.
I<Verbosity> is 0 by default.
=back
=head1 METHODS
I<Crypt::OpenPGP::Key> is not meant to be used directly (unless you
are generating keys; see I<KEY GENERATION>, above); instead you should
use the subclasses of this module. There are, however, useful interface
methods that are shared by all subclasses.
=head2 Key Data Access
Each public-key algorithm has different key data associated with it.
For example, a public DSA key has 4 attributes: I<p>, I<q>, I<g>, and
I<y>. A secret DSA key has the same attributes as a public key, and
in addition it has an attribute I<x>.
All of the key data attributes can be accessed by calling methods of
the same name on the I<Key> object. For example:
my $q = $dsa_key->q;
The attributes for each public-key algorithm are:
=over 4
=item * RSA
Public key: I<n>, I<e>
Secret key: I<n>, I<e>, I<d>, I<p>, I<q>, I<u>
=item * DSA
Public key: I<p>, I<q>, I<g>, I<y>
Secret key: I<p>, I<q>, I<g>, I<y>, I<x>
=item * ElGamal
Public key: I<p>, I<g>, I<y>
Secret key: I<p>, I<g>, I<y>, I<x>
=back
=head2 $key->check
Check the key data to determine if it is valid. For example, an RSA
secret key would multiply the values of I<p> and I<q> and verify that
the product is equal to the value of I<n>. Returns true if the key
is valid, false otherwise.
Not all public key algorithm implementations implement a I<check>
method; for those that don't, I<check> will always return true.
=head2 $key->size
Returns the "size" of the key. The definition of "size" depends on
the public key algorithm; for example, DSA defines the size of a key
as the bitsize of the value of I<p>.
=head2 $key->bytesize
Whereas I<size> will return a bitsize of the key, I<bytesize> returns
the size in bytes. This value is defined as C<int((bitsize(key)+7)/8)>.
=head2 $key->is_secret
Returns true if the key I<$key> is a secret key, false otherwise.
=head2 $key->public_key
Returns the public part of the key I<$key>. If I<$key> is already a
public key, I<$key> is returned; otherwise a new public key object
(I<Crypt::OpenPGP::Key::Public>) is constructed, and the public values
from the secret key are copied into the public key. The new public
key is returned.
=head2 $key->can_encrypt
Returns true if the key algorithm has encryption/decryption
capabilities, false otherwise.
=head2 $key->can_sign
Returns true if the key algorithm has signing/verification
capabilities, false otherwise.
=head2 $key->alg
Returns the name of the public key algorithm.
=head2 $key->alg_id
Returns the number ID of the public key algorithm.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

12
database/perl/vendor/lib/Crypt/OpenPGP/Key/Public.pm vendored Normal file
View File

@@ -0,0 +1,12 @@
package Crypt::OpenPGP::Key::Public;
use strict;
use Crypt::OpenPGP::Key;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::Key Crypt::OpenPGP::ErrorHandler );
sub all_props { $_[0]->public_props }
sub is_secret { 0 }
sub public_key { $_[0] }
1;

53
database/perl/vendor/lib/Crypt/OpenPGP/Key/Public/DSA.pm vendored Normal file
View File

@@ -0,0 +1,53 @@
package Crypt::OpenPGP::Key::Public::DSA;
use strict;
use Crypt::DSA::Key;
use Crypt::OpenPGP::Key::Public;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::Key::Public Crypt::OpenPGP::ErrorHandler );
sub can_sign { 1 }
sub abbrev { 'D' }
sub init {
my $key = shift;
$key->{key_data} = shift || Crypt::DSA::Key->new;
$key;
}
sub keygen {
my $class = shift;
my %param = @_;
require Crypt::DSA;
my $dsa = Crypt::DSA->new;
my $sec = $dsa->keygen( %param );
my $pub = bless { }, 'Crypt::DSA::Key';
for my $e (qw( p q g pub_key )) {
$pub->$e( $sec->$e() );
}
($pub, $sec);
}
sub public_props { qw( p q g y ) }
sub sig_props { qw( r s ) }
sub y { $_[0]->{key_data}->pub_key(@_[1..$#_]) }
sub size { $_[0]->{key_data}->size }
sub verify {
my $key = shift;
my($sig, $dgst) = @_;
require Crypt::DSA;
my $dsa = Crypt::DSA->new;
my $dsa_sig = Crypt::DSA::Signature->new;
$dsa_sig->r($sig->{r});
$dsa_sig->s($sig->{s});
$dsa->verify(
Key => $key->{key_data},
Digest => $dgst,
Signature => $dsa_sig
);
}
1;

79
database/perl/vendor/lib/Crypt/OpenPGP/Key/Public/ElGamal.pm vendored Normal file
View File

@@ -0,0 +1,79 @@
package Crypt::OpenPGP::Key::Public::ElGamal;
use strict;
use Crypt::OpenPGP::Util qw( bitsize);
use Crypt::OpenPGP::Key::Public;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::Key::Public Crypt::OpenPGP::ErrorHandler );
sub can_encrypt { 1 }
sub abbrev { 'g' }
sub public_props { qw( p g y ) }
sub crypt_props { qw( a b ) }
sub sig_props { qw( a b ) }
sub size { bitsize($_[0]->p) }
sub init {
my $key = shift;
$key->{key_data} = shift || Crypt::OpenPGP::ElGamal::Public->new;
$key;
}
sub keygen {
return $_[0]->error("ElGamal key generation is not supported");
}
sub encrypt {
my $key = shift;
my($M) = @_;
$key->{key_data}->encrypt($M);
}
package Crypt::OpenPGP::ElGamal::Public;
use strict;
use Crypt::OpenPGP::Util qw( mod_exp );
use Math::BigInt;
sub new { bless {}, $_[0] }
sub encrypt {
my $key = shift;
my($M) = @_;
my $k = gen_k($key->p);
my $a = mod_exp($key->g, $k, $key->p);
my $b = mod_exp($key->y, $k, $key->p);
$b->bmod($key->p);
{ a => $a, b => $b * $M };
}
sub gen_k {
my($p) = @_;
## XXX choose bitsize based on bitsize of $p
my $bits = 198;
my $p_minus1 = $p - 1;
my $k = Crypt::OpenPGP::Util::get_random_bigint($bits);
while (1) {
last if Math::BigInt::bgcd($k, $p_minus1) == 1;
$k++;
}
$k;
}
sub _getset {
my $e = shift;
sub {
my $key = shift;
$key->{$e} = shift if @_;
$key->{$e};
}
}
*p = _getset('p');
*g = _getset('g');
*y = _getset('y');
1;

82
database/perl/vendor/lib/Crypt/OpenPGP/Key/Public/RSA.pm vendored Normal file
View File

@@ -0,0 +1,82 @@
package Crypt::OpenPGP::Key::Public::RSA;
use strict;
use Crypt::RSA::Key::Public;
use Crypt::OpenPGP::Digest;
use Crypt::OpenPGP::Util qw( bitsize bin2mp mp2bin );
use Crypt::OpenPGP::Key::Public;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::Key::Public Crypt::OpenPGP::ErrorHandler );
sub can_encrypt { 1 }
sub can_sign { 1 }
sub abbrev { 'R' }
sub public_props { qw( n e ) }
sub crypt_props { qw( c ) }
sub sig_props { qw( c ) }
sub init {
my $key = shift;
$key->{key_data} = shift || Crypt::RSA::Key::Public->new;
$key;
}
sub keygen {
my $class = shift;
my %param = @_;
$param{Password} = $param{Passphrase};
require Crypt::RSA::Key;
my $chain = Crypt::RSA::Key->new;
my($pub, $sec) = $chain->generate( %param );
return $class->error( $chain->errstr ) unless $pub && $sec;
($pub, $sec);
}
sub size { bitsize($_[0]->{key_data}->n) }
sub check { $_[0]->{key_data}->check }
sub encrypt {
my $key = shift;
my($M) = @_;
require Crypt::RSA::Primitives;
my $prim = Crypt::RSA::Primitives->new;
my $c = $prim->core_encrypt( Key => $key->{key_data}, Plaintext => $M ) or
return $key->error($prim->errstr);
{ c => $c }
}
sub verify {
my $key = shift;
my($sig, $dgst) = @_;
my $k = $key->bytesize;
require Crypt::RSA::Primitives;
my $prim = Crypt::RSA::Primitives->new;
my $c = $sig->{c};
my $m = $prim->core_verify( Key => $key->{key_data}, Signature => $c) or
return;
$m = mp2bin($m, $k - 1);
my $hash_alg = Crypt::OpenPGP::Digest->alg($sig->{hash_alg});
my $M = encode($dgst, $hash_alg, $k - 1);
$m eq $M;
}
{
my %ENCODING = (
MD2 => pack('H*', '3020300C06082A864886F70D020205000410'),
MD5 => pack('H*', '3020300C06082A864886F70D020505000410'),
SHA1 => pack('H*', '3021300906052B0E03021A05000414'),
);
sub encode {
my($dgst, $hash_alg, $mlen) = @_;
my $alg = $ENCODING{$hash_alg};
my $m = $alg . $dgst;
my $padlen = $mlen - length($m) - 2;
my $pad = chr(255) x $padlen;
chr(1) . $pad . chr(0) . $m;
}
}
1;

21
database/perl/vendor/lib/Crypt/OpenPGP/Key/Secret.pm vendored Normal file
View File

@@ -0,0 +1,21 @@
package Crypt::OpenPGP::Key::Secret;
use strict;
use Crypt::OpenPGP::Key;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::Key Crypt::OpenPGP::ErrorHandler );
sub is_secret { 1 }
sub all_props { ($_[0]->public_props, $_[0]->secret_props) }
sub public_key {
my $key = shift;
my @pub = $key->public_props;
my $pub = Crypt::OpenPGP::Key::Public->new($key->alg);
for my $e (@pub) {
$pub->$e($key->$e());
}
$pub;
}
1;

39
database/perl/vendor/lib/Crypt/OpenPGP/Key/Secret/DSA.pm vendored Normal file
View File

@@ -0,0 +1,39 @@
package Crypt::OpenPGP::Key::Secret::DSA;
use strict;
use Crypt::DSA::Key;
use Crypt::OpenPGP::Key::Public::DSA;
use Crypt::OpenPGP::Key::Secret;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::Key::Secret Crypt::OpenPGP::ErrorHandler );
sub secret_props { qw( x ) }
*sig_props = \&Crypt::OpenPGP::Key::Public::DSA::sig_props;
*public_props = \&Crypt::OpenPGP::Key::Public::DSA::public_props;
*size = \&Crypt::OpenPGP::Key::Public::DSA::size;
*keygen = \&Crypt::OpenPGP::Key::Public::DSA::keygen;
*can_sign = \&Crypt::OpenPGP::Key::Public::DSA::can_sign;
sub init {
my $key = shift;
$key->{key_data} = shift || Crypt::DSA::Key->new;
$key;
}
sub y { $_[0]->{key_data}->pub_key(@_[1..$#_]) }
sub x { $_[0]->{key_data}->priv_key(@_[1..$#_]) }
sub sign {
my $key = shift;
my($dgst) = @_;
require Crypt::DSA;
my $dsa = Crypt::DSA->new;
my $sig = $dsa->sign(
Key => $key->{key_data},
Digest => $dgst,
);
}
*verify = \&Crypt::OpenPGP::Key::Public::DSA::verify;
1;

57
database/perl/vendor/lib/Crypt/OpenPGP/Key/Secret/ElGamal.pm vendored Normal file
View File

@@ -0,0 +1,57 @@
package Crypt::OpenPGP::Key::Secret::ElGamal;
use strict;
use Crypt::OpenPGP::Key::Public::ElGamal;
use Crypt::OpenPGP::Key::Secret;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::Key::Secret Crypt::OpenPGP::ErrorHandler );
sub secret_props { qw( x ) }
*public_props = \&Crypt::OpenPGP::Key::Public::ElGamal::public_props;
*crypt_props = \&Crypt::OpenPGP::Key::Public::ElGamal::crypt_props;
*size = \&Crypt::OpenPGP::Key::Public::ElGamal::size;
*keygen = \&Crypt::OpenPGP::Key::Public::ElGamal::keygen;
*can_encrypt = \&Crypt::OpenPGP::Key::Public::ElGamal::can_encrypt;
sub init {
my $key = shift;
$key->{key_data} = shift || Crypt::OpenPGP::ElGamal::Private->new;
$key;
}
sub decrypt { $_[0]->{key_data}->decrypt(@_[1..$#_]) }
package Crypt::OpenPGP::ElGamal::Private;
use strict;
use Crypt::OpenPGP::Util qw( mod_exp mod_inverse );
use Math::BigInt;
sub new { bless {}, $_[0] }
sub decrypt {
my $key = shift;
my($C) = @_;
my $p = $key->p;
my $t1 = mod_exp($C->{a}, $key->x, $p);
$t1 = mod_inverse($t1, $p);
my $n = Math::BigInt->new($C->{b} * $t1);
$n->bmod($p);
return $n;
}
sub _getset {
my $e = shift;
sub {
my $key = shift;
$key->{$e} = shift if @_;
$key->{$e};
}
}
*p = _getset('p');
*g = _getset('g');
*y = _getset('y');
*x = _getset('x');
1;

49
database/perl/vendor/lib/Crypt/OpenPGP/Key/Secret/RSA.pm vendored Normal file
View File

@@ -0,0 +1,49 @@
package Crypt::OpenPGP::Key::Secret::RSA;
use strict;
use Crypt::RSA::Key::Private;
use Crypt::OpenPGP::Key::Public::RSA;
use Crypt::OpenPGP::Key::Secret;
use Crypt::OpenPGP::Util qw( bin2mp );
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::Key::Secret Crypt::OpenPGP::ErrorHandler );
sub secret_props { qw( d p q u ) }
*sig_props = \&Crypt::OpenPGP::Key::Public::RSA::sig_props;
*public_props = \&Crypt::OpenPGP::Key::Public::RSA::public_props;
*crypt_props = \&Crypt::OpenPGP::Key::Public::RSA::crypt_props;
*size = \&Crypt::OpenPGP::Key::Public::RSA::size;
*encode = \&Crypt::OpenPGP::Key::Public::RSA::encode;
*keygen = \&Crypt::OpenPGP::Key::Public::RSA::keygen;
*can_encrypt = \&Crypt::OpenPGP::Key::Public::RSA::can_encrypt;
*can_sign = \&Crypt::OpenPGP::Key::Public::RSA::can_sign;
sub init {
my $key = shift;
$key->{key_data} = shift ||
Crypt::RSA::Key::Private->new( Password => 'pgp' );
$key;
}
*encrypt = \&Crypt::OpenPGP::Key::Public::RSA::encrypt;
sub decrypt {
my $key = shift;
my($C) = @_;
require Crypt::RSA::Primitives;
my $prim = Crypt::RSA::Primitives->new;
$prim->core_decrypt( Key => $key->{key_data}, Cyphertext => $C->{c} );
}
sub sign {
my $key = shift;
my($dgst, $hash_alg) = @_;
my $m = encode($dgst, $hash_alg, $key->bytesize - 1);
require Crypt::RSA::Primitives;
my $prim = Crypt::RSA::Primitives->new;
$m = bin2mp($m);
my $c = $prim->core_sign( Key => $key->{key_data}, Message => $m );
{ c => $c }
}
1;

145
database/perl/vendor/lib/Crypt/OpenPGP/KeyBlock.pm vendored Normal file
View File

@@ -0,0 +1,145 @@
package Crypt::OpenPGP::KeyBlock;
use strict;
use Crypt::OpenPGP::PacketFactory;
sub primary_uid {
$_[0]->{pkt}{ 'Crypt::OpenPGP::UserID' } ?
$_[0]->{pkt}{ 'Crypt::OpenPGP::UserID' }->[0]->id : undef;
}
sub key { $_[0]->get('Crypt::OpenPGP::Certificate')->[0] }
sub subkey { $_[0]->get('Crypt::OpenPGP::Certificate')->[1] }
sub encrypting_key {
my $kb = shift;
my $keys = $kb->get('Crypt::OpenPGP::Certificate');
return unless $keys && @$keys;
for my $key (@$keys) {
return $key if $key->can_encrypt;
}
}
sub signing_key {
my $kb = shift;
my $keys = $kb->get('Crypt::OpenPGP::Certificate');
return unless $keys && @$keys;
for my $key (@$keys) {
return $key if $key->can_sign;
}
}
sub key_by_id { $_[0]->{keys_by_id}->{$_[1]} ||
$_[0]->{keys_by_short_id}->{$_[1]} }
sub new {
my $class = shift;
my $kb = bless { }, $class;
$kb->init(@_);
}
sub init {
my $kb = shift;
$kb->{pkt} = { };
$kb->{order} = [ ];
$kb->{keys_by_id} = { };
$kb;
}
sub add {
my $kb = shift;
my($pkt) = @_;
push @{ $kb->{pkt}->{ ref($pkt) } }, $pkt;
push @{ $kb->{order} }, $pkt;
if (ref($pkt) eq 'Crypt::OpenPGP::Certificate') {
my $kid = $pkt->key_id;
$kb->{keys_by_id}{ $kid } = $pkt;
$kb->{keys_by_short_id}{ substr $kid, -4, 4 } = $pkt;
}
}
sub get { $_[0]->{pkt}->{ $_[1] } }
sub save {
my $kb = shift;
Crypt::OpenPGP::PacketFactory->save( @{ $kb->{order} } );
}
sub save_armoured {
my $kb = shift;
require Crypt::OpenPGP::Armour;
Crypt::OpenPGP::Armour->armour(
Data => $kb->save,
Object => 'PUBLIC KEY BLOCK'
);
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::KeyBlock - Key block object
=head1 SYNOPSIS
use Crypt::OpenPGP::KeyBlock;
my $packet = Crypt::OpenPGP::UserID->new( Identity => 'foo' );
my $kb = Crypt::OpenPGP::KeyBlock->new;
$kb->add($packet);
my $serialized = $kb->save;
=head1 DESCRIPTION
I<Crypt::OpenPGP::KeyBlock> represents a single keyblock in a keyring.
A key block is essentially just a set of associated keys containing
exactly one master key, zero or more subkeys, some user ID packets, some
signatures, etc. The key is that there is only one master key
associated with each keyblock.
=head1 USAGE
=head2 Crypt::OpenPGP::KeyBlock->new
Constructs a new key block object and returns that object.
=head2 $kb->encrypting_key
Returns the key that performs encryption in this key block. For example,
if a DSA key is the master key in a key block with an ElGamal subkey,
I<encrypting_key> returns the ElGamal subkey certificate, because DSA
keys do not perform encryption/decryption.
=head2 $kb->signing_key
Returns the key that performs signing in this key block. For example,
if a DSA key is the master key in a key block with an ElGamal subkey,
I<encrypting_key> returns the DSA master key certificate, because DSA
supports signing/verification.
=head2 $kb->add($packet)
Adds the packet I<$packet> to the key block. If the packet is a PGP
certificate (a I<Crypt::OpenPGP::Certificate> object), the certificate
is also added to the internal key-management mechanism.
=head2 $kb->save
Serializes each of the packets contained in the I<KeyBlock> object,
in order, and returns the serialized data. This output can then be
fed to I<Crypt::OpenPGP::Armour> for ASCII-armouring, for example,
or can be written out to a keyring file.
=head2 $kb->save_armoured
Saves an armoured version of the keyblock (this is useful for exporting
public keys).
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

267
database/perl/vendor/lib/Crypt/OpenPGP/KeyRing.pm vendored Normal file
View File

@@ -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

153
database/perl/vendor/lib/Crypt/OpenPGP/KeyServer.pm vendored Normal file
View File

@@ -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.*?&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

97
database/perl/vendor/lib/Crypt/OpenPGP/MDC.pm vendored Normal file
View File

@@ -0,0 +1,97 @@
package Crypt::OpenPGP::MDC;
use strict;
use Crypt::OpenPGP::Digest;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub new {
my $mdc = bless { }, shift;
$mdc->init(@_);
}
sub init {
my $mdc = shift;
my %param = @_;
if (my $data = $param{Data}) {
my $dgst = Crypt::OpenPGP::Digest->new('SHA1');
$mdc->{body} = $dgst->hash($data);
}
$mdc;
}
sub digest { $_[0]->{body} }
sub parse {
my $class = shift;
my($buf) = @_;
my $mdc = $class->new;
$mdc->{body} = $buf->get_bytes($buf->length - $buf->offset);
$mdc;
}
sub save { $_[0]->{body} }
1;
__END__
=head1 NAME
Crypt::OpenPGP::MDC - MDC (modification detection code) packet
=head1 SYNOPSIS
use Crypt::OpenPGP::MDC;
my $mdc = Crypt::OpenPGP::MDC->new( Data => 'foobar' );
my $digest = $mdc->digest;
my $serialized = $mdc->save;
=head1 DESCRIPTION
I<Crypt::OpenPGP::MDC> is a PGP MDC (modification detection code) packet.
Such a packet is used alongside Encrypted-MDC data packets so that
modifications to the ciphertext can be detected. The MDC packet contains
a C<SHA-1> digest of the plaintext for comparison with the decrypted
plaintext.
You generally will never need to construct a I<Crypt::OpenPGP::MDC>
packet yourself; usage is by the I<Crypt::OpenPGP::Ciphertext> object.
=head1 USAGE
=head2 Crypt::OpenPGP::MDC->new( [ Data => $data ] )
Creates a new MDC packet object and returns that object. If you do not
supply any data I<$data>, the object is created empty; this is used, for
example, in I<parse> (below), to create an empty packet which is then
filled from the data in the buffer.
If you wish to initialize a non-empty object, supply I<new> with
the I<Data> parameter along with a value I<$data>. I<$data> should
contain the plaintext prefix (length = cipher blocksize + 2), the actual
plaintext, and two octets corresponding to the hex digits C<0xd3> and
C<0x14>.
=head2 $mdc->save
Returns the text of the MDC packet; this is the digest of the data passed
to I<new> (above) as I<$data>, for example.
=head2 Crypt::OpenPGP::MDC->parse($buffer)
Given I<$buffer>, a I<Crypt::OpenPGP::Buffer> object holding (or
with offset pointing to) an MDC packet, returns a new <Crypt::OpenPGP::MDC>
object, initialized with the MDC data in the buffer.
=head2 $mdc->digest
Returns the MDC digest data (eg. the string passed as I<$data> to
I<new>, above).
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

40
database/perl/vendor/lib/Crypt/OpenPGP/Marker.pm vendored Normal file
View File

@@ -0,0 +1,40 @@
package Crypt::OpenPGP::Marker;
use strict;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub new { bless { }, $_[0] }
sub parse {
my $class = shift;
my($buf) = @_;
my $marker = $class->new;
$marker->{mark} = $buf->bytes;
$marker;
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Marker - PGP Marker packet
=head1 DESCRIPTION
I<Crypt::OpenPGP::Marker> is a PGP Marker packet. These packets are
used by PGP 5.x to signal to earlier versions of PGP (eg. 2.6.x)
that the message requires newer software to be read and understood.
The contents of the Marker packet are always the same: the three
octets 0x50, 0x47, and 0x50 (which spell C<PGP>).
It is very likely that you will never have to use a Marker packet
directly.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

157
database/perl/vendor/lib/Crypt/OpenPGP/Message.pm vendored Normal file
View File

@@ -0,0 +1,157 @@
package Crypt::OpenPGP::Message;
use strict;
use Crypt::OpenPGP::Buffer;
use Crypt::OpenPGP::PacketFactory;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub new {
my $class = shift;
my $msg = bless { }, $class;
$msg->init(@_);
}
sub init {
my $msg = shift;
my %param = @_;
$msg->{is_packet_stream} = delete $param{IsPacketStream};
$msg->{pieces} = [];
$msg->{_data} = $param{Data} || '';
if (!$msg->{_data} && (my $file = $param{Filename})) {
local *FH;
open FH, $file or
return (ref $msg)->error("Can't open message $file: $!");
binmode FH;
{ local $/; $msg->{_data} = <FH> }
close FH;
}
$msg->read or return;
$msg;
}
sub read {
my $msg = shift;
my $data = $msg->{_data} or
return $msg->error("Message contains no data");
my $pt;
if (!$msg->{is_packet_stream} &&
$data =~ /-----BEGIN PGP SIGNED MESSAGE/) {
require Crypt::OpenPGP::Armour;
require Crypt::OpenPGP::Util;
require Crypt::OpenPGP::Plaintext;
my($head, $text, $sig) = $data =~
m!-----BEGIN PGP SIGNED MESSAGE-----(.*?\r?\n\r?\n)?(.+?)(-----BEGIN PGP SIGNATURE.*?END PGP SIGNATURE-----)!s;
## In clear-signed messages, the line ending before the signature
## is not considered part of the signed text.
$text =~ s!\r?\n$!!;
$pt = Crypt::OpenPGP::Plaintext->new(
Data => Crypt::OpenPGP::Util::dash_unescape($text),
Mode => 't',
);
$data = $sig;
}
if (!$msg->{is_packet_stream} && $data =~ /^-----BEGIN PGP/m) {
require Crypt::OpenPGP::Armour;
my $rec = Crypt::OpenPGP::Armour->unarmour($data) or
return $msg->error("Unarmour failed: " .
Crypt::OpenPGP::Armour->errstr);
$data = $rec->{Data};
}
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->append($data);
$msg->restore($buf);
push @{ $msg->{pieces} }, $pt if $pt;
1;
}
sub restore {
my $msg = shift;
my($buf) = @_;
while (my $packet = Crypt::OpenPGP::PacketFactory->parse($buf)) {
push @{ $msg->{pieces} }, $packet;
}
}
sub pieces { @{ $_[0]->{pieces} } }
1;
__END__
=head1 NAME
Crypt::OpenPGP::Message - Sequence of PGP packets
=head1 SYNOPSIS
use Crypt::OpenPGP::Message;
my $data; $data .= $_ while <STDIN>;
my $msg = Crypt::OpenPGP::Message->new( Data => $data );
my @pieces = $msg->pieces;
=head1 DESCRIPTION
I<Crypt::OpenPGP::Message> provides a container for a sequence of PGP
packets. It transparently handles ASCII-armoured messages, as well as
cleartext signatures.
=head1 USAGE
=head2 Crypt::OpenPGP::Message->new( %arg )
Constructs a new I<Crypt::OpenPGP::Message> object, presumably to be
filled with some data, where the data is a serialized stream of PGP
packets.
Reads the packets into in-memory packet objects.
Returns the new I<Message> object on success, C<undef> on failure.
I<%arg> can contain:
=over 4
=item * Data
A scalar string containing the serialized packets.
This argument is optional, but either this argument or I<Filename> must
be provided.
=item * Filename
The path to a file that contains a serialized stream of packets.
This argument is optional, but either this argument or I<Data> must be
provided.
=item * IsPacketStream
By default I<Crypt::OpenPGP::Message> will attempt to unarmour ASCII-armoured
text. Since the armoured text can actually appear anywhere in a string, as
long as it starts at the beginning of a line, this can cause problems when a
stream of packets happens to include armoured text. At those times you want
the packets to be treated as a stream, not as a string that happens to contain
armoured text.
In this case, set I<IsPacketStream> to a true value, and the ASCII armour
detection will be skipped.
=back
=head2 $msg->pieces
Returns an array containing packet objects. For example, if the packet
stream contains a public key packet, a user ID packet, and a signature
packet, the array will contain three objects: a
I<Crypt::OpenPGP::Certificate> object; a I<Crypt::OpenPGP::UserID>
object; and a I<Crypt::OpenPGP::Signature> object, in that order.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

52
database/perl/vendor/lib/Crypt/OpenPGP/OnePassSig.pm vendored Normal file
View File

@@ -0,0 +1,52 @@
package Crypt::OpenPGP::OnePassSig;
use strict;
sub new { bless { }, $_[0] }
sub parse {
my $class = shift;
my($buf) = @_;
my $onepass = $class->new;
$onepass->{version} = $buf->get_int8;
$onepass->{type} = $buf->get_int8;
$onepass->{hash_alg} = $buf->get_int8;
$onepass->{pk_alg} = $buf->get_int8;
$onepass->{key_id} = $buf->get_bytes(8);
$onepass->{nested} = $buf->get_int8;
$onepass;
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::OnePassSig - One-Pass Signature packet
=head1 DESCRIPTION
I<Crypt::OpenPGP::OnePassSig> implements a PGP One-Pass Signature
packet, a packet that precedes the signature data and contains
enough information to allow the receiver of the signature to begin
computing the hashed data. Standard signature packets always come
I<before> the signed data, which forces receivers to backtrack to
the beginning of the message--to the signature packet--to add on
the signature trailer data. The one-pass signature packet allows
the receive to start computing the hashed data while reading the
data packet, then continue on sequentially when it reaches the
signature packet.
=head1 USAGE
=head2 my $onepass = Crypt::OpenPGP::OnePassSig->parse($buffer)
Given the I<Crypt::OpenPGP::Buffer> object buffer, which should
contain a one-pass signature packet, parses the object from the
buffer and returns the object.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

255
database/perl/vendor/lib/Crypt/OpenPGP/PacketFactory.pm vendored Normal file
View File

@@ -0,0 +1,255 @@
package Crypt::OpenPGP::PacketFactory;
use strict;
use Crypt::OpenPGP::Constants qw( :packet );
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
use vars qw( %PACKET_TYPES %PACKET_TYPES_BY_CLASS );
%PACKET_TYPES = (
PGP_PKT_PUBKEY_ENC() => { class => 'Crypt::OpenPGP::SessionKey' },
PGP_PKT_SIGNATURE() => { class => 'Crypt::OpenPGP::Signature' },
PGP_PKT_SYMKEY_ENC() => { class => 'Crypt::OpenPGP::SKSessionKey' },
PGP_PKT_ONEPASS_SIG() => { class => 'Crypt::OpenPGP::OnePassSig' },
PGP_PKT_SECRET_KEY() => { class => 'Crypt::OpenPGP::Certificate',
args => [ 1, 0 ] },
PGP_PKT_PUBLIC_KEY() => { class => 'Crypt::OpenPGP::Certificate',
args => [ 0, 0 ] },
PGP_PKT_SECRET_SUBKEY() => { class => 'Crypt::OpenPGP::Certificate',
args => [ 1, 1 ] },
PGP_PKT_USER_ID() => { class => 'Crypt::OpenPGP::UserID' },
PGP_PKT_PUBLIC_SUBKEY() => { class => 'Crypt::OpenPGP::Certificate',
args => [ 0, 1 ] },
PGP_PKT_COMPRESSED() => { class => 'Crypt::OpenPGP::Compressed' },
PGP_PKT_ENCRYPTED() => { class => 'Crypt::OpenPGP::Ciphertext' },
PGP_PKT_MARKER() => { class => 'Crypt::OpenPGP::Marker' },
PGP_PKT_PLAINTEXT() => { class => 'Crypt::OpenPGP::Plaintext' },
PGP_PKT_RING_TRUST() => { class => 'Crypt::OpenPGP::Trust' },
PGP_PKT_ENCRYPTED_MDC() => { class => 'Crypt::OpenPGP::Ciphertext',
args => [ 1 ] },
PGP_PKT_MDC() => { class => 'Crypt::OpenPGP::MDC' },
);
%PACKET_TYPES_BY_CLASS = map { $PACKET_TYPES{$_}{class} => $_ } keys %PACKET_TYPES;
sub parse {
my $class = shift;
my($buf, $find, $parse) = @_;
return unless $buf && $buf->offset < $buf->length;
my(%find, %parse);
if ($find) {
%find = ref($find) eq 'ARRAY' ? (map { $_ => 1 } @$find) :
($find => 1);
}
else {
%find = map { $_ => 1 } keys %PACKET_TYPES;
}
if ($parse) {
%parse = ref($parse) eq 'ARRAY' ? (map { $_ => 1 } @$parse) :
($parse => 1);
}
else {
%parse = %find;
}
my($type, $len, $partial, $hdrlen, $b);
do {
($type, $len, $partial, $hdrlen) = $class->_parse_header($buf);
$b = $buf->extract($len ? $len : $buf->length - $buf->offset);
return unless $type;
} while !$find{$type}; ## Skip
while ($partial) {
my $off = $buf->offset;
(my($nlen), $partial) = $class->_parse_new_len_header($buf);
$len += $nlen + ($buf->offset - $off);
$b->append( $buf->get_bytes($nlen) );
}
my $obj;
if ($parse{$type} && (my $ref = $PACKET_TYPES{$type})) {
my $pkt_class = $ref->{class};
my @args = $ref->{args} ? @{ $ref->{args} } : ();
eval "use $pkt_class;";
return $class->error("Loading $pkt_class failed: $@") if $@;
$obj = $pkt_class->parse($b, @args);
}
else {
$obj = { type => $type, length => $len,
__pkt_len => $len + $hdrlen, __unparsed => 1 };
}
$obj;
}
sub _parse_header {
my $class = shift;
my($buf) = @_;
return unless $buf && $buf->offset < $buf->length;
my $off_start = $buf->offset;
my $tag = $buf->get_int8;
return $class->error("Parse error: bit 7 not set!")
unless $tag & 0x80;
my $is_new = $tag & 0x40;
my($type, $len, $partial);
if ($is_new) {
$type = $tag & 0x3f;
($len, $partial) = $class->_parse_new_len_header($buf);
}
else {
$type = ($tag>>2)&0xf;
my $lenbytes = (($tag&3)==3) ? 0 : (1<<($tag & 3));
$len = 0;
for (1..$lenbytes) {
$len <<= 8;
$len += $buf->get_int8;
}
}
($type, $len, $partial, $buf->offset - $off_start);
}
sub _parse_new_len_header {
my $class = shift;
my($buf) = @_;
return unless $buf && $buf->offset < $buf->length;
my $lb1 = $buf->get_int8;
my($partial, $len);
if ($lb1 <= 191) {
$len = $lb1;
} elsif ($lb1 <= 223) {
$len = (($lb1-192) << 8) + $buf->get_int8 + 192;
} elsif ($lb1 < 255) {
$partial++;
$len = 1 << ($lb1 & 0x1f);
} else {
$len = $buf->get_int32;
}
($len, $partial);
}
sub save {
my $class = shift;
my @objs = @_;
my $ser = '';
for my $obj (@objs) {
my $body = $obj->save;
my $len = length($body);
my $type = $obj->can('pkt_type') ? $obj->pkt_type :
$PACKET_TYPES_BY_CLASS{ref($obj)};
my $hdrlen = $obj->can('pkt_hdrlen') ? $obj->pkt_hdrlen : undef;
my $buf = Crypt::OpenPGP::Buffer->new;
if ($obj->{is_new} || $type > 15) {
my $tag = 0xc0 | ($type & 0x3f);
$buf->put_int8($tag);
return $class->error("Can't write partial length packets")
unless $len;
if ($len < 192) {
$buf->put_int8($len);
} elsif ($len < 8384) {
$len -= 192;
$buf->put_int8(int($len / 256) + 192);
$buf->put_int8($len % 256);
} else {
$buf->put_int8(0xff);
$buf->put_int32($len);
}
}
else {
unless ($hdrlen) {
if (!defined $len) {
$hdrlen = 0;
} elsif ($len < 256) {
$hdrlen = 1;
} elsif ($len < 65536) {
$hdrlen = 2;
} else {
$hdrlen = 4;
}
}
return $class->error("Packet overflow: overflow preset len")
if $hdrlen == 1 && $len > 255;
$hdrlen = 4 if $hdrlen == 2 && $len > 65535;
my $tag = 0x80 | ($type << 2);
if ($hdrlen == 0) {
$buf->put_int8($tag | 3);
} elsif ($hdrlen == 1) {
$buf->put_int8($tag);
$buf->put_int8($len);
} elsif ($hdrlen == 2) {
$buf->put_int8($tag | 1);
$buf->put_int16($len);
} else {
$buf->put_int8($tag | 2);
$buf->put_int32($len);
}
}
$buf->put_bytes($body);
$ser .= $buf->bytes;
}
$ser;
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::PacketFactory - Parse and save PGP packet streams
=head1 SYNOPSIS
use Crypt::OpenPGP::PacketFactory;
my $buf = Crypt::OpenPGP::Buffer->new;
while (my $packet = Crypt::OpenPGP::PacketFactory->parse($buf)) {
## Do something with $packet
}
my @packets;
my $serialized = Crypt::OpenPGP::PacketFactory->save(@packets);
=head1 DESCRIPTION
I<Crypt::OpenPGP::PacketFactory> parses PGP buffers (objects of type
I<Crypt::OpenPGP::Buffer>) and generates packet objects of various
packet classes (for example, I<Crypt::OpenPGP::Certificate> objects,
I<Crypt::OpenPGP::Signature> objects, etc.). It also takes lists of
packets, serializes each of them, and adds type/length headers to
them, forming a stream of packets suitable for armouring, writing
to disk, sending through email, etc.
=head1 USAGE
=head2 Crypt::OpenPGP::PacketFactory->parse($buffer [, $find ])
Given a buffer object I<$buffer> of type I<Crypt::OpenPGP::Buffer>,
iterates through the packets serialized in the buffer, parsing
each one, and returning each packet one by one. In other words, given
a buffer, it acts as a standard iterator.
By default I<parse> parses and returns all packets in the buffer, of
any packet type. If you are only looking for packets of a specific
type, though, it makes no sense to return every packet; you can
control which packets I<parse> parses and returns with I<$find>, which
should be a reference to a list of packet types to find in the buffer.
Only packets of those types will be parsed and returned to you. You
can get the packet type constants from I<Crypt::OpenPGP::Constants>
by importing the C<:packet> tag.
Returns the next packet in the buffer until the end of the buffer
is reached (or until there are no more of the packets which you wish
to find), at which point returns a false value.
=head2 Crypt::OpenPGP::PacketFactory->save(@packets)
Given a list of packets I<@packets>, serializes each packet, then
adds a type/length header on to each one, resulting in a string of
octets representing the serialized packets, suitable for passing in
to I<parse>, or for writing to disk, or anywhere else.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

137
database/perl/vendor/lib/Crypt/OpenPGP/Plaintext.pm vendored Normal file
View File

@@ -0,0 +1,137 @@
package Crypt::OpenPGP::Plaintext;
use strict;
use Crypt::OpenPGP::Buffer;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub new {
my $class = shift;
my $pt = bless { }, $class;
$pt->init(@_);
}
sub data { $_[0]->{data} }
sub mode { $_[0]->{mode} }
sub init {
my $pt = shift;
my %param = @_;
if (my $data = $param{Data}) {
$pt->{data} = $data;
$pt->{mode} = $param{Mode} || 'b';
$pt->{timestamp} = time;
$pt->{filename} = $param{Filename} || '';
}
$pt;
}
sub parse {
my $class = shift;
my($buf) = @_;
my $pt = $class->new;
$pt->{mode} = $buf->get_char;
$pt->{filename} = $buf->get_bytes($buf->get_int8);
$pt->{timestamp} = $buf->get_int32;
$pt->{data} = $buf->get_bytes( $buf->length - $buf->offset );
$pt;
}
sub save {
my $pt = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->put_char($pt->{mode});
$buf->put_int8(length $pt->{filename});
$buf->put_bytes($pt->{filename});
$buf->put_int32($pt->{timestamp});
$buf->put_bytes($pt->{data});
$buf->bytes;
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Plaintext - A plaintext, literal-data packet
=head1 SYNOPSIS
use Crypt::OpenPGP::Plaintext;
my $data = 'foo bar';
my $file = 'foo.txt';
my $pt = Crypt::OpenPGP::Plaintext->new(
Data => $data,
Filename => $file,
);
my $serialized = $pt->save;
=head1 DESCRIPTION
I<Crypt::OpenPGP::Plaintext> implements plaintext literal-data packets,
and is essentially just a container for a string of octets, along
with some meta-data about the plaintext.
=head1 USAGE
=head2 Crypt::OpenPGP::Plaintext->new( %arg )
Creates a new plaintext data packet object and returns that object.
If there are no arguments in I<%arg>, the object is created with an
empty data container; this is used, for example, in I<parse> (below),
to create an empty packet which is then filled from the data in the
buffer.
If you wish to initialize a non-empty object, I<%arg> can contain:
=over 4
=item * Data
A block of octets that make up the plaintext data.
This argument is required (for a non-empty object).
=item * Filename
The name of the file that this data came from, or the name of a file
where it should be saved upon extraction from the packet (after
decryption, for example, if this packet is going to be encrypted).
=item * Mode
The mode in which the data is formatted. Valid values are C<t> and
C<b>, meaning "text" and "binary", respectively.
This argument is optional; I<Mode> defaults to C<b>.
=back
=head2 $pt->save
Returns the serialized form of the plaintext object, which is the
plaintext data, preceded by some meta-data describing the data.
=head2 Crypt::OpenPGP::Plaintext->parse($buffer)
Given I<$buffer>, a I<Crypt::OpenPGP::Buffer> object holding (or
with offset pointing to) a plaintext data packet, returns a new
I<Crypt::OpenPGP::Ciphertext> object, initialized with the data
in the buffer.
=head2 $pt->data
Returns the plaintext data.
=head2 $pt->mode
Returns the mode of the packet (either C<t> or C<b>).
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

244
database/perl/vendor/lib/Crypt/OpenPGP/S2k.pm vendored Normal file
View File

@@ -0,0 +1,244 @@
package Crypt::OpenPGP::S2k;
use strict;
use Crypt::OpenPGP::Buffer;
use Crypt::OpenPGP::Digest;
use Crypt::OpenPGP::ErrorHandler;
use Crypt::OpenPGP::Util;
use base qw( Crypt::OpenPGP::ErrorHandler );
use vars qw( %TYPES );
%TYPES = (
0 => 'Simple',
1 => 'Salted',
3 => 'Salt_Iter',
);
sub new {
my $class = shift;
my $type = shift;
$type = $TYPES{ $type } || $type;
return $class->error("Invalid type of S2k") unless $type;
my $pkg = join '::', __PACKAGE__, $type;
my $s2k = bless { }, $pkg;
$s2k->init(@_);
}
sub parse {
my $class = shift;
my($buf) = @_;
my $id = $buf->get_int8;
my $type = $TYPES{$id};
$class->new($type, $buf);
}
sub init { $_[0] }
sub generate {
my $s2k = shift;
my($passphrase, $keysize) = @_;
my($material, $pass) = ('', 0);
my $hash = $s2k->{hash};
while (length($material) < $keysize) {
my $pad = '' . chr(0) x $pass;
$material .= $s2k->s2k($passphrase, $pad);
$pass++;
}
substr($material, 0, $keysize);
}
sub set_hash {
my $s2k = shift;
my($hash_alg) = @_;
$s2k->{hash} = ref($hash_alg) ? $hash_alg :
Crypt::OpenPGP::Digest->new($hash_alg);
}
package Crypt::OpenPGP::S2k::Simple;
use base qw( Crypt::OpenPGP::S2k );
use Crypt::OpenPGP::Constants qw( DEFAULT_DIGEST );
sub init {
my $s2k = shift;
my($buf) = @_;
if ($buf) {
$s2k->{hash_alg} = $buf->get_int8;
}
else {
$s2k->{hash_alg} = DEFAULT_DIGEST;
}
if ($s2k->{hash_alg}) {
$s2k->{hash} = Crypt::OpenPGP::Digest->new($s2k->{hash_alg});
}
$s2k;
}
sub s2k { $_[0]->{hash}->hash($_[2] . $_[1]) }
sub save {
my $s2k = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->put_int8(1);
$buf->put_int8($s2k->{hash_alg});
$buf->bytes;
}
package Crypt::OpenPGP::S2k::Salted;
use base qw( Crypt::OpenPGP::S2k );
use Crypt::OpenPGP::Constants qw( DEFAULT_DIGEST );
sub init {
my $s2k = shift;
my($buf) = @_;
if ($buf) {
$s2k->{hash_alg} = $buf->get_int8;
$s2k->{salt} = $buf->get_bytes(8);
}
else {
$s2k->{hash_alg} = DEFAULT_DIGEST;
$s2k->{salt} = Crypt::OpenPGP::Util::get_random_bytes(8);
}
if ($s2k->{hash_alg}) {
$s2k->{hash} = Crypt::OpenPGP::Digest->new($s2k->{hash_alg});
}
$s2k;
}
sub s2k { $_[0]->{hash}->hash($_[0]->{salt} . $_[2] . $_[1]) }
sub save {
my $s2k = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->put_int8(2);
$buf->put_int8($s2k->{hash_alg});
$buf->put_bytes($s2k->{salt});
$buf->bytes;
}
package Crypt::OpenPGP::S2k::Salt_Iter;
use base qw( Crypt::OpenPGP::S2k );
use Crypt::OpenPGP::Constants qw( DEFAULT_DIGEST );
sub init {
my $s2k = shift;
my($buf) = @_;
if ($buf) {
$s2k->{hash_alg} = $buf->get_int8;
$s2k->{salt} = $buf->get_bytes(8);
$s2k->{count} = $buf->get_int8;
}
else {
$s2k->{hash_alg} = DEFAULT_DIGEST;
$s2k->{salt} = Crypt::OpenPGP::Util::get_random_bytes(8);
$s2k->{count} = 96;
}
if ($s2k->{hash_alg}) {
$s2k->{hash} = Crypt::OpenPGP::Digest->new($s2k->{hash_alg});
}
$s2k;
}
sub s2k {
my $s2k = shift;
my($pass, $pad) = @_;
my $salt = $s2k->{salt};
my $count = (16 + ($s2k->{count} & 15)) << (($s2k->{count} >> 4) + 6);
my $len = length($pass) + 8;
if ($count < $len) {
$count = $len;
}
my $res = $pad;
while ($count > $len) {
$res .= $salt . $pass;
$count -= $len;
}
if ($count < 8) {
$res .= substr($salt, 0, $count);
} else {
$res .= $salt;
$count -= 8;
$res .= substr($pass, 0, $count);
}
$s2k->{hash}->hash($res);
}
sub save {
my $s2k = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->put_int8(3);
$buf->put_int8($s2k->{hash_alg});
$buf->put_bytes($s2k->{salt});
$buf->put_int8($s2k->{count});
$buf->bytes;
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::S2k - String-to-key generation
=head1 SYNOPSIS
use Crypt::OpenPGP::S2k;
# S2k generates an encryption key from a passphrase; in order to
# understand how large of a key to generate, we need to know which
# cipher we're using, and what the passphrase is.
my $cipher = Crypt::OpenPGP::Cipher->new( '...' );
my $passphrase = 'foo';
my $s2k = Crypt::OpenPGP::S2k->new( 'Salt_Iter' );
my $key = $s2k->generate( $passphrase, $cipher->keysize );
my $serialized = $s2k->save;
=head1 DESCRIPTION
I<Crypt::OpenPGP::S2k> implements string-to-key generation for use in
generating symmetric cipher keys from standard, arbitrary-length
passphrases (like those used to lock secret key files). Since a
passphrase can be of any length, and key material must be a very
specific length, a method is needed to translate the passphrase into
the key. The OpenPGP RFC defines three such methods, each of which
this class implements.
=head1 USAGE
=head2 Crypt::OpenPGP::S2k->new($type)
Creates a new type of S2k-generator of type I<$type>; valid values for
I<$type> are C<Simple>, C<Salted>, and C<Salt_Iter>. These generator
types are described in the OpenPGP RFC section 3.7.
Returns the new S2k-generator object.
=head2 Crypt::OpenPGP::S2k->parse($buffer)
Given a buffer I<$buffer> of type I<Crypt::OpenPGP::Buffer>, determines
the type of S2k from the first octet in the buffer (one of the types
listed above in I<new>), then creates a new object of that type and
initializes the S2k state from the buffer I<$buffer>. Different
initializations occur based on the type of S2k.
Returns the new S2k-generator object.
=head2 $s2k->save
Serializes the S2k object and returns the serialized form; this form
will differ based on the type of S2k.
=head2 $s2k->generate($passphrase, $keysize)
Given a passphrase I<$passphrase>, which should be a string of octets
of arbitrary length, and a keysize I<$keysize>, generates enough key
material to meet the size I<$keysize>, and returns that key material.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

195
database/perl/vendor/lib/Crypt/OpenPGP/SKSessionKey.pm vendored Normal file
View File

@@ -0,0 +1,195 @@
package Crypt::OpenPGP::SKSessionKey;
use strict;
use Crypt::OpenPGP::Constants qw( DEFAULT_CIPHER );
use Crypt::OpenPGP::Buffer;
use Crypt::OpenPGP::S2k;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub new {
my $class = shift;
my $key = bless { }, $class;
$key->init(@_);
}
sub init {
my $key = shift;
my %param = @_;
$key->{version} = 4;
if ((my $sym_key = $param{SymKey}) && (my $pass = $param{Passphrase})) {
my $alg = $param{Cipher} || DEFAULT_CIPHER;
my $cipher = Crypt::OpenPGP::Cipher->new($alg);
my $keysize = $cipher->keysize;
$key->{s2k_ciph} = $cipher->alg_id;
$key->{s2k} = $param{S2k} || Crypt::OpenPGP::S2k->new('Salt_Iter');
$sym_key = substr $sym_key, 0, $keysize;
my $s2k_key = $key->{s2k}->generate($pass, $keysize);
$cipher->init($s2k_key);
}
$key;
}
sub parse {
my $class = shift;
my($buf) = @_;
my $key = $class->new;
$key->{version} = $buf->get_int8;
return $class->error("Unsupported version ($key->{version})")
unless $key->{version} == 4;
$key->{s2k_ciph} = $buf->get_int8;
$key->{s2k} = Crypt::OpenPGP::S2k->parse($buf);
if ($buf->offset < $buf->length) {
$key->{encrypted} = $buf->get_bytes( $buf->length - $buf->offset );
}
$key;
}
sub save {
my $key = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->put_int8($key->{version});
$buf->put_int8($key->{s2k_ciph});
$buf->put_bytes( $key->{s2k}->save );
$buf->bytes;
}
sub decrypt {
my $key = shift;
my($passphrase) = @_;
my $cipher = Crypt::OpenPGP::Cipher->new($key->{s2k_ciph});
my $keysize = $cipher->keysize;
my $s2k_key = $key->{s2k}->generate($passphrase, $keysize);
my($sym_key, $alg);
if ($key->{encrypted}) {
$cipher->init($s2k_key);
$sym_key = $cipher->decrypt($key->{encrypted});
$alg = ord substr $sym_key, 0, 1, '';
} else {
$sym_key = $s2k_key;
$alg = $cipher->alg_id;
}
($sym_key, $alg);
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::SKSessionKey - Symmetric-Key Encrypted Session Key
=head1 SYNOPSIS
use Crypt::OpenPGP::SKSessionKey;
my $passphrase = 'foobar'; # Not a very good passphrase
my $key_data = 'f' x 64; # Not a very good key
my $skey = Crypt::OpenPGP::SKSessionKey->new(
Passphrase => $passphrase,
SymKey => $key_data,
);
my $serialized = $skey->save;
=head1 DESCRIPTION
I<Crypt::OpenPGP::SKSessionKey> implements symmetric-key encrypted
session key packets; these packets store symmetric-key-encrypted key data
that, when decrypted using the proper passphrase, can be used to decrypt a
block of ciphertext--that is, a I<Crypt::OpenPGP::Ciphertext> object.
Symmetric-key encrypted session key packets can work in two different
ways: in one scenario the passphrase you provide is used to encrypt
a randomly chosen string of key material; the key material is the key
that is actually used to encrypt the data packet, and the passphrase
just serves to encrypt the key material. This encrypted key material
is then serialized into the symmetric-key encrypted session key packet.
The other method of using this encryption form is to use the passphrase
directly to encrypt the data packet. In this scenario the need for any
additional key material goes away, because all the receiver needs is
the same passphrase that you have entered to encrypt the data.
At the moment I<Crypt::OpenPGP> really only supports the first
scenario; note also that the interface to I<new> may change in the
future when support for the second scenario is added.
=head1 USAGE
=head2 Crypt::OpenPGP::SKSessionKey->new( %arg )
Creates a new encrypted session key packet object and returns that
object. If there are no arguments in I<%arg>, the object is created
empty; this is used, for example in I<parse> (below), to create an
empty packet which is then filled from the data in the buffer.
If you wish to initialize a non-empty object, I<%arg> can contain:
=over 4
=item * Passphrase
An arbitrary-length passphrase; that is, a string of octets. The
passphrase is used to encrypt the actual session key such that it can
only be decrypted by supplying the correct passphrase.
This argument is required (for a non-empty object).
=item * SymKey
The symmetric cipher key: a string of octets that make up the key data
of the symmetric cipher key. This should be at least long enough for
the key length of your chosen cipher (see I<Cipher>, below), or, if
you have not specified a cipher, at least 64 bytes (to allow for long
cipher key sizes).
This argument is required (for a non-empty object).
=item * S2k
An object of type I<Crypt::OpenPGP::S2k> (or rather, of one of its
subclasses). If you use the passphrase directly to encrypt the data
packet (scenario one, above), you will probably be generating the
key material outside of this class, meaning that you will need to pass
in the I<S2k> object that was used to generate that key material from
the passphrase. This is the way to do that.
=item * Cipher
The name (or ID) of a supported PGP cipher. See I<Crypt::OpenPGP::Cipher>
for a list of valid cipher names.
This argument is optional; by default I<Crypt::OpenPGP::Cipher> will
use C<DES3>.
=back
=head2 $skey->save
Serializes the session key packet and returns the string of octets.
=head2 Crypt::OpenPGP::SKSessionKey->parse($buffer)
Given I<$buffer>, a I<Crypt::OpenPGP::Buffer> object holding (or
with offset pointing to) an encrypted session key packet, returns
a new I<Crypt::OpenPGP::Ciphertext> object, initialized with the
data in the buffer.
=head2 $skey->decrypt($passphrase)
Given a passphrase I<$passphrase>, decrypts the encrypted session key
data. The key data includes the symmetric key itself, along with a
one-octet ID of the symmetric cipher used to encrypt the message.
Returns a list containing two items: the symmetric key and the cipher
algorithm ID. These are suitable for passing off to the I<decrypt>
method of a I<Crypt::OpenPGP::Ciphertext> object to decrypt a block
of encrypted data.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

225
database/perl/vendor/lib/Crypt/OpenPGP/SessionKey.pm vendored Normal file
View File

@@ -0,0 +1,225 @@
package Crypt::OpenPGP::SessionKey;
use strict;
use Crypt::OpenPGP::Constants qw( DEFAULT_CIPHER );
use Crypt::OpenPGP::Key::Public;
use Crypt::OpenPGP::Util qw( mp2bin bin2mp bitsize );
use Crypt::OpenPGP::Buffer;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub key_id { $_[0]->{key_id} }
sub new {
my $class = shift;
my $key = bless { }, $class;
$key->init(@_);
}
sub init {
my $key = shift;
my %param = @_;
$key->{version} = 3;
if ((my $cert = $param{Key}) && (my $sym_key = $param{SymKey})) {
my $alg = $param{Cipher} || DEFAULT_CIPHER;
my $cipher = Crypt::OpenPGP::Cipher->new($alg) or
return (ref $key)->error( Crypt::OpenPGP::Cipher->errstr );
my $keysize = $cipher->keysize;
$sym_key = substr $sym_key, 0, $keysize;
my $pk = $cert->key->public_key;
my $enc = $key->_encode($sym_key, $alg, $pk->bytesize) or
return (ref $key)->error("Encoding symkey failed: " . $key->errstr);
$key->{key_id} = $cert->key_id;
$key->{C} = $pk->encrypt($enc) or
return (ref $key)->error("Encryption failed: " . $pk->errstr);
$key->{pk_alg} = $pk->alg_id;
}
$key;
}
sub parse {
my $class = shift;
my($buf) = @_;
my $key = $class->new;
$key->{version} = $buf->get_int8;
return $class->error("Unsupported version ($key->{version})")
unless $key->{version} == 2 || $key->{version} == 3;
$key->{key_id} = $buf->get_bytes(8);
$key->{pk_alg} = $buf->get_int8;
my $pk = Crypt::OpenPGP::Key::Public->new($key->{pk_alg});
my @props = $pk->crypt_props;
for my $e (@props) {
$key->{C}{$e} = $buf->get_mp_int;
}
$key;
}
sub save {
my $key = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->put_int8($key->{version});
$buf->put_bytes($key->{key_id}, 8);
$buf->put_int8($key->{pk_alg});
my $c = $key->{C};
for my $prop (sort keys %$c) {
$buf->put_mp_int($c->{$prop});
}
$buf->bytes;
}
sub display {
my $key = shift;
my $str = sprintf ":pubkey enc packet: version %d, algo %d, keyid %s\n",
$key->{version}, $key->{pk_alg}, uc unpack('H*', $key->{key_id});
my $c = $key->{C};
for my $prop (sort keys %$c) {
$str .= sprintf " data: [%d bits]\n", bitsize($c->{$prop});
}
$str;
}
sub decrypt {
my $key = shift;
my($sk) = @_;
return $key->error("Invalid secret key ID")
unless $key->key_id eq $sk->key_id;
my($sym_key, $alg) = __PACKAGE__->_decode($sk->key->decrypt($key->{C}))
or return $key->error("Session key decryption failed: " .
__PACKAGE__->errstr);
($sym_key, $alg);
}
sub _encode {
my $class = shift;
my($sym_key, $sym_alg, $size) = @_;
my $padlen = "$size" - length($sym_key) - 2 - 2 - 2;
my $pad = "\0";
while ($pad =~ tr/\0//) {
$pad = Crypt::OpenPGP::Util::get_random_bytes($padlen);
}
bin2mp(pack 'na*na*n', 2, $pad, $sym_alg, $sym_key,
unpack('%16C*', $sym_key));
}
sub _decode {
my $class = shift;
my($n) = @_;
my $ser = mp2bin($n);
return $class->error("Encoded data must start with 2")
unless unpack('C', $ser) == 2;
my $csum = unpack 'n', substr $ser, -2, 2, '';
my($pad, $sym_key) = split /\0/, $ser, 2;
my $sym_alg = ord substr $sym_key, 0, 1, '';
return $class->error("Encoded data has bad checksum")
unless unpack('%16C*', $sym_key) == $csum;
($sym_key, $sym_alg);
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::SessionKey - Encrypted Session Key
=head1 SYNOPSIS
use Crypt::OpenPGP::SessionKey;
my $public_key = Crypt::OpenPGP::Key::Public->new( 'RSA' );
my $key_data = 'f' x 64; ## Not a very good key :)
my $skey = Crypt::OpenPGP::SessionKey->new(
Key => $public_key,
SymKey => $key_data,
);
my $serialized = $skey->save;
my $secret_key = Crypt::OpenPGP::Key::Secret->new( 'RSA' );
( $key_data, my( $alg ) ) = $skey->decrypt( $secret_key );
=head1 DESCRIPTION
I<Crypt::OpenPGP::SessionKey> implements encrypted session key packets;
these packets store public-key-encrypted key data that, when decrypted
using the corresponding secret key, can be used to decrypt a block of
ciphertext--that is, a I<Crypt::OpenPGP::Ciphertext> object.
=head1 USAGE
=head2 Crypt::OpenPGP::SessionKey->new( %arg )
Creates a new encrypted session key packet object and returns that
object. If there are no arguments in I<%arg>, the object is created
empty; this is used, for example in I<parse> (below), to create an
empty packet which is then filled from the data in the buffer.
If you wish to initialize a non-empty object, I<%arg> can contain:
=over 4
=item * Key
A public key object; in other words, an object of a subclass of
I<Crypt::OpenPGP::Key::Private>. The public key is used to encrypt the
encoded session key such that it can only be decrypted by the secret
portion of the key.
This argument is required (for a non-empty object).
=item * SymKey
The symmetric cipher key: a string of octets that make up the key data
of the symmetric cipher key. This should be at least long enough for
the key length of your chosen cipher (see I<Cipher>, below), or, if
you have not specified a cipher, at least 64 bytes (to allow for long
cipher key sizes).
This argument is required (for a non-empty object).
=item * Cipher
The name (or ID) of a supported PGP cipher. See I<Crypt::OpenPGP::Cipher>
for a list of valid cipher names.
This argument is optional; by default I<Crypt::OpenPGP::Cipher> will
use C<DES3>.
=back
=head2 $skey->save
Serializes the session key packet and returns the string of octets.
=head2 Crypt::OpenPGP::SessionKey->parse($buffer)
Given I<$buffer>, a I<Crypt::OpenPGP::Buffer> object holding (or
with offset pointing to) an encrypted session key packet, returns
a new I<Crypt::OpenPGP::Ciphertext> object, initialized with the
data in the buffer.
=head2 $skey->decrypt($secret_key)
Given a secret key object I<$secret_key> (an object of a subclass of
I<Crypt::OpenPGP::Key::Public>), decrypts and decodes the encrypted
session key data. The key data includes the symmetric key itself,
along with a one-octet ID of the symmetric cipher used to encrypt
the message.
Returns a list containing two items: the symmetric key and the cipher
algorithm ID. These are suitable for passing off to the I<decrypt>
method of a I<Crypt::OpenPGP::Ciphertext> object to decrypt a block
of encrypted data.
=head2 $skey->key_id
Returns the key ID of the public key used to encrypt the session key;
this is necessary for finding the appropriate secret key to decrypt
the key.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

423
database/perl/vendor/lib/Crypt/OpenPGP/Signature.pm vendored Normal file
View File

@@ -0,0 +1,423 @@
package Crypt::OpenPGP::Signature;
use strict;
use Crypt::OpenPGP::Digest;
use Crypt::OpenPGP::Signature::SubPacket;
use Crypt::OpenPGP::Key::Public;
use Crypt::OpenPGP::Constants qw( DEFAULT_DIGEST );
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub pkt_hdrlen { 2 }
sub key_id {
my $sig = shift;
unless ($sig->{key_id}) {
my $sp = $sig->find_subpacket(16);
$sig->{key_id} = $sp->{data};
}
$sig->{key_id};
}
sub timestamp {
my $sig = shift;
$sig->{version} < 4 ?
$sig->{timestamp} :
$sig->find_subpacket(2)->{data};
}
sub digest {
my $sig = shift;
Crypt::OpenPGP::Digest->new($sig->{hash_alg});
}
sub find_subpacket {
my $sig = shift;
my($type) = @_;
my @sp = (@{$sig->{subpackets_hashed}}, @{$sig->{subpackets_unhashed}});
for my $sp (@sp) {
return $sp if $sp->{type} == $type;
}
}
sub new {
my $class = shift;
my $sig = bless { }, $class;
$sig->init(@_);
}
sub init {
my $sig = shift;
my %param = @_;
$sig->{subpackets_hashed} = [];
$sig->{subpackets_unhashed} = [];
if ((my $obj = $param{Data}) && (my $cert = $param{Key})) {
$sig->{version} = $param{Version} || 4;
$sig->{type} = $param{Type} || 0x00;
$sig->{hash_alg} = $param{Digest} ? $param{Digest} :
$sig->{version} == 4 ? DEFAULT_DIGEST : 1;
$sig->{pk_alg} = $cert->key->alg_id;
if ($sig->{version} < 4) {
$sig->{timestamp} = time;
$sig->{key_id} = $cert->key_id;
$sig->{hash_len} = 5;
}
else {
my $sp = Crypt::OpenPGP::Signature::SubPacket->new;
$sp->{type} = 2;
$sp->{data} = time;
push @{ $sig->{subpackets_hashed} }, $sp;
$sp = Crypt::OpenPGP::Signature::SubPacket->new;
$sp->{type} = 16;
$sp->{data} = $cert->key_id;
push @{ $sig->{subpackets_unhashed} }, $sp;
}
my $hash = $sig->hash_data(ref($obj) eq 'ARRAY' ? @$obj : $obj);
$sig->{chk} = substr $hash, 0, 2;
my $sig_data = $cert->key->sign($hash,
Crypt::OpenPGP::Digest->alg($sig->{hash_alg}));
my @sig = $cert->key->sig_props;
for my $e (@sig) {
$sig->{$e} = $sig_data->{$e};
}
}
$sig;
}
sub sig_trailer {
my $sig = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
if ($sig->{version} < 4) {
$buf->put_int8($sig->{type});
$buf->put_int32($sig->{timestamp});
}
else {
$buf->put_int8($sig->{version});
$buf->put_int8($sig->{type});
$buf->put_int8($sig->{pk_alg});
$buf->put_int8($sig->{hash_alg});
my $sp_data = $sig->_save_subpackets('hashed');
$buf->put_int16(defined $sp_data ? length($sp_data) : 0);
$buf->put_bytes($sp_data) if $sp_data;
my $len = $buf->length;
$buf->put_int8($sig->{version});
$buf->put_int8(0xff);
$buf->put_int32($len);
}
$buf->bytes;
}
sub parse {
my $class = shift;
my($buf) = @_;
my $sig = $class->new;
$sig->{version} = $buf->get_int8;
if ($sig->{version} < 4) {
$sig->{sig_data} = $buf->bytes($buf->offset+1, 5);
$sig->{hash_len} = $buf->get_int8;
return $class->error("Hash len $sig->{hash_len} != 5")
unless $sig->{hash_len} == 5;
$sig->{type} = $buf->get_int8;
$sig->{timestamp} = $buf->get_int32;
$sig->{key_id} = $buf->get_bytes(8);
$sig->{pk_alg} = $buf->get_int8;
$sig->{hash_alg} = $buf->get_int8;
}
else {
$sig->{sig_data} = $buf->bytes($buf->offset-1, 6);
$sig->{type} = $buf->get_int8;
$sig->{pk_alg} = $buf->get_int8;
$sig->{hash_alg} = $buf->get_int8;
for my $h (qw( hashed unhashed )) {
my $subpack_len = $buf->get_int16;
my $sp_buf = $buf->extract($subpack_len);
$sig->{sig_data} .= $sp_buf->bytes if $h eq 'hashed';
while ($sp_buf->offset < $sp_buf->length) {
my $len = $sp_buf->get_int8;
if ($len >= 192 && $len < 255) {
my $len2 = $sp_buf->get_int8;
$len = (($len-192) << 8) + $len2 + 192;
} elsif ($len == 255) {
$len = $sp_buf->get_int32;
}
my $this_buf = $sp_buf->extract($len);
my $sp = Crypt::OpenPGP::Signature::SubPacket->parse($this_buf);
push @{ $sig->{"subpackets_$h"} }, $sp;
}
}
}
$sig->{chk} = $buf->get_bytes(2);
## XXX should be Crypt::OpenPGP::Signature->new($sig->{pk_alg})?
my $key = Crypt::OpenPGP::Key::Public->new($sig->{pk_alg})
or return $class->error(Crypt::OpenPGP::Key::Public->errstr);
my @sig = $key->sig_props;
for my $e (@sig) {
$sig->{$e} = $buf->get_mp_int;
}
$sig;
}
sub save {
my $sig = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
$buf->put_int8($sig->{version});
if ($sig->{version} < 4) {
$buf->put_int8($sig->{hash_len});
$buf->put_int8($sig->{type});
$buf->put_int32($sig->{timestamp});
$buf->put_bytes($sig->{key_id}, 8);
$buf->put_int8($sig->{pk_alg});
$buf->put_int8($sig->{hash_alg});
}
else {
$buf->put_int8($sig->{type});
$buf->put_int8($sig->{pk_alg});
$buf->put_int8($sig->{hash_alg});
for my $h (qw( hashed unhashed )) {
my $sp_data = $sig->_save_subpackets($h);
$buf->put_int16(defined $sp_data ? length($sp_data) : 0);
$buf->put_bytes($sp_data) if $sp_data;
}
}
$buf->put_bytes($sig->{chk}, 2);
## XXX should be Crypt::OpenPGP::Signature->new($sig->{pk_alg})?
my $key = Crypt::OpenPGP::Key::Public->new($sig->{pk_alg});
my @sig = $key->sig_props;
for my $e (@sig) {
$buf->put_mp_int($sig->{$e});
}
$buf->bytes;
}
sub _save_subpackets {
my $sig = shift;
my($h) = @_;
my @sp;
return unless $sig->{"subpackets_$h"} &&
(@sp = @{ $sig->{"subpackets_$h"} });
my $sp_buf = Crypt::OpenPGP::Buffer->new;
for my $sp (@sp) {
my $data = $sp->save;
my $len = length $data;
if ($len < 192) {
$sp_buf->put_int8($len);
} elsif ($len < 8384) {
$len -= 192;
$sp_buf->put_int8( int($len / 256) + 192 );
$sp_buf->put_int8( $len % 256 );
} else {
$sp_buf->put_int8(255);
$sp_buf->put_int32($len);
}
$sp_buf->put_bytes($data);
}
$sp_buf->bytes;
}
sub hash_data {
my $sig = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
my $type = ref($_[0]);
if ($type eq 'Crypt::OpenPGP::Certificate') {
my $cert = shift;
$buf->put_int8(0x99);
my $pk = $cert->public_cert->save;
$buf->put_int16(length $pk);
$buf->put_bytes($pk);
if (@_) {
if (ref($_[0]) eq 'Crypt::OpenPGP::UserID') {
my $uid = shift;
my $ud = $uid->save;
if ($sig->{version} >= 4) {
$buf->put_int8(0xb4);
$buf->put_int32(length $ud);
}
$buf->put_bytes($ud);
}
elsif (ref($_[0]) eq 'Crypt::OpenPGP::Certificate') {
my $subcert = shift;
$buf->put_int8(0x99);
my $k = $subcert->public_cert->save;
$buf->put_int16(length $k);
$buf->put_bytes($k);
}
}
}
elsif ($type eq 'Crypt::OpenPGP::Plaintext') {
my $pt = shift;
my $data = $pt->data;
if ($pt->mode eq 't') {
require Crypt::OpenPGP::Util;
$buf->put_bytes(Crypt::OpenPGP::Util::canonical_text($data));
}
else {
$buf->put_bytes($data);
}
}
$buf->put_bytes($sig->sig_trailer);
my $hash = Crypt::OpenPGP::Digest->new($sig->{hash_alg}) or
return $sig->error( Crypt::OpenPGP::Digest->errstr );
$hash->hash($buf->bytes);
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Signature - Signature packet
=head1 SYNOPSIS
use Crypt::OpenPGP::Signature;
my $cert = Crypt::OpenPGP::Certificate->new;
my $plaintext = 'foo bar';
my $sig = Crypt::OpenPGP::Signature->new(
Key => $cert,
Data => $plaintext,
);
my $serialized = $sig->save;
=head1 DESCRIPTION
I<Crypt::OpenPGP::Signature> implements PGP signature packets and
provides functionality for hashing PGP packets to obtain message
digests; these digests are then signed by the secret key to form a
signature.
I<Crypt::OpenPGP::Signature> reads and writes both version 3 and version
4 signatures, along with the signature subpackets found in version 4
(see I<Crypt::OpenPGP::Signature::SubPacket>).
=head1 USAGE
=head2 Crypt::OpenPGP::Signature->new( %arg )
Creates a new signature packet object and returns that object. If
there are no arguments in I<%arg>, the object is created empty; this is
used, for example, in I<parse> (below), to create an empty packet which is
then filled from the data in the buffer.
If you wish to initialize a non-empty object, I<%arg> can contain:
=over 4
=item * Data
A PGP packet object of some kind. Currently the two supported objects
are I<Crypt::OpenPGP::Certificate> objects, to create self-signatures
for keyrings, and I<Crypt::OpenPGP::Plaintext> objects, for signatures
on blocks of data.
This argument is required (for a non-empty packet).
=item * Key
A secret-key certificate that can be used to sign the data. In other
words an object of type I<Crypt::OpenPGP::Certificate> that holds
a secret key.
This argument is required.
=item * Version
The packet format version of the signature. Valid values are either
C<3> or C<4>; version C<4> signatures are the default, but will be
incompatible with older PGP implementations; for example, PGP2 will
only read version 3 signatures; PGP5 can read version 4 signatures,
but only on signatures of data packets (not on key signatures).
This argument is optional; the default is version 4.
=item * Type
Specifies the type of signature (data, key, etc.). Valid values can
be found in the OpenPGP RFC, section 5.2.1.
This argument is optional; the default is C<0x00>, signature of a
binary document.
=item * Digest
The digest algorithm to use when generating the digest of the data
to be signed. See the documentation for I<Crypt::OpenPGP::Digest>
for a list of valid values.
This argument is optional; the default is C<SHA1>.
=back
=head2 $sig->save
Serializes the signature packet and returns a string of octets.
=head2 Crypt::OpenPGP::Signature->parse($buffer)
Given I<$buffer>, a I<Crypt::OpenPGP::Buffer> object holding (or
with offset pointing to) a signature packet, returns a new
I<Crypt::OpenPGP::Signature> object, initialized with the signature
data in the buffer.
=head2 $sig->hash_data(@data)
Prepares a digital hash of the packets in I<@data>; the hashing method
depends on the type of packets in I<@data>, and the hashing algorithm used
depends on the algorithm associated with the I<Crypt::OpenPGP::Signature>
object I<$sig>. This digital hash is then signed to produce the signature
itself.
You generally do not need to use this method unless you have not passed in
the I<Data> parameter to I<new> (above).
There are two possible packet types that can be included in I<@data>:
=over 4
=item * Key Certificate and User ID
An OpenPGP keyblock contains a key certificate and a signature of the
public key and user ID made by the secret key. This is called a
self-signature. To produce a self-signature, I<@data> should contain two
packet objects: a I<Crypt::OpenPGP::Certificate> object and a
I<Crypt::OpenPGP::UserID> object. For example:
my $hash = $sig->hash_data($cert, $id)
or die $sig->errstr;
=item * Plaintext
To sign a piece of plaintext, pass in a I<Crypt::OpenPGP::Plaintext> object.
This is a standard OpenPGP signature.
my $pt = Crypt::OpenPGP::Plaintext->new( Data => 'foo bar' );
my $hash = $sig->hash_data($pt)
or die $sig->errstr;
=back
=head2 $sig->key_id
Returns the ID of the key that created the signature.
=head2 $sig->timestamp
Returns the time that the signature was created in Unix epoch time (seconds
since 1970).
=head2 $sig->digest
Returns a Crypt::OpenPGP::Digest object representing the digest algorithm
used by the signature.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

140
database/perl/vendor/lib/Crypt/OpenPGP/Signature/SubPacket.pm vendored Normal file
View File

@@ -0,0 +1,140 @@
package Crypt::OpenPGP::Signature::SubPacket;
use strict;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
use vars qw( %SUBPACKET_TYPES );
%SUBPACKET_TYPES = (
2 => { name => 'Signature creation time',
r => sub { $_[0]->get_int32 },
w => sub { $_[0]->put_int32($_[1]) } },
3 => { name => 'Signature expiration time',
r => sub { $_[0]->get_int32 },
w => sub { $_[0]->put_int32($_[1]) } },
4 => { name => 'Exportable certification',
r => sub { $_[0]->get_int8 },
w => sub { $_[0]->put_int8($_[1]) } },
5 => { name => 'Trust signature',
r => sub { $_[0]->get_int8 },
w => sub { $_[0]->put_int8($_[1]) } },
6 => { name => 'Regular expression',
r => sub { $_[0]->bytes },
w => sub { $_[0]->append($_[1]) } },
7 => { name => 'Revocable',
r => sub { $_[0]->get_int8 },
w => sub { $_[0]->put_int8($_[1]) } },
9 => { name => 'Key expiration time',
r => sub { $_[0]->get_int32 },
w => sub { $_[0]->put_int32($_[1]) } },
10 => { name => '(Unsupported placeholder',
r => sub { },
w => sub { } },
11 => { name => 'Preferred symmetric algorithms',
r => sub { [ unpack 'C*', $_[0]->bytes ] },
w => sub { $_[0]->append(pack 'C*', @{ $_[1] }) } },
12 => { name => 'Revocation key',
r => sub {
{ class => $_[0]->get_int8,
alg_id => $_[0]->get_int8,
fingerprint => $_[0]->get_bytes(20) } },
w => sub {
$_[0]->put_int8($_[1]->{class});
$_[0]->put_int8($_[1]->{alg_id});
$_[0]->put_bytes($_[1]->{fingerprint}, 20) } },
16 => { name => 'Issuer key ID',
r => sub { $_[0]->get_bytes(8) },
w => sub { $_[0]->put_bytes($_[1], 8) } },
20 => { name => 'Notation data',
r => sub {
{ flags => $_[0]->get_int32,
name => $_[0]->get_bytes($_[0]->get_int16),
value => $_[0]->get_bytes($_[0]->get_int16) } },
w => sub {
$_[0]->put_int32($_[1]->{flags});
$_[0]->put_int16(length $_[1]->{name});
$_[0]->put_bytes($_[1]->{name});
$_[0]->put_int16(length $_[1]->{value});
$_[0]->put_bytes($_[1]->{value}) } },
21 => { name => 'Preferred hash algorithms',
r => sub { [ unpack 'C', $_[0]->bytes ] },
w => sub { $_[0]->put_bytes(pack 'C*', @{ $_[1] }) } },
22 => { name => 'Preferred compression algorithms',
r => sub { [ unpack 'C', $_[0]->bytes ] },
w => sub { $_[0]->put_bytes(pack 'C*', @{ $_[1] }) } },
23 => { name => 'Key server preferences',
r => sub { $_[0]->bytes },
w => sub { $_[0]->append($_[1]) } },
24 => { name => 'Preferred key server',
r => sub { $_[0]->bytes },
w => sub { $_[0]->append($_[1]) } },
25 => { name => 'Primary user ID',
r => sub { $_[0]->get_int8 },
w => sub { $_[0]->put_int8($_[1]) } },
26 => { name => 'Policy URL',
r => sub { $_[0]->bytes },
w => sub { $_[0]->append($_[1]) } },
27 => { name => 'Key flags',
r => sub { $_[0]->bytes },
w => sub { $_[0]->append($_[1]) } },
28 => { name => 'Signer\'s user ID',
r => sub { $_[0]->bytes },
w => sub { $_[0]->append($_[1]) } },
29 => { name => 'Reason for revocation',
r => sub {
{ code => $_[0]->get_int8,
reason => $_[0]->get_bytes($_[0]->length -
$_[0]->offset) } },
w => sub {
$_[0]->put_int8($_[1]->{code});
$_[0]->put_bytes($_[1]->{reason}) } },
);
sub new { bless { }, $_[0] }
sub parse {
my $class = shift;
my($buf) = @_;
my $sp = $class->new;
my $tag = $buf->get_int8;
$sp->{critical} = $tag & 0x80;
$sp->{type} = $tag & 0x7f;
$buf->bytes(0, 1, ''); ## Cut off tag byte
$buf->{offset} = 0;
my $ref = $SUBPACKET_TYPES{$sp->{type}};
$sp->{data} = $ref->{r}->($buf) if $ref && $ref->{r};
$sp;
}
sub save {
my $sp = shift;
my $buf = Crypt::OpenPGP::Buffer->new;
my $tag = $sp->{type};
$tag |= 0x80 if $sp->{critical};
$buf->put_int8($tag);
my $ref = $SUBPACKET_TYPES{$sp->{type}};
$ref->{w}->($buf, $sp->{data}) if $ref && $ref->{w};
$buf->bytes;
}
1;

36
database/perl/vendor/lib/Crypt/OpenPGP/Trust.pm vendored Normal file
View File

@@ -0,0 +1,36 @@
package Crypt::OpenPGP::Trust;
use strict;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub new { bless { }, $_[0] }
sub flags { $_[0]->{flags} }
sub parse {
my $class = shift;
my($buf) = @_;
my $trust = $class->new;
$trust->{flags} = $buf->get_int8;
$trust;
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Trust - PGP Trust packet
=head1 DESCRIPTION
I<Crypt::OpenPGP::Trust> is a PGP Trust packet. From the OpenPGP
RFC: "Trust packets contain data that record the user's specifications
of which key holders are trustworthy introducers, along with other
information that implementing software uses for trust information."
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

90
database/perl/vendor/lib/Crypt/OpenPGP/UserID.pm vendored Normal file
View File

@@ -0,0 +1,90 @@
package Crypt::OpenPGP::UserID;
use strict;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
sub new {
my $id = bless { }, shift;
$id->init(@_);
}
sub init {
my $id = shift;
my %param = @_;
if (my $ident = $param{Identity}) {
$id->{id} = $ident;
}
$id;
}
sub id { $_[0]->{id} }
sub parse {
my $class = shift;
my($buf) = @_;
my $id = $class->new;
$id->{id} = $buf->bytes;
$id;
}
sub save { $_[0]->{id} }
1;
__END__
=head1 NAME
Crypt::OpenPGP::UserID - PGP User ID packet
=head1 SYNOPSIS
use Crypt::OpenPGP::UserID;
my $uid = Crypt::OpenPGP::UserID->new( Identity => 'Foo' );
my $serialized = $uid->save;
my $identity = $uid->id;
=head1 DESCRIPTION
I<Crypt::OpenPGP::UserID> is a PGP User ID packet. Such a packet is
used to represent the name and email address of the key holder,
and typically contains an RFC822 mail name like
Foo Bar <foo@bar.com>
=head1 USAGE
=head2 Crypt::OpenPGP::UserID->new( [ Identity => $identity ] )
Creates a new User ID packet object and returns that object. If you
do not supply an identity, the object is created empty; this is used,
for example, in I<parse> (below), to create an empty packet which is
then filled from the data in the buffer.
If you wish to initialize a non-empty object, supply I<new> with
the I<Identity> parameter along with a value I<$identity> which
should generally be in RFC822 form (above).
=head2 $uid->save
Returns the text of the user ID packet; this is the string passed to
I<new> (above) as I<$identity>, for example.
=head2 Crypt::OpenPGP::UserID->parse($buffer)
Given I<$buffer>, a I<Crypt::OpenPGP::Buffer> object holding (or
with offset pointing to) a User ID packet, returns a new
<Crypt::OpenPGP::UserID> object, initialized with the user ID data
in the buffer.
=head2 $uid->id
Returns the user ID data (eg. the string passed as I<$identity> to
I<new>, above).
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

199
database/perl/vendor/lib/Crypt/OpenPGP/Util.pm vendored Normal file
View File

@@ -0,0 +1,199 @@
package Crypt::OpenPGP::Util;
use strict;
# For some reason, FastCalc causes problems. Restrict to one of these 3 backends
use Math::BigInt only => 'Pari,GMP,Calc';
use vars qw( @EXPORT_OK @ISA );
use Exporter;
@EXPORT_OK = qw( bitsize bin2bigint bin2mp bigint2bin mp2bin mod_exp mod_inverse
dash_escape dash_unescape canonical_text );
@ISA = qw( Exporter );
sub bitsize {
my $bigint = Math::BigInt->new($_[0]);
return $bigint->bfloor($bigint->blog(2)) + 1;
}
sub bin2bigint { $_[0] ? Math::BigInt->new('0x' . unpack 'H*', $_[0]) : 0 }
*bin2mp = \&bin2bigint;
sub bigint2bin {
my($p) = @_;
$p = _ensure_bigint($p);
my $base = _ensure_bigint(1) << _ensure_bigint(4*8);
my $res = '';
while ($p != 0) {
my $r = $p % $base;
$p = ($p-$r) / $base;
my $buf = pack 'N', $r;
if ($p == 0) {
$buf = $r >= 16777216 ? $buf :
$r >= 65536 ? substr($buf, -3, 3) :
$r >= 256 ? substr($buf, -2, 2) :
substr($buf, -1, 1);
}
$res = $buf . $res;
}
$res;
}
*mp2bin = \&bigint2bin;
sub mod_exp {
my($a, $exp, $n) = @_;
$a = _ensure_bigint($a);
$a->copy->bmodpow($exp, $n);
}
sub mod_inverse {
my($a, $n) = @_;
$a = _ensure_bigint($a);
$a->copy->bmodinv($n);
}
sub dash_escape {
my($data) = @_;
$data =~ s/^-/- -/mg;
$data;
}
sub dash_unescape {
my($data) = @_;
$data =~ s/^-\s//mg;
$data;
}
sub canonical_text {
my($text) = @_;
my @lines = split /\n/, $text, -1;
for my $l (@lines) {
## pgp2 and pgp5 do not trim trailing whitespace from "canonical text"
## signatures, only from cleartext signatures.
## See:
## http://cert.uni-stuttgart.de/archive/ietf-openpgp/2000/01/msg00033.html
if ($Crypt::OpenPGP::Globals::Trim_trailing_ws) {
$l =~ s/[ \t\r\n]*$//;
} else {
$l =~ s/[\r\n]*$//;
}
}
join "\r\n", @lines;
}
sub _ensure_bigint {
my $num = shift;
if ($num && (! ref $num || ! $num->isa('Math::BigInt'))) {
$num = Math::BigInt->new($num);
}
return $num;
}
sub get_random_bytes {
my $length = shift;
if (eval 'require Crypt::Random; 1;') {
return Crypt::Random::makerandom_octet( Length => $length);
}
elsif (eval 'require Bytes::Random::Secure; 1;') {
return Bytes::Random::Secure::random_bytes($length);
}
else {
die "No random source available!";
}
}
sub get_random_bigint {
my $bits = shift;
if (eval 'require Crypt::Random; 1;') {
my $pari = Crypt::Random::makerandom( Size => $bits, Strength => 0 );
return Math::BigInt->new($pari);
}
elsif (eval 'require Bytes::Random::Secure; 1;') {
my $hex = Bytes::Random::Secure::random_bytes_hex(int(($bits + 7) / 8));
my $val = Math::BigInt->new("0x$hex");
# Get exactly the correct number of bits.
$val->brsft(8 - ($bits & 7)) if ($bits & 7);
# Make sure the top bit is set.
$val->bior(Math::BigInt->bone->blsft($bits-1));
return $val;
}
else {
die "No random source available!";
}
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Util - Miscellaneous utility functions
=head1 DESCRIPTION
I<Crypt::OpenPGP::Util> contains a set of exportable utility functions
used through the I<Crypt::OpenPGP> set of libraries.
=head2 bitsize($n)
Returns the number of bits in the I<Math::BigInt> integer object
I<$n>.
=head2 bin2bigint($string)
Given a string I<$string> of any length, treats the string as a
base-256 representation of an integer, and returns that integer,
a I<Math::BigInt> object.
I<bin2mp> is an alias for this function, for backwards
compatibility reasons.
=head2 bigint2bin($int)
Given a biginteger I<$int> (a I<Math::BigInt> object), linearizes
the integer into an octet string, and returns the octet string.
I<mp2bin> is an alias for this function, for backwards
compatibility reasons.
=head2 mod_exp($a, $exp, $n)
Computes $a ^ $exp mod $n and returns the value. The calculations
are done using I<Math::BigInt>, and the return value is a I<Math::BigInt>
object.
=head2 mod_inverse($a, $n)
Computes the multiplicative inverse of $a mod $n and returns the
value. The calculations are done using I<Math::BigInt>, and the
return value is a I<Math::BigInt> object.
=head2 canonical_text($text)
Takes a piece of text content I<$text> and formats it into PGP canonical
text, where: 1) all whitespace at the end of lines is stripped, and
2) all line endings are made up of a carriage return followed by a line
feed. Returns the canonical form of the text.
=head2 dash_escape($text)
Escapes I<$text> for use in a cleartext signature; the escaping looks
for any line starting with a dash, and on such lines prepends a dash
('-') followed by a space (' '). Returns the escaped text.
=head1 AUTHOR & COPYRIGHTS
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut

222
database/perl/vendor/lib/Crypt/OpenPGP/Words.pm vendored Normal file
View File

@@ -0,0 +1,222 @@
package Crypt::OpenPGP::Words;
use strict;
use Crypt::OpenPGP::ErrorHandler;
use base qw( Crypt::OpenPGP::ErrorHandler );
## Biometric word lists as defined in manual for
## PGPFreeware for Windows 6.5.1, Appendix D
## Code based on Mike Dillon's PGPWords.pm
{
my @WORDS;
sub encode_hex { $_[0]->encode(pack 'H*', $_[1]) }
sub encode {
my $class = shift;
my($data) = @_;
my $toggle = 1;
map { $WORDS[$toggle = !$toggle][$_] } unpack 'C*', $data;
}
@WORDS = (
## Two-syllable words for encoding odd bytes
[ qw(
aardvark absurd accrue acme
adrift adult afflict ahead
aimless Algol allow alone
ammo ancient apple artist
assume Athens atlas Aztec
baboon backfield backward banjo
beaming bedlamp beehive beeswax
befriend Belfast berserk billiard
bison blackjack blockade blowtorch
bluebird bombast bookshelf brackish
breadline breakup brickyard briefcase
Burbank button buzzard cement
chairlift chatter checkup chisel
choking chopper Christmas clamshell
classic classroom cleanup clockwork
cobra commence concert cowbell
crackdown cranky crowfoot crucial
crumpled crusade cubic dashboard
deadbolt deckhand dogsled dragnet
drainage dreadful drifter dropper
drumbeat drunken Dupont dwelling
eating edict egghead eightball
endorse endow enlist erase
escape exceed eyeglass eyetooth
facial fallout flagpole flatfoot
flytrap fracture framework freedom
frighten gazelle Geiger glitter
glucose goggles goldfish gremlin
guidance hamlet highchair hockey
indoors indulge inverse involve
island jawbone keyboard kickoff
kiwi klaxon locale lockup
merit minnow miser Mohawk
mural music necklace Neptune
newborn nightbird Oakland obtuse
offload optic orca payday
peachy pheasant physique playhouse
Pluto preclude prefer preshrunk
printer prowler pupil puppy
python quadrant quiver quota
ragtime ratchet rebirth reform
regain reindeer rematch repay
retouch revenge reward rhythm
ribcage ringbolt robust rocker
ruffled sailboat sawdust scallion
scenic scorecard Scotland seabird
select sentence shadow shamrock
showgirl skullcap skydive slingshot
slowdown snapline snapshot snowcap
snowslide solo southward soybean
spaniel spearhead spellbind spheroid
spigot spindle spyglass stagehand
stagnate stairway standard stapler
steamship sterling stockman stopwatch
stormy sugar surmount suspense
sweatband swelter tactics talon
tapeworm tempest tiger tissue
tonic topmost tracker transit
trauma treadmill Trojan trouble
tumor tunnel tycoon uncut
unearth unwind uproot upset
upshot vapor village virus
Vulcan waffle wallet watchword
wayside willow woodlark Zulu
) ],
## Three-syllable words for encoding even bytes
[ qw(
adroitness adviser aftermath aggregate
alkali almighty amulet amusement
antenna applicant Apollo armistice
article asteroid Atlantic atmosphere
autopsy Babylon backwater barbecue
belowground bifocals bodyguard bookseller
borderline bottomless Bradbury bravado
Brazilian breakaway Burlington businessman
butterfat Camelot candidate cannonball
Capricorn caravan caretaker celebrate
cellulose certify chambermaid Cherokee
Chicago clergyman coherence combustion
commando company component concurrent
confidence conformist congregate consensus
consulting corporate corrosion councilman
crossover crucifix cumbersome customer
Dakota decadence December decimal
designing detector detergent determine
dictator dinosaur direction disable
disbelief disruptive distortion document
embezzle enchanting enrollment enterprise
equation equipment escapade Eskimo
everyday examine existence exodus
fascinate filament finicky forever
fortitude frequency gadgetry Galveston
getaway glossary gossamer graduate
gravity guitarist hamburger Hamilton
handiwork hazardous headwaters hemisphere
hesitate hideaway holiness hurricane
hydraulic impartial impetus inception
indigo inertia infancy inferno
informant insincere insurgent integrate
intention inventive Istanbul Jamaica
Jupiter leprosy letterhead liberty
maritime matchmaker maverick Medusa
megaton microscope microwave midsummer
millionaire miracle misnomer molasses
molecule Montana monument mosquito
narrative nebula newsletter Norwegian
October Ohio onlooker opulent
Orlando outfielder Pacific pandemic
Pandora paperweight paragon paragraph
paramount passenger pedigree Pegasus
penetrate perceptive performance pharmacy
phonetic photograph pioneer pocketful
politeness positive potato processor
provincial proximate puberty publisher
pyramid quantity racketeer rebellion
recipe recover repellent replica
reproduce resistor responsive retraction
retrieval retrospect revenue revival
revolver sandalwood sardonic Saturday
savagery scavenger sensation sociable
souvenir specialist speculate stethoscope
stupendous supportive surrender suspicious
sympathy tambourine telephone therapist
tobacco tolerance tomorrow torpedo
tradition travesty trombonist truncated
typewriter ultimate undaunted underfoot
unicorn unify universe unravel
upcoming vacancy vagabond vertigo
Virginia visitor vocalist voyager
warranty Waterloo whimsical Wichita
Wilmington Wyoming yesteryear Yucatan
) ]
);
}
1;
__END__
=head1 NAME
Crypt::OpenPGP::Words - Create English-word encodings
=head1 SYNOPSIS
use Crypt::OpenPGP::Words;
my $cert = Crypt::OpenPGP::Certificate->new;
my @words = Crypt::OpenPGP::Words->encode( $cert->fingerprint );
=head1 DESCRIPTION
I<Crypt::OpenPGP::Words> provides routines to convert either octet or
hexadecimal strings into a list of English words, using the same
algorithm and biometric word lists as used in PGP (see
I<AUTHOR & COPYRIGHTS> for source of word lists).
In PGP this is often used for creating memorable fingerprints, the idea
being that it is easier to associate a list of words with one's key
than a string of hex digits. See the I<fingerprint_words> method in
I<Crypt::OpenPGP::Certificate> for an interface to word fingerprints.
=head1 USAGE
=head2 Crypt::OpenPGP::Words->encode( $octet_str )
Given an octet string I<$octet_str>, encodes that string into a list of
English words.
The encoding is performed by splitting the string into octets; the list
of octets is then iterated over. There are two lists of words, 256 words
each. Two-syllable words are used for encoding odd iterations through
the loop; three-syllable words for even iterations. The word list is
formed by treating each octet as an index into the appropriate word list
(two- or three-syllable), then adding the word at that index to the list.
Returns the list of words.
=head2 Crypt::OpenPGP::Words->encode_hex( $hex_str )
Performs the exact same encoding as I<encode>; I<$hex_str>, a string
of hexadecimal digits, is first transformed into a string of octets,
then passed to I<encode>.
Returns the list of words.
=head1 AUTHOR & COPYRIGHTS
Based on PGPWords.pm by Mike Dillon. Biometric word lists as defined in
manual for PGPFreeware for Windows 6.5.1, Appendix D
Please see the Crypt::OpenPGP manpage for author, copyright, and
license information.
=cut