diff options
| author | Norbert Preining <preining@logic.at> | 2010-02-28 09:36:33 +0000 |
|---|---|---|
| committer | Norbert Preining <preining@logic.at> | 2010-02-28 09:36:33 +0000 |
| commit | 5589232e99f0fa13868111280c5b64ce9dc25730 (patch) | |
| tree | 28f2e6ff422108ac87934aff9c3fc5911963625c /Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP | |
| parent | a6f5de6eed80d66fbd23ceabda7edf22b8162236 (diff) | |
add a tlperl.straw directory for public inspection
git-svn-id: svn://tug.org/texlive/trunk@17235 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP')
38 files changed, 5688 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Armour.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Armour.pm new file mode 100755 index 00000000000..26177b77c9e --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Armour.pm @@ -0,0 +1,209 @@ +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; + 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 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>. + +=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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Buffer.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Buffer.pm new file mode 100755 index 00000000000..7a8c7bda500 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Buffer.pm @@ -0,0 +1,75 @@ +package Crypt::OpenPGP::Buffer; +use base qw( Data::Buffer ); + +use Crypt::OpenPGP::Util qw( bin2mp mp2bin bitsize ); + +sub get_mp_int { + my $buf = shift; + my $bits = $buf->get_int16; + my $bytes = int(($bits + 7) / 8); + my $off = $buf->{offset}; + $buf->{offset} += $bytes; + bin2mp($buf->bytes($off, $bytes)); +} + +sub put_mp_int { + my $buf = shift; + my($n) = @_; + $buf->put_int16(bitsize($n)); + $buf->put_bytes(mp2bin($n)); +} + +1; +__END__ + +=head1 NAME + +Crypt::OpenPGP::Buffer - Binary in/out buffer + +=head1 SYNOPSIS + + use Crypt::OpenPGP::Buffer; + + my $n = PARI( 1 ); + + my $buf = Crypt::OpenPGP::Buffer->new; + $buf->put_mp_int($n); + + my $m = $buf->get_mp_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::Pari> +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_mp_int + +Grabs a multiple-precision integer from the buffer I<$buf> (starting +after the current offset position in the buffer) and returns that +integer. + +=head2 $buf->put_mp_int($n) + +Serializes a multiple-precision integer into the buffer in the above +form (two-octet bitsize, string of octets). + +=head1 AUTHOR & COPYRIGHTS + +Please see the Crypt::OpenPGP manpage for author, copyright, and +license information. + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/CFB.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/CFB.pm new file mode 100755 index 00000000000..adcc182640f --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/CFB.pm @@ -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) { + 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) { + 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 12.8 +(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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Certificate.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Certificate.pm new file mode 100755 index 00000000000..72d344b9118 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Certificate.pm @@ -0,0 +1,562 @@ +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); + require Crypt::Random; + $cert->{iv} = Crypt::Random::makerandom_octet( Length => 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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Cipher.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Cipher.pm new file mode 100755 index 00000000000..8476657bbe2 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Cipher.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Ciphertext.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Ciphertext.pm new file mode 100755 index 00000000000..4b76e0a104d --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Ciphertext.pm @@ -0,0 +1,221 @@ +package Crypt::OpenPGP::Ciphertext; +use strict; + +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; + require Crypt::Random; + my $alg = $param{Cipher} || DEFAULT_CIPHER; + my $cipher = Crypt::OpenPGP::Cipher->new($alg, $key); + my $bs = $cipher->blocksize; + my $pad = Crypt::Random::makerandom_octet( Length => $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 12.8 (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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Compressed.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Compressed.pm new file mode 100755 index 00000000000..3d9c4fc2b8f --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Compressed.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Config.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Config.pm new file mode 100755 index 00000000000..ee5dc41442d --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Config.pm @@ -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; diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Constants.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Constants.pm new file mode 100755 index 00000000000..7ad9e14a477 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Constants.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Digest.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Digest.pm new file mode 100755 index 00000000000..6b76cadfc9c --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Digest.pm @@ -0,0 +1,147 @@ +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', +); +%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::SHA1; + $dig->{md} = \&Digest::SHA1::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; +} + +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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/ErrorHandler.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/ErrorHandler.pm new file mode 100755 index 00000000000..fd28b0c04ae --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/ErrorHandler.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key.pm new file mode 100755 index 00000000000..0fd5edc4a65 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public.pm new file mode 100755 index 00000000000..837d81f4d87 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public.pm @@ -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; diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public/DSA.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public/DSA.pm new file mode 100755 index 00000000000..321c62c913f --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public/DSA.pm @@ -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; diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public/ElGamal.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public/ElGamal.pm new file mode 100755 index 00000000000..a6f589c0f82 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public/ElGamal.pm @@ -0,0 +1,80 @@ +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::Pari qw( Mod lift gcd ); + +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 = Mod($b, $key->p); + $b = lift($b * $M); + { a => $a, b => $b }; +} + +sub gen_k { + my($p) = @_; + ## XXX choose bitsize based on bitsize of $p + my $bits = 198; + my $p_minus1 = $p - 1; + require Crypt::Random; + my $k = Crypt::Random::makerandom( Size => $bits, Strength => 0 ); + while (1) { + last if gcd($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; diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public/RSA.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public/RSA.pm new file mode 100755 index 00000000000..1ebca3397bd --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Public/RSA.pm @@ -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->errstr( $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; diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret.pm new file mode 100755 index 00000000000..3a93e9afe60 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret.pm @@ -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; diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret/DSA.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret/DSA.pm new file mode 100755 index 00000000000..cfb1bbec4c4 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret/DSA.pm @@ -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; diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret/ElGamal.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret/ElGamal.pm new file mode 100755 index 00000000000..b7d6eb3d7b1 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret/ElGamal.pm @@ -0,0 +1,56 @@ +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::Pari qw( Mod lift ); + +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 $output = Mod($C->{b}, $p); + lift($output * $t1); +} + +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; diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret/RSA.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret/RSA.pm new file mode 100755 index 00000000000..4db25036456 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Key/Secret/RSA.pm @@ -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; diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/KeyBlock.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/KeyBlock.pm new file mode 100755 index 00000000000..5784bbb11ac --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/KeyBlock.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/KeyRing.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/KeyRing.pm new file mode 100755 index 00000000000..6709ed47a77 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/KeyRing.pm @@ -0,0 +1,267 @@ +package Crypt::OpenPGP::KeyRing; +use strict; + +use Crypt::OpenPGP::Constants qw( PGP_PKT_USER_ID + PGP_PKT_PUBLIC_KEY + PGP_PKT_SECRET_KEY + PGP_PKT_PUBLIC_SUBKEY + PGP_PKT_SECRET_SUBKEY ); +use Crypt::OpenPGP::Buffer; +use Crypt::OpenPGP::KeyBlock; +use Crypt::OpenPGP::PacketFactory; +use Crypt::OpenPGP::ErrorHandler; +use base qw( Crypt::OpenPGP::ErrorHandler ); + +sub new { + my $class = shift; + my $ring = bless { }, $class; + $ring->init(@_); +} + +sub init { + my $ring = shift; + my %param = @_; + $ring->{_data} = $param{Data} || ''; + if (!$ring->{_data} && (my $file = $param{Filename})) { + local *FH; + open FH, $file or + return (ref $ring)->error("Can't open keyring $file: $!"); + binmode FH; + { local $/; $ring->{_data} = <FH> } + close FH; + } + if ($ring->{_data} =~ /-----BEGIN/) { + require Crypt::OpenPGP::Armour; + my $rec = Crypt::OpenPGP::Armour->unarmour($ring->{_data}) or + return (ref $ring)->error("Unarmour failed: " . + Crypt::OpenPGP::Armour->errstr); + $ring->{_data} = $rec->{Data}; + } + $ring; +} + +sub save { + my $ring = shift; + my @blocks = $ring->blocks; + my $res = ''; + for my $block (@blocks) { + $res .= $block->save; + } + $res; +} + +sub read { + my $ring = shift; + return $ring->error("No data to read") unless $ring->{_data}; + my $buf = Crypt::OpenPGP::Buffer->new; + $buf->append($ring->{_data}); + $ring->restore($buf); + 1; +} + +sub restore { + my $ring = shift; + my($buf) = @_; + $ring->{blocks} = []; + my($kb); + while (my $packet = Crypt::OpenPGP::PacketFactory->parse($buf)) { + if (ref($packet) eq "Crypt::OpenPGP::Certificate" && + !$packet->is_subkey) { + $kb = Crypt::OpenPGP::KeyBlock->new; + $ring->add($kb); + } + $kb->add($packet) if $kb; + } +} + +sub add { + my $ring = shift; + my($entry) = @_; + push @{ $ring->{blocks} }, $entry; +} + +sub find_keyblock_by_keyid { + my $ring = shift; + my($key_id) = @_; + my $ref = $ring->{by_keyid}{$key_id}; + unless ($ref) { + my $len = length($key_id); + my @kbs = $ring->find_keyblock( + sub { substr($_[0]->key_id, -$len, $len) eq $key_id }, + [ PGP_PKT_PUBLIC_KEY, PGP_PKT_SECRET_KEY, + PGP_PKT_PUBLIC_SUBKEY, PGP_PKT_SECRET_SUBKEY ], 1 ); + return unless @kbs; + $ref = $ring->{by_keyid}{ $key_id } = \@kbs; + } + return wantarray ? @$ref : $ref->[0]; +} + +sub find_keyblock_by_uid { + my $ring = shift; + my($uid) = @_; + $ring->find_keyblock(sub { $_[0]->id =~ /$uid/i }, + [ PGP_PKT_USER_ID ], 1 ); +} + +sub find_keyblock_by_index { + my $ring = shift; + my($index) = @_; + ## XXX should not have to read entire keyring + $ring->read; + ($ring->blocks)[$index]; +} + +sub find_keyblock { + my $ring = shift; + my($test, $pkttypes, $multiple) = @_; + $pkttypes ||= []; + return $ring->error("No data to read") unless $ring->{_data}; + my $buf = Crypt::OpenPGP::Buffer->new_with_init($ring->{_data}); + my($last_kb_start_offset, $last_kb_start_cert, @kbs); + while (my $pkt = Crypt::OpenPGP::PacketFactory->parse($buf, + [ PGP_PKT_SECRET_KEY, PGP_PKT_PUBLIC_KEY, + @$pkttypes ], $pkttypes)) { + if (($pkt->{__unparsed} && ($pkt->{type} == PGP_PKT_SECRET_KEY || + $pkt->{type} == PGP_PKT_PUBLIC_KEY)) || + (ref($pkt) eq 'Crypt::OpenPGP::Certificate' && !$pkt->is_subkey)) { + $last_kb_start_offset = $buf->offset; + $last_kb_start_cert = $pkt; + } + next unless !$pkt->{__unparsed} && $test->($pkt); + my $kb = Crypt::OpenPGP::KeyBlock->new; + + ## Rewind buffer; if start-cert is parsed, rewind to offset + ## after start-cert--otherwise rewind before start-cert + if ($last_kb_start_cert->{__unparsed}) { + $buf->set_offset($last_kb_start_offset - + $last_kb_start_cert->{__pkt_len}); + my $cert = Crypt::OpenPGP::PacketFactory->parse($buf); + $kb->add($cert); + } else { + $buf->set_offset($last_kb_start_offset); + $kb->add($last_kb_start_cert); + } + { + my $off = $buf->offset; + my $packet = Crypt::OpenPGP::PacketFactory->parse($buf); + last unless $packet; + $buf->set_offset($off), + last if ref($packet) eq "Crypt::OpenPGP::Certificate" && + !$packet->is_subkey; + $kb->add($packet) if $kb; + redo; + } + unless ($multiple) { + return wantarray ? ($kb, $pkt) : $kb; + } else { + return $kb unless wantarray; + push @kbs, $kb; + } + } + @kbs; +} + +sub blocks { $_[0]->{blocks} ? @{ $_[0]->{blocks} } : () } + +1; +__END__ + +=head1 NAME + +Crypt::OpenPGP::KeyRing - Key ring object + +=head1 SYNOPSIS + + use Crypt::OpenPGP::KeyRing; + + my $ring = Crypt::OpenPGP::KeyRing->new( Filename => 'foo.ring' ); + + my $key_id = '...'; + my $kb = $ring->find_keyblock_by_keyid($key_id); + +=head1 DESCRIPTION + +I<Crypt::OpenPGP::KeyRing> provides keyring management and key lookup +for I<Crypt::OpenPGP>. A I<KeyRing>, in this case, does not necessarily +have to be a keyring file; a I<KeyRing> object is just a collection of +key blocks, where each key block contains exactly one master key, +zero or more subkeys, some user ID packets, some signatures, etc. + +=head1 USAGE + +=head2 Crypt::OpenPGP::KeyRing->new( %arg ) + +Constructs a new I<Crypt::OpenPGP::KeyRing> object and returns that +object. This has the effect os hooking the object to a particular +keyring, so that all subsequent methods called on the I<KeyRing> +object will use the data specified in the arguments to I<new>. + +I<%arg> can contain: + +=over 4 + +=item * Data + +A block of data specifying the serialized keyring, presumably as read +in from a file on disk. This data can be either in binary form or in +ASCII-armoured form; if the latter it will be unarmoured automatically. + +This argument is optional. + +=item * Filename + +The path to a keyring file, or at least, a file containing a key (and +perhaps other associated keyblock data). The data in this file can be +either in binary form or in ASCII-armoured form; if the latter it will be +unarmoured automatically. + +This argument is optional. + +=back + +=head2 $ring->find_keyblock_by_keyid($key_id) + +Looks up the key ID I<$key_id> in the keyring I<$ring>. I<$key_id> +should be either a 4-octet or 8-octet string--it should I<not> be a +string of hexadecimal digits. If that is what you have, use I<pack> to +convert it to an octet string: + + pack 'H*', $hex_key_id + +If a keyblock is found where the key ID of either the master key or +subkey matches I<$key_id>, that keyblock will be returned. The +definition of "match" depends on the length of I<$key_id>: if it is a +16-digit hex number, only exact matches will be returned; if it is an +8-digit hex number, any keyblocks containing keys whose last 8 hex +digits match I<$key_id> will be returned. + +In scalar context, only the first keyblock found in the keyring is +returned; in list context, all matching keyblocks are returned. In +practice, duplicated key IDs are rare, particularly so if you specify +the full 16 hex digits in I<$key_id>. + +Returns false on failure (C<undef> in scalar context, an empty list in +list context). + +=head2 $ring->find_keyblock_by_uid($uid) + +Given a string I<$uid>, looks up all keyblocks with User ID packets +matching the string I<$uid>, including partial matches. + +In scalar context, returns only the first keyblock with a matching +user ID; in list context, returns all matching keyblocks. + +Returns false on failure. + +=head2 $ring->find_keyblock_by_index($index) + +Given an index into a list of keyblocks I<$index>, returns the keyblock +(a I<Crypt::OpenPGP::KeyBlock> object) at that index. Accepts negative +indexes, so C<-1> will give you the last keyblock in the keyring. + +=head1 AUTHOR & COPYRIGHTS + +Please see the Crypt::OpenPGP manpage for author, copyright, and +license information. + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/KeyServer.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/KeyServer.pm new file mode 100755 index 00000000000..a82f17f9616 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/KeyServer.pm @@ -0,0 +1,153 @@ +package Crypt::OpenPGP::KeyServer; +use strict; + +use Crypt::OpenPGP; +use Crypt::OpenPGP::KeyRing; +use LWP::UserAgent; +use URI::Escape; + +use Crypt::OpenPGP::ErrorHandler; +use base qw( Crypt::OpenPGP::ErrorHandler ); + +sub new { + my $class = shift; + my $server = bless { }, $class; + $server->init(@_) + or return $class->error($server->errstr); + $server; +} + +sub init { + my $server = shift; + my %param = @_; + $server->{keyserver} = $param{Server} + or return $server->error("Need a keyserver ('Server')"); + $server->{keyserver} = 'http://' . $server->{keyserver} . ':11371' . + '/pks/lookup'; + $server->{include_revoked} = $param{IncludeRevoked} || 0; + $server; +} + + +sub find_keyblock_by_uid { + my $server = shift; + my($address) = @_; + my $ua = LWP::UserAgent->new; + $ua->agent('Crypt::OpenPGP/' . Crypt::OpenPGP->VERSION); + my $url = $server->{keyserver} . '?op=index&search=' . + uri_escape($address); + my $req = HTTP::Request->new(GET => $url); + my $res = $ua->request($req); + return $server->error("HTTP error: " . $res->status_line) + unless $res->is_success; + my $page = $res->content; + my @kb; + while ($page =~ m!(pub.*?>)!gs) { + my $line = $1; + next if index($line, "*** KEY REVOKED ***") != -1 && + !$server->{include_revoked}; + my($key_id) = $line =~ m!<a.*?>(.{8})</a>!g; + my $kb = $server->find_keyblock_by_keyid(pack 'H*', $key_id) or next; + push @kb, $kb; + } + @kb; +} + +sub find_keyblock_by_keyid { + my $server = shift; + my($key_id) = @_; + $key_id = unpack 'H*', $key_id; + my $ua = LWP::UserAgent->new; + $ua->agent('Crypt::OpenPGP/' . Crypt::OpenPGP->VERSION); + $key_id = substr($key_id, -8, 8); + my $url = $server->{keyserver} . '?op=get&search=0x' . $key_id; + my $req = HTTP::Request->new(GET => $url); + my $res = $ua->request($req); + return $server->error("HTTP error: " . $res->status_line) + unless $res->is_success; + my $page = $res->content; + my($key) = $page =~ /(-----BEGIN PGP PUBLIC KEY BLOCK-----.*?-----END PGP PUBLIC KEY BLOCK-----)/s; + return $server->error("No matching keys") unless $key; + my $ring = Crypt::OpenPGP::KeyRing->new( Data => $key ) + or return Crypt::OpenPGP::KeyRing->errstr; + $ring->find_keyblock_by_index(0); +} + +1; +__END__ + +=head1 NAME + +Crypt::OpenPGP::KeyServer - Interface to HKP keyservers + +=head1 SYNOPSIS + + use Crypt::OpenPGP::KeyServer; + + my $key_id = '...'; + my $server = Crypt::OpenPGP::KeyServer->new( + Server => 'wwwkeys.us.pgp.net' + ); + my $kb = $server->find_keyblock_by_keyid($key_id); + print $kb->primary_uid, "\n"; + my $cert = $kb->key; + + my @kbs = $server->find_keyblock_by_uid( 'foo@bar.com' ); + +=head1 DESCRIPTION + +I<Crypt::OpenPGP::KeyServer> is an interface to HKP keyservers; it provides +lookup by UID and by key ID. At the moment only HKP keyservers are +supported; future releases will likely support the NAI LDAP servers and +the email keyservers. + +=head1 USAGE + +=head2 Crypt::OpenPGP::KeyServer->new( %arg ) + +Constructs a new I<Crypt::OpenPGP::KeyServer> object and returns that +object. + +I<%arg> can contain: + +=over 4 + +=item * Server + +The hostname of the HKP keyserver. This is a required argument. You can get +a list of keyservers through + + % host -l pgp.net | grep wwwkeys + +=item * IncludeRevoked + +By default, revoked keys will be skipped when calling I<find_keyblock_by_uid>. +If you set I<IncludeRevoked> to C<1>, I<find_keyblock_by_keyid> will include +any revoked keys in the list of keys returned. + +=back + +=head2 $ring->find_keyblock_by_keyid($key_id) + +Looks up the key ID I<$key_id> in the keyring I<$ring>. For consistency +with the I<Crypt::OpenPGP::KeyRing::find_keyblock_by_keyid> interface, +I<$key_id> should be either a 4-octet or 8-octet string--it should +B<not> be a string of hexadecimal digits. If you have the hex key ID, use +I<pack> to convert it to an octet string: + + pack 'H*', $hex_key_id + +Returns false on failure. + +=head2 $ring->find_keyblock_by_uid($uid) + +Given a string I<$uid>, searches the keyserver for all keyblocks matching +the user ID I<$uid>, including partial matches. Returns all of the matching +keyblocks, the empty list on failure. + +=head1 AUTHOR & COPYRIGHTS + +Please see the Crypt::OpenPGP manpage for author, copyright, and +license information. + +=cut diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/MDC.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/MDC.pm new file mode 100755 index 00000000000..c59b32f3bc1 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/MDC.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Marker.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Marker.pm new file mode 100755 index 00000000000..69d9c3363c1 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Marker.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Message.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Message.pm new file mode 100755 index 00000000000..fcf606f509d --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Message.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/OnePassSig.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/OnePassSig.pm new file mode 100755 index 00000000000..b85779385c1 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/OnePassSig.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/PacketFactory.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/PacketFactory.pm new file mode 100755 index 00000000000..eba1ad88def --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/PacketFactory.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Plaintext.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Plaintext.pm new file mode 100755 index 00000000000..892bf15679d --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Plaintext.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/S2k.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/S2k.pm new file mode 100755 index 00000000000..0ce398c24d1 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/S2k.pm @@ -0,0 +1,245 @@ +package Crypt::OpenPGP::S2k; +use strict; + +use Crypt::OpenPGP::Buffer; +use Crypt::OpenPGP::Digest; +use Crypt::OpenPGP::ErrorHandler; +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; + require Crypt::Random; + $s2k->{salt} = Crypt::Random::makerandom_octet( Length => 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; + require Crypt::Random; + $s2k->{salt} = Crypt::Random::makerandom_octet( Length => 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.6. + +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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/SKSessionKey.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/SKSessionKey.pm new file mode 100755 index 00000000000..ec1e61ac536 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/SKSessionKey.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/SessionKey.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/SessionKey.pm new file mode 100755 index 00000000000..8ebb112a4c3 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/SessionKey.pm @@ -0,0 +1,221 @@ +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 $keysize = Crypt::OpenPGP::Cipher->new($alg)->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 $mp (values %$c) { + $buf->put_mp_int($mp); + } + $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}); + for my $mp (values %{ $key->{C} }) { + $str .= sprintf " data: [%d bits]\n", bitsize($mp); + } + $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; + require Crypt::Random; + my($sym_key, $sym_alg, $size) = @_; + my $padlen = $size - length($sym_key) - 2 - 2 - 2; + my $pad = Crypt::Random::makerandom_octet( Length => $padlen, + Skip => chr(0) ); + 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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Signature.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Signature.pm new file mode 100755 index 00000000000..7fe236cc5ee --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Signature.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Signature/SubPacket.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Signature/SubPacket.pm new file mode 100755 index 00000000000..9e6139238f4 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Signature/SubPacket.pm @@ -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; diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Trust.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Trust.pm new file mode 100755 index 00000000000..ffe324d3e80 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Trust.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/UserID.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/UserID.pm new file mode 100755 index 00000000000..3d312e3aa0f --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/UserID.pm @@ -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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Util.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Util.pm new file mode 100755 index 00000000000..495dc936317 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Util.pm @@ -0,0 +1,137 @@ +package Crypt::OpenPGP::Util; +use strict; + +use Math::Pari qw( PARI pari2num floor Mod lift ); + +use vars qw( @EXPORT_OK @ISA ); +use Exporter; +@EXPORT_OK = qw( bitsize bin2mp mp2bin mod_exp mod_inverse + dash_escape dash_unescape canonical_text ); +@ISA = qw( Exporter ); + +sub bitsize { + return pari2num(floor(Math::Pari::log($_[0])/Math::Pari::log(2)) + 1); +} + +sub bin2mp { Math::Pari::_hex_cvt('0x' . unpack 'H*', $_[0]) } + +sub mp2bin { + my($p) = @_; + $p = PARI($p); + my $base = PARI(1) << PARI(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; +} + +sub mod_exp { + my($a, $exp, $n) = @_; + my $m = Mod($a, $n); + lift($m ** $exp); +} + +sub mod_inverse { + my($a, $n) = @_; + my $m = Mod(1, $n); + lift($m / $a); +} + +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; +} + +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::Pari> integer object +I<$n>. + +=head2 bin2mp($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::Pari> object. + +=head2 mp2bin($int) + +Given a biginteger I<$int> (a I<Math::Pari> object), linearizes +the integer into an octet string, and returns the octet string. + +=head2 mod_exp($a, $exp, $n) + +Computes $a ^ $exp mod $n and returns the value. The calculations +are done using I<Math::Pari>, and the return value is a I<Math::Pari> +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::Pari>, and the +return value is a I<Math::Pari> 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 diff --git a/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Words.pm b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Words.pm new file mode 100755 index 00000000000..f487af76ab3 --- /dev/null +++ b/Master/tlpkg/tlperl.straw/lib/Crypt/OpenPGP/Words.pm @@ -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 |