diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Crypt')
88 files changed, 17345 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Crypt/._test.pl b/Master/tlpkg/tlperl/lib/Crypt/._test.pl Binary files differnew file mode 100755 index 00000000000..85be40a9619 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/._test.pl diff --git a/Master/tlpkg/tlperl/lib/Crypt/Blowfish.pm b/Master/tlpkg/tlperl/lib/Crypt/Blowfish.pm new file mode 100755 index 00000000000..784501882ac --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/Blowfish.pm @@ -0,0 +1,207 @@ +package Crypt::Blowfish; + +require Exporter; +require DynaLoader; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +@ISA = qw(Exporter DynaLoader); +# @ISA = qw(Exporter DynaLoader Crypt::BlockCipher); + +# Items to export into callers namespace by default +@EXPORT = qw(); + +# Other items we are prepared to export if requested +@EXPORT_OK = qw( + blocksize keysize min_keysize max_keysize + new encrypt decrypt +); + +$VERSION = '2.10'; +bootstrap Crypt::Blowfish $VERSION; + +use strict; +use Carp; + +sub usage +{ + my ($package, $filename, $line, $subr) = caller(1); + $Carp::CarpLevel = 2; + croak "Usage: $subr(@_)"; +} + + +sub blocksize { 8; } # /* byte my shiny metal.. */ +sub keysize { 0; } # /* we'll leave this at 8 .. for now. expect change. */ +sub min_keysize { 8; } +sub max_keysize { 56; } + +sub new +{ + usage("new Blowfish key") unless @_ == 2; + + my $type = shift; my $self = {}; bless $self, $type; + + $self->{'ks'} = Crypt::Blowfish::init(shift); + + $self; +} + +sub encrypt +{ + usage("encrypt data[8 bytes]") unless @_ == 2; + + my $self = shift; + my $data = shift; + + Crypt::Blowfish::crypt($data, $data, $self->{'ks'}, 0); + + $data; +} + +sub decrypt +{ + usage("decrypt data[8 bytes]") unless @_ == 2; + + my $self = shift; + my $data = shift; + + Crypt::Blowfish::crypt($data, $data, $self->{'ks'}, 1); + + $data; +} + +1; + +__END__ +# +# Parts Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) +# New Parts Copyright (C) 2000, 2001 W3Works, LLC (http://www.w3works.com/) +# All rights reserved. +# + +=head1 NAME + +Crypt::Blowfish - Perl Blowfish encryption module + +=head1 SYNOPSIS + + use Crypt::Blowfish; + my $cipher = new Crypt::Blowfish $key; + my $ciphertext = $cipher->encrypt($plaintext); + my $plaintext = $cipher->decrypt($ciphertext); + +=head1 DESCRIPTION + +Blowfish is capable of strong encryption and can use key sizes up +to 56 bytes (a 448 bit key). You're encouraged to take advantage +of the full key size to ensure the strongest encryption possible +from this module. + +Crypt::Blowfish has the following methods: + +=over 4 + + blocksize() + keysize() + encrypt() + decrypt() + +=back + +=head1 FUNCTIONS + +=over 4 + +=item blocksize + +Returns the size (in bytes) of the block cipher. + +Crypt::Blowfish doesn't return a key size due to its ability +to use variable-length keys. (well, more accurately, it won't +as of 2.09 .. for now, it does. expect that to change) + +=item new + + my $cipher = new Crypt::Blowfish $key; + +This creates a new Crypt::Blowfish BlockCipher object, using $key, +where $key is a key of C<keysize()> bytes (minimum of eight bytes). + +=item encrypt + + my $cipher = new Crypt::Blowfish $key; + my $ciphertext = $cipher->encrypt($plaintext); + +This function encrypts $plaintext and returns the $ciphertext +where $plaintext and $ciphertext must be of C<blocksize()> bytes. +(hint: Blowfish is an 8 byte block cipher) + +=item decrypt + + my $cipher = new Crypt::Blowfish $key; + my $plaintext = $cipher->decrypt($ciphertext); + +This function decrypts $ciphertext and returns the $plaintext +where $plaintext and $ciphertext must be of C<blocksize()> bytes. +(hint: see previous hint) + +=back + +=head1 EXAMPLE + + my $key = pack("H16", "0123456789ABCDEF"); # min. 8 bytes + my $cipher = new Crypt::Blowfish $key; + my $ciphertext = $cipher->encrypt("plaintex"); # SEE NOTES + print unpack("H16", $ciphertext), "\n"; + +=head1 PLATFORMS + + Please see the README document for platforms and performance + tests. + +=head1 NOTES + +The module is capable of being used with Crypt::CBC. You're +encouraged to read the perldoc for Crypt::CBC if you intend to +use this module for Cipher Block Chaining modes. In fact, if +you have any intentions of encrypting more than eight bytes of +data with this, or any other block cipher, you're going to need +B<some> type of block chaining help. Crypt::CBC tends to be +very good at this. If you're not going to encrypt more than +eight bytes, your data B<must> be B<exactly> eight bytes long. +If need be, do your own padding. "\0" as a null byte is perfectly +valid to use for this. Additionally, the current maintainer for +Crypt::Blowfish may or may not release Crypt::CBC_R which +replaces the default 'RandomIV' initialization vector in +Crypt::CBC with a random initialization vector. (to the limits +of /dev/urandom and associates) In either case, please email +amused@pobox.com for Crypt::CBC_R. + +=head1 SEE ALSO + +Crypt::CBC, +Crypt::DES, +Crypt::IDEA + +Bruce Schneier, I<Applied Cryptography>, 1995, Second Edition, +published by John Wiley & Sons, Inc. + +=head1 COPYRIGHT + +The implementation of the Blowfish algorithm was developed by, +and is copyright of, A.M. Kuchling. + +Other parts of the perl extension and module are +copyright of Systemics Ltd ( http://www.systemics.com/ ). + +Code revisions, updates, and standalone release are copyright +1999-2001 W3Works, LLC. + +=head1 AUTHOR + +Original algorithm, Bruce Shneier. Original implementation, A.M. +Kuchling. Original Perl implementation, Systemics Ltd. Current +maintenance by W3Works, LLC. + +Current revision and maintainer: Dave Paris <amused@pobox.com> + diff --git a/Master/tlpkg/tlperl/lib/Crypt/CAST5_PP.pm b/Master/tlpkg/tlperl/lib/Crypt/CAST5_PP.pm new file mode 100755 index 00000000000..225b731c61f --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/CAST5_PP.pm @@ -0,0 +1,261 @@ +package Crypt::CAST5_PP; + +require 5.004; +use strict; +use AutoLoader qw( AUTOLOAD ); +use Carp; +use integer; +use vars qw( @s1 @s2 @s3 @s4 @s5 @s6 @s7 @s8 $VERSION ); + +$VERSION = "1.04"; + +sub new { + my ($class, $key) = @_; + my $cast5 = { }; + bless $cast5 => $class; + $cast5->init($key) if defined $key; + return $cast5; +} # new + +sub blocksize { return 8 } +sub keysize { return 16 } + +1 # end module +__END__ + +=head1 NAME + +Crypt::CAST5_PP - CAST5 block cipher in pure Perl + +=head1 SYNOPSIS + + use Crypt::CBC; + + my $crypt = Crypt::CBC->new({ + key => "secret key", + cipher => "CAST5_PP", + }); + + my $message = "All mimsy were the borogoves"; + my $ciphertext = $crypt->encrypt($message); + print unpack("H*", $ciphertext), "\n"; + + my $plaintext = $crypt->decrypt($ciphertext); + print $plaintext, "\n"; + +=head1 DESCRIPTION + +This module provides a pure Perl implementation of the CAST5 block cipher. +CAST5 is also known as CAST-128. It is a product of the CAST design +procedure developed by C. Adams and S. Tavares. + +The CAST5 cipher is available royalty-free. + +=head1 FUNCTIONS + +=head2 blocksize + +Returns the CAST5 block size, which is 8 bytes. This function exists +so that Crypt::CAST5_PP can work with Crypt::CBC. + +=head2 keysize + +Returns the maximum CAST5 key size, 16 bytes. + +=head2 new + + $cast5 = Crypt::CAST5_PP->new($key); + +Create a new encryption object. If the optional key parameter is given, +it will be passed to the init() function. + +=head2 init + + $cast5->init($key); + +Set or change the encryption key to be used. The key must be from 40 bits +(5 bytes) to 128 bits (16 bytes) in length. Note that if the key used is +80 bits or less, encryption and decryption will be somewhat faster. + +It is best for the key to be random binary data, not something printable +like a password. A message digest function may be useful for converting +a password to an encryption key; see L<Digest::SHA1> or L<Digest::MD5>. +Note that Crypt::CBC runs the given "key" through MD5 to get the actual +encryption key. + +=head2 encrypt + + $ciphertext = $cast5->encrypt($plaintext); + +Encrypt a block of plaintext using the current encryption key, and return +the corresponding ciphertext. The input must be 8 bytes long, and the output +has the same length. Note that the encryption is in ECB mode, which means +that it encrypts each block independently. That can leave you vulnerable +to dictionary attacks, so it is generally best to use some form of chaining +between blocks; see L<Crypt::CBC>. + +=head2 decrypt + + $plaintext = $cast5->decrypt($ciphertext); + +Decrypt the ciphertext and return the corresponding plaintext. + +=head1 LIMITATIONS + +Always produces untainted output, even if the input is tainted, because +that's what perl's pack() function does. + +=head1 SEE ALSO + +RFC 2144, "The CAST-128 Encryption Algorithm", C. Adams, May 1997 + +L<Crypt::CBC> + +=head1 AUTHOR + +Bob Mathews, <bobmathews@alumni.calpoly.edu> + +=head1 COPYRIGHT + +Copyright (c) 2006 Bob Mathews. All rights reserved. +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + +sub init { + use strict; + use integer; + my ($cast5, $key) = @_; + croak "Key length must be 40 to 128 bits" + if length($key) < 5 || length($key) > 16; + require Crypt::CAST5_PP::Tables; + + # untaint the key. this keeps the evals from blowing up later. + # arguably, a tainted key should result in tainted output. oh well. + $key =~ /^(.*)$/s and $key = $1; + + # null-pad the key to 16 bytes, and then split it into 32-bit chunks + my ($s, $t, $u, $v) = unpack "N4", pack "a16", $key; + + # compute the key schedule + # don't try to read this -- it's generated by mkschedule + my ($w, $x, $y, $z, @k); + for (1..2) { + $w=$s^$s5[$v>>16&255]^$s6[$v&255]^$s7[$v>>24&255]^$s8[$v>>8&255]^$s7[$u>>24&255]; + $x=$u^$s5[$w>>24&255]^$s6[$w>>8&255]^$s7[$w>>16&255]^$s8[$w&255]^$s8[$u>>8&255]; + $y=$v^$s5[$x&255]^$s6[$x>>8&255]^$s7[$x>>16&255]^$s8[$x>>24&255]^$s5[$u>>16&255]; + $z=$t^$s5[$y>>8&255]^$s6[$y>>16&255]^$s7[$y&255]^$s8[$y>>24&255]^$s6[$u&255]; + push@k,$s5[$y>>24&255]^$s6[$y>>16&255]^$s7[$x&255]^$s8[$x>>8&255]^$s5[$w>>8&255]; + push@k,$s5[$y>>8&255]^$s6[$y&255]^$s7[$x>>16&255]^$s8[$x>>24&255]^$s6[$x>>8&255]; + push@k,$s5[$z>>24&255]^$s6[$z>>16&255]^$s7[$w&255]^$s8[$w>>8&255]^$s7[$y>>16&255]; + push@k,$s5[$z>>8&255]^$s6[$z&255]^$s7[$w>>16&255]^$s8[$w>>24&255]^$s8[$z>>24&255]; + $s=$y^$s5[$x>>16&255]^$s6[$x&255]^$s7[$x>>24&255]^$s8[$x>>8&255]^$s7[$w>>24&255]; + $t=$w^$s5[$s>>24&255]^$s6[$s>>8&255]^$s7[$s>>16&255]^$s8[$s&255]^$s8[$w>>8&255]; + $u=$x^$s5[$t&255]^$s6[$t>>8&255]^$s7[$t>>16&255]^$s8[$t>>24&255]^$s5[$w>>16&255]; + $v=$z^$s5[$u>>8&255]^$s6[$u>>16&255]^$s7[$u&255]^$s8[$u>>24&255]^$s6[$w&255]; + push@k,$s5[$s&255]^$s6[$s>>8&255]^$s7[$v>>24&255]^$s8[$v>>16&255]^$s5[$u>>24&255]; + push@k,$s5[$s>>16&255]^$s6[$s>>24&255]^$s7[$v>>8&255]^$s8[$v&255]^$s6[$v>>16&255]; + push@k,$s5[$t&255]^$s6[$t>>8&255]^$s7[$u>>24&255]^$s8[$u>>16&255]^$s7[$s&255]; + push@k,$s5[$t>>16&255]^$s6[$t>>24&255]^$s7[$u>>8&255]^$s8[$u&255]^$s8[$t&255]; + $w=$s^$s5[$v>>16&255]^$s6[$v&255]^$s7[$v>>24&255]^$s8[$v>>8&255]^$s7[$u>>24&255]; + $x=$u^$s5[$w>>24&255]^$s6[$w>>8&255]^$s7[$w>>16&255]^$s8[$w&255]^$s8[$u>>8&255]; + $y=$v^$s5[$x&255]^$s6[$x>>8&255]^$s7[$x>>16&255]^$s8[$x>>24&255]^$s5[$u>>16&255]; + $z=$t^$s5[$y>>8&255]^$s6[$y>>16&255]^$s7[$y&255]^$s8[$y>>24&255]^$s6[$u&255]; + push@k,$s5[$w&255]^$s6[$w>>8&255]^$s7[$z>>24&255]^$s8[$z>>16&255]^$s5[$y>>16&255]; + push@k,$s5[$w>>16&255]^$s6[$w>>24&255]^$s7[$z>>8&255]^$s8[$z&255]^$s6[$z>>24&255]; + push@k,$s5[$x&255]^$s6[$x>>8&255]^$s7[$y>>24&255]^$s8[$y>>16&255]^$s7[$w>>8&255]; + push@k,$s5[$x>>16&255]^$s6[$x>>24&255]^$s7[$y>>8&255]^$s8[$y&255]^$s8[$x>>8&255]; + $s=$y^$s5[$x>>16&255]^$s6[$x&255]^$s7[$x>>24&255]^$s8[$x>>8&255]^$s7[$w>>24&255]; + $t=$w^$s5[$s>>24&255]^$s6[$s>>8&255]^$s7[$s>>16&255]^$s8[$s&255]^$s8[$w>>8&255]; + $u=$x^$s5[$t&255]^$s6[$t>>8&255]^$s7[$t>>16&255]^$s8[$t>>24&255]^$s5[$w>>16&255]; + $v=$z^$s5[$u>>8&255]^$s6[$u>>16&255]^$s7[$u&255]^$s8[$u>>24&255]^$s6[$w&255]; + push@k,$s5[$u>>24&255]^$s6[$u>>16&255]^$s7[$t&255]^$s8[$t>>8&255]^$s5[$s&255]; + push@k,$s5[$u>>8&255]^$s6[$u&255]^$s7[$t>>16&255]^$s8[$t>>24&255]^$s6[$t&255]; + push@k,$s5[$v>>24&255]^$s6[$v>>16&255]^$s7[$s&255]^$s8[$s>>8&255]^$s7[$u>>24&255]; + push@k,$s5[$v>>8&255]^$s6[$v&255]^$s7[$s>>16&255]^$s8[$s>>24&255]^$s8[$v>>16&255]; + } + + for (16..31) { $k[$_] &= 31 } + delete $cast5->{encrypt}; + delete $cast5->{decrypt}; + $cast5->{rounds} = length($key) <= 10 ? 12 : 16; + $cast5->{key} = \@k; + return $cast5; +} # init + +sub encrypt { + use strict; + use integer; + my ($cast5, $block) = @_; + croak "Block size must be 8" if length($block) != 8; + + my $encrypt = $cast5->{encrypt}; + unless ($encrypt) { + my $key = $cast5->{key} or croak "Call init() first"; + my $f = 'sub{my($l,$r,$i)=unpack"N2",$_[0];'; + + my ($l, $r) = qw( $l $r ); + my ($op1, $op2, $op3) = qw( + ^ - ); + foreach my $round (0 .. $cast5->{rounds}-1) { + my $km = $key->[$round]; + my $kr = $key->[$round+16]; + + my $rot = ""; + if ($kr) { + my $mask = ~(~0<<$kr) & 0xffffffff; + my $kr2 = 32-$kr; + $rot = "\$i=\$i<<$kr|\$i>>$kr2&$mask;" + } + + $f .= "\$i=$km$op1$r;$rot$l^=((\$s1[\$i>>24&255]$op2\$s2[\$i>>16&255])$op3\$s3[\$i>>8&255])$op1\$s4[\$i&255];"; + ($l, $r) = ($r, $l); + ($op1, $op2, $op3) = ($op2, $op3, $op1); + } + + $f .= 'pack"N2",$r&0xffffffff,$l&0xffffffff}'; + $cast5->{encrypt} = $encrypt = eval $f; + } + + return $encrypt->($block); +} # encrypt + +sub decrypt { + use strict; + use integer; + my ($cast5, $block) = @_; + croak "Block size must be 8" if length($block) != 8; + + my $decrypt = $cast5->{decrypt}; + unless ($decrypt) { + my $key = $cast5->{key} or croak "Call init() first"; + my $rounds = $cast5->{rounds}; + my $f = 'sub{my($r,$l,$i)=unpack"N2",$_[0];'; + + my ($l, $r) = qw( $r $l ); + my ($op1, $op2, $op3) = qw( - + ^ ); + foreach (1 .. $rounds%3) { ($op1, $op2, $op3) = ($op2, $op3, $op1) } + foreach my $round (1 .. $rounds) { + my $km = $key->[$rounds-$round]; + my $kr = $key->[$rounds-$round+16]; + + my $rot = ""; + if ($kr) { + my $mask = ~(~0<<$kr) & 0xffffffff; + my $kr2 = 32-$kr; + $rot = "\$i=\$i<<$kr|\$i>>$kr2&$mask;" + } + + $f .= "\$i=$km$op1$r;$rot$l^=((\$s1[\$i>>24&255]$op2\$s2[\$i>>16&255])$op3\$s3[\$i>>8&255])$op1\$s4[\$i&255];"; + ($l, $r) = ($r, $l); + ($op1, $op2, $op3) = ($op3, $op1, $op2); + } + + $f .= 'pack"N2",$l&0xffffffff,$r&0xffffffff}'; + $cast5->{decrypt} = $decrypt = eval $f; + } + + return $decrypt->($block); +} # decrypt + +# end CAST5_PP.pm diff --git a/Master/tlpkg/tlperl/lib/Crypt/CAST5_PP/Tables.pm b/Master/tlpkg/tlperl/lib/Crypt/CAST5_PP/Tables.pm new file mode 100755 index 00000000000..0713957a658 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/CAST5_PP/Tables.pm @@ -0,0 +1,375 @@ +# Crypt::CAST5_PP::Tables +# S-box tables for CAST5 encryption + +use strict; +use integer; + +@Crypt::CAST5_PP::s1 = ( +0x30fb40d4, 0x9fa0ff0b, 0x6beccd2f, 0x3f258c7a, 0x1e213f2f, 0x9c004dd3, +0x6003e540, 0xcf9fc949, 0xbfd4af27, 0x88bbbdb5, 0xe2034090, 0x98d09675, +0x6e63a0e0, 0x15c361d2, 0xc2e7661d, 0x22d4ff8e, 0x28683b6f, 0xc07fd059, +0xff2379c8, 0x775f50e2, 0x43c340d3, 0xdf2f8656, 0x887ca41a, 0xa2d2bd2d, +0xa1c9e0d6, 0x346c4819, 0x61b76d87, 0x22540f2f, 0x2abe32e1, 0xaa54166b, +0x22568e3a, 0xa2d341d0, 0x66db40c8, 0xa784392f, 0x004dff2f, 0x2db9d2de, +0x97943fac, 0x4a97c1d8, 0x527644b7, 0xb5f437a7, 0xb82cbaef, 0xd751d159, +0x6ff7f0ed, 0x5a097a1f, 0x827b68d0, 0x90ecf52e, 0x22b0c054, 0xbc8e5935, +0x4b6d2f7f, 0x50bb64a2, 0xd2664910, 0xbee5812d, 0xb7332290, 0xe93b159f, +0xb48ee411, 0x4bff345d, 0xfd45c240, 0xad31973f, 0xc4f6d02e, 0x55fc8165, +0xd5b1caad, 0xa1ac2dae, 0xa2d4b76d, 0xc19b0c50, 0x882240f2, 0x0c6e4f38, +0xa4e4bfd7, 0x4f5ba272, 0x564c1d2f, 0xc59c5319, 0xb949e354, 0xb04669fe, +0xb1b6ab8a, 0xc71358dd, 0x6385c545, 0x110f935d, 0x57538ad5, 0x6a390493, +0xe63d37e0, 0x2a54f6b3, 0x3a787d5f, 0x6276a0b5, 0x19a6fcdf, 0x7a42206a, +0x29f9d4d5, 0xf61b1891, 0xbb72275e, 0xaa508167, 0x38901091, 0xc6b505eb, +0x84c7cb8c, 0x2ad75a0f, 0x874a1427, 0xa2d1936b, 0x2ad286af, 0xaa56d291, +0xd7894360, 0x425c750d, 0x93b39e26, 0x187184c9, 0x6c00b32d, 0x73e2bb14, +0xa0bebc3c, 0x54623779, 0x64459eab, 0x3f328b82, 0x7718cf82, 0x59a2cea6, +0x04ee002e, 0x89fe78e6, 0x3fab0950, 0x325ff6c2, 0x81383f05, 0x6963c5c8, +0x76cb5ad6, 0xd49974c9, 0xca180dcf, 0x380782d5, 0xc7fa5cf6, 0x8ac31511, +0x35e79e13, 0x47da91d0, 0xf40f9086, 0xa7e2419e, 0x31366241, 0x051ef495, +0xaa573b04, 0x4a805d8d, 0x548300d0, 0x00322a3c, 0xbf64cddf, 0xba57a68e, +0x75c6372b, 0x50afd341, 0xa7c13275, 0x915a0bf5, 0x6b54bfab, 0x2b0b1426, +0xab4cc9d7, 0x449ccd82, 0xf7fbf265, 0xab85c5f3, 0x1b55db94, 0xaad4e324, +0xcfa4bd3f, 0x2deaa3e2, 0x9e204d02, 0xc8bd25ac, 0xeadf55b3, 0xd5bd9e98, +0xe31231b2, 0x2ad5ad6c, 0x954329de, 0xadbe4528, 0xd8710f69, 0xaa51c90f, +0xaa786bf6, 0x22513f1e, 0xaa51a79b, 0x2ad344cc, 0x7b5a41f0, 0xd37cfbad, +0x1b069505, 0x41ece491, 0xb4c332e6, 0x032268d4, 0xc9600acc, 0xce387e6d, +0xbf6bb16c, 0x6a70fb78, 0x0d03d9c9, 0xd4df39de, 0xe01063da, 0x4736f464, +0x5ad328d8, 0xb347cc96, 0x75bb0fc3, 0x98511bfb, 0x4ffbcc35, 0xb58bcf6a, +0xe11f0abc, 0xbfc5fe4a, 0xa70aec10, 0xac39570a, 0x3f04442f, 0x6188b153, +0xe0397a2e, 0x5727cb79, 0x9ceb418f, 0x1cacd68d, 0x2ad37c96, 0x0175cb9d, +0xc69dff09, 0xc75b65f0, 0xd9db40d8, 0xec0e7779, 0x4744ead4, 0xb11c3274, +0xdd24cb9e, 0x7e1c54bd, 0xf01144f9, 0xd2240eb1, 0x9675b3fd, 0xa3ac3755, +0xd47c27af, 0x51c85f4d, 0x56907596, 0xa5bb15e6, 0x580304f0, 0xca042cf1, +0x011a37ea, 0x8dbfaadb, 0x35ba3e4a, 0x3526ffa0, 0xc37b4d09, 0xbc306ed9, +0x98a52666, 0x5648f725, 0xff5e569d, 0x0ced63d0, 0x7c63b2cf, 0x700b45e1, +0xd5ea50f1, 0x85a92872, 0xaf1fbda7, 0xd4234870, 0xa7870bf3, 0x2d3b4d79, +0x42e04198, 0x0cd0ede7, 0x26470db8, 0xf881814c, 0x474d6ad7, 0x7c0c5e5c, +0xd1231959, 0x381b7298, 0xf5d2f4db, 0xab838653, 0x6e2f1e23, 0x83719c9e, +0xbd91e046, 0x9a56456e, 0xdc39200c, 0x20c8c571, 0x962bda1c, 0xe1e696ff, +0xb141ab08, 0x7cca89b9, 0x1a69e783, 0x02cc4843, 0xa2f7c579, 0x429ef47d, +0x427b169c, 0x5ac9f049, 0xdd8f0f00, 0x5c8165bf, +); + +@Crypt::CAST5_PP::s2 = ( +0x1f201094, 0xef0ba75b, 0x69e3cf7e, 0x393f4380, 0xfe61cf7a, 0xeec5207a, +0x55889c94, 0x72fc0651, 0xada7ef79, 0x4e1d7235, 0xd55a63ce, 0xde0436ba, +0x99c430ef, 0x5f0c0794, 0x18dcdb7d, 0xa1d6eff3, 0xa0b52f7b, 0x59e83605, +0xee15b094, 0xe9ffd909, 0xdc440086, 0xef944459, 0xba83ccb3, 0xe0c3cdfb, +0xd1da4181, 0x3b092ab1, 0xf997f1c1, 0xa5e6cf7b, 0x01420ddb, 0xe4e7ef5b, +0x25a1ff41, 0xe180f806, 0x1fc41080, 0x179bee7a, 0xd37ac6a9, 0xfe5830a4, +0x98de8b7f, 0x77e83f4e, 0x79929269, 0x24fa9f7b, 0xe113c85b, 0xacc40083, +0xd7503525, 0xf7ea615f, 0x62143154, 0x0d554b63, 0x5d681121, 0xc866c359, +0x3d63cf73, 0xcee234c0, 0xd4d87e87, 0x5c672b21, 0x071f6181, 0x39f7627f, +0x361e3084, 0xe4eb573b, 0x602f64a4, 0xd63acd9c, 0x1bbc4635, 0x9e81032d, +0x2701f50c, 0x99847ab4, 0xa0e3df79, 0xba6cf38c, 0x10843094, 0x2537a95e, +0xf46f6ffe, 0xa1ff3b1f, 0x208cfb6a, 0x8f458c74, 0xd9e0a227, 0x4ec73a34, +0xfc884f69, 0x3e4de8df, 0xef0e0088, 0x3559648d, 0x8a45388c, 0x1d804366, +0x721d9bfd, 0xa58684bb, 0xe8256333, 0x844e8212, 0x128d8098, 0xfed33fb4, +0xce280ae1, 0x27e19ba5, 0xd5a6c252, 0xe49754bd, 0xc5d655dd, 0xeb667064, +0x77840b4d, 0xa1b6a801, 0x84db26a9, 0xe0b56714, 0x21f043b7, 0xe5d05860, +0x54f03084, 0x066ff472, 0xa31aa153, 0xdadc4755, 0xb5625dbf, 0x68561be6, +0x83ca6b94, 0x2d6ed23b, 0xeccf01db, 0xa6d3d0ba, 0xb6803d5c, 0xaf77a709, +0x33b4a34c, 0x397bc8d6, 0x5ee22b95, 0x5f0e5304, 0x81ed6f61, 0x20e74364, +0xb45e1378, 0xde18639b, 0x881ca122, 0xb96726d1, 0x8049a7e8, 0x22b7da7b, +0x5e552d25, 0x5272d237, 0x79d2951c, 0xc60d894c, 0x488cb402, 0x1ba4fe5b, +0xa4b09f6b, 0x1ca815cf, 0xa20c3005, 0x8871df63, 0xb9de2fcb, 0x0cc6c9e9, +0x0beeff53, 0xe3214517, 0xb4542835, 0x9f63293c, 0xee41e729, 0x6e1d2d7c, +0x50045286, 0x1e6685f3, 0xf33401c6, 0x30a22c95, 0x31a70850, 0x60930f13, +0x73f98417, 0xa1269859, 0xec645c44, 0x52c877a9, 0xcdff33a6, 0xa02b1741, +0x7cbad9a2, 0x2180036f, 0x50d99c08, 0xcb3f4861, 0xc26bd765, 0x64a3f6ab, +0x80342676, 0x25a75e7b, 0xe4e6d1fc, 0x20c710e6, 0xcdf0b680, 0x17844d3b, +0x31eef84d, 0x7e0824e4, 0x2ccb49eb, 0x846a3bae, 0x8ff77888, 0xee5d60f6, +0x7af75673, 0x2fdd5cdb, 0xa11631c1, 0x30f66f43, 0xb3faec54, 0x157fd7fa, +0xef8579cc, 0xd152de58, 0xdb2ffd5e, 0x8f32ce19, 0x306af97a, 0x02f03ef8, +0x99319ad5, 0xc242fa0f, 0xa7e3ebb0, 0xc68e4906, 0xb8da230c, 0x80823028, +0xdcdef3c8, 0xd35fb171, 0x088a1bc8, 0xbec0c560, 0x61a3c9e8, 0xbca8f54d, +0xc72feffa, 0x22822e99, 0x82c570b4, 0xd8d94e89, 0x8b1c34bc, 0x301e16e6, +0x273be979, 0xb0ffeaa6, 0x61d9b8c6, 0x00b24869, 0xb7ffce3f, 0x08dc283b, +0x43daf65a, 0xf7e19798, 0x7619b72f, 0x8f1c9ba4, 0xdc8637a0, 0x16a7d3b1, +0x9fc393b7, 0xa7136eeb, 0xc6bcc63e, 0x1a513742, 0xef6828bc, 0x520365d6, +0x2d6a77ab, 0x3527ed4b, 0x821fd216, 0x095c6e2e, 0xdb92f2fb, 0x5eea29cb, +0x145892f5, 0x91584f7f, 0x5483697b, 0x2667a8cc, 0x85196048, 0x8c4bacea, +0x833860d4, 0x0d23e0f9, 0x6c387e8a, 0x0ae6d249, 0xb284600c, 0xd835731d, +0xdcb1c647, 0xac4c56ea, 0x3ebd81b3, 0x230eabb0, 0x6438bc87, 0xf0b5b1fa, +0x8f5ea2b3, 0xfc184642, 0x0a036b7a, 0x4fb089bd, 0x649da589, 0xa345415e, +0x5c038323, 0x3e5d3bb9, 0x43d79572, 0x7e6dd07c, 0x06dfdf1e, 0x6c6cc4ef, +0x7160a539, 0x73bfbe70, 0x83877605, 0x4523ecf1, +); + +@Crypt::CAST5_PP::s3 = ( +0x8defc240, 0x25fa5d9f, 0xeb903dbf, 0xe810c907, 0x47607fff, 0x369fe44b, +0x8c1fc644, 0xaececa90, 0xbeb1f9bf, 0xeefbcaea, 0xe8cf1950, 0x51df07ae, +0x920e8806, 0xf0ad0548, 0xe13c8d83, 0x927010d5, 0x11107d9f, 0x07647db9, +0xb2e3e4d4, 0x3d4f285e, 0xb9afa820, 0xfade82e0, 0xa067268b, 0x8272792e, +0x553fb2c0, 0x489ae22b, 0xd4ef9794, 0x125e3fbc, 0x21fffcee, 0x825b1bfd, +0x9255c5ed, 0x1257a240, 0x4e1a8302, 0xbae07fff, 0x528246e7, 0x8e57140e, +0x3373f7bf, 0x8c9f8188, 0xa6fc4ee8, 0xc982b5a5, 0xa8c01db7, 0x579fc264, +0x67094f31, 0xf2bd3f5f, 0x40fff7c1, 0x1fb78dfc, 0x8e6bd2c1, 0x437be59b, +0x99b03dbf, 0xb5dbc64b, 0x638dc0e6, 0x55819d99, 0xa197c81c, 0x4a012d6e, +0xc5884a28, 0xccc36f71, 0xb843c213, 0x6c0743f1, 0x8309893c, 0x0feddd5f, +0x2f7fe850, 0xd7c07f7e, 0x02507fbf, 0x5afb9a04, 0xa747d2d0, 0x1651192e, +0xaf70bf3e, 0x58c31380, 0x5f98302e, 0x727cc3c4, 0x0a0fb402, 0x0f7fef82, +0x8c96fdad, 0x5d2c2aae, 0x8ee99a49, 0x50da88b8, 0x8427f4a0, 0x1eac5790, +0x796fb449, 0x8252dc15, 0xefbd7d9b, 0xa672597d, 0xada840d8, 0x45f54504, +0xfa5d7403, 0xe83ec305, 0x4f91751a, 0x925669c2, 0x23efe941, 0xa903f12e, +0x60270df2, 0x0276e4b6, 0x94fd6574, 0x927985b2, 0x8276dbcb, 0x02778176, +0xf8af918d, 0x4e48f79e, 0x8f616ddf, 0xe29d840e, 0x842f7d83, 0x340ce5c8, +0x96bbb682, 0x93b4b148, 0xef303cab, 0x984faf28, 0x779faf9b, 0x92dc560d, +0x224d1e20, 0x8437aa88, 0x7d29dc96, 0x2756d3dc, 0x8b907cee, 0xb51fd240, +0xe7c07ce3, 0xe566b4a1, 0xc3e9615e, 0x3cf8209d, 0x6094d1e3, 0xcd9ca341, +0x5c76460e, 0x00ea983b, 0xd4d67881, 0xfd47572c, 0xf76cedd9, 0xbda8229c, +0x127dadaa, 0x438a074e, 0x1f97c090, 0x081bdb8a, 0x93a07ebe, 0xb938ca15, +0x97b03cff, 0x3dc2c0f8, 0x8d1ab2ec, 0x64380e51, 0x68cc7bfb, 0xd90f2788, +0x12490181, 0x5de5ffd4, 0xdd7ef86a, 0x76a2e214, 0xb9a40368, 0x925d958f, +0x4b39fffa, 0xba39aee9, 0xa4ffd30b, 0xfaf7933b, 0x6d498623, 0x193cbcfa, +0x27627545, 0x825cf47a, 0x61bd8ba0, 0xd11e42d1, 0xcead04f4, 0x127ea392, +0x10428db7, 0x8272a972, 0x9270c4a8, 0x127de50b, 0x285ba1c8, 0x3c62f44f, +0x35c0eaa5, 0xe805d231, 0x428929fb, 0xb4fcdf82, 0x4fb66a53, 0x0e7dc15b, +0x1f081fab, 0x108618ae, 0xfcfd086d, 0xf9ff2889, 0x694bcc11, 0x236a5cae, +0x12deca4d, 0x2c3f8cc5, 0xd2d02dfe, 0xf8ef5896, 0xe4cf52da, 0x95155b67, +0x494a488c, 0xb9b6a80c, 0x5c8f82bc, 0x89d36b45, 0x3a609437, 0xec00c9a9, +0x44715253, 0x0a874b49, 0xd773bc40, 0x7c34671c, 0x02717ef6, 0x4feb5536, +0xa2d02fff, 0xd2bf60c4, 0xd43f03c0, 0x50b4ef6d, 0x07478cd1, 0x006e1888, +0xa2e53f55, 0xb9e6d4bc, 0xa2048016, 0x97573833, 0xd7207d67, 0xde0f8f3d, +0x72f87b33, 0xabcc4f33, 0x7688c55d, 0x7b00a6b0, 0x947b0001, 0x570075d2, +0xf9bb88f8, 0x8942019e, 0x4264a5ff, 0x856302e0, 0x72dbd92b, 0xee971b69, +0x6ea22fde, 0x5f08ae2b, 0xaf7a616d, 0xe5c98767, 0xcf1febd2, 0x61efc8c2, +0xf1ac2571, 0xcc8239c2, 0x67214cb8, 0xb1e583d1, 0xb7dc3e62, 0x7f10bdce, +0xf90a5c38, 0x0ff0443d, 0x606e6dc6, 0x60543a49, 0x5727c148, 0x2be98a1d, +0x8ab41738, 0x20e1be24, 0xaf96da0f, 0x68458425, 0x99833be5, 0x600d457d, +0x282f9350, 0x8334b362, 0xd91d1120, 0x2b6d8da0, 0x642b1e31, 0x9c305a00, +0x52bce688, 0x1b03588a, 0xf7baefd5, 0x4142ed9c, 0xa4315c11, 0x83323ec5, +0xdfef4636, 0xa133c501, 0xe9d3531c, 0xee353783, +); + +@Crypt::CAST5_PP::s4 = ( +0x9db30420, 0x1fb6e9de, 0xa7be7bef, 0xd273a298, 0x4a4f7bdb, 0x64ad8c57, +0x85510443, 0xfa020ed1, 0x7e287aff, 0xe60fb663, 0x095f35a1, 0x79ebf120, +0xfd059d43, 0x6497b7b1, 0xf3641f63, 0x241e4adf, 0x28147f5f, 0x4fa2b8cd, +0xc9430040, 0x0cc32220, 0xfdd30b30, 0xc0a5374f, 0x1d2d00d9, 0x24147b15, +0xee4d111a, 0x0fca5167, 0x71ff904c, 0x2d195ffe, 0x1a05645f, 0x0c13fefe, +0x081b08ca, 0x05170121, 0x80530100, 0xe83e5efe, 0xac9af4f8, 0x7fe72701, +0xd2b8ee5f, 0x06df4261, 0xbb9e9b8a, 0x7293ea25, 0xce84ffdf, 0xf5718801, +0x3dd64b04, 0xa26f263b, 0x7ed48400, 0x547eebe6, 0x446d4ca0, 0x6cf3d6f5, +0x2649abdf, 0xaea0c7f5, 0x36338cc1, 0x503f7e93, 0xd3772061, 0x11b638e1, +0x72500e03, 0xf80eb2bb, 0xabe0502e, 0xec8d77de, 0x57971e81, 0xe14f6746, +0xc9335400, 0x6920318f, 0x081dbb99, 0xffc304a5, 0x4d351805, 0x7f3d5ce3, +0xa6c866c6, 0x5d5bcca9, 0xdaec6fea, 0x9f926f91, 0x9f46222f, 0x3991467d, +0xa5bf6d8e, 0x1143c44f, 0x43958302, 0xd0214eeb, 0x022083b8, 0x3fb6180c, +0x18f8931e, 0x281658e6, 0x26486e3e, 0x8bd78a70, 0x7477e4c1, 0xb506e07c, +0xf32d0a25, 0x79098b02, 0xe4eabb81, 0x28123b23, 0x69dead38, 0x1574ca16, +0xdf871b62, 0x211c40b7, 0xa51a9ef9, 0x0014377b, 0x041e8ac8, 0x09114003, +0xbd59e4d2, 0xe3d156d5, 0x4fe876d5, 0x2f91a340, 0x557be8de, 0x00eae4a7, +0x0ce5c2ec, 0x4db4bba6, 0xe756bdff, 0xdd3369ac, 0xec17b035, 0x06572327, +0x99afc8b0, 0x56c8c391, 0x6b65811c, 0x5e146119, 0x6e85cb75, 0xbe07c002, +0xc2325577, 0x893ff4ec, 0x5bbfc92d, 0xd0ec3b25, 0xb7801ab7, 0x8d6d3b24, +0x20c763ef, 0xc366a5fc, 0x9c382880, 0x0ace3205, 0xaac9548a, 0xeca1d7c7, +0x041afa32, 0x1d16625a, 0x6701902c, 0x9b757a54, 0x31d477f7, 0x9126b031, +0x36cc6fdb, 0xc70b8b46, 0xd9e66a48, 0x56e55a79, 0x026a4ceb, 0x52437eff, +0x2f8f76b4, 0x0df980a5, 0x8674cde3, 0xedda04eb, 0x17a9be04, 0x2c18f4df, +0xb7747f9d, 0xab2af7b4, 0xefc34d20, 0x2e096b7c, 0x1741a254, 0xe5b6a035, +0x213d42f6, 0x2c1c7c26, 0x61c2f50f, 0x6552daf9, 0xd2c231f8, 0x25130f69, +0xd8167fa2, 0x0418f2c8, 0x001a96a6, 0x0d1526ab, 0x63315c21, 0x5e0a72ec, +0x49bafefd, 0x187908d9, 0x8d0dbd86, 0x311170a7, 0x3e9b640c, 0xcc3e10d7, +0xd5cad3b6, 0x0caec388, 0xf73001e1, 0x6c728aff, 0x71eae2a1, 0x1f9af36e, +0xcfcbd12f, 0xc1de8417, 0xac07be6b, 0xcb44a1d8, 0x8b9b0f56, 0x013988c3, +0xb1c52fca, 0xb4be31cd, 0xd8782806, 0x12a3a4e2, 0x6f7de532, 0x58fd7eb6, +0xd01ee900, 0x24adffc2, 0xf4990fc5, 0x9711aac5, 0x001d7b95, 0x82e5e7d2, +0x109873f6, 0x00613096, 0xc32d9521, 0xada121ff, 0x29908415, 0x7fbb977f, +0xaf9eb3db, 0x29c9ed2a, 0x5ce2a465, 0xa730f32c, 0xd0aa3fe8, 0x8a5cc091, +0xd49e2ce7, 0x0ce454a9, 0xd60acd86, 0x015f1919, 0x77079103, 0xdea03af6, +0x78a8565e, 0xdee356df, 0x21f05cbe, 0x8b75e387, 0xb3c50651, 0xb8a5c3ef, +0xd8eeb6d2, 0xe523be77, 0xc2154529, 0x2f69efdf, 0xafe67afb, 0xf470c4b2, +0xf3e0eb5b, 0xd6cc9876, 0x39e4460c, 0x1fda8538, 0x1987832f, 0xca007367, +0xa99144f8, 0x296b299e, 0x492fc295, 0x9266beab, 0xb5676e69, 0x9bd3ddda, +0xdf7e052f, 0xdb25701c, 0x1b5e51ee, 0xf65324e6, 0x6afce36c, 0x0316cc04, +0x8644213e, 0xb7dc59d0, 0x7965291f, 0xccd6fd43, 0x41823979, 0x932bcdf6, +0xb657c34d, 0x4edfd282, 0x7ae5290c, 0x3cb9536b, 0x851e20fe, 0x9833557e, +0x13ecf0b0, 0xd3ffb372, 0x3f85c5c1, 0x0aef7ed2, +); + +@Crypt::CAST5_PP::s5 = ( +0x7ec90c04, 0x2c6e74b9, 0x9b0e66df, 0xa6337911, 0xb86a7fff, 0x1dd358f5, +0x44dd9d44, 0x1731167f, 0x08fbf1fa, 0xe7f511cc, 0xd2051b00, 0x735aba00, +0x2ab722d8, 0x386381cb, 0xacf6243a, 0x69befd7a, 0xe6a2e77f, 0xf0c720cd, +0xc4494816, 0xccf5c180, 0x38851640, 0x15b0a848, 0xe68b18cb, 0x4caadeff, +0x5f480a01, 0x0412b2aa, 0x259814fc, 0x41d0efe2, 0x4e40b48d, 0x248eb6fb, +0x8dba1cfe, 0x41a99b02, 0x1a550a04, 0xba8f65cb, 0x7251f4e7, 0x95a51725, +0xc106ecd7, 0x97a5980a, 0xc539b9aa, 0x4d79fe6a, 0xf2f3f763, 0x68af8040, +0xed0c9e56, 0x11b4958b, 0xe1eb5a88, 0x8709e6b0, 0xd7e07156, 0x4e29fea7, +0x6366e52d, 0x02d1c000, 0xc4ac8e05, 0x9377f571, 0x0c05372a, 0x578535f2, +0x2261be02, 0xd642a0c9, 0xdf13a280, 0x74b55bd2, 0x682199c0, 0xd421e5ec, +0x53fb3ce8, 0xc8adedb3, 0x28a87fc9, 0x3d959981, 0x5c1ff900, 0xfe38d399, +0x0c4eff0b, 0x062407ea, 0xaa2f4fb1, 0x4fb96976, 0x90c79505, 0xb0a8a774, +0xef55a1ff, 0xe59ca2c2, 0xa6b62d27, 0xe66a4263, 0xdf65001f, 0x0ec50966, +0xdfdd55bc, 0x29de0655, 0x911e739a, 0x17af8975, 0x32c7911c, 0x89f89468, +0x0d01e980, 0x524755f4, 0x03b63cc9, 0x0cc844b2, 0xbcf3f0aa, 0x87ac36e9, +0xe53a7426, 0x01b3d82b, 0x1a9e7449, 0x64ee2d7e, 0xcddbb1da, 0x01c94910, +0xb868bf80, 0x0d26f3fd, 0x9342ede7, 0x04a5c284, 0x636737b6, 0x50f5b616, +0xf24766e3, 0x8eca36c1, 0x136e05db, 0xfef18391, 0xfb887a37, 0xd6e7f7d4, +0xc7fb7dc9, 0x3063fcdf, 0xb6f589de, 0xec2941da, 0x26e46695, 0xb7566419, +0xf654efc5, 0xd08d58b7, 0x48925401, 0xc1bacb7f, 0xe5ff550f, 0xb6083049, +0x5bb5d0e8, 0x87d72e5a, 0xab6a6ee1, 0x223a66ce, 0xc62bf3cd, 0x9e0885f9, +0x68cb3e47, 0x086c010f, 0xa21de820, 0xd18b69de, 0xf3f65777, 0xfa02c3f6, +0x407edac3, 0xcbb3d550, 0x1793084d, 0xb0d70eba, 0x0ab378d5, 0xd951fb0c, +0xded7da56, 0x4124bbe4, 0x94ca0b56, 0x0f5755d1, 0xe0e1e56e, 0x6184b5be, +0x580a249f, 0x94f74bc0, 0xe327888e, 0x9f7b5561, 0xc3dc0280, 0x05687715, +0x646c6bd7, 0x44904db3, 0x66b4f0a3, 0xc0f1648a, 0x697ed5af, 0x49e92ff6, +0x309e374f, 0x2cb6356a, 0x85808573, 0x4991f840, 0x76f0ae02, 0x083be84d, +0x28421c9a, 0x44489406, 0x736e4cb8, 0xc1092910, 0x8bc95fc6, 0x7d869cf4, +0x134f616f, 0x2e77118d, 0xb31b2be1, 0xaa90b472, 0x3ca5d717, 0x7d161bba, +0x9cad9010, 0xaf462ba2, 0x9fe459d2, 0x45d34559, 0xd9f2da13, 0xdbc65487, +0xf3e4f94e, 0x176d486f, 0x097c13ea, 0x631da5c7, 0x445f7382, 0x175683f4, +0xcdc66a97, 0x70be0288, 0xb3cdcf72, 0x6e5dd2f3, 0x20936079, 0x459b80a5, +0xbe60e2db, 0xa9c23101, 0xeba5315c, 0x224e42f2, 0x1c5c1572, 0xf6721b2c, +0x1ad2fff3, 0x8c25404e, 0x324ed72f, 0x4067b7fd, 0x0523138e, 0x5ca3bc78, +0xdc0fd66e, 0x75922283, 0x784d6b17, 0x58ebb16e, 0x44094f85, 0x3f481d87, +0xfcfeae7b, 0x77b5ff76, 0x8c2302bf, 0xaaf47556, 0x5f46b02a, 0x2b092801, +0x3d38f5f7, 0x0ca81f36, 0x52af4a8a, 0x66d5e7c0, 0xdf3b0874, 0x95055110, +0x1b5ad7a8, 0xf61ed5ad, 0x6cf6e479, 0x20758184, 0xd0cefa65, 0x88f7be58, +0x4a046826, 0x0ff6f8f3, 0xa09c7f70, 0x5346aba0, 0x5ce96c28, 0xe176eda3, +0x6bac307f, 0x376829d2, 0x85360fa9, 0x17e3fe2a, 0x24b79767, 0xf5a96b20, +0xd6cd2595, 0x68ff1ebf, 0x7555442c, 0xf19f06be, 0xf9e0659a, 0xeeb9491d, +0x34010718, 0xbb30cab8, 0xe822fe15, 0x88570983, 0x750e6249, 0xda627e55, +0x5e76ffa8, 0xb1534546, 0x6d47de08, 0xefe9e7d4, +); + +@Crypt::CAST5_PP::s6 = ( +0xf6fa8f9d, 0x2cac6ce1, 0x4ca34867, 0xe2337f7c, 0x95db08e7, 0x016843b4, +0xeced5cbc, 0x325553ac, 0xbf9f0960, 0xdfa1e2ed, 0x83f0579d, 0x63ed86b9, +0x1ab6a6b8, 0xde5ebe39, 0xf38ff732, 0x8989b138, 0x33f14961, 0xc01937bd, +0xf506c6da, 0xe4625e7e, 0xa308ea99, 0x4e23e33c, 0x79cbd7cc, 0x48a14367, +0xa3149619, 0xfec94bd5, 0xa114174a, 0xeaa01866, 0xa084db2d, 0x09a8486f, +0xa888614a, 0x2900af98, 0x01665991, 0xe1992863, 0xc8f30c60, 0x2e78ef3c, +0xd0d51932, 0xcf0fec14, 0xf7ca07d2, 0xd0a82072, 0xfd41197e, 0x9305a6b0, +0xe86be3da, 0x74bed3cd, 0x372da53c, 0x4c7f4448, 0xdab5d440, 0x6dba0ec3, +0x083919a7, 0x9fbaeed9, 0x49dbcfb0, 0x4e670c53, 0x5c3d9c01, 0x64bdb941, +0x2c0e636a, 0xba7dd9cd, 0xea6f7388, 0xe70bc762, 0x35f29adb, 0x5c4cdd8d, +0xf0d48d8c, 0xb88153e2, 0x08a19866, 0x1ae2eac8, 0x284caf89, 0xaa928223, +0x9334be53, 0x3b3a21bf, 0x16434be3, 0x9aea3906, 0xefe8c36e, 0xf890cdd9, +0x80226dae, 0xc340a4a3, 0xdf7e9c09, 0xa694a807, 0x5b7c5ecc, 0x221db3a6, +0x9a69a02f, 0x68818a54, 0xceb2296f, 0x53c0843a, 0xfe893655, 0x25bfe68a, +0xb4628abc, 0xcf222ebf, 0x25ac6f48, 0xa9a99387, 0x53bddb65, 0xe76ffbe7, +0xe967fd78, 0x0ba93563, 0x8e342bc1, 0xe8a11be9, 0x4980740d, 0xc8087dfc, +0x8de4bf99, 0xa11101a0, 0x7fd37975, 0xda5a26c0, 0xe81f994f, 0x9528cd89, +0xfd339fed, 0xb87834bf, 0x5f04456d, 0x22258698, 0xc9c4c83b, 0x2dc156be, +0x4f628daa, 0x57f55ec5, 0xe2220abe, 0xd2916ebf, 0x4ec75b95, 0x24f2c3c0, +0x42d15d99, 0xcd0d7fa0, 0x7b6e27ff, 0xa8dc8af0, 0x7345c106, 0xf41e232f, +0x35162386, 0xe6ea8926, 0x3333b094, 0x157ec6f2, 0x372b74af, 0x692573e4, +0xe9a9d848, 0xf3160289, 0x3a62ef1d, 0xa787e238, 0xf3a5f676, 0x74364853, +0x20951063, 0x4576698d, 0xb6fad407, 0x592af950, 0x36f73523, 0x4cfb6e87, +0x7da4cec0, 0x6c152daa, 0xcb0396a8, 0xc50dfe5d, 0xfcd707ab, 0x0921c42f, +0x89dff0bb, 0x5fe2be78, 0x448f4f33, 0x754613c9, 0x2b05d08d, 0x48b9d585, +0xdc049441, 0xc8098f9b, 0x7dede786, 0xc39a3373, 0x42410005, 0x6a091751, +0x0ef3c8a6, 0x890072d6, 0x28207682, 0xa9a9f7be, 0xbf32679d, 0xd45b5b75, +0xb353fd00, 0xcbb0e358, 0x830f220a, 0x1f8fb214, 0xd372cf08, 0xcc3c4a13, +0x8cf63166, 0x061c87be, 0x88c98f88, 0x6062e397, 0x47cf8e7a, 0xb6c85283, +0x3cc2acfb, 0x3fc06976, 0x4e8f0252, 0x64d8314d, 0xda3870e3, 0x1e665459, +0xc10908f0, 0x513021a5, 0x6c5b68b7, 0x822f8aa0, 0x3007cd3e, 0x74719eef, +0xdc872681, 0x073340d4, 0x7e432fd9, 0x0c5ec241, 0x8809286c, 0xf592d891, +0x08a930f6, 0x957ef305, 0xb7fbffbd, 0xc266e96f, 0x6fe4ac98, 0xb173ecc0, +0xbc60b42a, 0x953498da, 0xfba1ae12, 0x2d4bd736, 0x0f25faab, 0xa4f3fceb, +0xe2969123, 0x257f0c3d, 0x9348af49, 0x361400bc, 0xe8816f4a, 0x3814f200, +0xa3f94043, 0x9c7a54c2, 0xbc704f57, 0xda41e7f9, 0xc25ad33a, 0x54f4a084, +0xb17f5505, 0x59357cbe, 0xedbd15c8, 0x7f97c5ab, 0xba5ac7b5, 0xb6f6deaf, +0x3a479c3a, 0x5302da25, 0x653d7e6a, 0x54268d49, 0x51a477ea, 0x5017d55b, +0xd7d25d88, 0x44136c76, 0x0404a8c8, 0xb8e5a121, 0xb81a928a, 0x60ed5869, +0x97c55b96, 0xeaec991b, 0x29935913, 0x01fdb7f1, 0x088e8dfa, 0x9ab6f6f5, +0x3b4cbf9f, 0x4a5de3ab, 0xe6051d35, 0xa0e1d855, 0xd36b4cf1, 0xf544edeb, +0xb0e93524, 0xbebb8fbd, 0xa2d762cf, 0x49c92f54, 0x38b5f331, 0x7128a454, +0x48392905, 0xa65b1db8, 0x851c97bd, 0xd675cf2f, +); + +@Crypt::CAST5_PP::s7 = ( +0x85e04019, 0x332bf567, 0x662dbfff, 0xcfc65693, 0x2a8d7f6f, 0xab9bc912, +0xde6008a1, 0x2028da1f, 0x0227bce7, 0x4d642916, 0x18fac300, 0x50f18b82, +0x2cb2cb11, 0xb232e75c, 0x4b3695f2, 0xb28707de, 0xa05fbcf6, 0xcd4181e9, +0xe150210c, 0xe24ef1bd, 0xb168c381, 0xfde4e789, 0x5c79b0d8, 0x1e8bfd43, +0x4d495001, 0x38be4341, 0x913cee1d, 0x92a79c3f, 0x089766be, 0xbaeeadf4, +0x1286becf, 0xb6eacb19, 0x2660c200, 0x7565bde4, 0x64241f7a, 0x8248dca9, +0xc3b3ad66, 0x28136086, 0x0bd8dfa8, 0x356d1cf2, 0x107789be, 0xb3b2e9ce, +0x0502aa8f, 0x0bc0351e, 0x166bf52a, 0xeb12ff82, 0xe3486911, 0xd34d7516, +0x4e7b3aff, 0x5f43671b, 0x9cf6e037, 0x4981ac83, 0x334266ce, 0x8c9341b7, +0xd0d854c0, 0xcb3a6c88, 0x47bc2829, 0x4725ba37, 0xa66ad22b, 0x7ad61f1e, +0x0c5cbafa, 0x4437f107, 0xb6e79962, 0x42d2d816, 0x0a961288, 0xe1a5c06e, +0x13749e67, 0x72fc081a, 0xb1d139f7, 0xf9583745, 0xcf19df58, 0xbec3f756, +0xc06eba30, 0x07211b24, 0x45c28829, 0xc95e317f, 0xbc8ec511, 0x38bc46e9, +0xc6e6fa14, 0xbae8584a, 0xad4ebc46, 0x468f508b, 0x7829435f, 0xf124183b, +0x821dba9f, 0xaff60ff4, 0xea2c4e6d, 0x16e39264, 0x92544a8b, 0x009b4fc3, +0xaba68ced, 0x9ac96f78, 0x06a5b79a, 0xb2856e6e, 0x1aec3ca9, 0xbe838688, +0x0e0804e9, 0x55f1be56, 0xe7e5363b, 0xb3a1f25d, 0xf7debb85, 0x61fe033c, +0x16746233, 0x3c034c28, 0xda6d0c74, 0x79aac56c, 0x3ce4e1ad, 0x51f0c802, +0x98f8f35a, 0x1626a49f, 0xeed82b29, 0x1d382fe3, 0x0c4fb99a, 0xbb325778, +0x3ec6d97b, 0x6e77a6a9, 0xcb658b5c, 0xd45230c7, 0x2bd1408b, 0x60c03eb7, +0xb9068d78, 0xa33754f4, 0xf430c87d, 0xc8a71302, 0xb96d8c32, 0xebd4e7be, +0xbe8b9d2d, 0x7979fb06, 0xe7225308, 0x8b75cf77, 0x11ef8da4, 0xe083c858, +0x8d6b786f, 0x5a6317a6, 0xfa5cf7a0, 0x5dda0033, 0xf28ebfb0, 0xf5b9c310, +0xa0eac280, 0x08b9767a, 0xa3d9d2b0, 0x79d34217, 0x021a718d, 0x9ac6336a, +0x2711fd60, 0x438050e3, 0x069908a8, 0x3d7fedc4, 0x826d2bef, 0x4eeb8476, +0x488dcf25, 0x36c9d566, 0x28e74e41, 0xc2610aca, 0x3d49a9cf, 0xbae3b9df, +0xb65f8de6, 0x92aeaf64, 0x3ac7d5e6, 0x9ea80509, 0xf22b017d, 0xa4173f70, +0xdd1e16c3, 0x15e0d7f9, 0x50b1b887, 0x2b9f4fd5, 0x625aba82, 0x6a017962, +0x2ec01b9c, 0x15488aa9, 0xd716e740, 0x40055a2c, 0x93d29a22, 0xe32dbf9a, +0x058745b9, 0x3453dc1e, 0xd699296e, 0x496cff6f, 0x1c9f4986, 0xdfe2ed07, +0xb87242d1, 0x19de7eae, 0x053e561a, 0x15ad6f8c, 0x66626c1c, 0x7154c24c, +0xea082b2a, 0x93eb2939, 0x17dcb0f0, 0x58d4f2ae, 0x9ea294fb, 0x52cf564c, +0x9883fe66, 0x2ec40581, 0x763953c3, 0x01d6692e, 0xd3a0c108, 0xa1e7160e, +0xe4f2dfa6, 0x693ed285, 0x74904698, 0x4c2b0edd, 0x4f757656, 0x5d393378, +0xa132234f, 0x3d321c5d, 0xc3f5e194, 0x4b269301, 0xc79f022f, 0x3c997e7e, +0x5e4f9504, 0x3ffafbbd, 0x76f7ad0e, 0x296693f4, 0x3d1fce6f, 0xc61e45be, +0xd3b5ab34, 0xf72bf9b7, 0x1b0434c0, 0x4e72b567, 0x5592a33d, 0xb5229301, +0xcfd2a87f, 0x60aeb767, 0x1814386b, 0x30bcc33d, 0x38a0c07d, 0xfd1606f2, +0xc363519b, 0x589dd390, 0x5479f8e6, 0x1cb8d647, 0x97fd61a9, 0xea7759f4, +0x2d57539d, 0x569a58cf, 0xe84e63ad, 0x462e1b78, 0x6580f87e, 0xf3817914, +0x91da55f4, 0x40a230f3, 0xd1988f35, 0xb6e318d2, 0x3ffa50bc, 0x3d40f021, +0xc3c0bdae, 0x4958c24c, 0x518f36b2, 0x84b1d370, 0x0fedce83, 0x878ddada, +0xf2a279c7, 0x94e01be8, 0x90716f4b, 0x954b8aa3, +); + +@Crypt::CAST5_PP::s8 = ( +0xe216300d, 0xbbddfffc, 0xa7ebdabd, 0x35648095, 0x7789f8b7, 0xe6c1121b, +0x0e241600, 0x052ce8b5, 0x11a9cfb0, 0xe5952f11, 0xece7990a, 0x9386d174, +0x2a42931c, 0x76e38111, 0xb12def3a, 0x37ddddfc, 0xde9adeb1, 0x0a0cc32c, +0xbe197029, 0x84a00940, 0xbb243a0f, 0xb4d137cf, 0xb44e79f0, 0x049eedfd, +0x0b15a15d, 0x480d3168, 0x8bbbde5a, 0x669ded42, 0xc7ece831, 0x3f8f95e7, +0x72df191b, 0x7580330d, 0x94074251, 0x5c7dcdfa, 0xabbe6d63, 0xaa402164, +0xb301d40a, 0x02e7d1ca, 0x53571dae, 0x7a3182a2, 0x12a8ddec, 0xfdaa335d, +0x176f43e8, 0x71fb46d4, 0x38129022, 0xce949ad4, 0xb84769ad, 0x965bd862, +0x82f3d055, 0x66fb9767, 0x15b80b4e, 0x1d5b47a0, 0x4cfde06f, 0xc28ec4b8, +0x57e8726e, 0x647a78fc, 0x99865d44, 0x608bd593, 0x6c200e03, 0x39dc5ff6, +0x5d0b00a3, 0xae63aff2, 0x7e8bd632, 0x70108c0c, 0xbbd35049, 0x2998df04, +0x980cf42a, 0x9b6df491, 0x9e7edd53, 0x06918548, 0x58cb7e07, 0x3b74ef2e, +0x522fffb1, 0xd24708cc, 0x1c7e27cd, 0xa4eb215b, 0x3cf1d2e2, 0x19b47a38, +0x424f7618, 0x35856039, 0x9d17dee7, 0x27eb35e6, 0xc9aff67b, 0x36baf5b8, +0x09c467cd, 0xc18910b1, 0xe11dbf7b, 0x06cd1af8, 0x7170c608, 0x2d5e3354, +0xd4de495a, 0x64c6d006, 0xbcc0c62c, 0x3dd00db3, 0x708f8f34, 0x77d51b42, +0x264f620f, 0x24b8d2bf, 0x15c1b79e, 0x46a52564, 0xf8d7e54e, 0x3e378160, +0x7895cda5, 0x859c15a5, 0xe6459788, 0xc37bc75f, 0xdb07ba0c, 0x0676a3ab, +0x7f229b1e, 0x31842e7b, 0x24259fd7, 0xf8bef472, 0x835ffcb8, 0x6df4c1f2, +0x96f5b195, 0xfd0af0fc, 0xb0fe134c, 0xe2506d3d, 0x4f9b12ea, 0xf215f225, +0xa223736f, 0x9fb4c428, 0x25d04979, 0x34c713f8, 0xc4618187, 0xea7a6e98, +0x7cd16efc, 0x1436876c, 0xf1544107, 0xbedeee14, 0x56e9af27, 0xa04aa441, +0x3cf7c899, 0x92ecbae6, 0xdd67016d, 0x151682eb, 0xa842eedf, 0xfdba60b4, +0xf1907b75, 0x20e3030f, 0x24d8c29e, 0xe139673b, 0xefa63fb8, 0x71873054, +0xb6f2cf3b, 0x9f326442, 0xcb15a4cc, 0xb01a4504, 0xf1e47d8d, 0x844a1be5, +0xbae7dfdc, 0x42cbda70, 0xcd7dae0a, 0x57e85b7a, 0xd53f5af6, 0x20cf4d8c, +0xcea4d428, 0x79d130a4, 0x3486ebfb, 0x33d3cddc, 0x77853b53, 0x37effcb5, +0xc5068778, 0xe580b3e6, 0x4e68b8f4, 0xc5c8b37e, 0x0d809ea2, 0x398feb7c, +0x132a4f94, 0x43b7950e, 0x2fee7d1c, 0x223613bd, 0xdd06caa2, 0x37df932b, +0xc4248289, 0xacf3ebc3, 0x5715f6b7, 0xef3478dd, 0xf267616f, 0xc148cbe4, +0x9052815e, 0x5e410fab, 0xb48a2465, 0x2eda7fa4, 0xe87b40e4, 0xe98ea084, +0x5889e9e1, 0xefd390fc, 0xdd07d35b, 0xdb485694, 0x38d7e5b2, 0x57720101, +0x730edebc, 0x5b643113, 0x94917e4f, 0x503c2fba, 0x646f1282, 0x7523d24a, +0xe0779695, 0xf9c17a8f, 0x7a5b2121, 0xd187b896, 0x29263a4d, 0xba510cdf, +0x81f47c9f, 0xad1163ed, 0xea7b5965, 0x1a00726e, 0x11403092, 0x00da6d77, +0x4a0cdd61, 0xad1f4603, 0x605bdfb0, 0x9eedc364, 0x22ebe6a8, 0xcee7d28a, +0xa0e736a0, 0x5564a6b9, 0x10853209, 0xc7eb8f37, 0x2de705ca, 0x8951570f, +0xdf09822b, 0xbd691a6c, 0xaa12e4f2, 0x87451c0f, 0xe0f6a27a, 0x3ada4819, +0x4cf1764f, 0x0d771c2b, 0x67cdb156, 0x350d8384, 0x5938fa0f, 0x42399ef3, +0x36997b07, 0x0e84093d, 0x4aa93e61, 0x8360d87b, 0x1fa98b0c, 0x1149382c, +0xe97625a5, 0x0614d1b7, 0x0e25244b, 0x0c768347, 0x589e8d82, 0x0d2059d1, +0xa466bb1e, 0xf8da0a82, 0x04f19130, 0xba6e4ec0, 0x99265164, 0x1ee7230d, +0x50b2ad80, 0xeaee6801, 0x8db2a283, 0xea8bf59e, +); + +1 # end Tables.pm diff --git a/Master/tlpkg/tlperl/lib/Crypt/CBC.pm b/Master/tlpkg/tlperl/lib/Crypt/CBC.pm new file mode 100755 index 00000000000..2de20af4d61 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/CBC.pm @@ -0,0 +1,1050 @@ +package Crypt::CBC; + +use Digest::MD5 'md5'; +use Carp; +use strict; +use bytes; +use vars qw($VERSION); +$VERSION = '2.30'; + +use constant RANDOM_DEVICE => '/dev/urandom'; + +sub new { + my $class = shift; + + my $options = {}; + + # hashref arguments + if (ref $_[0] eq 'HASH') { + $options = shift; + } + + # CGI style arguments + elsif ($_[0] =~ /^-[a-zA-Z_]{1,20}$/) { + my %tmp = @_; + while ( my($key,$value) = each %tmp) { + $key =~ s/^-//; + $options->{lc $key} = $value; + } + } + + else { + $options->{key} = shift; + $options->{cipher} = shift; + } + + my $cipher_object_provided = $options->{cipher} && ref $options->{cipher}; + + # "key" is a misnomer here, because it is actually usually a passphrase that is used + # to derive the true key + my $pass = $options->{key}; + + if ($cipher_object_provided) { + carp "Both a key and a pre-initialized Crypt::* object were passed. The key will be ignored" + if defined $pass; + $pass ||= ''; + } + elsif (!defined $pass) { + croak "Please provide an encryption/decryption passphrase or key using -key" + } + + # header mode + my %valid_modes = map {$_=>1} qw(none salt randomiv); + my $header_mode = $options->{header}; + $header_mode ||= 'none' if exists $options->{prepend_iv} && !$options->{prepend_iv}; + $header_mode ||= 'none' if exists $options->{add_header} && !$options->{add_header}; + $header_mode ||= 'salt'; # default + croak "Invalid -header mode '$header_mode'" unless $valid_modes{$header_mode}; + + croak "The -salt argument is incompatible with a -header mode of $header_mode" + if exists $options->{salt} && $header_mode ne 'salt'; + + my $cipher = $options->{cipher}; + $cipher = 'Crypt::DES' unless $cipher; + my $cipherclass = ref $cipher || $cipher; + + unless (ref $cipher) { # munge the class name if no object passed + $cipher = $cipher=~/^Crypt::/ ? $cipher : "Crypt::$cipher"; + $cipher->can('encrypt') or eval "require $cipher; 1" or croak "Couldn't load $cipher: $@"; + # some crypt modules use the class Crypt::, and others don't + $cipher =~ s/^Crypt::// unless $cipher->can('keysize'); + } + + # allow user to override these values + my $ks = $options->{keysize}; + my $bs = $options->{blocksize}; + + # otherwise we get the values from the cipher + $ks ||= eval {$cipher->keysize}; + $bs ||= eval {$cipher->blocksize}; + + # Some of the cipher modules are busted and don't report the + # keysize (well, Crypt::Blowfish in any case). If we detect + # this, and find the blowfish module in use, then assume 56. + # Otherwise assume the least common denominator of 8. + $ks ||= $cipherclass =~ /blowfish/i ? 56 : 8; + $bs ||= $ks; + + my $pcbc = $options->{'pcbc'}; + + # Default behavior is to treat -key as a passphrase. + # But if the literal_key option is true, then use key as is + croak "The options -literal_key and -regenerate_key are incompatible with each other" + if exists $options->{literal_key} && exists $options->{regenerate_key}; + my $key; + $key = $pass if $options->{literal_key}; + $key = $pass if exists $options->{regenerate_key} && !$options->{regenerate_key}; + + # Get the salt. + my $salt = $options->{salt}; + my $random_salt = 1 unless defined $salt && $salt ne '1'; + croak "Argument to -salt must be exactly 8 bytes long" if defined $salt && length $salt != 8 && $salt ne '1'; + + # note: iv will be autogenerated by start() if not specified in options + my $iv = $options->{iv}; + my $random_iv = 1 unless defined $iv; + croak "Initialization vector must be exactly $bs bytes long when using the $cipherclass cipher" if defined $iv and length($iv) != $bs; + + my $literal_key = $options->{literal_key} || (exists $options->{regenerate_key} && !$options->{regenerate_key}); + my $legacy_hack = $options->{insecure_legacy_decrypt}; + my $padding = $options->{padding} || 'standard'; + + if ($padding && ref($padding) eq 'CODE') { + # check to see that this code does its padding correctly + for my $i (1..$bs-1) { + my $rbs = length($padding->(" "x$i,$bs,'e')); + croak "padding method callback does not behave properly: expected $bs bytes back, got $rbs bytes back." + unless ($rbs == $bs); + } + } else { + $padding = $padding eq 'null' ? \&_null_padding + :$padding eq 'space' ? \&_space_padding + :$padding eq 'oneandzeroes' ? \&_oneandzeroes_padding + :$padding eq 'rijndael_compat'? \&_rijndael_compat + :$padding eq 'standard' ? \&_standard_padding + :croak "'$padding' padding not supported. See perldoc Crypt::CBC for instructions on creating your own."; + } + + # CONSISTENCY CHECKS + # HEADER consistency + if ($header_mode eq 'salt') { + croak "Cannot use salt-based key generation if literal key is specified" + if $options->{literal_key}; + croak "Cannot use salt-based IV generation if literal IV is specified" + if exists $options->{iv}; + } + elsif ($header_mode eq 'randomiv') { + croak "Cannot encrypt using a non-8 byte blocksize cipher when using randomiv header mode" + unless $bs == 8 || $legacy_hack; + } + elsif ($header_mode eq 'none') { + croak "You must provide an initialization vector using -iv when using -header=>'none'" + unless exists $options->{iv}; + } + + # KEYSIZE consistency + if (defined $key && length($key) != $ks) { + croak "If specified by -literal_key, then the key length must be equal to the chosen cipher's key length of $ks bytes"; + } + + # IV consistency + if (defined $iv && length($iv) != $bs) { + croak "If specified by -iv, then the initialization vector length must be equal to the chosen cipher's blocksize of $bs bytes"; + } + + + return bless {'cipher' => $cipher, + 'passphrase' => $pass, + 'key' => $key, + 'iv' => $iv, + 'salt' => $salt, + 'padding' => $padding, + 'blocksize' => $bs, + 'keysize' => $ks, + 'header_mode' => $header_mode, + 'legacy_hack' => $legacy_hack, + 'literal_key' => $literal_key, + 'pcbc' => $pcbc, + 'make_random_salt' => $random_salt, + 'make_random_iv' => $random_iv, + },$class; +} + +sub encrypt (\$$) { + my ($self,$data) = @_; + $self->start('encrypting'); + my $result = $self->crypt($data); + $result .= $self->finish; + $result; +} + +sub decrypt (\$$){ + my ($self,$data) = @_; + $self->start('decrypting'); + my $result = $self->crypt($data); + $result .= $self->finish; + $result; +} + +sub encrypt_hex (\$$) { + my ($self,$data) = @_; + return join('',unpack 'H*',$self->encrypt($data)); +} + +sub decrypt_hex (\$$) { + my ($self,$data) = @_; + return $self->decrypt(pack'H*',$data); +} + +# call to start a series of encryption/decryption operations +sub start (\$$) { + my $self = shift; + my $operation = shift; + croak "Specify <e>ncryption or <d>ecryption" unless $operation=~/^[ed]/i; + + $self->{'buffer'} = ''; + $self->{'decrypt'} = $operation=~/^d/i; +} + +# call to encrypt/decrypt a bit of data +sub crypt (\$$){ + my $self = shift; + my $data = shift; + + my $result; + + croak "crypt() called without a preceding start()" + unless exists $self->{'buffer'}; + + my $d = $self->{'decrypt'}; + + unless ($self->{civ}) { # block cipher has not yet been initialized + $result = $self->_generate_iv_and_cipher_from_datastream(\$data) if $d; + $result = $self->_generate_iv_and_cipher_from_options() unless $d; + } + + my $iv = $self->{'civ'}; + $self->{'buffer'} .= $data; + + my $bs = $self->{'blocksize'}; + + croak "When using rijndael_compat padding, plaintext size must be a multiple of $bs" + if $self->{'padding'} eq \&_rijndael_compat + and length($data) % $bs; + + return $result unless (length($self->{'buffer'}) >= $bs); + + my @blocks = unpack("a$bs "x(int(length($self->{'buffer'})/$bs)) . "a*", $self->{'buffer'}); + $self->{'buffer'} = ''; + + if ($d) { # when decrypting, always leave a free block at the end + $self->{'buffer'} = length($blocks[-1]) < $bs ? join '',splice(@blocks,-2) : pop(@blocks); + } else { + $self->{'buffer'} = pop @blocks if length($blocks[-1]) < $bs; # what's left over + } + + foreach my $block (@blocks) { + if ($d) { # decrypting + $result .= $iv = $iv ^ $self->{'crypt'}->decrypt($block); + $iv = $block unless $self->{pcbc}; + } else { # encrypting + $result .= $iv = $self->{'crypt'}->encrypt($iv ^ $block); + } + $iv = $iv ^ $block if $self->{pcbc}; + } + $self->{'civ'} = $iv; # remember the iv + return $result; +} + +# this is called at the end to flush whatever's left +sub finish (\$) { + my $self = shift; + my $bs = $self->{'blocksize'}; + my $block = defined $self->{'buffer'} ? $self->{'buffer'} : ''; + + $self->{civ} ||= ''; + + my $result; + if ($self->{'decrypt'}) { #decrypting + $block = length $block ? pack("a$bs",$block) : ''; # pad and truncate to block size + + if (length($block)) { + $result = $self->{'civ'} ^ $self->{'crypt'}->decrypt($block); + $result = $self->{'padding'}->($result, $bs, 'd'); + } else { + $result = ''; + } + + } else { # encrypting + $block = $self->{'padding'}->($block,$bs,'e') || ''; + $result = length $block ? $self->{'crypt'}->encrypt($self->{'civ'} ^ $block) : ''; + } + delete $self->{'civ'}; + delete $self->{'buffer'}; + return $result; +} + +# this subroutine will generate the actual {en,de}cryption key, the iv +# and the block cipher object. This is called when reading from a datastream +# and so it uses previous values of salt or iv if they are encoded in datastream +# header +sub _generate_iv_and_cipher_from_datastream { + my $self = shift; + my $input_stream = shift; + my $bs = $self->blocksize; + + # use our header mode to figure out what to do with the data stream + my $header_mode = $self->header_mode; + + if ($header_mode eq 'none') { + croak "You must specify a $bs byte initialization vector by passing the -iv option to new() when using -header_mode=>'none'" + unless exists $self->{iv}; + $self->{civ} = $self->{iv}; # current IV equals saved IV + $self->{key} ||= $self->_key_from_key($self->{passphrase}); + } + + elsif ($header_mode eq 'salt') { + my ($salt) = $$input_stream =~ /^Salted__(.{8})/s; + croak "Ciphertext does not begin with a valid header for 'salt' header mode" unless defined $salt; + $self->{salt} = $salt; # new salt + substr($$input_stream,0,16) = ''; + my ($key,$iv) = $self->_salted_key_and_iv($self->{passphrase},$salt); + $self->{iv} = $self->{civ} = $iv; + $self->{key} = $key; + } + + elsif ($header_mode eq 'randomiv') { + my ($iv) = $$input_stream =~ /^RandomIV(.{8})/s; + croak "Ciphertext does not begin with a valid header for 'randomiv' header mode" unless defined $iv; + croak "randomiv header mode cannot be used securely when decrypting with a >8 byte block cipher.\nUse the -insecure_legacy_decrypt flag if you are sure you want to do this" unless $self->blocksize == 8 || $self->legacy_hack; + $self->{iv} = $self->{civ} = $iv; + $self->{key} = $self->_key_from_key($self->{passphrase}); + undef $self->{salt}; # paranoia + substr($$input_stream,0,16) = ''; # truncate + } + + else { + croak "Invalid header mode '$header_mode'"; + } + + # we should have the key and iv now, or we are dead in the water + croak "Cipher stream did not contain IV or salt, and you did not specify these values in new()" + unless $self->{key} && $self->{civ}; + + # now we can generate the crypt object itself + $self->{crypt} = ref $self->{cipher} ? $self->{cipher} + : $self->{cipher}->new($self->{key}) + or croak "Could not create $self->{cipher} object: $@"; + return ''; +} + +sub _generate_iv_and_cipher_from_options { + my $self = shift; + my $blocksize = $self->blocksize; + + my $result = ''; + + my $header_mode = $self->header_mode; + if ($header_mode eq 'none') { + croak "You must specify a $blocksize byte initialization vector by passing the -iv option to new() when using -header_mode=>'none'" + unless exists $self->{iv}; + $self->{civ} = $self->{iv}; + $self->{key} ||= $self->_key_from_key($self->{passphrase}); + } + + elsif ($header_mode eq 'salt') { + $self->{salt} = $self->_get_random_bytes(8) if $self->{make_random_salt}; + defined (my $salt = $self->{salt}) or croak "No header_mode of 'salt' specified, but no salt value provided"; # shouldn't happen + length($salt) == 8 or croak "Salt must be exactly 8 bytes long"; + my ($key,$iv) = $self->_salted_key_and_iv($self->{passphrase},$salt); + $self->{key} = $key; + $self->{civ} = $self->{iv} = $iv; + $result = "Salted__${salt}"; + } + + elsif ($header_mode eq 'randomiv') { + croak "randomiv header mode cannot be used when encrypting with a >8 byte block cipher. There is no option to allow this" + unless $blocksize == 8; + $self->{key} ||= $self->_key_from_key($self->{passphrase}); + $self->{iv} = $self->_get_random_bytes(8) if $self->{make_random_iv}; + length($self->{iv}) == 8 or croak "IV must be exactly 8 bytes long when used with header mode of 'randomiv'"; + $self->{civ} = $self->{iv}; + $result = "RandomIV$self->{iv}"; + } + + croak "key and/or iv are missing" unless defined $self->{key} && defined $self->{civ}; + + $self->_taintcheck($self->{key}); + $self->{crypt} = ref $self->{cipher} ? $self->{cipher} + : $self->{cipher}->new($self->{key}) + or croak "Could not create $self->{cipher} object: $@"; + return $result; +} + +sub _taintcheck { + my $self = shift; + my $key = shift; + return unless ${^TAINT}; + + my $has_scalar_util = eval "require Scalar::Util; 1"; + my $tainted; + + if ($has_scalar_util) { + $tainted = Scalar::Util::tainted($key); + } else { + local($@, $SIG{__DIE__}, $SIG{__WARN__}); + local $^W = 0; + eval { kill 0 * $key }; + $tainted = $@ =~ /^Insecure/; + } + + croak "Taint checks are turned on and your key is tainted. Please untaint the key and try again" + if $tainted; +} + +sub _key_from_key { + my $self = shift; + my $pass = shift; + my $ks = $self->{keysize}; + + return $pass if $self->{literal_key}; + + my $material = md5($pass); + while (length($material) < $ks) { + $material .= md5($material); + } + return substr($material,0,$ks); +} + +sub _salted_key_and_iv { + my $self = shift; + my ($pass,$salt) = @_; + + croak "Salt must be 8 bytes long" unless length $salt == 8; + + my $key_len = $self->{keysize}; + my $iv_len = $self->{blocksize}; + + my $desired_len = $key_len+$iv_len; + + my $data = ''; + my $d = ''; + + while (length $data < $desired_len) { + $d = md5($d . $pass . $salt); + $data .= $d; + } + return (substr($data,0,$key_len),substr($data,$key_len,$iv_len)); +} + +sub random_bytes { + my $self = shift; + my $bytes = shift or croak "usage: random_bytes(\$byte_length)"; + $self->_get_random_bytes($bytes); +} + +sub _get_random_bytes { + my $self = shift; + my $length = shift; + my $result; + + if (-r RANDOM_DEVICE && open(F,RANDOM_DEVICE)) { + read(F,$result,$length); + close F; + } else { + $result = pack("C*",map {rand(256)} 1..$length); + } + # Clear taint and check length + $result =~ /^(.{$length})$/s or croak "Invalid length while gathering $length randim bytes"; + return $1; +} + +sub _standard_padding ($$$) { + my ($b,$bs,$decrypt) = @_; + $b = length $b ? $b : ''; + if ($decrypt eq 'd') { + my $pad_length = unpack("C",substr($b,-1)); + + # sanity check for implementations that don't pad correctly + return $b unless $pad_length >= 0 && $pad_length <= $bs; + my @pad_chars = unpack("C*",substr($b,-$pad_length)); + return $b if grep {$pad_length != $_} @pad_chars; + + return substr($b,0,$bs-$pad_length); + } + my $pad = $bs - length($b) % $bs; + return $b . pack("C*",($pad)x$pad); +} + +sub _space_padding ($$$) { + my ($b,$bs,$decrypt) = @_; + return unless length $b; + $b = length $b ? $b : ''; + if ($decrypt eq 'd') { + $b=~ s/ *$//s; + return $b; + } + return $b . pack("C*", (32) x ($bs - length($b) % $bs)); +} + +sub _null_padding ($$$) { + my ($b,$bs,$decrypt) = @_; + return unless length $b; + $b = length $b ? $b : ''; + if ($decrypt eq 'd') { + $b=~ s/\0*$//s; + return $b; + } + return $b . pack("C*", (0) x ($bs - length($b) % $bs)); +} + +sub _oneandzeroes_padding ($$$) { + my ($b,$bs,$decrypt) = @_; + $b = length $b ? $b : ''; + if ($decrypt eq 'd') { + my $hex = unpack("H*", $b); + $hex =~ s/80*$//s; + return pack("H*", $hex); + } + return $b . pack("C*", 128, (0) x ($bs - length($b) % $bs - 1) ); +} + +sub _rijndael_compat ($$$) { + my ($b,$bs,$decrypt) = @_; + return unless length $b; + if ($decrypt eq 'd') { + my $hex = unpack("H*", $b); + $hex =~ s/80*$//s; + return pack("H*", $hex); + } + return $b . pack("C*", 128, (0) x ($bs - length($b) % $bs - 1) ); +} + +sub get_initialization_vector (\$) { + my $self = shift; + $self->iv(); +} + +sub set_initialization_vector (\$$) { + my $self = shift; + my $iv = shift; + my $bs = $self->blocksize; + croak "Initialization vector must be $bs bytes in length" unless length($iv) == $bs; + $self->iv($iv); +} + +sub salt { + my $self = shift; + my $d = $self->{salt}; + $self->{salt} = shift if @_; + $d; +} + +sub iv { + my $self = shift; + my $d = $self->{iv}; + $self->{iv} = shift if @_; + $d; +} + +sub key { + my $self = shift; + my $d = $self->{key}; + $self->{key} = shift if @_; + $d; +} + +sub passphrase { + my $self = shift; + my $d = $self->{passphrase}; + if (@_) { + undef $self->{key}; + undef $self->{iv}; + $self->{passphrase} = shift; + } + $d; +} + +sub cipher { shift->{cipher} } +sub padding { shift->{padding} } +sub keysize { shift->{keysize} } +sub blocksize { shift->{blocksize} } +sub pcbc { shift->{pcbc} } +sub header_mode {shift->{header_mode} } +sub legacy_hack { shift->{legacy_hack} } + +1; +__END__ + +=head1 NAME + +Crypt::CBC - Encrypt Data with Cipher Block Chaining Mode + +=head1 SYNOPSIS + + use Crypt::CBC; + $cipher = Crypt::CBC->new( -key => 'my secret key', + -cipher => 'Blowfish' + ); + + $ciphertext = $cipher->encrypt("This data is hush hush"); + $plaintext = $cipher->decrypt($ciphertext); + + $cipher->start('encrypting'); + open(F,"./BIG_FILE"); + while (read(F,$buffer,1024)) { + print $cipher->crypt($buffer); + } + print $cipher->finish; + + # do-it-yourself mode -- specify key, initialization vector yourself + $key = Crypt::CBC->random_bytes(8); # assuming a 8-byte block cipher + $iv = Crypt::CBC->random_bytes(8); + $cipher = Crypt::CBC->new(-literal_key => 1, + -key => $key, + -iv => $iv, + -header => 'none'); + + $ciphertext = $cipher->encrypt("This data is hush hush"); + $plaintext = $cipher->decrypt($ciphertext); + + # RANDOMIV-compatible mode + $cipher = Crypt::CBC->new(-key => 'Super Secret!' + -header => 'randomiv'); + + +=head1 DESCRIPTION + +This module is a Perl-only implementation of the cryptographic cipher +block chaining mode (CBC). In combination with a block cipher such as +DES or IDEA, you can encrypt and decrypt messages of arbitrarily long +length. The encrypted messages are compatible with the encryption +format used by the B<OpenSSL> package. + +To use this module, you will first create a Crypt::CBC cipher object +with new(). At the time of cipher creation, you specify an encryption +key to use and, optionally, a block encryption algorithm. You will +then call the start() method to initialize the encryption or +decryption process, crypt() to encrypt or decrypt one or more blocks +of data, and lastly finish(), to pad and encrypt the final block. For +your convenience, you can call the encrypt() and decrypt() methods to +operate on a whole data value at once. + +=head2 new() + + $cipher = Crypt::CBC->new( -key => 'my secret key', + -cipher => 'Blowfish', + ); + + # or (for compatibility with versions prior to 2.13) + $cipher = Crypt::CBC->new( { + key => 'my secret key', + cipher => 'Blowfish' + } + ); + + + # or (for compatibility with versions prior to 2.0) + $cipher = new Crypt::CBC('my secret key' => 'Blowfish'); + +The new() method creates a new Crypt::CBC object. It accepts a list of +-argument => value pairs selected from the following list: + + Argument Description + -------- ----------- + + -key The encryption/decryption key (required) + + -cipher The cipher algorithm (defaults to Crypt::DES), or + a preexisting cipher object. + + -salt Enables OpenSSL-compatibility. If equal to a value + of "1" then causes a random salt to be generated + and used to derive the encryption key and IV. Other + true values are taken to be the literal salt. + + -iv The initialization vector (IV) + + -header What type of header to prepend to ciphertext. One of + 'salt' -- use OpenSSL-compatible salted header + 'randomiv' -- Randomiv-compatible "RandomIV" header + 'none' -- prepend no header at all + + -padding The padding method, one of "standard" (default), + "space", "oneandzeroes", "rijndael_compat", + or "null" (default "standard"). + + -literal_key If true, the key provided by "key" is used directly + for encryption/decryption. Otherwise the actual + key used will be a hash of the provided key. + (default false) + + -pcbc Whether to use the PCBC chaining algorithm rather than + the standard CBC algorithm (default false). + + -keysize Force the cipher keysize to the indicated number of bytes. + + -blocksize Force the cipher blocksize to the indicated number of bytes. + + -insecure_legacy_decrypt + Allow decryption of data encrypted using the "RandomIV" header + produced by pre-2.17 versions of Crypt::CBC. + + -add_header [deprecated; use -header instread] + Whether to add the salt and IV to the header of the output + cipher text. + + -regenerate_key [deprecated; use literal_key instead] + Whether to use a hash of the provided key to generate + the actual encryption key (default true) + + -prepend_iv [deprecated; use add_header instead] + Whether to prepend the IV to the beginning of the + encrypted stream (default true) + +Crypt::CBC requires three pieces of information to do its job. First +it needs the name of the block cipher algorithm that will encrypt or +decrypt the data in blocks of fixed length known as the cipher's +"blocksize." Second, it needs an encryption/decryption key to pass to +the block cipher. Third, it needs an initialization vector (IV) that +will be used to propagate information from one encrypted block to the +next. Both the key and the IV must be exactly the same length as the +chosen cipher's blocksize. + +Crypt::CBC can derive the key and the IV from a passphrase that you +provide, or can let you specify the true key and IV manually. In +addition, you have the option of embedding enough information to +regenerate the IV in a short header that is emitted at the start of +the encrypted stream, or outputting a headerless encryption stream. In +the first case, Crypt::CBC will be able to decrypt the stream given +just the original key or passphrase. In the second case, you will have +to provide the original IV as well as the key/passphrase. + +The B<-cipher> option specifies which block cipher algorithm to use to +encode each section of the message. This argument is optional and +will default to the quick-but-not-very-secure DES algorithm unless +specified otherwise. You may use any compatible block encryption +algorithm that you have installed. Currently, this includes +Crypt::DES, Crypt::DES_EDE3, Crypt::IDEA, Crypt::Blowfish, +Crypt::CAST5 and Crypt::Rijndael. You may refer to them using their +full names ("Crypt::IDEA") or in abbreviated form ("IDEA"). + +Instead of passing the name of a cipher class, you may pass an +already-created block cipher object. This allows you to take advantage +of cipher algorithms that have parameterized new() methods, such as +Crypt::Eksblowfish: + + my $eksblowfish = Crypt::Eksblowfish->new(8,$salt,$key); + my $cbc = Crypt::CBC->new(-cipher=>$eksblowfish); + +The B<-key> argument provides either a passphrase to use to generate +the encryption key, or the literal value of the block cipher key. If +used in passphrase mode (which is the default), B<-key> can be any +number of characters; the actual key will be derived by passing the +passphrase through a series of MD5 hash operations. To take full +advantage of a given block cipher, the length of the passphrase should +be at least equal to the cipher's blocksize. To skip this hashing +operation and specify the key directly, pass a true value to the +B<-literal_key> option. In this case, you should choose a key of +length exactly equal to the cipher's key length. You should also +specify the IV yourself and a -header mode of 'none'. + +If you pass an existing Crypt::* object to new(), then the -key +argument is ignored and the module will generate a warning. + +The B<-header> argument specifies what type of header, if any, to +prepend to the beginning of the encrypted data stream. The header +allows Crypt::CBC to regenerate the original IV and correctly decrypt +the data without your having to provide the same IV used to encrypt +the data. Valid values for the B<-header> are: + + "salt" -- Combine the passphrase with an 8-byte random value to + generate both the block cipher key and the IV from the + provided passphrase. The salt will be appended to the + beginning of the data stream allowing decryption to + regenerate both the key and IV given the correct passphrase. + This method is compatible with current versions of OpenSSL. + + "randomiv" -- Generate the block cipher key from the passphrase, and + choose a random 8-byte value to use as the IV. The IV will + be prepended to the data stream. This method is compatible + with ciphertext produced by versions of the library prior to + 2.17, but is incompatible with block ciphers that have non + 8-byte block sizes, such as Rijndael. Crypt::CBC will exit + with a fatal error if you try to use this header mode with a + non 8-byte cipher. + + "none" -- Do not generate a header. To decrypt a stream encrypted + in this way, you will have to provide the original IV + manually. + +B<The "salt" header is now the default as of Crypt::CBC version 2.17. In +all earlier versions "randomiv" was the default.> + +When using a "salt" header, you may specify your own value of the +salt, by passing the desired 8-byte salt to the B<-salt> +argument. Otherwise, the module will generate a random salt for +you. Crypt::CBC will generate a fatal error if you specify a salt +value that isn't exactly 8 bytes long. For backward compatibility +reasons, passing a value of "1" will generate a random salt, the same +as if no B<-salt> argument was provided. + +The B<-padding> argument controls how the last few bytes of the +encrypted stream are dealt with when they not an exact multiple of the +cipher block length. The default is "standard", the method specified +in PKCS#5. + +The B<-pcbc> argument, if true, activates a modified chaining mode +known as PCBC. It provides better error propagation characteristics +than the default CBC encryption and is required for authenticating to +Kerberos4 systems (see RFC 2222). + +The B<-keysize> and B<-blocksize> arguments can be used to force the +cipher's keysize and/or blocksize. This is only currently useful for +the Crypt::Blowfish module, which accepts a variable length +keysize. If -keysize is not specified, then Crypt::CBC will use the +maximum length Blowfish key size of 56 bytes (448 bits). The Openssl +library defaults to 16 byte Blowfish key sizes, so for compatibility +with Openssl you may wish to set -keysize=>16. There are currently no +Crypt::* modules that have variable block sizes, but an option to +change the block size is provided just in case. + +For compatibility with earlier versions of this module, you can +provide new() with a hashref containing key/value pairs. The key names +are the same as the arguments described earlier, but without the +initial hyphen. You may also call new() with one or two positional +arguments, in which case the first argument is taken to be the key and +the second to be the optional block cipher algorithm. + +B<IMPORTANT NOTE:> Versions of this module prior to 2.17 were +incorrectly using 8-byte IVs when generating the "randomiv" style of +header, even when the chosen cipher's blocksize was greater than 8 +bytes. This primarily affects the Rijndael algorithm. Such encrypted +data streams were B<not secure>. From versions 2.17 onward, Crypt::CBC +will refuse to encrypt or decrypt using the "randomiv" header and non-8 +byte block ciphers. To decrypt legacy data encrypted with earlier +versions of the module, you can override the check using the +B<-insecure_legacy_decrypt> option. It is not possible to override +encryption. Please use the default "salt" header style, or no headers +at all. + +=head2 start() + + $cipher->start('encrypting'); + $cipher->start('decrypting'); + +The start() method prepares the cipher for a series of encryption or +decryption steps, resetting the internal state of the cipher if +necessary. You must provide a string indicating whether you wish to +encrypt or decrypt. "E" or any word that begins with an "e" indicates +encryption. "D" or any word that begins with a "d" indicates +decryption. + +=head2 crypt() + + $ciphertext = $cipher->crypt($plaintext); + +After calling start(), you should call crypt() as many times as +necessary to encrypt the desired data. + +=head2 finish() + + $ciphertext = $cipher->finish(); + +The CBC algorithm must buffer data blocks inernally until they are +even multiples of the encryption algorithm's blocksize (typically 8 +bytes). After the last call to crypt() you should call finish(). +This flushes the internal buffer and returns any leftover ciphertext. + +In a typical application you will read the plaintext from a file or +input stream and write the result to standard output in a loop that +might look like this: + + $cipher = new Crypt::CBC('hey jude!'); + $cipher->start('encrypting'); + print $cipher->crypt($_) while <>; + print $cipher->finish(); + +=head2 encrypt() + + $ciphertext = $cipher->encrypt($plaintext) + +This convenience function runs the entire sequence of start(), crypt() +and finish() for you, processing the provided plaintext and returning +the corresponding ciphertext. + +=head2 decrypt() + + $plaintext = $cipher->decrypt($ciphertext) + +This convenience function runs the entire sequence of start(), crypt() +and finish() for you, processing the provided ciphertext and returning +the corresponding plaintext. + +=head2 encrypt_hex(), decrypt_hex() + + $ciphertext = $cipher->encrypt_hex($plaintext) + $plaintext = $cipher->decrypt_hex($ciphertext) + +These are convenience functions that operate on ciphertext in a +hexadecimal representation. B<encrypt_hex($plaintext)> is exactly +equivalent to B<unpack('H*',encrypt($plaintext))>. These functions +can be useful if, for example, you wish to place the encrypted in an +email message. + +=head2 get_initialization_vector() + + $iv = $cipher->get_initialization_vector() + +This function will return the IV used in encryption and or decryption. +The IV is not guaranteed to be set when encrypting until start() is +called, and when decrypting until crypt() is called the first +time. Unless the IV was manually specified in the new() call, the IV +will change with every complete encryption operation. + +=head2 set_initialization_vector() + + $cipher->set_initialization_vector('76543210') + +This function sets the IV used in encryption and/or decryption. This +function may be useful if the IV is not contained within the +ciphertext string being decrypted, or if a particular IV is desired +for encryption. Note that the IV must match the chosen cipher's +blocksize bytes in length. + +=head2 iv() + + $iv = $cipher->iv(); + $cipher->iv($new_iv); + +As above, but using a single method call. + +=head2 key() + + $key = $cipher->key(); + $cipher->key($new_key); + +Get or set the block cipher key used for encryption/decryption. When +encrypting, the key is not guaranteed to exist until start() is +called, and when decrypting, the key is not guaranteed to exist until +after the first call to crypt(). The key must match the length +required by the underlying block cipher. + +When salted headers are used, the block cipher key will change after +each complete sequence of encryption operations. + +=head2 salt() + + $salt = $cipher->salt(); + $cipher->salt($new_salt); + +Get or set the salt used for deriving the encryption key and IV when +in OpenSSL compatibility mode. + +=head2 passphrase() + + $passphrase = $cipher->passphrase(); + $cipher->passphrase($new_passphrase); + +This gets or sets the value of the B<key> passed to new() when +B<literal_key> is false. + +=head2 $data = get_random_bytes($numbytes) + +Return $numbytes worth of random data. On systems that support the +"/dev/urandom" device file, this data will be read from the +device. Otherwise, it will be generated by repeated calls to the Perl +rand() function. + +=head2 cipher(), padding(), keysize(), blocksize(), pcbc() + +These read-only methods return the identity of the chosen block cipher +algorithm, padding method, key and block size of the chosen block +cipher, and whether PCBC chaining is in effect. + +=head2 Padding methods + +Use the 'padding' option to change the padding method. + +When the last block of plaintext is shorter than the block size, +it must be padded. Padding methods include: "standard" (i.e., PKCS#5), +"oneandzeroes", "space", "rijndael_compat" and "null". + + standard: (default) Binary safe + pads with the number of bytes that should be truncated. So, if + blocksize is 8, then "0A0B0C" will be padded with "05", resulting + in "0A0B0C0505050505". If the final block is a full block of 8 + bytes, then a whole block of "0808080808080808" is appended. + + oneandzeroes: Binary safe + pads with "80" followed by as many "00" necessary to fill the + block. If the last block is a full block and blocksize is 8, a + block of "8000000000000000" will be appended. + + rijndael_compat: Binary safe, with caveats + similar to oneandzeroes, except that no padding is performed if + the last block is a full block. This is provided for + compatibility with Crypt::Rijndael only and can only be used + with messages that are a multiple of the Rijndael blocksize + of 16 bytes. + + null: text only + pads with as many "00" necessary to fill the block. If the last + block is a full block and blocksize is 8, a block of + "0000000000000000" will be appended. + + space: text only + same as "null", but with "20". + +Both the standard and oneandzeroes paddings are binary safe. The +space and null paddings are recommended only for text data. Which +type of padding you use depends on whether you wish to communicate +with an external (non Crypt::CBC library). If this is the case, use +whatever padding method is compatible. + +You can also pass in a custom padding function. To do this, create a +function that takes the arguments: + + $padded_block = function($block,$blocksize,$direction); + +where $block is the current block of data, $blocksize is the size to +pad it to, $direction is "e" for encrypting and "d" for decrypting, +and $padded_block is the result after padding or depadding. + +When encrypting, the function should always return a string of +<blocksize> length, and when decrypting, can expect the string coming +in to always be that length. See _standard_padding(), _space_padding(), +_null_padding(), or _oneandzeroes_padding() in the source for examples. + +Standard and oneandzeroes padding are recommended, as both space and +null padding can potentially truncate more characters than they should. + +=head1 EXAMPLES + +Two examples, des.pl and idea.pl can be found in the eg/ subdirectory +of the Crypt-CBC distribution. These implement command-line DES and +IDEA encryption algorithms. + +=head1 LIMITATIONS + +The encryption and decryption process is about a tenth the speed of +the equivalent SSLeay programs (compiled C). This could be improved +by implementing this module in C. It may also be worthwhile to +optimize the DES and IDEA block algorithms further. + +=head1 BUGS + +Please report them. + +=head1 AUTHOR + +Lincoln Stein, lstein@cshl.org + +This module is distributed under the ARTISTIC LICENSE using the same +terms as Perl itself. + +=head1 SEE ALSO + +perl(1), Crypt::DES(3), Crypt::IDEA(3), rfc2898 (PKCS#5) + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/DES.pm b/Master/tlpkg/tlperl/lib/Crypt/DES.pm new file mode 100755 index 00000000000..35ec11907cb --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/DES.pm @@ -0,0 +1,172 @@ +# +# Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) +# All rights reserved. +# +# Modifications are Copyright (c) 2000, W3Works, LLC +# All Rights Reserved. + +package Crypt::DES; + +require Exporter; +require DynaLoader; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +@ISA = qw(Exporter DynaLoader); + +# Items to export into callers namespace by default +@EXPORT = qw(); + +# Other items we are prepared to export if requested +@EXPORT_OK = qw(); + +$VERSION = '2.05'; +bootstrap Crypt::DES $VERSION; + +use strict; +use Carp; + +sub usage +{ + my ($package, $filename, $line, $subr) = caller(1); + $Carp::CarpLevel = 2; + croak "Usage: $subr(@_)"; +} + + +sub blocksize { 8; } +sub keysize { 8; } + +sub new +{ + usage("new DES key") unless @_ == 2; + + my $type = shift; + my $self = {}; + bless $self, $type; + + $self->{'ks'} = Crypt::DES::expand_key(shift); + + return $self; +} + +sub encrypt +{ + usage("encrypt data[8 bytes]") unless @_ == 2; + + my ($self,$data) = @_; + return Crypt::DES::crypt($data, $data, $self->{'ks'}, 1); +} + +sub decrypt +{ + usage("decrypt data[8 bytes]") unless @_ == 2; + + my ($self,$data) = @_; + return Crypt::DES::crypt($data, $data, $self->{'ks'}, 0); +} + +1; + +__END__ + +=head1 NAME + +Crypt::DES - Perl DES encryption module + +=head1 SYNOPSIS + + use Crypt::DES; + + +=head1 DESCRIPTION + +The module implements the Crypt::CBC interface, +which has the following methods + +=over 4 + +=item blocksize +=item keysize +=item encrypt +=item decrypt + +=back + +=head1 FUNCTIONS + +=over 4 + +=item blocksize + +Returns the size (in bytes) of the block cipher. + +=item keysize + +Returns the size (in bytes) of the key. Optimal size is 8 bytes. + +=item new + + my $cipher = new Crypt::DES $key; + +This creates a new Crypt::DES BlockCipher object, using $key, +where $key is a key of C<keysize()> bytes. + +=item encrypt + + my $cipher = new Crypt::DES $key; + my $ciphertext = $cipher->encrypt($plaintext); + +This function encrypts $plaintext and returns the $ciphertext +where $plaintext and $ciphertext should be of C<blocksize()> bytes. + +=item decrypt + + my $cipher = new Crypt::DES $key; + my $plaintext = $cipher->decrypt($ciphertext); + +This function decrypts $ciphertext and returns the $plaintext +where $plaintext and $ciphertext should be of C<blocksize()> bytes. + +=back + +=head1 EXAMPLE + + my $key = pack("H16", "0123456789ABCDEF"); + my $cipher = new Crypt::DES $key; + my $ciphertext = $cipher->encrypt("plaintex"); # NB - 8 bytes + print unpack("H16", $ciphertext), "\n"; + +=head1 NOTES + +Do note that DES only uses 8 byte keys and only works on 8 byte data +blocks. If you're intending to encrypt larger blocks or entire files, +please use Crypt::CBC in conjunction with this module. See the +Crypt::CBC documentation for proper syntax and use. + +Also note that the DES algorithm is, by today's standard, weak +encryption. Crypt::Blowfish is highly recommended if you're +interested in using strong encryption and a faster algorithm. + +=head1 SEE ALSO + +Crypt::Blowfish +Crypt::IDEA + +Bruce Schneier, I<Applied Cryptography>, 1995, Second Edition, +published by John Wiley & Sons, Inc. + +=head1 COPYRIGHT + +The implementation of the DES algorithm was developed by, +and is copyright of, Eric Young (eay@mincom.oz.au). +Other parts of the perl extension and module are +copyright of Systemics Ltd ( http://www.systemics.com/ ). +Cross-platform work and packaging for single algorithm +distribution is copyright of W3Works, LLC. + +=head1 MAINTAINER + +This single-algorithm package and cross-platform code is +maintained by Dave Paris <amused@pobox.com>. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/DES_EDE3.pm b/Master/tlpkg/tlperl/lib/Crypt/DES_EDE3.pm new file mode 100755 index 00000000000..5bb52e97955 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/DES_EDE3.pm @@ -0,0 +1,118 @@ +# $Id: DES_EDE3.pm,v 1.2 2001/09/15 03:41:09 btrott Exp $ + +package Crypt::DES_EDE3; +use strict; + +use Crypt::DES; +use vars qw( $VERSION ); +$VERSION = '0.01'; + +sub new { + my $class = shift; + my $ede3 = bless {}, $class; + $ede3->init(@_); +} + +sub keysize { 24 } +sub blocksize { 8 } + +sub init { + my $ede3 = shift; + my($key) = @_; + for my $i (1..3) { + $ede3->{"des$i"} = Crypt::DES->new(substr $key, 8*($i-1), 8); + } + $ede3; +} + +sub encrypt { + my($ede3, $block) = @_; + $ede3->{des3}->encrypt( + $ede3->{des2}->decrypt( + $ede3->{des1}->encrypt($block) + ) + ); +} + +sub decrypt { + my($ede3, $block) = @_; + $ede3->{des1}->decrypt( + $ede3->{des2}->encrypt( + $ede3->{des3}->decrypt($block) + ) + ); +} + +1; +__END__ + +=head1 NAME + +Crypt::DES_EDE3 - Triple-DES EDE encryption/decryption + +=head1 SYNOPSIS + + use Crypt::DES_EDE3; + my $ede3 = Crypt::DES_EDE3->new($key); + $ede3->encrypt($block); + +=head1 DESCRIPTION + +I<Crypt::DES_EDE3> implements DES-EDE3 encryption. This is triple-DES +encryption where an encrypt operation is encrypt-decrypt-encrypt, and +decrypt is decrypt-encrypt-decrypt. This implementation uses I<Crypt::DES> +to do its dirty DES work, and simply provides a wrapper around that +module: setting up the individual DES ciphers, initializing the keys, +and performing the encryption/decryption steps. + +DES-EDE3 encryption requires a key size of 24 bytes. + +You're probably best off not using this module directly, as the I<encrypt> +and I<decrypt> methods expect 8-octet blocks. You might want to use the +module in conjunction with I<Crypt::CBC>, for example. This would be +DES-EDE3-CBC, or triple-DES in outer CBC mode. + +=head1 USAGE + +=head2 $ede3 = Crypt::DES_EDE3->new($key) + +Creates a new I<Crypt::DES_EDE3> object (really, a collection of three DES +ciphers), and initializes each cipher with part of I<$key>, which should be +at least 24 bytes. If it's longer than 24 bytes, the extra bytes will be +ignored. + +Returns the new object. + +=head2 $ede3->encrypt($block) + +Encrypts an 8-byte block of data I<$block> using the three DES ciphers in +an encrypt-decrypt-encrypt operation. + +Returns the encrypted block. + +=head2 $ede3->decrypt($block) + +Decrypts an 8-byte block of data I<$block> using the three DES ciphers in +a decrypt-encrypt-decrypt operation. + +Returns the decrypted block. + +=head2 $ede3->blocksize + +Returns the block size (8). + +=head2 $ede3->keysize + +Returns the key size (24). + +=head1 LICENSE + +Crypt::DES_EDE3 is free software; you may redistribute it and/or modify +it under the same terms as Perl itself. + +=head1 AUTHOR & COPYRIGHTS + +Crypt::DES_EDE3 is Copyright 2001 Benjamin Trott, ben@rhumba.pair.com. All +rights reserved. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/DH.pm b/Master/tlpkg/tlperl/lib/Crypt/DH.pm new file mode 100755 index 00000000000..b9f3ecf0d80 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/DH.pm @@ -0,0 +1,250 @@ +# $Id: DH.pm 1860 2005-06-11 06:15:44Z btrott $ + +package Crypt::DH; +use strict; + +use Math::BigInt lib => "GMP,Pari"; +our $VERSION = '0.06'; + +sub new { + my $class = shift; + my $dh = bless {}, $class; + + my %param = @_; + for my $w (qw( p g priv_key )) { + next unless exists $param{$w}; + $dh->$w(delete $param{$w}); + } + die "Unknown parameters to constructor: " . join(", ", keys %param) if %param; + + $dh; +} + +BEGIN { + no strict 'refs'; + for my $meth (qw( p g pub_key priv_key )) { + *$meth = sub { + my $key = shift; + if (@_) { + $key->{$meth} = _any2bigint(shift); + } + my $ret = $key->{$meth} || ""; + $ret; + }; + } +} + +sub _any2bigint { + my($value) = @_; + if (ref $value eq 'Math::BigInt') { + return $value; + } + elsif (ref $value eq 'Math::Pari') { + return Math::BigInt->new(Math::Pari::pari2pv($value)); + } + elsif (defined $value && !(ref $value)) { + return Math::BigInt->new($value); + } + elsif (defined $value) { + die "Unknown parameter type: $value\n"; + } +} + +sub generate_keys { + my $dh = shift; + + unless (defined $dh->{priv_key}) { + my $i = _bitsize($dh->{p}) - 1; + $dh->{priv_key} = + $Crypt::Random::VERSION ? + Crypt::Random::makerandom_itv(Strength => 0, Uniform => 1, + Lower => 1, Upper => $dh->{p} - 1) : + _makerandom_itv($i, 1, $dh->{p} - 1); + } + + $dh->{pub_key} = $dh->{g}->copy->bmodpow($dh->{priv_key}, $dh->{p}); +} + +sub compute_key { + my $dh = shift; + my $pub_key = _any2bigint(shift); + $pub_key->copy->bmodpow($dh->{priv_key}, $dh->{p}); +} +*compute_secret = \&compute_key; + +sub _bitsize { + return length($_[0]->as_bin) - 2; +} + +sub _makerandom_itv { + my ($size, $min_inc, $max_exc) = @_; + + while (1) { + my $r = _makerandom($size); + return $r if $r >= $min_inc && $r < $max_exc; + } +} + +sub _makerandom { + my $size = shift; + + my $bytes = int($size / 8) + ($size % 8 ? 1 : 0); + + my $rand; + if (-e "/dev/urandom") { + my $fh; + open($fh, '/dev/urandom') + or die "Couldn't open /dev/urandom"; + my $got = sysread $fh, $rand, $bytes; + die "Didn't read all bytes from urandom" unless $got == $bytes; + close $fh; + } else { + for (1..$bytes) { + $rand .= chr(int(rand(256))); + } + } + + my $bits = unpack("b*", $rand); + die unless length($bits) >= $size; + + Math::BigInt->new('0b' . substr($bits, 0, $size)); +} + +1; +__END__ + +=head1 NAME + +Crypt::DH - Diffie-Hellman key exchange system + +=head1 SYNOPSIS + + use Crypt::DH; + my $dh = Crypt::DH->new; + $dh->g($g); + $dh->p($p); + + ## Generate public and private keys. + $dh->generate_keys; + + $my_pub_key = $dh->pub_key; + + ## Send $my_pub_key to "other" party, and receive "other" + ## public key in return. + + ## Now compute shared secret from "other" public key. + my $shared_secret = $dh->compute_secret( $other_pub_key ); + +=head1 DESCRIPTION + +I<Crypt::DH> is a Perl implementation of the Diffie-Hellman key +exchange system. Diffie-Hellman is an algorithm by which two +parties can agree on a shared secret key, known only to them. +The secret is negotiated over an insecure network without the +two parties ever passing the actual shared secret, or their +private keys, between them. + +=head1 THE ALGORITHM + +The algorithm generally works as follows: Party A and Party B +choose a property I<p> and a property I<g>; these properties are +shared by both parties. Each party then computes a random private +key integer I<priv_key>, where the length of I<priv_key> is at +most (number of bits in I<p>) - 1. Each party then computes a +public key based on I<g>, I<priv_key>, and I<p>; the exact value +is + + g ^ priv_key mod p + +The parties exchange these public keys. + +The shared secret key is generated based on the exchanged public +key, the private key, and I<p>. If the public key of Party B is +denoted I<pub_key_B>, then the shared secret is equal to + + pub_key_B ^ priv_key mod p + +The mathematical principles involved insure that both parties will +generate the same shared secret key. + +More information can be found in PKCS #3 (Diffie-Hellman Key +Agreement Standard): + + http://www.rsasecurity.com/rsalabs/pkcs/pkcs-3/ + +=head1 USAGE + +I<Crypt::DH> implements the core routines needed to use +Diffie-Hellman key exchange. To actually use the algorithm, +you'll need to start with values for I<p> and I<g>; I<p> is a +large prime, and I<g> is a base which must be larger than 0 +and less than I<p>. + +I<Crypt::DH> uses I<Math::BigInt> internally for big-integer +calculations. All accessor methods (I<p>, I<g>, I<priv_key>, and +I<pub_key>) thus return I<Math::BigInt> objects, as does the +I<compute_secret> method. The accessors, however, allow setting with a +scalar decimal string, hex string (^0x), Math::BigInt object, or +Math::Pari object (for backwards compatibility). + +=head2 $dh = Crypt::DH->new([ %param ]). + +Constructs a new I<Crypt::DH> object and returns the object. +I<%param> may include none, some, or all of the keys I<p>, I<g>, and +I<priv_key>. + +=head2 $dh->p([ $p ]) + +Given an argument I<$p>, sets the I<p> parameter (large prime) for +this I<Crypt::DH> object. + +Returns the current value of I<p>. (as a Math::BigInt object) + +=head2 $dh->g([ $g ]) + +Given an argument I<$g>, sets the I<g> parameter (base) for +this I<Crypt::DH> object. + +Returns the current value of I<g>. + +=head2 $dh->generate_keys + +Generates the public and private key portions of the I<Crypt::DH> +object, assuming that you've already filled I<p> and I<g> with +appropriate values. + +If you've provided a priv_key, it's used, otherwise a random priv_key +is created using either Crypt::Random (if already loaded), or +/dev/urandom, or Perl's rand, in that order. + +=head2 $dh->compute_secret( $public_key ) + +Given the public key I<$public_key> of Party B (the party with which +you're performing key negotiation and exchange), computes the shared +secret key, based on that public key, your own private key, and your +own large prime value (I<p>). + +The historical method name "compute_key" is aliased to this for +compatibility. + +=head2 $dh->priv_key([ $priv_key ]) + +Returns the private key. Given an argument I<$priv_key>, sets the +I<priv_key> parameter for this I<Crypt::DH> object. + +=head2 $dh->pub_key + +Returns the public key. + +=head1 AUTHOR & COPYRIGHT + +Benjamin Trott, ben@rhumba.pair.com + +Brad Fitzpatrick, brad@danga.com + +Except where otherwise noted, Crypt::DH is Copyright 2001 +Benjamin Trott. All rights reserved. Crypt::DH is free +software; you may redistribute it and/or modify it under +the same terms as Perl itself. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/DSA.pm b/Master/tlpkg/tlperl/lib/Crypt/DSA.pm new file mode 100755 index 00000000000..9ef5199103a --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/DSA.pm @@ -0,0 +1,297 @@ +package Crypt::DSA; + +use 5.005; +use strict; +use Digest::SHA1 qw( sha1 ); +use Carp qw( croak ); +use Crypt::DSA::KeyChain; +use Crypt::DSA::Key; +use Crypt::DSA::Signature; +use Crypt::DSA::Util qw( bitsize bin2mp mod_inverse mod_exp makerandom ); + +use vars qw( $VERSION ); +BEGIN { + $VERSION = '1.16'; +} + +sub new { + my $class = shift; + my $dsa = bless { @_ }, $class; + $dsa->{_keychain} = Crypt::DSA::KeyChain->new(@_); + $dsa; +} + +sub keygen { + my $dsa = shift; + my $key = $dsa->{_keychain}->generate_params(@_); + $dsa->{_keychain}->generate_keys($key); + $key; +} + +sub sign { + my $dsa = shift; + my %param = @_; + my($key, $dgst); + croak __PACKAGE__, "->sign: Need a Key" unless $key = $param{Key}; + unless ($dgst = $param{Digest}) { + croak __PACKAGE__, "->sign: Need either Message or Digest" + unless $param{Message}; + $dgst = sha1($param{Message}); + } + my $dlen = length $dgst; + + my $i = bitsize($key->q) / 8; + croak "Data too large for key size" + if $dlen > $i || $dlen > 50; + + $dsa->_sign_setup($key) + unless $key->kinv && $key->r; + + my $m = bin2mp($dgst); + my $xr = ($key->priv_key * $key->r) % $key->q; + my $s = $xr + $m; + $s -= $key->q if $s > $key->q; + $s = ($s * $key->kinv) % $key->q; + + my $sig = Crypt::DSA::Signature->new; + $sig->r($key->r); + $sig->s($s); + $sig; +} + +sub _sign_setup { + my $dsa = shift; + my $key = shift; + my($k, $r); + { + $k = makerandom(Size => bitsize($key->q)); + $k -= $key->q if $k >= $key->q; + redo if $k == 0; + } + $r = mod_exp($key->g, $k, $key->p); + $r %= $key->q; + my $kinv = mod_inverse($k, $key->q); + $key->r($r); + $key->kinv($kinv); +} + +sub verify { + my $dsa = shift; + my %param = @_; + my($key, $dgst, $sig); + croak __PACKAGE__, "->verify: Need a Key" unless $key = $param{Key}; + unless ($dgst = $param{Digest}) { + croak __PACKAGE__, "->verify: Need either Message or Digest" + unless $param{Message}; + $dgst = sha1($param{Message}); + } + croak __PACKAGE__, "->verify: Need a Signature" + unless $sig = $param{Signature}; + my $u2 = mod_inverse($sig->s, $key->q); + my $u1 = bin2mp($dgst); + $u1 = ($u1 * $u2) % $key->q; + $u2 = ($sig->r * $u2) % $key->q; + my $t1 = mod_exp($key->g, $u1, $key->p); + my $t2 = mod_exp($key->pub_key, $u2, $key->p); + $u1 = ($t1 * $t2) % $key->p; + $u1 %= $key->q; + $u1 == $sig->r; +} + +1; + +__END__ + +=pod + +=head1 NAME + +Crypt::DSA - DSA Signatures and Key Generation + +=head1 SYNOPSIS + + use Crypt::DSA; + my $dsa = Crypt::DSA->new; + + my $key = $dsa->keygen( + Size => 512, + Seed => $seed, + Verbosity => 1 + ); + + my $sig = $dsa->sign( + Message => "foo bar", + Key => $key + ); + + my $verified = $dsa->verify( + Message => "foo bar", + Signature => $sig, + Key => $key, + ); + +=head1 DESCRIPTION + +I<Crypt::DSA> is an implementation of the DSA (Digital Signature +Algorithm) signature verification system. The implementation +itself is pure Perl, although the heavy-duty mathematics underneath +are provided by the I<Math::Pari> library. + +This package provides DSA signing, signature verification, and key +generation. + +=head1 USAGE + +The I<Crypt::DSA> public interface is similar to that of +I<Crypt::RSA>. This was done intentionally. + +=head2 Crypt::DSA->new + +Constructs a new I<Crypt::DSA> object. At the moment this isn't +particularly useful in itself, other than being the object you +need to do much else in the system. + +Returns the new object. + +=head2 $key = $dsa->keygen(%arg) + +Generates a new set of DSA keys, including both the public and +private portions of the key. + +I<%arg> can contain: + +=over 4 + +=item * Size + +The size in bits of the I<p> value to generate. The I<q> and +I<g> values are always 160 bits each. + +This argument is mandatory. + +=item * Seed + +A seed with which I<q> generation will begin. If this seed does +not lead to a suitable prime, it will be discarded, and a new +random seed chosen in its place, until a suitable prime can be +found. + +This is entirely optional, and if not provided a random seed will +be generated automatically. + +=item * Verbosity + +Should be either 0 or 1. A value of 1 will give you a progress +meter during I<p> and I<q> generation--this can be useful, since +the process can be relatively long. + +The default is 0. + +=back + +=head2 $signature = $dsa->sign(%arg) + +Signs a message (or the digest of a message) using the private +portion of the DSA key and returns the signature. + +The return value--the signature--is a I<Crypt::DSA::Signature> +object. + +I<%arg> can include: + +=over 4 + +=item * Digest + +A digest to be signed. The digest should be 20 bytes in length +or less. + +You must provide either this argument or I<Message> (see below). + +=item * Key + +The I<Crypt::DSA::Key> object with which the signature will be +generated. Should contain a private key attribute (I<priv_key>). + +This argument is required. + +=item * Message + +A plaintext message to be signed. If you provide this argument, +I<sign> will first produce a SHA1 digest of the plaintext, then +use that as the digest to sign. Thus writing + + my $sign = $dsa->sign(Message => $message, ... ); + +is a shorter way of writing + + use Digest::SHA1 qw( sha1 ); + my $sig = $dsa->sign(Digest => sha1( $message ), ... ); + +=back + +=head2 $verified = $dsa->verify(%arg) + +Verifies a signature generated with I<sign>. Returns a true +value on success and false on failure. + +I<%arg> can contain: + +=over 4 + +=item * Key + +Key of the signer of the message; a I<Crypt::DSA::Key> object. +The public portion of the key is used to verify the signature. + +This argument is required. + +=item * Signature + +The signature itself. Should be in the same format as returned +from I<sign>, a I<Crypt::DSA::Signature> object. + +This argument is required. + +=item * Digest + +The original signed digest whose length is less than or equal to +20 bytes. + +Either this argument or I<Message> (see below) must be present. + +=item * Message + +As above in I<sign>, the plaintext message that was signed, a +string of arbitrary length. A SHA1 digest of this message will +be created and used in the verification process. + +=back + +=head1 TODO + +Add ability to munge format of keys. For example, read/write keys +from/to key files (SSH key files, etc.), and also write them in +other formats. + +=head1 SUPPORT + +Bugs should be reported via the CPAN bug tracker at + +L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Crypt-DSA> + +For other issues, contact the author. + +=head1 AUTHOR + +Benjamin Trott E<lt>ben@sixapart.comE<gt> + +=head1 COPYRIGHT + +Except where otherwise noted, +Crypt::DSA is Copyright 2006 - 2009 Benjamin Trott. + +Crypt::DSA is free software; you may redistribute it +and/or modify it under the same terms as Perl itself. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/DSA/Key.pm b/Master/tlpkg/tlperl/lib/Crypt/DSA/Key.pm new file mode 100755 index 00000000000..69ded9debdd --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/DSA/Key.pm @@ -0,0 +1,230 @@ +package Crypt::DSA::Key; + +use strict; +use Math::BigInt 1.78 try => 'GMP, Pari'; +use Carp qw( croak ); +use Crypt::DSA::Util qw( bitsize ); + + + +use vars qw{$VERSION}; +BEGIN { + $VERSION = '1.16'; +} + +sub new { + my $class = shift; + my %param = @_; + my $key = bless { }, $class; + + if ($param{Filename} || $param{Content}) { + if ($param{Filename} && $param{Content}) { + croak "Filename and Content are mutually exclusive."; + } + return $key->read(%param); + } + $key; +} + +sub size { bitsize($_[0]->p) } + +BEGIN { + no strict 'refs'; + for my $meth (qw( p q g pub_key priv_key r kinv )) { + *$meth = sub { + my($key, $value) = @_; + if (ref $value eq 'Math::Pari') { + $key->{$meth} = Math::Pari::pari2pv($value); + } + elsif (ref $value) { + $key->{$meth} = "$value"; + } + elsif ($value) { + if ($value =~ /^0x/) { + $key->{$meth} = Math::BigInt->new($value)->bstr; + } + else { + $key->{$meth} = $value; + } + } elsif (@_ > 1 && !defined $value) { + delete $key->{$meth}; + } + my $ret = $key->{$meth} || ""; + $ret = Math::BigInt->new("$ret") if $ret =~ /^\d+$/; + $ret; + }; + } +} + +sub read { + my $key = shift; + my %param = @_; + my $type = $param{Type} or croak "read: Need a key file 'Type'"; + my $class = join '::', __PACKAGE__, $type; + eval "use $class;"; + croak "Invalid key file type '$type': $@" if $@; + bless $key, $class; + local *FH; + if (my $fname = delete $param{Filename}) { + open FH, $fname or return; + my $blob = do { local $/; <FH> }; + close FH; + $param{Content} = $blob; + } + $key->deserialize(%param); +} + +sub write { + my $key = shift; + my %param = @_; + my $type; + unless ($type = $param{Type}) { + my $pkg = __PACKAGE__; + ($type) = ref($key) =~ /^${pkg}::(\w+)$/; + } + croak "write: Need a key file 'Type'" unless $type; + my $class = join '::', __PACKAGE__, $type; + eval "use $class;"; + croak "Invalid key file type '$type': $@" if $@; + bless $key, $class; + my $blob = $key->serialize(%param); + if (my $fname = delete $param{Filename}) { + local *FH; + open FH, ">$fname" or croak "Can't open $fname: $!"; + print FH $blob; + close FH; + } + $blob; +} + +1; +__END__ + +=head1 NAME + +Crypt::DSA::Key - DSA key + +=head1 SYNOPSIS + + use Crypt::DSA::Key; + my $key = Crypt::DSA::Key->new; + + $key->p($p); + +=head1 DESCRIPTION + +I<Crypt::DSA::Key> contains a DSA key, both the public and +private portions. Subclasses of I<Crypt::DSA::Key> implement +I<read> and I<write> methods, such that you can store DSA +keys on disk, and read them back into your application. + +=head1 USAGE + +Any of the key attributes can be accessed through combination +get/set methods. The key attributes are: I<p>, I<q>, I<g>, +I<priv_key>, and I<pub_key>. For example: + + $key->p($p); + my $p2 = $key->p; + +=head2 $key = Crypt::DSA::Key->new(%arg) + +Creates a new (empty) key object. All of the attributes are +initialized to 0. + +Alternately, if you provide the I<Filename> parameter (see +below), the key will be read in from disk. If you provide +the I<Type> parameter (mandatory if I<Filename> is provided), +be aware that your key will actually be blessed into a subclass +of I<Crypt::DSA::Key>. Specifically, it will be the class +implementing the specific read functionality for that type, +eg. I<Crypt::DSA::Key::PEM>. + +Returns the key on success, C<undef> otherwise. (See I<Password> +for one reason why I<new> might return C<undef>). + +I<%arg> can contain: + +=over 4 + +=item * Type + +The type of file where the key is stored. Currently the only +option is I<PEM>, which indicates a PEM file (optionally +encrypted, ASN.1-encoded object). Support for reading/writing +PEM files comes from I<Convert::PEM>; if you don't have this +module installed, the I<new> method will die. + +This argument is mandatory, I<if> you're either reading the file from +disk (ie. you provide a I<Filename> argument) or you've specified the +I<Content> argument. + +=item * Filename + +The location of the file from which you'd like to read the key. +Requires a I<Type> argument so the decoder knows what type of file it +is. You can't specify I<Content> and I<Filename> at the same time. + +=item * Content + +The serialized version of the key. Requires a I<Type> argument so the +decoder knows how to decode it. You can't specify I<Content> and +I<Filename> at the same time. + +=item * Password + +If your key file is encrypted, you'll need to supply a +passphrase to decrypt it. You can do that here. + +If your passphrase is incorrect, I<new> will return C<undef>. + +=back + +=head2 $key->write(%arg) + +Writes a key (optionally) to disk, using a format that you +define with the I<Type> parameter. + +If your I<$key> object has a defined I<priv_key> (private key portion), +the key will be written as a DSA private key object; otherwise, it will +be written out as a public key. Note that not all serialization mechanisms +can produce public keys in this version--currently, only PEM public keys +are supported. + +I<%arg> can include: + +=over 4 + +=item * Type + +The type of file format that you wish to write. I<PEM> is one +example (in fact, currently, it's the only example). + +This argument is mandatory, I<unless> your I<$key> object is +already blessed into a subclass (eg. I<Crypt::DSA::Key::PEM>), +and you wish to write the file using the same subclass. + +=item * Filename + +The location of the file on disk where you want the key file +to be written. + +=item * Password + +If you want the key file to be encrypted, provide this +argument, and the ASN.1-encoded string will be encrypted using +the passphrase as a key. + +=back + +=head2 $key->size + +Returns the size of the key, in bits. This is actually the +number of bits in the large prime I<p>. + +=head1 AUTHOR & COPYRIGHTS + +Please see the Crypt::DSA manpage for author, copyright, +and license information. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/DSA/Key/PEM.pm b/Master/tlpkg/tlperl/lib/Crypt/DSA/Key/PEM.pm new file mode 100755 index 00000000000..b760cc40317 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/DSA/Key/PEM.pm @@ -0,0 +1,178 @@ +package Crypt::DSA::Key::PEM; + +use strict; +use Carp qw( croak ); +use Convert::PEM; +use Crypt::DSA::Key; + +use vars qw{$VERSION @ISA}; +BEGIN { + $VERSION = '1.16'; + @ISA = 'Crypt::DSA::Key'; +} + +sub deserialize { + my $key = shift; + my %param = @_; + $param{Content} =~ /DSA PRIVATE KEY/ ? + $key->_deserialize_privkey(%param) : + $key->_deserialize_pubkey(%param); +} + +sub _deserialize_privkey { + my $key = shift; + my %param = @_; + + my $pem = $key->_pem; + my $pkey = $pem->decode( Content => $param{Content}, + Password => $param{Password}, + Macro => 'DSAPrivateKey' ); + return unless $pkey; + + for my $m (qw( p q g pub_key priv_key )) { + $key->$m( $pkey->{$m} ); + } + $key; +} + +sub _deserialize_pubkey { + my $key = shift; + my %param = @_; + + my $pem = $key->_pem; + my $pkey = $pem->decode( Content => $param{Content}, + Password => $param{Password}, + Macro => 'DSAPublicKey', + Name => 'PUBLIC KEY' ); + return unless $pkey; + + my $asn = $pem->asn->find('DSAPubKeyInner'); + my $num = $asn->decode($pkey->{pub_key}[0]) or croak $asn->{error}; + + for my $m (qw( p q g )) { + $key->$m( $pkey->{inner}{DSAParams}{$m} ); + } + $key->pub_key($num); + + $key; +} + +sub serialize { + my $key = shift; + ## If this is a private key (has the private key portion), serialize + ## it as a private key; otherwise use a public key ASN.1 object. + $key->priv_key ? $key->_serialize_privkey(@_) : $key->_serialize_pubkey(@_); +} + +sub _serialize_privkey { + my $key = shift; + my %param = @_; + + my $pkey = { version => 0 }; + for my $m (qw( p q g pub_key priv_key )) { + $pkey->{$m} = $key->$m(); + } + + my $pem = $key->_pem; + my $buf = $pem->encode( + Content => $pkey, + Password => $param{Password}, + Name => 'DSA PRIVATE KEY', + Macro => 'DSAPrivateKey', + ) or croak $pem->errstr; + $buf; +} + +sub _serialize_pubkey { + my $key = shift; + my %param = @_; + my $pem = $key->_pem; + my $asn = $pem->asn->find('DSAPubKeyInner'); + ## Force stringification. + my $str = $asn->encode($key->pub_key . '') or croak $asn->{error}; + my $pkey = { + inner => { + objId => '1.2.840.10040.4.1', + DSAParams => { + p => $key->p, + q => $key->q, + g => $key->g + }, + }, + pub_key => $str + }; + my $buf = $pem->encode( + Content => $pkey, + Password => $param{Password}, + Name => 'PUBLIC KEY', + Macro => 'DSAPublicKey', + ) or return $key->error($pem->errstr); + $buf; +} + +sub _pem { + my $key = shift; + unless (defined $key->{__pem}) { + my $pem = Convert::PEM->new( + Name => "DSA PRIVATE KEY", + ASN => qq( + DSAPrivateKey ::= SEQUENCE { + version INTEGER, + p INTEGER, + q INTEGER, + g INTEGER, + pub_key INTEGER, + priv_key INTEGER + } + + DSAPublicKey ::= SEQUENCE { + inner SEQUENCE { + objId OBJECT IDENTIFIER, + DSAParams SEQUENCE { + p INTEGER, + q INTEGER, + g INTEGER + } + } + pub_key BIT STRING + } + + DSAPubKeyInner ::= INTEGER + )); + $key->{__pem} = $pem; + } + $key->{__pem}; +} + +1; +__END__ + +=head1 NAME + +Crypt::DSA::Key::PEM - Read/write DSA PEM files + +=head1 SYNOPSIS + + use Crypt::DSA::Key; + my $key = Crypt::DSA::Key->new( Type => 'PEM', ...); + $key->write( Type => 'PEM', ...); + +=head1 DESCRIPTION + +I<Crypt::DSA::Key::PEM> provides an interface to reading and +writing DSA PEM files, using I<Convert::PEM>. The files are +ASN.1-encoded and optionally encrypted. + +You shouldn't use this module directly. As the SYNOPSIS above +suggests, this module should be considered a plugin for +I<Crypt::DSA::Key>, and all access to PEM files (reading DSA +keys from disk, etc.) should be done through that module. + +Read the I<Crypt::DSA::Key> documentation for more details. + +=head1 AUTHOR & COPYRIGHTS + +Please see the Crypt::DSA manpage for author, copyright, +and license information. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/DSA/Key/SSH2.pm b/Master/tlpkg/tlperl/lib/Crypt/DSA/Key/SSH2.pm new file mode 100755 index 00000000000..0260ddb6ada --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/DSA/Key/SSH2.pm @@ -0,0 +1,120 @@ +package Crypt::DSA::Key::SSH2; + +use strict; +use MIME::Base64 qw( decode_base64 ); +use Crypt::DSA::Key; + +use vars qw{$VERSION @ISA}; +BEGIN { + $VERSION = '1.16'; + @ISA = 'Crypt::DSA::Key'; +} + +use constant PRIVKEY_MAGIC => 0x3f6ff9eb; + +sub deserialize { + my $key = shift; + my %param = @_; + + chomp($param{Content}); + my($head, $object, $content, $tail) = $param{Content} =~ + m:(---- BEGIN ([^\n\-]+) ----)\n(.+)(---- END .*? ----)$:s; + my @lines = split /\n/, $content; + my $escaped = 0; + my @real; + for my $l (@lines) { + if (substr($l, -1) eq '\\') { + $escaped++; + next; + } + next if index($l, ':') != -1; + if ($escaped) { + $escaped--; + next; + } + push @real, $l; + } + $content = join "\n", @real; + $content = decode_base64($content); + + my $b = BufferWithInt->new; + $b->append($content); + my $magic = $b->get_int32; + return unless $magic == PRIVKEY_MAGIC; + + my($ignore); + $ignore = $b->get_int32; + my $type = $b->get_str; + my $cipher = $b->get_str; + $ignore = $b->get_int32 for 1..3; + + return unless $cipher eq 'none'; + + $key->p( $b->get_mp_ssh2 ); + $key->g( $b->get_mp_ssh2 ); + $key->q( $b->get_mp_ssh2 ); + $key->pub_key( $b->get_mp_ssh2 ); + $key->priv_key( $b->get_mp_ssh2 ); + + #return unless $b->length == $b->offset; + + $key; +} + +sub serialize { + my $key = shift; + my %param = @_; + die "serialize is unimplemented"; +} + +package BufferWithInt; +use strict; + +use Data::Buffer; +use Crypt::DSA::Util qw( bin2mp ); +use base qw( Data::Buffer ); + +sub get_mp_ssh2 { + my $buf = shift; + my $bits = $buf->get_int32; + my $off = $buf->{offset}; + my $bytes = int(($bits+7) / 8); + my $int = bin2mp( $buf->bytes($off, $bytes) ); + $buf->{offset} += $bytes; + $int; +} + +1; +__END__ + +=head1 NAME + +Crypt::DSA::Key::SSH2 - Read/write DSA SSH2 files + +=head1 SYNOPSIS + + use Crypt::DSA::Key; + my $key = Crypt::DSA::Key->new( Type => 'SSH2', ...); + $key->write( Type => 'SSH2', ...); + +=head1 DESCRIPTION + +I<Crypt::DSA::Key::SSH2> provides an interface to reading and +writing DSA SSH2 files, using I<Data::Buffer>, which provides +functionality for SSH-compatible binary in/out buffers. + +Currently encrypted key files are not supported. + +You shouldn't use this module directly. As the SYNOPSIS above +suggests, this module should be considered a plugin for +I<Crypt::DSA::Key>, and all access to SSH2 files (reading DSA +keys from disk, etc.) should be done through that module. + +Read the I<Crypt::DSA::Key> documentation for more details. + +=head1 AUTHOR & COPYRIGHTS + +Please see the Crypt::DSA manpage for author, copyright, +and license information. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/DSA/KeyChain.pm b/Master/tlpkg/tlperl/lib/Crypt/DSA/KeyChain.pm new file mode 100755 index 00000000000..b5555add0e3 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/DSA/KeyChain.pm @@ -0,0 +1,257 @@ +package Crypt::DSA::KeyChain; + +use strict; +use Math::BigInt 1.78 try => 'GMP, Pari'; +use Digest::SHA1 qw( sha1 ); +use Carp qw( croak ); +use IPC::Open3; +use File::Spec; +use File::Which (); +use Symbol qw( gensym ); + +use vars qw{$VERSION}; +BEGIN { + $VERSION = '1.16'; +} + +use Crypt::DSA::Key; +use Crypt::DSA::Util qw( bin2mp bitsize mod_exp makerandom isprime ); + +sub new { + my $class = shift; + bless { @_ }, $class; +} + +sub generate_params { + my $keygen = shift; + my %param = @_; + my $bits = Math::BigInt->new($param{Size}); + croak "Number of bits (Size) is too small" unless $bits; + delete $param{Seed} if $param{Seed} && length $param{Seed} != 20; + my $v = $param{Verbosity}; + + # try to use fast implementations found on the system, if available. + unless ($param{Seed} || wantarray || $param{PurePerl}) { + + # OpenSSL support + my $bin = $^O eq 'MSWin32' ? 'openssl.exe' : 'openssl'; + my $openssl = File::Which::which($bin); + if ( $openssl ) { + print STDERR "Using openssl\n" if $v; + my $bits_n = int($bits); + open( NULL, ">", File::Spec->devnull ); + my $pid = open3( gensym, \*OPENSSL, ">&NULL", "$openssl dsaparam -text -noout $bits_n" ); + my @res; + while( <OPENSSL> ) { + push @res, $_; + } + waitpid( $pid, 0 ); + close OPENSSL; + close NULL; + + my %parts; + my $cur_part; + foreach (@res) { + if (/^\s+(\w):\s*$/) { + $cur_part = $1; + next; + } + if (/^\s*((?:[0-9a-f]{2,2}:?)+)\s*$/) { + $parts{$cur_part} .= $1; + } + } + + $parts{$_} =~ s/://g for keys %parts; + + if (scalar keys %parts == 3) { + my $key = Crypt::DSA::Key->new; + $key->p(Math::BigInt->new("0x" . $parts{p})); + $key->q(Math::BigInt->new("0x" . $parts{q})); + $key->g(Math::BigInt->new("0x" . $parts{g})); + return $key; + } + } + + } + + # Pure Perl version: + + my($counter, $q, $p, $seed, $seedp1) = (0); + + ## Generate q. + SCOPE: { + print STDERR "." if $v; + $seed = $param{Seed} ? delete $param{Seed} : + join '', map chr rand 256, 1..20; + $seedp1 = _seed_plus_one($seed); + my $md = sha1($seed) ^ sha1($seedp1); + vec($md, 0, 8) |= 0x80; + vec($md, 19, 8) |= 0x01; + $q = bin2mp($md); + redo unless isprime($q); + } + + print STDERR "*\n" if $v; + my $n = int(("$bits"-1) / 160); + my $b = ($bits-1)-Math::BigInt->new($n)*160; + my $p_test = Math::BigInt->new(1); $p_test <<= ($bits-1); + + ## Generate p. + SCOPE: { + print STDERR "." if $v; + my $W = Math::BigInt->new(0); + for my $k (0..$n) { + $seedp1 = _seed_plus_one($seedp1); + my $r0 = bin2mp(sha1($seedp1)); + $r0 %= Math::BigInt->new(2) ** $b + if $k == $n; + $W += $r0 << (Math::BigInt->new(160) * $k); + } + my $X = $W + $p_test; + $p = $X - ($X % (2 * $q) - 1); + last if $p >= $p_test && isprime($p); + redo unless ++$counter >= 4096; + } + + print STDERR "*" if $v; + my $e = ($p - 1) / $q; + my $h = Math::BigInt->new(2); + my $g; + SCOPE: { + $g = mod_exp($h, $e, $p); + $h++, redo if $g == 1; + } + print STDERR "\n" if $v; + + my $key = Crypt::DSA::Key->new; + $key->p($p); + $key->q($q); + $key->g($g); + + return wantarray ? ($key, $counter, "$h", $seed) : $key; +} + +sub generate_keys { + my $keygen = shift; + my $key = shift; + my($priv_key, $pub_key); + SCOPE: { + my $i = bitsize($key->q); + $priv_key = makerandom(Size => $i); + $priv_key -= $key->q if $priv_key >= $key->q; + redo if $priv_key == 0; + } + $pub_key = mod_exp($key->g, $priv_key, $key->p); + $key->priv_key($priv_key); + $key->pub_key($pub_key); +} + +sub _seed_plus_one { + my($s, $i) = ($_[0]); + for ($i=19; $i>=0; $i--) { + vec($s, $i, 8)++; + last unless vec($s, $i, 8) == 0; + } + $s; +} + +1; + +=pod + +=head1 NAME + +Crypt::DSA::KeyChain - DSA key generation system + +=head1 SYNOPSIS + + use Crypt::DSA::KeyChain; + my $keychain = Crypt::DSA::KeyChain->new; + + my $key = $keychain->generate_params( + Size => 512, + Seed => $seed, + Verbosity => 1, + ); + + $keychain->generate_keys($key); + +=head1 DESCRIPTION + +I<Crypt::DSA::KeyChain> is a lower-level interface to key +generation than the interface in I<Crypt::DSA> (the I<keygen> +method). It allows you to separately generate the I<p>, I<q>, +and I<g> key parameters, given an optional starting seed, and +a mandatory bit size for I<p> (I<q> and I<g> are 160 bits each). + +You can then call I<generate_keys> to generate the public and +private portions of the key. + +=head1 USAGE + +=head2 $keychain = Crypt::DSA::KeyChain->new + +Constructs a new I<Crypt::DSA::KeyChain> object. At the moment +this isn't particularly useful in itself, other than being the +object you need in order to call the other methods. + +Returns the new object. + +=head2 $key = $keychain->generate_params(%arg) + +Generates a set of DSA parameters: the I<p>, I<q>, and I<g> +values of the key. This involves finding primes, and as such +it can be a relatively long process. + +When invoked in scalar context, returns a new +I<Crypt::DSA::Key> object. + +In list context, returns the new I<Crypt::DSA::Key> object, +along with: the value of the internal counter when a suitable +prime I<p> was found; the value of I<h> when I<g> was derived; +and the value of the seed (a 20-byte string) when I<q> was +found. These values aren't particularly useful in normal +circumstances, but they could be useful. + +I<%arg> can contain: + +=over 4 + +=item * Size + +The size in bits of the I<p> value to generate. The I<q> and +I<g> values are always 160 bits each. + +This argument is mandatory. + +=item * Seed + +A seed with which I<q> generation will begin. If this seed does +not lead to a suitable prime, it will be discarded, and a new +random seed chosen in its place, until a suitable prime can be +found. + +This is entirely optional, and if not provided a random seed will +be generated automatically. + +=item * Verbosity + +Should be either 0 or 1. A value of 1 will give you a progress +meter during I<p> and I<q> generation--this can be useful, since +the process can be relatively long. + +The default is 0. + +=back + +=head2 $keychain->generate_keys($key) + +Generates the public and private portions of the key I<$key>, +a I<Crypt::DSA::Key> object. + +=head1 AUTHOR & COPYRIGHT + +Please see the L<Crypt::DSA> manpage for author, copyright, +and license information. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/DSA/Signature.pm b/Master/tlpkg/tlperl/lib/Crypt/DSA/Signature.pm new file mode 100755 index 00000000000..3bab8a30d78 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/DSA/Signature.pm @@ -0,0 +1,139 @@ +package Crypt::DSA::Signature; + +use strict; +use Carp qw( croak ); + +use vars qw{$VERSION}; +BEGIN { + $VERSION = '1.16'; +} + +sub new { + my $class = shift; + my %param = @_; + my $sig = bless { }, $class; + if ($param{Content}) { + return $sig->deserialize(%param); + } + $sig; +} + +BEGIN { + no strict 'refs'; + for my $meth (qw( r s )) { + *$meth = sub { + my($key, $value) = @_; + if (ref $value eq 'Math::Pari') { + $key->{$meth} = Math::Pari::pari2pv($value); + } + elsif (ref $value) { + $key->{$meth} = "$value"; + } + elsif ($value) { + if ($value =~ /^0x/) { + $key->{$meth} = Math::BigInt->new($value)->bstr; + } + else { + $key->{$meth} = $value; + } + } + my $ret = $key->{$meth} || ""; + $ret = Math::BigInt->new("$ret") if $ret =~ /^\d+$/; + $ret; + }; + } +} + +sub asn { + require Convert::ASN1; + my $asn = Convert::ASN1->new; + $asn->prepare('SEQUENCE { r INTEGER, s INTEGER }') or croak $asn->{error}; + $asn; +} + +sub deserialize { + my $sig = shift; + my %param = @_; + my $asn = __PACKAGE__->asn; + my $ref; + require MIME::Base64; + ## Turn off warnings, because we're attempting to base64-decode content + ## that may not be base64-encoded. + local $^W = 0; + for ($param{Content}, MIME::Base64::decode_base64($param{Content})) { + my $out = $asn->decode($_); + $ref = $out, last if $out; + } + croak "Invalid Content" unless $ref; + $sig->s($ref->{s}); + $sig->r($ref->{r}); + $sig; +} + +sub serialize { + my $sig = shift; + my %param = @_; + my $asn = __PACKAGE__->asn; + my $buf = $asn->encode({ s => $sig->s, r => $sig->r }) + or croak $asn->{error}; + $buf; +} + +1; +__END__ + +=head1 NAME + +Crypt::DSA::Signature - DSA signature object + +=head1 SYNOPSIS + + use Crypt::DSA::Signature; + my $sig = Crypt::DSA::Signature->new; + + $sig->r($r); + $sig->s($s); + +=head1 DESCRIPTION + +I<Crypt::DSA::Signature> represents a DSA signature. It has 2 methods, +I<r> and I<s>, which are the big number representations of the 2 pieces of +the DSA signature. + +=head1 USAGE + +=head2 Crypt::DSA::Signature->new( %options ) + +Creates a new signature object, and optionally initializes it with the +information in I<%options>, which can contain: + +=over 4 + +=item * Content + +An ASN.1-encoded string representing the DSA signature. In ASN.1 notation, +this looks like: + + SEQUENCE { + r INTEGER, + s INTEGER + } + +If I<Content> is provided, I<new> will automatically call the I<deserialize> +method to parse the content, and set the I<r> and I<s> methods on the +resulting I<Crypt::DSA::Signature> object. + +=back + +=head2 $sig->serialize + +Serializes the signature object I<$sig> into the format described above: +an ASN.1-encoded representation of the signature, using the ASN.1 syntax +above. + +=head1 AUTHOR & COPYRIGHTS + +Please see the Crypt::DSA manpage for author, copyright, +and license information. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/DSA/Util.pm b/Master/tlpkg/tlperl/lib/Crypt/DSA/Util.pm new file mode 100755 index 00000000000..32cfbeac860 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/DSA/Util.pm @@ -0,0 +1,201 @@ +package Crypt::DSA::Util; + +use strict; +use Math::BigInt 1.78 try => 'GMP, Pari'; +use Fcntl; +use Carp qw( croak ); + +use vars qw( $VERSION @ISA @EXPORT_OK ); +use Exporter; +BEGIN { + $VERSION = '1.16'; + @ISA = qw( Exporter ); + @EXPORT_OK = qw( bitsize bin2mp mp2bin mod_inverse mod_exp makerandom isprime ); +} + +## Nicked from Crypt::RSA::DataFormat. +## Copyright (c) 2001, Vipul Ved Prakash. +sub bitsize { + length(Math::BigInt->new($_[0])->as_bin) - 2; +} + +sub bin2mp { + my $s = shift; + $s eq '' ? + Math::BigInt->new(0) : + Math::BigInt->new("0b" . unpack("B*", $s)); +} + +sub mp2bin { + my $p = Math::BigInt->new(shift); + my $base = Math::BigInt->new(256); + my $res = ''; + while ($p != 0) { + my $r = $p % $base; + $p = ($p-$r) / $base; + $res = chr($r) . $res; + } + $res; +} + +sub mod_exp { + my($a, $exp, $n) = @_; + $a->copy->bmodpow($exp, $n); +} + +sub mod_inverse { + my($a, $n) = @_; + $a->copy->bmodinv($n); +} + +sub makerandom { + my %param = @_; + my $size = $param{Size}; + my $bytes = int($size / 8) + 1; + my $r = ''; + if ( sysopen my $fh, '/dev/random', O_RDONLY ) { + my $read = 0; + while ($read < $bytes) { + my $got = sysread $fh, my($chunk), $bytes - $read; + next unless $got; + die "Error: $!" if $got == -1; + $r .= $chunk; + $read = length $r; + } + close $fh; + } + elsif ( require Data::Random ) { + $r .= Data::Random::rand_chars( set=>'numeric' ) for 1..$bytes; + } + else { + croak "makerandom requires /dev/random or Data::Random"; + } + my $down = $size - 1; + $r = unpack 'H*', pack 'B*', '0' x ( $size % 8 ? 8 - $size % 8 : 0 ) . + '1' . unpack "b$down", $r; + Math::BigInt->new('0x' . $r); +} + +# For testing, let us choose our isprime function: +*isprime = \&isprime_algorithms_with_perl; + +# from the book "Mastering Algorithms with Perl" by Jon Orwant, +# Jarkko Hietaniemi, and John Macdonald +sub isprime_algorithms_with_perl { + use integer; + my $n = shift; + my $n1 = $n - 1; + my $one = $n - $n1; # not just 1, but a bigint + my $witness = $one * 100; + + # find the power of two for the top bit of $n1 + my $p2 = $one; + my $p2index = -1; + ++$p2index, $p2 *= 2 + while $p2 <= $n1; + $p2 /= 2; + + # number of interations: 5 for 260-bit numbers, go up to 25 for smaller + my $last_witness = 5; + $last_witness += (260 - $p2index) / 13 if $p2index < 260; + + for my $witness_count (1..$last_witness) { + $witness *= 1024; + $witness += int(rand(1024)); # XXXX use good rand + $witness = $witness % $n if $witness > $n; + $witness = $one * 100, redo if $witness == 0; + + my $prod = $one; + my $n1bits = $n1; + my $p2next = $p2; + + # compute $witness ** ($n - 1) + while (1) { + my $rootone = $prod == 1 || $prod == $n1; + $prod = ($prod * $prod) % $n; + return 0 if $prod == 1 && ! $rootone; + if ($n1bits >= $p2next) { + $prod = ($prod * $witness) % $n; + $n1bits -= $p2next; + } + last if $p2next == 1; + $p2next /= 2; + } + return 0 unless $prod == 1; + } + return 1; +} + +sub isprime_gp_pari { + my $n = shift; + + my $sn = "$n"; + die if $sn =~ /\D/; + + my $is_prime = `echo "isprime($sn)" | gp -f -q`; + die "No gp installed?" if $?; + + chomp $is_prime; + return $is_prime; +} + +sub isprime_paranoid { + my $n = shift; + + my $perl = isprime_algorithms_with_perl($n); + my $pari = isprime_gp_pari($n); + + die "Perl vs. PARI don't match on '$n'\n" unless $perl == $pari; + return $perl; +} + +1; +__END__ + +=head1 NAME + +Crypt::DSA::Util - DSA Utility functions + +=head1 SYNOPSIS + + use Crypt::DSA::Util qw( func1 func2 ... ); + +=head1 DESCRIPTION + +I<Crypt::DSA::Util> contains a set of exportable utility functions +used through the I<Crypt::DSA> 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. + +=head1 AUTHOR & COPYRIGHTS + +Please see the Crypt::DSA manpage for author, copyright, +and license information. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/IDEA.pm b/Master/tlpkg/tlperl/lib/Crypt/IDEA.pm new file mode 100755 index 00000000000..d204859e34f --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/IDEA.pm @@ -0,0 +1,85 @@ +#! /usr/local/bin/perl -w + +# +# Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) +# All rights reserved. +# + +package Crypt::IDEA; + +require Exporter; +require DynaLoader; + +@ISA = (Exporter, DynaLoader); + +# Items to export into callers namespace by default +@EXPORT = qw(); + +# Other items we are prepared to export if requested +@EXPORT_OK = qw(); + +bootstrap Crypt::IDEA; + + +package IDEA; + +$VERSION="1.08"; + +use strict; +use Carp; + +sub usage +{ + my ($mess, $package, $filename, $line, $subr); + ($mess) = @_; + ($package, $filename, $line, $subr) = caller(1); + $Carp::CarpLevel = 2; + croak "Usage: $package\::$subr - $mess"; +} + + +sub blocksize { 8; } +sub keysize { 16; } + +sub new +{ + usage("new IDEA key") unless @_ == 2; + + my $type = shift; my $self = {}; bless $self, $type; + + $self->{'ks'} = Crypt::IDEA::expand_key(shift); + + $self; +} + +sub encrypt +{ + usage("encrypt data[8 bytes]") unless @_ == 2; + + my $self = shift; + my $data = shift; + + Crypt::IDEA::crypt($data, $data, $self->{'ks'}); + + $data; +} + +sub decrypt +{ + usage("decrypt data[8 bytes]") unless @_ == 2; + + my $self = shift; + my $data = shift; + + # + # Cache Decrypt key schedule + # + $self->{'dks'} = Crypt::IDEA::invert_key($self->{'ks'}) + unless exists $self->{'dks'}; + + Crypt::IDEA::crypt($data, $data, $self->{'dks'}); + + $data; +} + +1; diff --git a/Master/tlpkg/tlperl/lib/Crypt/IDEA.pod b/Master/tlpkg/tlperl/lib/Crypt/IDEA.pod new file mode 100755 index 00000000000..d026f8b7ecc --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/IDEA.pod @@ -0,0 +1,87 @@ +=head1 NAME + +IDEA - Perl interface to IDEA block cipher + +=head1 SYNOPSIS + + use Crypt::IDEA; + + +=head1 DESCRIPTION + +This perl extension is an implementation of the IDEA block cipher algorithm. +The module implements the Crypt::BlockCipher interface, +which has the following methods + +=over 4 + +=item blocksize +=item keysize +=item encrypt +=item decrypt + +=back + +=head1 FUNCTIONS + +=over 4 + +=item blocksize + +Returns the size (in bytes) of the block cipher. + +=item keysize + +Returns the size (in bytes) of the key. + +=item new + + my $cipher = new IDEA $key; + +This creates a new IDEA BlockCipher object, using $key, +where $key is a key of C<keysize()> bytes. + +=item encrypt + + my $cipher = new IDEA $key; + my $ciphertext = $cipher->encrypt($plaintext); + +This function encrypts $plaintext and returns the $ciphertext +where $plaintext and $ciphertext should be of C<blocksize()> bytes. + +=item decrypt + + my $cipher = new IDEA $key; + my $plaintext = $cipher->decrypt($ciphertext); + +This function decrypts $ciphertext and returns the $plaintext +where $plaintext and $ciphertext should be of C<blocksize()> bytes. + +=back + +=head1 EXAMPLE + + my $key = pack("H32", "0123456789ABCDEF0123456789ABCDEF"); + my $cipher = new IDEA $key; + my $ciphertext = $cipher->encrypt("plaintex"); # NB - 8 bytes + print unpack("H16", $ciphertext), "\n"; + +=head1 SEE ALSO + +Crypt::CBD, Crypt::DES, Crypt::Blowfish + +Bruce Schneier, I<Applied Cryptography>, 1995, Second Edition, +published by John Wiley & Sons, Inc. + + +=head1 COPYRIGHT + +This implementation is copyright Systemics Ltd ( http://www.systemics.com/ ). + +The IDEA algorithm is patented in Europe and the United States +by Ascom-Tech AG. + +Module altered between 1999 and 2005 to allow added functionality with perl -MCPAN, +Changes by Dave Paris (edited lib paths, endian issues, new tests). + +Thank you to contributors for endian patches and new test suite! diff --git a/Master/tlpkg/tlperl/lib/Crypt/OpenPGP.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP.pm new file mode 100755 index 00000000000..962de1db14d --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP.pm @@ -0,0 +1,1678 @@ +package Crypt::OpenPGP; +use strict; +use 5.008_001; + +use vars qw( $VERSION ); +$VERSION = '1.04'; + +use Crypt::OpenPGP::Constants qw( DEFAULT_CIPHER ); +use Crypt::OpenPGP::KeyRing; +use Crypt::OpenPGP::Plaintext; +use Crypt::OpenPGP::Message; +use Crypt::OpenPGP::PacketFactory; +use Crypt::OpenPGP::Config; + +use Crypt::OpenPGP::ErrorHandler; +use base qw( Crypt::OpenPGP::ErrorHandler ); + +use File::HomeDir; +use File::Spec; + +use vars qw( %COMPAT ); + +## 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 +$Crypt::OpenPGP::Globals::Trim_trailing_ws = 1; + +{ + my $env = sub { + my $dir = shift; my @paths; + if (exists $ENV{$dir}) { for (@_) { push @paths, "$ENV{$dir}/$_" } } + return @paths ? @paths : (); + }; + + my $home = sub { + my( @path ) = @_; + my $home_dir = File::HomeDir->my_home or return; + return File::Spec->catfile( $home_dir, @path ); + }; + + %COMPAT = ( + PGP2 => { + 'sign' => { Digest => 'MD5', Version => 3 }, + 'encrypt' => { Cipher => 'IDEA', Compress => 'ZIP' }, + 'keygen' => { Type => 'RSA', Cipher => 'IDEA', + Version => 3, Digest => 'MD5' }, + 'PubRing' => [ + $env->('PGPPATH','pubring.pgp'), + $home->( '.pgp', 'pubring.pgp' ), + ], + 'SecRing' => [ + $env->('PGPPATH','secring.pgp'), + $home->( '.pgp', 'secring.pgp' ), + ], + 'Config' => [ + $env->('PGPPATH', 'config.txt'), + $home->( '.pgp', 'config.txt' ), + ], + }, + + PGP5 => { + 'sign' => { Digest => 'SHA1', Version => 3 }, + 'encrypt' => { Cipher => 'DES3', Compress => 'ZIP' }, + 'keygen' => { Type => 'DSA', Cipher => 'DES3', + Version => 4, Digest => 'SHA1' }, + 'PubRing' => [ + $env->('PGPPATH','pubring.pkr'), + $home->( '.pgp', 'pubring.pkr' ), + ], + 'SecRing' => [ + $env->('PGPPATH','secring.skr'), + $home->( '.pgp', 'secring.skr' ), + ], + 'Config' => [ + $env->('PGPPATH', 'pgp.cfg'), + $home->( '.pgp', 'pgp.cfg' ), + ], + }, + + GnuPG => { + 'sign' => { Digest => 'RIPEMD160', Version => 4 }, + 'encrypt' => { Cipher => 'Rijndael', Compress => 'Zlib', + MDC => 1 }, + 'keygen' => { Type => 'DSA', Cipher => 'Rijndael', + Version => 4, Digest => 'RIPEMD160' }, + 'Config' => [ + $env->('GNUPGHOME', 'options'), + $home->( '.gnupg', 'options' ), + ], + 'PubRing' => [ + $env->('GNUPGHOME', 'pubring.gpg'), + $home->( '.gnupg', 'pubring.gpg' ), + ], + 'SecRing' => [ + $env->('GNUPGHOME', 'secring.gpg'), + $home->( '.gnupg', 'secring.gpg' ), + ], + }, + ); +} + +sub version_string { __PACKAGE__ . ' ' . $VERSION } + +sub pubrings { $_[0]->{pubrings} } +sub secrings { $_[0]->{secrings} } + +use constant PUBLIC => 1; +use constant SECRET => 2; + +sub add_ring { + my $pgp = shift; + my($type, $ring) = @_; + unless (ref($ring) eq 'Crypt::OpenPGP::KeyRing') { + $ring = Crypt::OpenPGP::KeyRing->new( Filename => $ring ) + or return Crypt::OpenPGP::KeyRing->errstr; + } + if ($type == SECRET) { + push @{ $pgp->{secrings} }, $ring; + } else { + push @{ $pgp->{pubrings} }, $ring; + } + $ring; +} + +sub new { + my $class = shift; + my $pgp = bless { }, $class; + $pgp->init(@_); +} + +sub _first_exists { + my($list) = @_; + for my $f (@$list) { + next unless $f; + return $f if -e $f; + } +} + +sub init { + my $pgp = shift; + $pgp->{pubrings} = []; + $pgp->{secrings} = []; + my %param = @_; + my $cfg_file = delete $param{ConfigFile}; + my $cfg = $pgp->{cfg} = Crypt::OpenPGP::Config->new(%param) or + return Crypt::OpenPGP::Config->errstr; + if (!$cfg_file && (my $compat = $cfg->get('Compat'))) { + $cfg_file = _first_exists($COMPAT{$compat}{Config}); + } + if ($cfg_file) { + $cfg->read_config($param{Compat}, $cfg_file); + } + ## Load public and secret keyrings. + for my $s (qw( PubRing SecRing )) { + unless (defined $cfg->get($s)) { + my @compats = $param{Compat} ? ($param{Compat}) : keys %COMPAT; + for my $compat (@compats) { + my $ring = _first_exists($COMPAT{$compat}{$s}); + $cfg->set($s, $ring), last if $ring; + } + } + if (my $ring = $cfg->get($s)) { + $pgp->add_ring($s eq 'PubRing' ? PUBLIC : SECRET, $ring); + } + } + $pgp; +} + +sub handle { + my $pgp = shift; + my %param = @_; + my($data); + unless ($data = $param{Data}) { + my $file = $param{Filename} or + return $pgp->error("Need either 'Data' or 'Filename' to decrypt"); + $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr); + } + my $msg = Crypt::OpenPGP::Message->new( Data => $data ) or + return $pgp->error("Reading data packets failed: " . + Crypt::OpenPGP::Message->errstr); + my @pieces = $msg->pieces; + return $pgp->error("No packets found in message") unless @pieces; + while (ref($pieces[0]) eq 'Crypt::OpenPGP::Marker') { + shift @pieces; + } + if (ref($pieces[0]) eq 'Crypt::OpenPGP::Compressed') { + $data = $pieces[0]->decompress or + return $pgp->error("Decompression error: " . $pieces[0]->errstr); + $msg = Crypt::OpenPGP::Message->new( Data => $data ) or + return $pgp->error("Reading decompressed data failed: " . + Crypt::OpenPGP::Message->errstr); + @pieces = $msg->pieces; + } + my $class = ref($pieces[0]); + my(%res); + if ($class eq 'Crypt::OpenPGP::OnePassSig' || + $class eq 'Crypt::OpenPGP::Signature') { + my($valid, $sig) = $pgp->verify( Signature => $data ); + return $pgp->error("Error verifying signature: " . $pgp->errstr) + if !defined $valid; + $res{Validity} = $valid; + $res{Signature} = $sig; + } else { + my $cb = $param{PassphraseCallback} || \&_default_passphrase_cb; + my($pt, $valid, $sig) = $pgp->decrypt( + Data => $data, + PassphraseCallback => $cb, + ); + return $pgp->error("Decryption failed: " . $pgp->errstr) + unless defined $pt; + return $pgp->error("Error verifying signature: " . $pgp->errstr) + if !defined($valid) && $pgp->errstr !~ /^No Signature/; + $res{Plaintext} = $pt; + $res{Validity} = $valid if defined $valid; + $res{Signature} = $sig if defined $sig; + } + \%res; +} + +sub _default_passphrase_cb { + my($cert) = @_; + my $prompt; + if ($cert) { + $prompt = sprintf qq( +You need a passphrase to unlock the secret key for +user "%s". +%d-bit %s key, ID %s + +Enter passphrase: ), $cert->uid, + $cert->key->size, + $cert->key->alg, + substr($cert->key_id_hex, -8, 8); + } else { + $prompt = "Enter passphrase: "; + } + _prompt($prompt, '', 1); +} + +sub _prompt { + my($prompt, $def, $noecho) = @_; + require Term::ReadKey; + Term::ReadKey->import; + print STDERR $prompt . ($def ? "[$def] " : ""); + if ($noecho) { + ReadMode('noecho'); + } + chomp(my $ans = ReadLine(0)); + ReadMode('restore'); + print STDERR "\n"; + $ans ? $ans : $def; +} + +sub sign { + my $pgp = shift; + my %param = @_; + $pgp->_merge_compat(\%param, 'sign') or + return $pgp->error( $pgp->errstr ); + my($cert, $data); + require Crypt::OpenPGP::Signature; + unless ($data = $param{Data}) { + my $file = $param{Filename} or + return $pgp->error("Need either 'Data' or 'Filename' to sign"); + $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr); + } + unless ($cert = $param{Key}) { + my $kid = $param{KeyID} or return $pgp->error("No KeyID specified"); + my $ring = $pgp->secrings->[0] + or return $pgp->error("No secret keyrings"); + my $kb = $ring->find_keyblock_by_keyid(pack 'H*', $kid) or + return $pgp->error("Could not find secret key with KeyID $kid"); + $cert = $kb->signing_key; + $cert->uid($kb->primary_uid); + } + if ($cert->is_protected) { + my $pass = $param{Passphrase}; + if (!defined $pass && (my $cb = $param{PassphraseCallback})) { + $pass = $cb->($cert); + } + return $pgp->error("Need passphrase to unlock secret key") + unless $pass; + $cert->unlock($pass) or + return $pgp->error("Secret key unlock failed: " . $cert->errstr); + } + my @ptarg; + push @ptarg, ( Filename => $param{Filename} ) if $param{Filename}; + if ($param{Clearsign}) { + push @ptarg, ( Mode => 't' ); + ## In clear-signed messages, the line ending before the signature + ## is not considered part of the signed text. + (my $tmp = $data) =~ s!\r?\n$!!; + push @ptarg, ( Data => $tmp ); + } else { + push @ptarg, ( Data => $data ); + } + my $pt = Crypt::OpenPGP::Plaintext->new(@ptarg); + my @sigarg; + if (my $hash_alg = $param{Digest}) { + my $dgst = Crypt::OpenPGP::Digest->new($hash_alg) or + return $pgp->error( Crypt::OpenPGP::Digest->errstr ); + @sigarg = ( Digest => $dgst->alg_id ); + } + push @sigarg, (Type => 0x01) if $param{Clearsign}; + my $sig = Crypt::OpenPGP::Signature->new( + Data => $pt, + Key => $cert, + Version => $param{Version}, + @sigarg, + ); + if ($param{Clearsign}) { + $param{Armour} = $param{Detach} = 1; + } + my $sig_data = Crypt::OpenPGP::PacketFactory->save($sig, + $param{Detach} ? () : ($pt)); + if ($param{Armour}) { + require Crypt::OpenPGP::Armour; + $sig_data = Crypt::OpenPGP::Armour->armour( + Data => $sig_data, + Object => ($param{Detach} ? 'SIGNATURE' : 'MESSAGE'), + ) or return $pgp->error( Crypt::OpenPGP::Armour->errstr ); + } + if ($param{Clearsign}) { + require Crypt::OpenPGP::Util; + my $hash = Crypt::OpenPGP::Digest->alg($sig->{hash_alg}); + my $data = Crypt::OpenPGP::Util::dash_escape($data); + $data .= "\n" unless $data =~ /\n$/; + $sig_data = "-----BEGIN PGP SIGNED MESSAGE-----\n" . + ($hash eq 'MD5' ? '' : "Hash: $hash\n") . + "\n" . + $data . + $sig_data; + } + $sig_data; +} + +sub verify { + my $pgp = shift; + my %param = @_; + my $wants_object = wantarray; + my($data, $sig); + require Crypt::OpenPGP::Signature; + $param{Signature} or $param{SigFile} or + return $pgp->error("Need Signature or SigFile to verify"); + my %arg = $param{Signature} ? (Data => $param{Signature}) : + (Filename => $param{SigFile}); + $arg{IsPacketStream} = 1 if $param{IsPacketStream}; + my $msg = Crypt::OpenPGP::Message->new( %arg ) or + return $pgp->error("Reading signature failed: " . + Crypt::OpenPGP::Message->errstr); + my @pieces = $msg->pieces; + if (ref($pieces[0]) eq 'Crypt::OpenPGP::Compressed') { + $data = $pieces[0]->decompress or + return $pgp->error("Decompression error: " . $pieces[0]->errstr); + $msg = Crypt::OpenPGP::Message->new( Data => $data ) or + return $pgp->error("Reading decompressed data failed: " . + Crypt::OpenPGP::Message->errstr); + @pieces = $msg->pieces; + } + if (ref($pieces[0]) eq 'Crypt::OpenPGP::OnePassSig') { + ($data, $sig) = @pieces[1,2]; + } elsif (ref($pieces[0]) eq 'Crypt::OpenPGP::Signature') { + ($sig, $data) = @pieces[0,1]; + } else { + return $pgp->error("SigFile contents are strange"); + } + unless ($data) { + if ($param{Data}) { + $data = Crypt::OpenPGP::Plaintext->new( Data => $param{Data} ); + } + else { + ## if no Signature or detached sig in SigFile + my @files = ref($param{Files}) eq 'ARRAY' ? @{ $param{Files} } : + $param{Files}; + my $fdata = $pgp->_read_files(@files); + return $pgp->error("Reading data files failed: " . $pgp->errstr) + unless defined $fdata; + $data = Crypt::OpenPGP::Plaintext->new( Data => $fdata ); + } + } + my($cert, $kb); + unless ($cert = $param{Key}) { + my $key_id = $sig->key_id; + my $ring = $pgp->pubrings->[0]; + unless ($ring && ($kb = $ring->find_keyblock_by_keyid($key_id))) { + my $cfg = $pgp->{cfg}; + if ($cfg->get('AutoKeyRetrieve') && $cfg->get('KeyServer')) { + require Crypt::OpenPGP::KeyServer; + my $server = Crypt::OpenPGP::KeyServer->new( + Server => $cfg->get('KeyServer'), + ); + $kb = $server->find_keyblock_by_keyid($key_id); + } + return $pgp->error("Could not find public key with KeyID " . + unpack('H*', $key_id)) + unless $kb; + } + $cert = $kb->signing_key; + } + +## pgp2 and pgp5 do not trim trailing whitespace from "canonical text" +## signatures, only from cleartext signatures. So we first try to verify +## the signature using proper RFC2440 canonical text, then if that fails, +## retry without trimming trailing whitespace. +## See: +## http://cert.uni-stuttgart.de/archive/ietf-openpgp/2000/01/msg00033.html + my($dgst, $found); + for (1, 0) { + local $Crypt::OpenPGP::Globals::Trim_trailing_ws = $_; + $dgst = $sig->hash_data($data) or + return $pgp->error( $sig->errstr ); + $found++, last if substr($dgst, 0, 2) eq $sig->{chk}; + } + return $pgp->error("Message hash does not match signature checkbytes") + unless $found; + my $valid = $cert->key->public_key->verify($sig, $dgst) ? + ($kb && $kb->primary_uid ? $kb->primary_uid : 1) : 0; + + $wants_object ? ($valid, $sig) : $valid; +} + +sub encrypt { + my $pgp = shift; + my %param = @_; + $pgp->_merge_compat(\%param, 'encrypt') or + return $pgp->error( $pgp->errstr ); + my($data); + require Crypt::OpenPGP::Cipher; + require Crypt::OpenPGP::Ciphertext; + unless ($data = $param{Data}) { + my $file = $param{Filename} or + return $pgp->error("Need either 'Data' or 'Filename' to encrypt"); + $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr); + } + my $ptdata; + if ($param{SignKeyID}) { + $ptdata = $pgp->sign( + Data => $data, + KeyID => $param{SignKeyID}, + Compat => $param{Compat}, + Armour => 0, + Passphrase => $param{SignPassphrase}, + PassphraseCallback => $param{SignPassphraseCallback}, + ) + or return; + } else { + my $pt = Crypt::OpenPGP::Plaintext->new( Data => $data, + $param{Filename} ? (Filename => $param{Filename}) : () ); + $ptdata = Crypt::OpenPGP::PacketFactory->save($pt); + } + if (my $alg = $param{Compress}) { + require Crypt::OpenPGP::Compressed; + $alg = Crypt::OpenPGP::Compressed->alg_id($alg); + my $cdata = Crypt::OpenPGP::Compressed->new( Data => $ptdata, + Alg => $alg ) or return $pgp->error("Compression error: " . + Crypt::OpenPGP::Compressed->errstr); + $ptdata = Crypt::OpenPGP::PacketFactory->save($cdata); + } + require Crypt::Random; + my $key_data = Crypt::Random::makerandom_octet( Length => 32 ); + my $sym_alg = $param{Cipher} ? + Crypt::OpenPGP::Cipher->alg_id($param{Cipher}) : DEFAULT_CIPHER; + my(@sym_keys); + if ($param{Recipients} && !ref($param{Recipients})) { + $param{Recipients} = [ $param{Recipients} ]; + } + if (my $kid = delete $param{KeyID}) { + my @kid = ref $kid eq 'ARRAY' ? @$kid : $kid; + push @{ $param{Recipients} }, @kid; + } + if ($param{Key} || $param{Recipients}) { + require Crypt::OpenPGP::SessionKey; + my @keys; + if (my $recips = $param{Recipients}) { + my @recips = ref $recips eq 'ARRAY' ? @$recips : $recips; + my $ring = $pgp->pubrings->[0]; + my %seen; + my $server; + my $cfg = $pgp->{cfg}; + if ($cfg->get('AutoKeyRetrieve') && $cfg->get('KeyServer')) { + require Crypt::OpenPGP::KeyServer; + $server = Crypt::OpenPGP::KeyServer->new( + Server => $cfg->get('KeyServer'), + ); + } + for my $r (@recips) { + my($lr, @kb) = (length($r)); + if (($lr == 8 || $lr == 16) && $r !~ /[^\da-fA-F]/) { + my $id = pack 'H*', $r; + @kb = $ring->find_keyblock_by_keyid($id) if $ring; + @kb = $server->find_keyblock_by_keyid($id) + if !@kb && $server; + } else { + @kb = $ring->find_keyblock_by_uid($r) if $ring; + @kb = $server->find_keyblock_by_uid($r) + if !@kb && $server; + } + for my $kb (@kb) { + next unless my $cert = $kb->encrypting_key; + next if $seen{ $cert->key_id }++; + $cert->uid($kb->primary_uid); + push @keys, $cert; + } + } + if (my $cb = $param{RecipientsCallback}) { + @keys = @{ $cb->(\@keys) }; + } + } + if ($param{Key}) { + push @keys, ref $param{Key} eq 'ARRAY' ? @{$param{Key}} : + $param{Key}; + } + return $pgp->error("No known recipients for encryption") + unless @keys; + for my $key (@keys) { + push @sym_keys, Crypt::OpenPGP::SessionKey->new( + Key => $key, + SymKey => $key_data, + Cipher => $sym_alg, + ) or + return $pgp->error( Crypt::OpenPGP::SessionKey->errstr ); + } + } + elsif (my $pass = $param{Passphrase}) { + require Crypt::OpenPGP::SKSessionKey; + require Crypt::OpenPGP::S2k; + my $s2k; + if ($param{Compat} && $param{Compat} eq 'PGP2') { + $s2k = Crypt::OpenPGP::S2k->new('Simple'); + $s2k->{hash} = Crypt::OpenPGP::Digest->new('MD5'); + } else { + $s2k = Crypt::OpenPGP::S2k->new('Salt_Iter'); + } + my $keysize = Crypt::OpenPGP::Cipher->new($sym_alg)->keysize; + $key_data = $s2k->generate($pass, $keysize); + push @sym_keys, Crypt::OpenPGP::SKSessionKey->new( + Passphrase => $pass, + SymKey => $key_data, + Cipher => $sym_alg, + S2k => $s2k, + ) or + return $pgp->error( Crypt::OpenPGP::SKSessionKey->errstr ); + } else { + return $pgp->error("Need something to encrypt with"); + } + my $enc = Crypt::OpenPGP::Ciphertext->new( + MDC => $param{MDC}, + SymKey => $key_data, + Data => $ptdata, + Cipher => $sym_alg, + ); + my $enc_data = Crypt::OpenPGP::PacketFactory->save( + $param{Passphrase} && $param{Compat} && $param{Compat} eq 'PGP2' ? + $enc : (@sym_keys, $enc) + ); + if ($param{Armour}) { + require Crypt::OpenPGP::Armour; + $enc_data = Crypt::OpenPGP::Armour->armour( + Data => $enc_data, + Object => 'MESSAGE', + ) or return $pgp->error( Crypt::OpenPGP::Armour->errstr ); + } + $enc_data; +} + +sub decrypt { + my $pgp = shift; + my %param = @_; + my $wants_verify = wantarray; + my($data); + unless ($data = $param{Data}) { + my $file = $param{Filename} or + return $pgp->error("Need either 'Data' or 'Filename' to decrypt"); + $data = $pgp->_read_files($file) or return $pgp->error($pgp->errstr); + } + my $msg = Crypt::OpenPGP::Message->new( Data => $data ) or + return $pgp->error("Reading data packets failed: " . + Crypt::OpenPGP::Message->errstr); + my @pieces = $msg->pieces; + return $pgp->error("No packets found in message") unless @pieces; + while (ref($pieces[0]) eq 'Crypt::OpenPGP::Marker') { + shift @pieces; + } + my($key, $alg); + if (ref($pieces[0]) eq 'Crypt::OpenPGP::SessionKey') { + my($sym_key, $cert, $ring) = (shift @pieces); + unless ($cert = $param{Key}) { + $ring = $pgp->secrings->[0] + or return $pgp->error("No secret keyrings"); + } + my($kb); + while (ref($sym_key) eq 'Crypt::OpenPGP::SessionKey') { + if ($cert) { + if ($cert->key_id eq $sym_key->key_id) { + shift @pieces + while ref($pieces[0]) eq 'Crypt::OpenPGP::SessionKey'; + last; + } + } else { + if ($kb = $ring->find_keyblock_by_keyid($sym_key->key_id)) { + shift @pieces + while ref($pieces[0]) eq 'Crypt::OpenPGP::SessionKey'; + last; + } + } + $sym_key = shift @pieces; + } + return $pgp->error("Can't find a secret key to decrypt message") + unless $kb || $cert; + if ($kb) { + $cert = $kb->encrypting_key; + $cert->uid($kb->primary_uid); + } + if ($cert->is_protected) { + my $pass = $param{Passphrase}; + if (!defined $pass && (my $cb = $param{PassphraseCallback})) { + $pass = $cb->($cert); + } + return $pgp->error("Need passphrase to unlock secret key") + unless $pass; + $cert->unlock($pass) or + return $pgp->error("Seckey unlock failed: " . $cert->errstr); + } + ($key, $alg) = $sym_key->decrypt($cert) or + return $pgp->error("Symkey decrypt failed: " . $sym_key->errstr); + } + elsif (ref($pieces[0]) eq 'Crypt::OpenPGP::SKSessionKey') { + my $sym_key = shift @pieces; + my $pass = $param{Passphrase}; + if (!defined $pass && (my $cb = $param{PassphraseCallback})) { + $pass = $cb->(); + } + return $pgp->error("Need passphrase to decrypt session key") + unless $pass; + ($key, $alg) = $sym_key->decrypt($pass) or + return $pgp->error("Symkey decrypt failed: " . $sym_key->errstr); + } + my $enc = $pieces[0]; + + ## If there is still no symkey and symmetric algorithm, *and* the + ## first packet is a Crypt::OpenPGP::Ciphertext packet, assume that + ## the packet is encrypted using a symmetric key, using a 'Simple' s2k. + if (!$key && !$alg && ref($enc) eq 'Crypt::OpenPGP::Ciphertext') { + my $pass = $param{Passphrase} or + return $pgp->error("Need passphrase to decrypt session key"); + require Crypt::OpenPGP::Cipher; + require Crypt::OpenPGP::S2k; + my $ciph = Crypt::OpenPGP::Cipher->new('IDEA'); + my $s2k = Crypt::OpenPGP::S2k->new('Simple'); + $s2k->{hash} = Crypt::OpenPGP::Digest->new('MD5'); + $key = $s2k->generate($pass, $ciph->keysize); + $alg = $ciph->alg_id; + } + + $data = $enc->decrypt($key, $alg) or + return $pgp->error("Ciphertext decrypt failed: " . $enc->errstr); + + ## This is a special hack: if decrypt gets a signed, encrypted message, + ## it needs to be able to pass back the decrypted text *and* a flag + ## saying whether the signature is valid or not. But in some cases, + ## you don't know ahead of time if there is a signature at all--and if + ## there isn't, there is no way of knowing whether the signature is valid, + ## or if there isn't a signature at all. So this prepopulates the internal + ## errstr with the string "No Signature\n"--if there is a signature, and + ## there is an error during verification, the second return value will be + ## undef, and the errstr will contain the error that occurred. If there is + ## *not* a signature, the second return value will still be undef, but + ## the errstr is guaranteed to be "No Signature\n". + $pgp->error("No Signature"); + + my($valid, $sig); + $msg = Crypt::OpenPGP::Message->new( Data => $data, + IsPacketStream => 1 ); + @pieces = $msg->pieces; + + ## If the first packet in the decrypted data is compressed, + ## decompress it and set the list of packets to the result. + if (ref($pieces[0]) eq 'Crypt::OpenPGP::Compressed') { + $data = $pieces[0]->decompress or + return $pgp->error("Decompression error: " . $pieces[0]->errstr); + $msg = Crypt::OpenPGP::Message->new( Data => $data, + IsPacketStream => 1 ); + @pieces = $msg->pieces; + } + + my($pt); + if (ref($pieces[0]) eq 'Crypt::OpenPGP::OnePassSig' || + ref($pieces[0]) eq 'Crypt::OpenPGP::Signature') { + $pt = $pieces[1]; + if ($wants_verify) { + ($valid, $sig) = + $pgp->verify( Signature => $data, IsPacketStream => 1 ); + } + } else { + $pt = $pieces[0]; + } + + $wants_verify ? ($pt->data, $valid, $sig) : $pt->data; +} + +sub keygen { + my $pgp = shift; + my %param = @_; + require Crypt::OpenPGP::Certificate; + require Crypt::OpenPGP::Key; + require Crypt::OpenPGP::KeyBlock; + require Crypt::OpenPGP::Signature; + require Crypt::OpenPGP::UserID; + + $param{Type} or + return $pgp->error("Need a Type of key to generate"); + $param{Size} ||= 1024; + $param{Version} ||= 4; + $param{Version} = 3 if $param{Type} eq 'RSA'; + + my $kb_pub = Crypt::OpenPGP::KeyBlock->new; + my $kb_sec = Crypt::OpenPGP::KeyBlock->new; + + my($pub, $sec) = Crypt::OpenPGP::Key->keygen($param{Type}, %param); + die Crypt::OpenPGP::Key->errstr unless $pub && $sec; + my $pubcert = Crypt::OpenPGP::Certificate->new( + Key => $pub, + Version => $param{Version} + ) or + die Crypt::OpenPGP::Certificate->errstr; + my $seccert = Crypt::OpenPGP::Certificate->new( + Key => $sec, + Passphrase => $param{Passphrase}, + Version => $param{Version} + ) or + die Crypt::OpenPGP::Certificate->errstr; + $kb_pub->add($pubcert); + $kb_sec->add($seccert); + + my $id = Crypt::OpenPGP::UserID->new( Identity => $param{Identity} ); + $kb_pub->add($id); + $kb_sec->add($id); + + my $sig = Crypt::OpenPGP::Signature->new( + Data => [ $pubcert, $id ], + Key => $seccert, + Version => $param{Version}, + Type => 0x13, + ); + $kb_pub->add($sig); + $kb_sec->add($sig); + + ($kb_pub, $kb_sec); +} + +sub _read_files { + my $pgp = shift; + return $pgp->error("No files specified") unless @_; + my @files = @_; + my $data = ''; + for my $file (@files) { + $file ||= ''; + local *FH; + open FH, $file or return $pgp->error("Error opening $file: $!"); + binmode FH; + { local $/; $data .= <FH> } + close FH or warn "Warning: Got error closing $file: $!"; + } + $data; +} + +{ + my @MERGE_CONFIG = qw( Cipher Armour Digest ); + sub _merge_compat { + my $pgp = shift; + my($param, $meth) = @_; + my $compat = $param->{Compat} || $pgp->{cfg}->get('Compat') || return 1; + my $ref = $COMPAT{$compat}{$meth} or + return $pgp->error("No settings for Compat class '$compat'"); + for my $arg (keys %$ref) { + $param->{$arg} = $ref->{$arg} unless exists $param->{$arg}; + } + for my $key (@MERGE_CONFIG) { + $param->{$key} = $pgp->{cfg}->get($key) + unless exists $param->{$key}; + } + 1; + } +} + +1; + +__END__ + +=head1 NAME + +Crypt::OpenPGP - Pure-Perl OpenPGP implementation + +=head1 SYNOPSIS + + my $pgp = Crypt::OpenPGP->new; + + # Given an input stream (could be a signature, ciphertext, etc), + # do the "right thing" to it. + my $message_body; $message_body .= $_ while <STDIN>; + my $result = $pgp->handle( Data => $message_body ); + + # Create a detached, ASCII-armoured signature of $file using the + # secret key $key_id, protected with the passphrase $pass. + my $file = 'really-from-me.txt'; + my $key_id = '...'; + my $pass = 'foo bar'; + my $signature = $pgp->sign( + Filename => $file, + KeyID => $key_id, + Passphrase => $pass, + Detach => 1, + Armour => 1, + ); + + # Verify the detached signature $signature, which should be of the + # source file $file. + my $is_valid = $pgp->verify( + Signature => $signature, + Files => [ $file ], + ); + + # Using the public key associated with $key_id, encrypt the contents + # of the file $file, and ASCII-armour the ciphertext. + my $ciphertext = $pgp->encrypt( + Filename => $file, + Recipients => $key_id, + Armour => 1, + ); + + # Decrypt $ciphertext using the secret key used to encrypt it, + # which key is protected with the passphrase $pass. + my $plaintext = $pgp->decrypt( + Data => $ciphertext, + Passphrase => $pass, + ); + +=head1 DESCRIPTION + +I<Crypt::OpenPGP> is a pure-Perl implementation of the OpenPGP +standard[1]. In addition to support for the standard itself, +I<Crypt::OpenPGP> claims compatibility with many other PGP implementations, +both those that support the standard and those that preceded it. + +I<Crypt::OpenPGP> provides signing/verification, encryption/decryption, +keyring management, and key-pair generation; in short it should provide +you with everything you need to PGP-enable yourself. Alternatively it +can be used as part of a larger system; for example, perhaps you have +a web-form-to-email generator written in Perl, and you'd like to encrypt +outgoing messages, because they contain sensitive information. +I<Crypt::OpenPGP> can be plugged into such a scenario, given your public +key, and told to encrypt all messages; they will then be readable only +by you. + +This module currently supports C<RSA> and C<DSA> for digital signatures, +and C<RSA> and C<ElGamal> for encryption/decryption. It supports the +symmetric ciphers C<3DES>, C<Blowfish>, C<IDEA>, C<Twofish>, C<CAST5>, and +C<Rijndael> (C<AES>). C<Rijndael> is supported for key sizes of C<128>, +C<192>, and C<256> bits. I<Crypt::OpenPGP> supports the digest algorithms +C<MD5>, C<SHA-1>, and C<RIPE-MD/160>. And it supports C<ZIP> and C<Zlib> +compression. + +=head1 COMPATIBILITY + +One of the highest priorities for I<Crypt::OpenPGP> is compatibility with +other PGP implementations, including PGP implementations that existed +before the OpenPGP standard. + +As a means towards that end, some of the high-level I<Crypt::OpenPGP> +methods can be used in compatibility mode; given an argument I<Compat> +and a PGP implementation with which they should be compatible, these +method will do their best to choose ciphers, digest algorithms, etc. that +are compatible with that implementation. For example, PGP2 only supports +C<IDEA> encryption, C<MD5> digests, and version 3 signature formats; if +you tell I<Crypt::OpenPGP> that it must be compatible with PGP2, it will +only use these algorithms/formats when encrypting and signing data. + +To use this feature, supply either I<sign> or I<encrypt> with the +I<Compat> parameter, giving it one of the values from the list below. +For example: + + my $ct = $pgp->encrypt( + Compat => 'PGP2', + Filename => 'foo.pl', + Recipients => $key_id, + ); + +Because I<PGP2> was specified, the data will automatically be encrypted +using the C<IDEA> cipher, and will be compressed using C<ZIP>. + +Here is a list of the current compatibility sets and the algorithms and +formats they support. + +=over 4 + +=item * PGP2 + +Encryption: symmetric cipher = C<IDEA>, compression = C<ZIP>, +modification detection code (MDC) = C<0> + +Signing: digest = C<MD5>, packet format = version 3 + +=item * PGP5 + +Encryption: symmetric cipher = C<3DES>, compression = C<ZIP>, +modification detection code (MDC) = C<0> + +Signing: digest = C<SHA-1>, packet format = version 3 + +=item * GnuPG + +Encryption: symmetric cipher = C<Rijndael>, compression = C<Zlib>, +modification detection code (MDC) = C<1> + +Signing: digest = C<RIPE-MD/160>, packet format = version 4 + +=back + +If the compatibility setting is unspecified (that is, if no I<Compat> +argument is supplied), the settings (ciphers, digests, etc.) fall +back to their default settings. + +=head1 USAGE + +I<Crypt::OpenPGP> has the following high-level interface. On failure, +all methods will return C<undef> and set the I<errstr> for the object; +look below at the I<ERROR HANDLING> section for more information. + +=head2 Crypt::OpenPGP->new( %args ) + +Constructs a new I<Crypt::OpenPGP> instance and returns that object. +Returns C<undef> on failure. + +I<%args> can contain: + +=over 4 + +=item * Compat + +The compatibility mode for this I<Crypt::OpenPGP> object. This value will +propagate down into method calls upon this object, meaning that it will be +applied for all method calls invoked on this object. For example, if you set +I<Compat> here, you do not have to set it again when calling I<encrypt> +or I<sign> (below), unless, of course, you want to set I<Compat> to a +different value for those methods. + +I<Compat> influences several factors upon object creation, unless otherwise +overridden in the constructor arguments: if you have a configuration file +for this compatibility mode (eg. F<~/.gnupg/options> for GnuPG), it will +be automatically read in, and I<Crypt::OpenPGP> will set any options +relevant to its execution (symmetric cipher algorithm, etc.); I<PubRing> +and I<SecRing> (below) are set according to the default values for this +compatibility mode (eg. F<~/.gnupg/pubring.gpg> for the GnuPG public +keyring). + +=item * SecRing + +Path to your secret keyring. If unspecified, I<Crypt::OpenPGP> will look +for your keyring in a number of default places. + +As an alternative to passing in a path to the keyring file, you can pass in +a I<Crypt::OpenPGP::KeyRing> object representing a secret keyring. + +=item * PubRing + +Path to your public keyring. If unspecified, I<Crypt::OpenPGP> will look +for your keyring in a number of default places. + +As an alternative to passing in a path to the keyring file, you can pass in +a I<Crypt::OpenPGP::KeyRing> object representing a public keyring. + +=item * ConfigFile + +Path to a PGP/GnuPG config file. If specified, you must also pass in a +value for the I<Compat> parameter, stating what format config file you are +passing in. For example, if you are passing in the path to a GnuPG config +file, you should give a value of C<GnuPG> for the I<Compat> flag. + +If you leave I<ConfigFile> unspecified, but you have specified a value for +I<Compat>, I<Crypt::OpenPGP> will try to find your config file, based on +the value of I<Compat> that you pass in (eg. F<~/.gnupg/options> if +I<Compat> is C<GnuPG>). + +NOTE: if you do not specify a I<Compat> flag, I<Crypt::OpenPGP> cannot read +any configuration files, even if you I<have> specified a value for the +I<ConfigFile> parameter, because it will not be able to determine the proper +config file format. + +=item * KeyServer + +The hostname of the HKP keyserver. You can get a list of keyservers through + + % host -l pgp.net | grep wwwkeys + +If I<AutoKeyRetrieve> is set to a true value, +keys will be automatically retrieved from the keyserver if they are not found +in your local keyring. + +=item * AutoKeyRetrieve + +If set to a true value, and if I<KeyServer> is set to a keyserver name, +I<encrypt> and I<verify> will automatically try to fetch public keys from +the keyserver if they are not found in your local keyring. + +=back + +=head2 $pgp->handle( %args ) + +A do-what-I-mean wrapper around I<decrypt> and I<verify>. Given either a +filename or a block of data--for example, data from an incoming email +message--I<handle> "handles" it as appropriate for whatever encryption or +signing the message contains. For example, if the data is encrypted, I<handle> +will return the decrypted data (after prompting you for the passphrase). If +the data is signed, I<handle> will check the validity of the signature and +return indication of the validity of the signature. + +The return value is a reference to a hash, which may contain the following +keys, depending on the data passed to the method: + +=over 4 + +=item * Plaintext + +If the data is encrypted, the decrypted message. + +=item * Validity + +If the data is signed, a true value if the signature is valid, a false value +otherwise. The true value will be either the signer's email address, if +available, or C<1>, if not. + +=item * Signature + +If the data is signed, the I<Crypt::OpenPGP::Signature> object representing +the signature. + +=back + +If an error occurs, the return value will be C<undef>, and the error message +can be obtained by calling I<errstr> on the I<Crypt::OpenPGP> object. + +I<%args> can contain: + +=over 4 + +=item * Data + +The data to be "handled". This should be a simple scalar containing an +arbitrary amount of data. + +I<Data> is optional; if unspecified, you should specify a filename (see +I<Filename>, below). + +=item * Filename + +The path to a file to "handle". + +I<Filename> is optional; if unspecified, you should specify the data +in I<Data>, above. If both I<Data> and I<Filename> are specified, the +data in I<Data> overrides that in I<Filename>. + +=item * PassphraseCallback + +If the data is encrypted, you will need to supply I<handle> with the proper +passphrase to unlock the private key, or the password to decrypt the +symmetrically-encrypted data (depending on the method of encryption used). +If you do not specify this parameter, this default passphrase callback will be +used: + + sub _default_passphrase_cb { + my($cert) = @_; + my $prompt; + if ($cert) { + $prompt = sprintf qq( + You need a passphrase to unlock the secret key for + user "%s". + %d-bit %s key, ID %s + + Enter passphrase: ), $cert->uid, + $cert->key->size, + $cert->key->alg, + substr($cert->key_id_hex, -8, 8); + } else { + $prompt = "Enter passphrase: "; + } + _prompt($prompt, '', 1); + } + +If you do specify this parameter, make sure that your callback function can +handle both asymmetric and symmetric encryption. + +See the I<PassphraseCallback> parameter for I<decrypt>, below. + +=back + +=head2 $pgp->encrypt( %args ) + +Encrypts a block of data. The encryption is actually done with a symmetric +cipher; the key for the symmetric cipher is then encrypted with either +the public key of the recipient or using a passphrase that you enter. The +former case is using public-key cryptography, the latter, standard +symmetric ciphers. In the first case, the session key can only be +unlocked by someone with the corresponding secret key; in the second, it +can only be unlocked by someone who knows the passphrase. + +Given the parameter I<SignKeyID> (see below), I<encrypt> will first sign +the message before encrypting it, adding a Signature packet to the +encrypted plaintext. + +Returns a block of data containing two PGP packets: the encrypted +symmetric key and the encrypted data. + +On failure returns C<undef>. + +I<%args> can contain: + +=over 4 + +=item * Compat + +Specifies the PGP compatibility setting. See I<COMPATIBILITY>, above. + +=item * Data + +The plaintext to be encrypted. This should be a simple scalar containing +an arbitrary amount of data. + +I<Data> is optional; if unspecified, you should specify a filename (see +I<Filename>, below). + +=item * Filename + +The path to a file to encrypt. + +I<Filename> is optional; if unspecified, you should specify the data +in I<Data>, above. If both I<Data> and I<Filename> are specified, the +data in I<Data> overrides that in I<Filename>. + +=item * Recipients + +The intended recipients of the encrypted message. In other words, +either the key IDs or user IDs of the public keys that should be used +to encrypt the message. Each recipient specified should be either a +key ID--an 8-digit or 16-digit hexadecimal number--or part of a user +ID that can be used to look up the user's public key in your keyring. +Examples: + + 8-digit hex key ID: 123ABC45 + 16-digit hex key ID: 678DEF90123ABC45 + (Part of) User ID: foo@bar + +Note that the 8-digit hex key ID is the last 8 digits of the (long) +16-digit hex key ID. + +If you wish to encrypt the message for multiple recipients, the value +of I<Recipients> should be a reference to a list of recipients (as +defined above). For each recipient in the list, the public key will be +looked up in your public keyring, and an encrypted session key packet +will be added to the encrypted message. + +This argument is optional; if not provided you should provide the +I<Passphrase> option (below) to perform symmetric-key encryption when +encrypting the session key. + +=item * KeyID + +A deprecated alias for I<Recipients> (above). There is no need to use +I<KeyID>, as its functionality has been completely subsumed into the +I<Recipients> parameter. + +=item * Passphrase + +The mechanism to use symmetric-key, or "conventional", encryption, +when encrypting the session key. In other words, this allows you to +use I<Crypt::OpenPGP> for encryption/decryption without using public-key +cryptography; this can be useful in certain circumstances (for example, +when encrypting data locally on disk). + +This argument is optional; if not provided you should provide the +I<Recipients> option (above) to perform public-key encryption when +encrypting the session key. + +=item * RecipientsCallback + +After the list of recipients for a message (as given in I<Recipients>, +above) has been mapped into a set of keys from your public keyring, +you can use I<RecipientsCallback> to review/modify that list of keys. +The value of I<RecipientsCallback> should be a reference to a +subroutine; when invoked that routine will be handed a reference to +an array of I<Crypt::OpenPGP::Certificate> objects. It should then +return a reference to a list of such objects. + +This can be useful particularly when supplying user IDs in the list +of I<Recipients> for an encrypted message. Since user IDs are looked +up using partial matches (eg. I<b> could match I<b>, I<abc>, I<bar>, +etc.), one intended recipient may actually turn up multiple keys. +You can use I<RecipientsCallback> to audit that list before actually +encrypting the message: + + my %BAD_KEYS = ( + ABCDEF1234567890 => 1, + 1234567890ABCDEF => 1, + ); + my $cb = sub { + my $keys = shift; + my @return; + for my $cert (@$keys) { + push @return, $cert unless $BAD_KEYS{ $cert->key_id_hex }; + } + \@returns; + }; + my $ct = $pgp->encrypt( ..., RecipientsCallback => $cb, ... ); + +=item * Cipher + +The name of a symmetric cipher with which the plaintext will be +encrypted. Valid arguments are C<DES3>, C<CAST5>, C<Blowfish>, C<IDEA>, +C<Twofish>, C<Rijndael>, C<Rijndael192>, and C<Rijndael256> (the last +two are C<Rijndael> with key sizes of 192 and 256 bits, respectively). + +This argument is optional; if you have provided a I<Compat> parameter, +I<Crypt::OpenPGP> will use the appropriate cipher for the supplied +compatibility mode. Otherwise, I<Crypt::OpenPGP> currently defaults to +C<DES3>; this could change in the future. + +=item * Compress + +The name of a compression algorithm with which the plaintext will be +compressed before it is encrypted. Valid values are C<ZIP> and +C<Zlib>. + +By default text is not compressed. + +=item * Armour + +If true, the data returned from I<encrypt> will be ASCII-armoured. This +can be useful when you need to send data through email, for example. + +By default the returned data is not armoured. + +=item * SignKeyID + +If you wish to sign the plaintext message before encrypting it, provide +I<encrypt> with the I<SignKeyID> parameter and give it a key ID with +which the message can be signed. This allows recipients of your message +to verify its validity. + +By default messages not signed. + +=item * SignPassphrase + +The passphrase to unlock the secret key to be used when signing the +message. + +If you are signing the message--that is, if you have provided the +I<SignKeyID> parameter--either this argument or I<SignPassphraseCallback> +is required. + +=item * SignPassphraseCallback + +The callback routine to enable the passphrase being passed in through +some user-defined routine. See the I<PassphraseCallback> parameter for +I<sign>, below. + +If you are signing the message--that is, if you have provided the +I<SignKeyID> parameter--either this argument or I<SignPassphrase> is +required. + +=item * MDC + +When set to a true value, instructs I<encrypt> to 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 I<encrypt> generates standard +encrypted data packets. Set it to a true value to turn on MDC packets. +Note that I<MDC> will automatically be turned on if you are using a +I<Compat> mode that is known to support it. + +=back + +=head2 $pgp->decrypt( %args ) + +Decrypts a block of ciphertext. The ciphertext should be of the sort +returned from I<encrypt>, in either armoured or non-armoured form. +This is compatible with all other implementations of PGP: the output +of their encryption should serves as the input to this method. + +When called in scalar context, returns the plaintext (that is, the +decrypted ciphertext), or C<undef> on failure. When called in list +context, returns a three-element list containing the plaintext and the +result of signature verification (see next paragraph), or the empty +list on failure. Either of the failure conditions listed here indicates +that decryption failed. + +If I<decrypt> is called in list context, and the encrypted text +contains a signature over the plaintext, I<decrypt> will attempt to +verify the signature and will return the result of that verification +as the second element in the return list, and the actual +I<Crypt::OpenPGP::Signature> object as the third element in the return +list. If you call I<decrypt> in +list context and the ciphertext does I<not> contain a signature, that +second element will be C<undef>, and the I<errstr> will be set to +the string C<No Signature\n>. The second element in the return list can +have one of three possible values: C<undef>, meaning that either an +error occurred in verifying the signature, I<or> the ciphertext did +not contain a signature; C<0>, meaning that the signature is invalid; +or a true value of either the signer's user ID or C<1>, if the user ID +cannot be determined. Note that these are the same values returned from +I<verify> (below). + +For example, to decrypt a message that may contain a signature that you +want verified, you might use code like this: + + my($pt, $valid, $sig) = $pgp->decrypt( ... ); + die "Decryption failed: ", $pgp->errstr unless $pt; + die "Signature verification failed: ", $pgp->errstr + unless defined $valid || $pgp->errstr !~ /^No Signature/; + print "Signature created at ", $sig->timestamp, "\n"; + +This checks for errors in decryption, as well as errors in signature +verification, excluding the error denoting that the plaintext was +not signed. + +I<%args> can contain: + +=over 4 + +=item * Data + +The ciphertext to be decrypted. This should be a simple scalar containing +an arbitrary amount of data. + +I<Data> is optional; if unspecified, you should specify a filename (see +I<Filename>, below). + +=item * Filename + +The path to a file to decrypt. + +I<Filename> is optional; if unspecified, you should specify the data +in I<Data>, above. If both I<Data> and I<Filename> are specified, the +data in I<Data> overrides that in I<Filename>. + +=item * Passphrase + +The passphrase to unlock your secret key, or to decrypt a +symmetrically-encrypted message; the usage depends on how the message is +encrypted. + +This argument is optional if your secret key is protected; if not +provided you should supply the I<PassphraseCallback> parameter (below). + +=item * PassphraseCallback + +A callback routine to allow interactive users (for example) to enter the +passphrase for the specific key being used to decrypt the ciphertext, or +the passphrase used to encrypt a symmetrically-encrypted message. This +is useful when your ciphertext is encrypted to several recipients, if +you do not necessarily know ahead of time the secret key that will be used +to decrypt it. It is also useful when you wish to provide an interactive +user with some feedback about the key being used to decrypt the message, +or when you don't know what type of encryption (symmetric or public-key) +will be used to encrypt a message. + +The value of this parameter should be a reference to a subroutine. This +routine will be called when a passphrase is needed from the user, and +it will be given either zero arguments or one argument, depending on +whether the message is encrypted symmetrically (zero arguments) or using +public-key encryption (one argument). If the latter, the one argument is +a I<Crypt::OpenPGP::Certificate> object representing the secret key. You +can use the information in this object to present details about the key to +the user. + +In either case, the callback routine should return the passphrase, a +scalar string. + +Your callback routine can use the number of arguments to determine how to +prompt the user for a passphrase; for example: + + sub passphrase_cb { + if (my $cert = $_[0]) { + printf "Enter passphrase for secret key %s: ", + $cert->key_id_hex; + } else { + print "Enter passphrase: "; + } + } + +This argument is optional if your secret key is protected; if not +provided you should supply the I<Passphrase> parameter (above). + +=back + +=head2 $pgp->sign( %args ) + +Creates and returns a digital signature on a block of data. + +On failure returns C<undef>. + +I<%args> can contain: + +=over 4 + +=item * Compat + +Specifies the PGP compatibility setting. See I<COMPATIBILITY>, above. + +=item * Data + +The text to be signed. This should be a simple scalar containing an +arbitrary amount of data. + +I<Data> is optional; if unspecified, you should specify a filename (see +I<Filename>, below). + +=item * Filename + +The path to a file to sign. + +I<Filename> is optional; if unspecified, you should specify the data +in I<Data>, above. If both I<Data> and I<Filename> are specified, the +data in I<Data> overrides that in I<Filename>. + +=item * Detach + +If set to a true value the signature created will be a detached +signature; that is, a signature that does not contain the original +text. This assumes that the person who will be verifying the signature +can somehow obtain the original text (for example, if you sign the text +of an email message, the original text is the message). + +By default signatures are not detached. + +=item * Armour + +If true, the data returned from I<sign> will be ASCII-armoured. This +can be useful when you need to send data through email, for example. + +By default the returned signature is not armoured. + +=item * Clearsign + +If true, the signature created on the data is a clear-text signature. +This form of signature displays the clear text of the signed data, +followed by the ASCII-armoured signature on that data. Such a format +is desirable when sending signed messages to groups of users who may +or may not have PGP, because it allows the text of the message to be +readable without special software. + +When I<Clearsign> is set to true, I<Armour> and I<Detach> are +automatically turned on, because the signature created is a detached, +armoured signature. + +By default I<Clearsign> is false. + +=item * KeyID + +The ID of the secret key that should be used to sign the message. The +value of the key ID should be specified as a 16-digit hexadecimal number. + +This argument is mandatory. + +=item * Passphrase + +The passphrase to unlock your secret key. + +This argument is optional if your secret key is protected; if not +provided you should supply the I<PassphraseCallback> parameter (below). + +=item * PassphraseCallback + +A callback routine to allow interactive users (for example) to enter the +passphrase for the specific key being used to sign the message. This is +useful when you wish to provide an interactive user with some feedback +about the key being used to sign the message. + +The value of this parameter should be a reference to a subroutine. This +routine will be called when a passphrase is needed from the user, and +it will be given one argument: a I<Crypt::OpenPGP::Certificate> object +representing the secret key. You can use the information in this object +to present details about the key to the user. The callback routine +should return the passphrase, a scalar string. + +This argument is optional if your secret key is protected; if not +provided you should supply the I<Passphrase> parameter (above). + +=item * Digest + +The digest algorithm to use when creating the signature; the data to be +signed is hashed by a message digest algorithm, then signed. Possible +values are C<MD5>, C<SHA1>, and C<RIPEMD160>. + +This argument is optional; if not provided, the digest algorithm will be +set based on the I<Compat> setting provided to I<sign> or I<new>. If you +have not provided a I<Compat> setting, I<SHA1> will be used. + +=item * Version + +The format version of the created signature. The two possible values +are C<3> and C<4>; version 4 signatures will not be compatible with +older PGP implementations. + +The default value is C<4>, although this could change in the future. + +=back + +=head2 $pgp->verify( %args ) + +Verifies a digital signature. Returns true for a valid signature, C<0> +for an invalid signature, and C<undef> if an error occurs (in which +case you should call I<errstr> to determine the source of the error). +The 'true' value returned for a successful signature will be, if available, +the PGP User ID of the person who created the signature. If that +value is unavailable, the return value will be C<1>. + +If called in list context, the second element returned in the return list +will be the I<Crypt::OpenPGP::Signature> object representing the actual +signature. + +I<%args> can contain: + +=over 4 + +=item * Signature + +The signature data, as returned from I<sign>. This data can be either +a detached signature or a non-detached signature. If the former, you +will need to specify the list of files comprising the original signed +data (see I<Data> or I<Files>, below). + +Either this argument or I<SigFile> is required. + +=item * SigFile + +The path to a file containing the signature data. This data can be either +a detached signature or a non-detached signature. If the former, you +will need to specify the list of files comprising the original signed +data (see I<Data> or I<Files>, below). + +Either this argument or I<SigFile> is required. + +=item * Data + +Specifies the original signed data. + +If the signature (in either I<Signature> or I<SigFile>) is a detached +signature, either I<Data> or I<Files> is a mandatory argument. + +=item * Files + +Specifies a list of files comprising the original signed data. The +value should be a reference to a list of file paths; if there is only +one file, the value can be specified as a scalar string, rather than +a reference to a list. + +If the signature (in either I<Signature> or I<SigFile>) is a detached +signature, either I<Data> or I<Files> is a mandatory argument. + +=back + +=head2 $pgp->keygen( %args ) + +NOTE: this interface is alpha and could change in future releases! + +Generates a public/secret PGP keypair. Returns two keyblocks (objects +of type I<Crypt::OpenPGP::KeyBlock>), a public and a secret keyblock, +respectively. A keyblock is essentially a block of keys, subkeys, +signatures, and user ID PGP packets. + +I<%args> can contain: + +=over 4 + +=item * Type + +The type of key to generate. Currently there are two valid values: +C<RSA> and C<DSA>. C<ElGamal> key generation is not supported at the +moment. + +This is a required argument. + +=item * Size + +Bitsize of the key to be generated. This should be an even integer; +there is no low end currently implemented in I<Crypt::OpenPGP>, but +for the sake of security I<Size> should be at least 1024 bits. + +This is a required argument. + +=item * Identity + +A string that identifies the owner of the key. Typically this is the +combination of the user's name and an email address; for example, + + Foo Bar <foo@bar.com> + +The I<Identity> is used to build a User ID packet that is stored in +each of the returned keyblocks. + +This is a required argument. + +=item * Passphrase + +String with which the secret key will be encrypted. When read in from +disk, the key can then only be unlocked using this string. + +This is a required argument. + +=item * Version + +Specifies the key version; defaults to version C<4> keys. You should +only set this to version C<3> if you know why you are doing so (for +backwards compatibility, most likely). Version C<3> keys only support +RSA. + +=item * Verbosity + +Set to a true value to enable a status display during key generation; +since key generation is a relatively lengthy process, it is helpful +to have an indication that some action is occurring. + +I<Verbosity> is 0 by default. + +=back + +=head1 ERROR HANDLING + +If an error occurs in any of the above methods, the method will return +C<undef>. You should then call the method I<errstr> to determine the +source of the error: + + $pgp->errstr + +In the case that you do not yet have a I<Crypt::OpenPGP> object (that +is, if an error occurs while creating a I<Crypt::OpenPGP> object), +the error can be obtained as a class method: + + Crypt::OpenPGP->errstr + +For example, if you try to decrypt some encrypted text, and you do +not give a passphrase to unlock your secret key: + + my $pt = $pgp->decrypt( Filename => "encrypted_data" ) + or die "Decryption failed: ", $pgp->errstr; + +=head1 SAMPLES/TUTORIALS + +Take a look at F<bin/pgplet> for an example of usage of I<Crypt::OpenPGP>. +It gives you an example of using the four main major methods (I<encrypt>, +I<sign>, I<decrypt>, and I<verify>), as well as the various parameters to +those methods. It also demonstrates usage of the callback parameters (eg. +I<PassphraseCallback>). + +F<bin/pgplet> currently does not have any documentation, but its interface +mirrors that of I<gpg>. + +=head1 LICENSE + +Crypt::OpenPGP is free software; you may redistribute it and/or modify +it under the same terms as Perl itself. + +=head1 AUTHOR & COPYRIGHT + +Except where otherwise noted, Crypt::OpenPGP is Copyright 2001 Benjamin +Trott, cpan@stupidfool.org. All rights reserved. + +=head1 REFERENCES + +=over 4 + +=item 1 RFC2440 - OpenPGP Message Format (1998). http://www.faqs.org/rfcs/rfc2440.html + +=back + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Armour.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Armour.pm new file mode 100755 index 00000000000..26177b77c9e --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Buffer.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Buffer.pm new file mode 100755 index 00000000000..7a8c7bda500 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/CFB.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/CFB.pm new file mode 100755 index 00000000000..adcc182640f --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Certificate.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Certificate.pm new file mode 100755 index 00000000000..72d344b9118 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Cipher.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Cipher.pm new file mode 100755 index 00000000000..8476657bbe2 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Ciphertext.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Ciphertext.pm new file mode 100755 index 00000000000..4b76e0a104d --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Compressed.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Compressed.pm new file mode 100755 index 00000000000..3d9c4fc2b8f --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Config.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Config.pm new file mode 100755 index 00000000000..ee5dc41442d --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Constants.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Constants.pm new file mode 100755 index 00000000000..7ad9e14a477 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Digest.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Digest.pm new file mode 100755 index 00000000000..6b76cadfc9c --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/ErrorHandler.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/ErrorHandler.pm new file mode 100755 index 00000000000..fd28b0c04ae --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Key.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Key.pm new file mode 100755 index 00000000000..0fd5edc4a65 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Key/Public.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Key/Public.pm new file mode 100755 index 00000000000..837d81f4d87 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Key/Public/DSA.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Key/Public/DSA.pm new file mode 100755 index 00000000000..321c62c913f --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Key/Public/ElGamal.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Key/Public/ElGamal.pm new file mode 100755 index 00000000000..a6f589c0f82 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Key/Public/RSA.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Key/Public/RSA.pm new file mode 100755 index 00000000000..1ebca3397bd --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Key/Secret.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Key/Secret.pm new file mode 100755 index 00000000000..3a93e9afe60 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Key/Secret/DSA.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Key/Secret/DSA.pm new file mode 100755 index 00000000000..cfb1bbec4c4 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Key/Secret/ElGamal.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Key/Secret/ElGamal.pm new file mode 100755 index 00000000000..b7d6eb3d7b1 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Key/Secret/RSA.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Key/Secret/RSA.pm new file mode 100755 index 00000000000..4db25036456 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/KeyBlock.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyBlock.pm new file mode 100755 index 00000000000..5784bbb11ac --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/KeyRing.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyRing.pm new file mode 100755 index 00000000000..6709ed47a77 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyRing.pm @@ -0,0 +1,267 @@ +package Crypt::OpenPGP::KeyRing; +use strict; + +use Crypt::OpenPGP::Constants qw( PGP_PKT_USER_ID + PGP_PKT_PUBLIC_KEY + PGP_PKT_SECRET_KEY + PGP_PKT_PUBLIC_SUBKEY + PGP_PKT_SECRET_SUBKEY ); +use Crypt::OpenPGP::Buffer; +use Crypt::OpenPGP::KeyBlock; +use Crypt::OpenPGP::PacketFactory; +use Crypt::OpenPGP::ErrorHandler; +use base qw( Crypt::OpenPGP::ErrorHandler ); + +sub new { + my $class = shift; + my $ring = bless { }, $class; + $ring->init(@_); +} + +sub init { + my $ring = shift; + my %param = @_; + $ring->{_data} = $param{Data} || ''; + if (!$ring->{_data} && (my $file = $param{Filename})) { + local *FH; + open FH, $file or + return (ref $ring)->error("Can't open keyring $file: $!"); + binmode FH; + { local $/; $ring->{_data} = <FH> } + close FH; + } + if ($ring->{_data} =~ /-----BEGIN/) { + require Crypt::OpenPGP::Armour; + my $rec = Crypt::OpenPGP::Armour->unarmour($ring->{_data}) or + return (ref $ring)->error("Unarmour failed: " . + Crypt::OpenPGP::Armour->errstr); + $ring->{_data} = $rec->{Data}; + } + $ring; +} + +sub save { + my $ring = shift; + my @blocks = $ring->blocks; + my $res = ''; + for my $block (@blocks) { + $res .= $block->save; + } + $res; +} + +sub read { + my $ring = shift; + return $ring->error("No data to read") unless $ring->{_data}; + my $buf = Crypt::OpenPGP::Buffer->new; + $buf->append($ring->{_data}); + $ring->restore($buf); + 1; +} + +sub restore { + my $ring = shift; + my($buf) = @_; + $ring->{blocks} = []; + my($kb); + while (my $packet = Crypt::OpenPGP::PacketFactory->parse($buf)) { + if (ref($packet) eq "Crypt::OpenPGP::Certificate" && + !$packet->is_subkey) { + $kb = Crypt::OpenPGP::KeyBlock->new; + $ring->add($kb); + } + $kb->add($packet) if $kb; + } +} + +sub add { + my $ring = shift; + my($entry) = @_; + push @{ $ring->{blocks} }, $entry; +} + +sub find_keyblock_by_keyid { + my $ring = shift; + my($key_id) = @_; + my $ref = $ring->{by_keyid}{$key_id}; + unless ($ref) { + my $len = length($key_id); + my @kbs = $ring->find_keyblock( + sub { substr($_[0]->key_id, -$len, $len) eq $key_id }, + [ PGP_PKT_PUBLIC_KEY, PGP_PKT_SECRET_KEY, + PGP_PKT_PUBLIC_SUBKEY, PGP_PKT_SECRET_SUBKEY ], 1 ); + return unless @kbs; + $ref = $ring->{by_keyid}{ $key_id } = \@kbs; + } + return wantarray ? @$ref : $ref->[0]; +} + +sub find_keyblock_by_uid { + my $ring = shift; + my($uid) = @_; + $ring->find_keyblock(sub { $_[0]->id =~ /$uid/i }, + [ PGP_PKT_USER_ID ], 1 ); +} + +sub find_keyblock_by_index { + my $ring = shift; + my($index) = @_; + ## XXX should not have to read entire keyring + $ring->read; + ($ring->blocks)[$index]; +} + +sub find_keyblock { + my $ring = shift; + my($test, $pkttypes, $multiple) = @_; + $pkttypes ||= []; + return $ring->error("No data to read") unless $ring->{_data}; + my $buf = Crypt::OpenPGP::Buffer->new_with_init($ring->{_data}); + my($last_kb_start_offset, $last_kb_start_cert, @kbs); + while (my $pkt = Crypt::OpenPGP::PacketFactory->parse($buf, + [ PGP_PKT_SECRET_KEY, PGP_PKT_PUBLIC_KEY, + @$pkttypes ], $pkttypes)) { + if (($pkt->{__unparsed} && ($pkt->{type} == PGP_PKT_SECRET_KEY || + $pkt->{type} == PGP_PKT_PUBLIC_KEY)) || + (ref($pkt) eq 'Crypt::OpenPGP::Certificate' && !$pkt->is_subkey)) { + $last_kb_start_offset = $buf->offset; + $last_kb_start_cert = $pkt; + } + next unless !$pkt->{__unparsed} && $test->($pkt); + my $kb = Crypt::OpenPGP::KeyBlock->new; + + ## Rewind buffer; if start-cert is parsed, rewind to offset + ## after start-cert--otherwise rewind before start-cert + if ($last_kb_start_cert->{__unparsed}) { + $buf->set_offset($last_kb_start_offset - + $last_kb_start_cert->{__pkt_len}); + my $cert = Crypt::OpenPGP::PacketFactory->parse($buf); + $kb->add($cert); + } else { + $buf->set_offset($last_kb_start_offset); + $kb->add($last_kb_start_cert); + } + { + my $off = $buf->offset; + my $packet = Crypt::OpenPGP::PacketFactory->parse($buf); + last unless $packet; + $buf->set_offset($off), + last if ref($packet) eq "Crypt::OpenPGP::Certificate" && + !$packet->is_subkey; + $kb->add($packet) if $kb; + redo; + } + unless ($multiple) { + return wantarray ? ($kb, $pkt) : $kb; + } else { + return $kb unless wantarray; + push @kbs, $kb; + } + } + @kbs; +} + +sub blocks { $_[0]->{blocks} ? @{ $_[0]->{blocks} } : () } + +1; +__END__ + +=head1 NAME + +Crypt::OpenPGP::KeyRing - Key ring object + +=head1 SYNOPSIS + + use Crypt::OpenPGP::KeyRing; + + my $ring = Crypt::OpenPGP::KeyRing->new( Filename => 'foo.ring' ); + + my $key_id = '...'; + my $kb = $ring->find_keyblock_by_keyid($key_id); + +=head1 DESCRIPTION + +I<Crypt::OpenPGP::KeyRing> provides keyring management and key lookup +for I<Crypt::OpenPGP>. A I<KeyRing>, in this case, does not necessarily +have to be a keyring file; a I<KeyRing> object is just a collection of +key blocks, where each key block contains exactly one master key, +zero or more subkeys, some user ID packets, some signatures, etc. + +=head1 USAGE + +=head2 Crypt::OpenPGP::KeyRing->new( %arg ) + +Constructs a new I<Crypt::OpenPGP::KeyRing> object and returns that +object. This has the effect os hooking the object to a particular +keyring, so that all subsequent methods called on the I<KeyRing> +object will use the data specified in the arguments to I<new>. + +I<%arg> can contain: + +=over 4 + +=item * Data + +A block of data specifying the serialized keyring, presumably as read +in from a file on disk. This data can be either in binary form or in +ASCII-armoured form; if the latter it will be unarmoured automatically. + +This argument is optional. + +=item * Filename + +The path to a keyring file, or at least, a file containing a key (and +perhaps other associated keyblock data). The data in this file can be +either in binary form or in ASCII-armoured form; if the latter it will be +unarmoured automatically. + +This argument is optional. + +=back + +=head2 $ring->find_keyblock_by_keyid($key_id) + +Looks up the key ID I<$key_id> in the keyring I<$ring>. I<$key_id> +should be either a 4-octet or 8-octet string--it should I<not> be a +string of hexadecimal digits. If that is what you have, use I<pack> to +convert it to an octet string: + + pack 'H*', $hex_key_id + +If a keyblock is found where the key ID of either the master key or +subkey matches I<$key_id>, that keyblock will be returned. The +definition of "match" depends on the length of I<$key_id>: if it is a +16-digit hex number, only exact matches will be returned; if it is an +8-digit hex number, any keyblocks containing keys whose last 8 hex +digits match I<$key_id> will be returned. + +In scalar context, only the first keyblock found in the keyring is +returned; in list context, all matching keyblocks are returned. In +practice, duplicated key IDs are rare, particularly so if you specify +the full 16 hex digits in I<$key_id>. + +Returns false on failure (C<undef> in scalar context, an empty list in +list context). + +=head2 $ring->find_keyblock_by_uid($uid) + +Given a string I<$uid>, looks up all keyblocks with User ID packets +matching the string I<$uid>, including partial matches. + +In scalar context, returns only the first keyblock with a matching +user ID; in list context, returns all matching keyblocks. + +Returns false on failure. + +=head2 $ring->find_keyblock_by_index($index) + +Given an index into a list of keyblocks I<$index>, returns the keyblock +(a I<Crypt::OpenPGP::KeyBlock> object) at that index. Accepts negative +indexes, so C<-1> will give you the last keyblock in the keyring. + +=head1 AUTHOR & COPYRIGHTS + +Please see the Crypt::OpenPGP manpage for author, copyright, and +license information. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyServer.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/KeyServer.pm new file mode 100755 index 00000000000..a82f17f9616 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/MDC.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/MDC.pm new file mode 100755 index 00000000000..c59b32f3bc1 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Marker.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Marker.pm new file mode 100755 index 00000000000..69d9c3363c1 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Message.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Message.pm new file mode 100755 index 00000000000..fcf606f509d --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/OnePassSig.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/OnePassSig.pm new file mode 100755 index 00000000000..b85779385c1 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/PacketFactory.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/PacketFactory.pm new file mode 100755 index 00000000000..eba1ad88def --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Plaintext.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Plaintext.pm new file mode 100755 index 00000000000..892bf15679d --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/S2k.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/S2k.pm new file mode 100755 index 00000000000..0ce398c24d1 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/SKSessionKey.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/SKSessionKey.pm new file mode 100755 index 00000000000..ec1e61ac536 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/SessionKey.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/SessionKey.pm new file mode 100755 index 00000000000..8ebb112a4c3 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Signature.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Signature.pm new file mode 100755 index 00000000000..7fe236cc5ee --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Signature/SubPacket.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Signature/SubPacket.pm new file mode 100755 index 00000000000..9e6139238f4 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Trust.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Trust.pm new file mode 100755 index 00000000000..ffe324d3e80 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/UserID.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/UserID.pm new file mode 100755 index 00000000000..3d312e3aa0f --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Util.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Util.pm new file mode 100755 index 00000000000..495dc936317 --- /dev/null +++ b/Master/tlpkg/tlperl/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/lib/Crypt/OpenPGP/Words.pm b/Master/tlpkg/tlperl/lib/Crypt/OpenPGP/Words.pm new file mode 100755 index 00000000000..f487af76ab3 --- /dev/null +++ b/Master/tlpkg/tlperl/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 diff --git a/Master/tlpkg/tlperl/lib/Crypt/Primes.pm b/Master/tlpkg/tlperl/lib/Crypt/Primes.pm new file mode 100755 index 00000000000..64d41f5555d --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/Primes.pm @@ -0,0 +1,901 @@ +#!/usr/bin/perl -s +## +## Crypt::Primes -- Provable Prime Number Generator +## for Cryptographic Applications. +## +## Copyright (c) 1998-2000, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: Primes.pm,v 0.49 2001/06/11 01:04:23 vipul Exp vipul $ + +package Crypt::Primes; +require Exporter; +use vars qw($VERSION @EXPORT_OK); +use Crypt::Random qw( makerandom makerandom_itv ); +use Math::Pari qw( PARI Mod floor sqrt); +*import = \&Exporter::import; + +@EXPORT_OK = qw( maurer trialdiv rsaparams ); +( $VERSION ) = '$Revision: 0.50 $' =~ /(\d+\.\d+)/; + +## list of small primes for trial division. + +@PRIMES = qw( + 2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 +103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 +199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 +313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 +433 439 443 449 457 461 463 467 479 487 491 499 503 509 521 523 541 547 557 +563 569 571 577 587 593 599 601 607 613 617 619 631 641 643 647 653 659 661 +673 677 683 691 701 709 719 727 733 739 743 751 757 761 769 773 787 797 809 +811 821 823 827 829 839 853 857 859 863 877 881 883 887 907 911 919 929 937 +941 947 953 967 971 977 983 991 997 1009 1013 1019 1021 1031 1033 1039 1049 +1051 1061 1063 1069 1087 1091 1093 1097 1103 1109 1117 1123 1129 1151 1153 +1163 1171 1181 1187 1193 1201 1213 1217 1223 1229 1231 1237 1249 1259 1277 +1279 1283 1289 1291 1297 1301 1303 1307 1319 1321 1327 1361 1367 1373 1381 +1399 1409 1423 1427 1429 1433 1439 1447 1451 1453 1459 1471 1481 1483 1487 +1489 1493 1499 1511 1523 1531 1543 1549 1553 1559 1567 1571 1579 1583 1597 +1601 1607 1609 1613 1619 1621 1627 1637 1657 1663 1667 1669 1693 1697 1699 +1709 1721 1723 1733 1741 1747 1753 1759 1777 1783 1787 1789 1801 1811 1823 +1831 1847 1861 1867 1871 1873 1877 1879 1889 1901 1907 1913 1931 1933 1949 +1951 1973 1979 1987 1993 1997 1999 2003 2011 2017 2027 2029 2039 2053 2063 +2069 2081 2083 2087 2089 2099 2111 2113 2129 2131 2137 2141 2143 2153 2161 +2179 2203 2207 2213 2221 2237 2239 2243 2251 2267 2269 2273 2281 2287 2293 +2297 2309 2311 2333 2339 2341 2347 2351 2357 2371 2377 2381 2383 2389 2393 +2399 2411 2417 2423 2437 2441 2447 2459 2467 2473 2477 2503 2521 2531 2539 +2543 2549 2551 2557 2579 2591 2593 2609 2617 2621 2633 2647 2657 2659 2663 +2671 2677 2683 2687 2689 2693 2699 2707 2711 2713 2719 2729 2731 2741 2749 +2753 2767 2777 2789 2791 2797 2801 2803 2819 2833 2837 2843 2851 2857 2861 +2879 2887 2897 2903 2909 2917 2927 2939 2953 2957 2963 2969 2971 2999 3001 +3011 3019 3023 3037 3041 3049 3061 3067 3079 3083 3089 3109 3119 3121 3137 +3163 3167 3169 3181 3187 3191 3203 3209 3217 3221 3229 3251 3253 3257 3259 +3271 3299 3301 3307 3313 3319 3323 3329 3331 3343 3347 3359 3361 3371 3373 +3389 3391 3407 3413 3433 3449 3457 3461 3463 3467 3469 3491 3499 3511 3517 +3527 3529 3533 3539 3541 3547 3557 3559 3571 3581 3583 3593 3607 3613 3617 +3623 3631 3637 3643 3659 3671 3673 3677 3691 3697 3701 3709 3719 3727 3733 +3739 3761 3767 3769 3779 3793 3797 3803 3821 3823 3833 3847 3851 3853 3863 +3877 3881 3889 3907 3911 3917 3919 3923 3929 3931 3943 3947 3967 3989 4001 +4003 4007 4013 4019 4021 4027 4049 4051 4057 4073 4079 4091 4093 4099 4111 +4127 4129 4133 4139 4153 4157 4159 4177 4201 4211 4217 4219 4229 4231 4241 +4243 4253 4259 4261 4271 4273 4283 4289 4297 4327 4337 4339 4349 4357 4363 +4373 4391 4397 4409 4421 4423 4441 4447 4451 4457 4463 4481 4483 4493 4507 +4513 4517 4519 4523 4547 4549 4561 4567 4583 4591 4597 4603 4621 4637 4639 +4643 4649 4651 4657 4663 4673 4679 4691 4703 4721 4723 4729 4733 4751 4759 +4783 4787 4789 4793 4799 4801 4813 4817 4831 4861 4871 4877 4889 4903 4909 +4919 4931 4933 4937 4943 4951 4957 4967 4969 4973 4987 4993 4999 5003 5009 +5011 5021 5023 5039 5051 5059 5077 5081 5087 5099 5101 5107 5113 5119 5147 +5153 5167 5171 5179 5189 5197 5209 5227 5231 5233 5237 5261 5273 5279 5281 +5297 5303 5309 5323 5333 5347 5351 5381 5387 5393 5399 5407 5413 5417 5419 +5431 5437 5441 5443 5449 5471 5477 5479 5483 5501 5503 5507 5519 5521 5527 +5531 5557 5563 5569 5573 5581 5591 5623 5639 5641 5647 5651 5653 5657 5659 +5669 5683 5689 5693 5701 5711 5717 5737 5741 5743 5749 5779 5783 5791 5801 +5807 5813 5821 5827 5839 5843 5849 5851 5857 5861 5867 5869 5879 5881 5897 +5903 5923 5927 5939 5953 5981 5987 6007 6011 6029 6037 6043 6047 6053 6067 +6073 6079 6089 6091 6101 6113 6121 6131 6133 6143 6151 6163 6173 6197 6199 +6203 6211 6217 6221 6229 6247 6257 6263 6269 6271 6277 6287 6299 6301 6311 +6317 6323 6329 6337 6343 6353 6359 6361 6367 6373 6379 6389 6397 6421 6427 +6449 6451 6469 6473 6481 6491 6521 6529 6547 6551 6553 6563 6569 6571 6577 +6581 6599 6607 6619 6637 6653 6659 6661 6673 6679 6689 6691 6701 6703 6709 +6719 6733 6737 6761 6763 6779 6781 6791 6793 6803 6823 6827 6829 6833 6841 +6857 6863 6869 6871 6883 6899 6907 6911 6917 6947 6949 6959 6961 6967 6971 +6977 6983 6991 6997 7001 7013 7019 7027 7039 7043 7057 7069 7079 7103 7109 +7121 7127 7129 7151 7159 7177 7187 7193 7207 7211 7213 7219 7229 7237 7243 +7247 7253 7283 7297 7307 7309 7321 7331 7333 7349 7351 7369 7393 7411 7417 +7433 7451 7457 7459 7477 7481 7487 7489 7499 7507 7517 7523 7529 7537 7541 +7547 7549 7559 7561 7573 7577 7583 7589 7591 7603 7607 7621 7639 7643 7649 +7669 7673 7681 7687 7691 7699 7703 7717 7723 7727 7741 7753 7757 7759 7789 +7793 7817 7823 7829 7841 7853 7867 7873 7877 7879 7883 7901 7907 7919 7927 +7933 7937 7949 7951 7963 7993 8009 8011 8017 8039 8053 8059 8069 8081 8087 +8089 8093 8101 8111 8117 8123 8147 8161 8167 8171 8179 8191 8209 8219 8221 +8231 8233 8237 8243 8263 8269 8273 8287 8291 8293 8297 8311 8317 8329 8353 +8363 8369 8377 8387 8389 8419 8423 8429 8431 8443 8447 8461 8467 8501 8513 +8521 8527 8537 8539 8543 8563 8573 8581 8597 8599 8609 8623 8627 8629 8641 +8647 8663 8669 8677 8681 8689 8693 8699 8707 8713 8719 8731 8737 8741 8747 +8753 8761 8779 8783 8803 8807 8819 8821 8831 8837 8839 8849 8861 8863 8867 +8887 8893 8923 8929 8933 8941 8951 8963 8969 8971 8999 9001 9007 9011 9013 +9029 9041 9043 9049 9059 9067 9091 9103 9109 9127 9133 9137 9151 9157 9161 +9173 9181 9187 9199 9203 9209 9221 9227 9239 9241 9257 9277 9281 9283 9293 +9311 9319 9323 9337 9341 9343 9349 9371 9377 9391 9397 9403 9413 9419 9421 +9431 9433 9437 9439 9461 9463 9467 9473 9479 9491 9497 9511 9521 9533 9539 +9547 9551 9587 9601 9613 9619 9623 9629 9631 9643 9649 9661 9677 9679 9689 +9697 9719 9721 9733 9739 9743 9749 9767 9769 9781 9787 9791 9803 9811 9817 +9829 9833 9839 9851 9857 9859 9871 9883 9887 9901 9907 9923 9929 9931 9941 +9949 9967 9973 10007 10009 10037 10039 10061 10067 10069 10079 10091 10093 +10099 10103 10111 10133 10139 10141 10151 10159 10163 10169 10177 10181 +10193 10211 10223 10243 10247 10253 10259 10267 10271 10273 10289 10301 +10303 10313 10321 10331 10333 10337 10343 10357 10369 10391 10399 10427 +10429 10433 10453 10457 10459 10463 10477 10487 10499 10501 10513 10529 +10531 10559 10567 10589 10597 10601 10607 10613 10627 10631 10639 10651 +10657 10663 10667 10687 10691 10709 10711 10723 10729 10733 10739 10753 +10771 10781 10789 10799 10831 10837 10847 10853 10859 10861 10867 10883 +10889 10891 10903 10909 10937 10939 10949 10957 10973 10979 10987 10993 +11003 11027 11047 11057 11059 11069 11071 11083 11087 11093 11113 11117 +11119 11131 11149 11159 11161 11171 11173 11177 11197 11213 11239 11243 +11251 11257 11261 11273 11279 11287 11299 11311 11317 11321 11329 11351 +11353 11369 11383 11393 11399 11411 11423 11437 11443 11447 11467 11471 +11483 11489 11491 11497 11503 11519 11527 11549 11551 11579 11587 11593 +11597 11617 11621 11633 11657 11677 11681 11689 11699 11701 11717 11719 +11731 11743 11777 11779 11783 11789 11801 11807 11813 11821 11827 11831 +11833 11839 11863 11867 11887 11897 11903 11909 11923 11927 11933 11939 +11941 11953 11959 11969 11971 11981 11987 12007 12011 12037 12041 12043 +12049 12071 12073 12097 12101 12107 12109 12113 12119 12143 12149 12157 +12161 12163 12197 12203 12211 12227 12239 12241 12251 12253 12263 12269 +12277 12281 12289 12301 12323 12329 12343 12347 12373 12377 12379 12391 +12401 12409 12413 12421 12433 12437 12451 12457 12473 12479 12487 12491 +12497 12503 12511 12517 12527 12539 12541 12547 12553 12569 12577 12583 +12589 12601 12611 12613 12619 12637 12641 12647 12653 12659 12671 12689 +12697 12703 12713 12721 12739 12743 12757 12763 12781 12791 12799 12809 +12821 12823 12829 12841 12853 12889 12893 12899 12907 12911 12917 12919 +12923 12941 12953 12959 12967 12973 12979 12983 13001 13003 13007 13009 +13033 13037 13043 13049 13063 13093 13099 13103 13109 13121 13127 13147 +13151 13159 13163 13171 13177 13183 13187 13217 13219 13229 13241 13249 +13259 13267 13291 13297 13309 13313 13327 13331 13337 13339 13367 13381 +13397 13399 13411 13417 13421 13441 13451 13457 13463 13469 13477 13487 +13499 13513 13523 13537 13553 13567 13577 13591 13597 13613 13619 13627 +13633 13649 13669 13679 13681 13687 13691 13693 13697 13709 13711 13721 +13723 13729 13751 13757 13759 13763 13781 13789 13799 13807 13829 13831 +13841 13859 13873 13877 13879 13883 13901 13903 13907 13913 13921 13931 +13933 13963 13967 13997 13999 14009 14011 14029 14033 14051 14057 14071 +14081 14083 14087 14107 14143 14149 14153 14159 14173 14177 14197 14207 +14221 14243 14249 14251 14281 14293 14303 14321 14323 14327 14341 14347 +14369 14387 14389 14401 14407 14411 14419 14423 14431 14437 14447 14449 +14461 14479 14489 14503 14519 14533 14537 14543 14549 14551 14557 14561 +14563 14591 14593 14621 14627 14629 14633 14639 14653 14657 14669 14683 +14699 14713 14717 14723 14731 14737 14741 14747 14753 14759 14767 14771 +14779 14783 14797 14813 14821 14827 14831 14843 14851 14867 14869 14879 +14887 14891 14897 14923 14929 14939 14947 14951 14957 14969 14983 15013 +15017 15031 15053 15061 15073 15077 15083 15091 15101 15107 15121 15131 +15137 15139 15149 15161 15173 15187 15193 15199 15217 15227 15233 15241 +15259 15263 15269 15271 15277 15287 15289 15299 15307 15313 15319 15329 +15331 15349 15359 15361 15373 15377 15383 15391 15401 15413 15427 15439 +15443 15451 15461 15467 15473 15493 15497 15511 15527 15541 15551 15559 +15569 15581 15583 15601 15607 15619 15629 15641 15643 15647 15649 15661 +15667 15671 15679 15683 15727 15731 15733 15737 15739 15749 15761 15767 +15773 15787 15791 15797 15803 15809 15817 15823 15859 15877 15881 15887 +15889 15901 15907 15913 15919 15923 15937 15959 15971 15973 15991 16001 +16007 16033 16057 16061 16063 16067 16069 16073 16087 16091 16097 16103 +16111 16127 16139 16141 16183 16187 16189 16193 16217 16223 16229 16231 +16249 16253 16267 16273 16301 16319 16333 16339 16349 16361 16363 16369 +16381 16411 16417 16421 16427 16433 16447 16451 16453 16477 16481 16487 +16493 16519 16529 16547 16553 16561 16567 16573 16603 16607 16619 16631 +16633 16649 16651 16657 16661 16673 16691 16693 16699 16703 16729 16741 +16747 16759 16763 16787 16811 16823 16829 16831 16843 16871 16879 16883 +16889 16901 16903 16921 16927 16931 16937 16943 16963 16979 16981 16987 +16993 17011 17021 17027 17029 17033 17041 17047 17053 17077 17093 17099 +17107 17117 17123 17137 17159 17167 17183 17189 17191 17203 17207 17209 +17231 17239 17257 17291 17293 17299 17317 17321 17327 17333 17341 17351 +17359 17377 17383 17387 17389 17393 17401 17417 17419 17431 17443 17449 +17467 17471 17477 17483 17489 17491 17497 17509 17519 17539 17551 17569 +17573 17579 17581 17597 17599 17609 17623 17627 17657 17659 17669 17681 +17683 17707 17713 17729 17737 17747 17749 17761 17783 17789 17791 17807 +17827 17837 17839 17851 17863 17881 17891 17903 17909 17911 17921 17923 +17929 17939 17957 17959 17971 17977 17981 17987 17989 18013 18041 18043 +18047 18049 18059 18061 18077 18089 18097 18119 18121 18127 18131 18133 +18143 18149 18169 18181 18191 18199 18211 18217 18223 18229 18233 18251 +18253 18257 18269 18287 18289 18301 18307 18311 18313 18329 18341 18353 +18367 18371 18379 18397 18401 18413 18427 18433 18439 18443 18451 18457 +18461 18481 18493 18503 18517 18521 18523 18539 18541 18553 18583 18587 +18593 18617 18637 18661 18671 18679 18691 18701 18713 18719 18731 18743 +18749 18757 18773 18787 18793 18797 18803 18839 18859 18869 18899 18911 +18913 18917 18919 18947 18959 18973 18979 19001 19009 19013 19031 19037 +19051 19069 19073 19079 19081 19087 19121 19139 19141 19157 19163 19181 +19183 19207 19211 19213 19219 19231 19237 19249 19259 19267 19273 19289 +19301 19309 19319 19333 19373 19379 19381 19387 19391 19403 19417 19421 +19423 19427 19429 19433 19441 19447 19457 19463 19469 19471 19477 19483 +19489 19501 19507 19531 19541 19543 19553 19559 19571 19577 19583 19597 +19603 19609 19661 19681 19687 19697 19699 19709 19717 19727 19739 19751 +19753 19759 19763 19777 19793 19801 19813 19819 19841 19843 19853 19861 +19867 19889 19891 19913 19919 19927 19937 19949 19961 19963 19973 19979 +19991 19993 19997 20011 20021 20023 20029 20047 20051 20063 20071 20089 +20101 20107 20113 20117 20123 20129 20143 20147 20149 20161 20173 20177 +20183 20201 20219 20231 20233 20249 20261 20269 20287 20297 20323 20327 +20333 20341 20347 20353 20357 20359 20369 20389 20393 20399 20407 20411 +20431 20441 20443 20477 20479 20483 20507 20509 20521 20533 20543 20549 +20551 20563 20593 20599 20611 20627 20639 20641 20663 20681 20693 20707 +20717 20719 20731 20743 20747 20749 20753 20759 20771 20773 20789 20807 +20809 20849 20857 20873 20879 20887 20897 20899 20903 20921 20929 20939 +20947 20959 20963 20981 20983 21001 21011 21013 21017 21019 21023 21031 +21059 21061 21067 21089 21101 21107 21121 21139 21143 21149 21157 21163 +21169 21179 21187 21191 21193 21211 21221 21227 21247 21269 21277 21283 +21313 21317 21319 21323 21341 21347 21377 21379 21383 21391 21397 21401 +21407 21419 21433 21467 21481 21487 21491 21493 21499 21503 21517 21521 +21523 21529 21557 21559 21563 21569 21577 21587 21589 21599 21601 21611 +21613 21617 21647 21649 21661 21673 21683 21701 21713 21727 21737 21739 +21751 21757 21767 21773 21787 21799 21803 21817 21821 21839 21841 21851 +21859 21863 21871 21881 21893 21911 21929 21937 21943 21961 21977 21991 +21997 22003 22013 22027 22031 22037 22039 22051 22063 22067 22073 22079 +22091 22093 22109 22111 22123 22129 22133 22147 22153 22157 22159 22171 +22189 22193 22229 22247 22259 22271 22273 22277 22279 22283 22291 22303 +22307 22343 22349 22367 22369 22381 22391 22397 22409 22433 22441 22447 +22453 22469 22481 22483 22501 22511 22531 22541 22543 22549 22567 22571 +22573 22613 22619 22621 22637 22639 22643 22651 22669 22679 22691 22697 +22699 22709 22717 22721 22727 22739 22741 22751 22769 22777 22783 22787 +22807 22811 22817 22853 22859 22861 22871 22877 22901 22907 22921 22937 +22943 22961 22963 22973 22993 23003 23011 23017 23021 23027 23029 23039 +23041 23053 23057 23059 23063 23071 23081 23087 23099 23117 23131 23143 +23159 23167 23173 23189 23197 23201 23203 23209 23227 23251 23269 23279 +23291 23293 23297 23311 23321 23327 23333 23339 23357 23369 23371 23399 +23417 23431 23447 23459 23473 23497 23509 23531 23537 23539 23549 23557 +23561 23563 23567 23581 23593 23599 23603 23609 23623 23627 23629 23633 +23663 23669 23671 23677 23687 23689 23719 23741 23743 23747 23753 23761 +23767 23773 23789 23801 23813 23819 23827 23831 23833 23857 23869 23873 +23879 23887 23893 23899 23909 23911 23917 23929 23957 23971 23977 23981 +23993 24001 24007 24019 24023 24029 24043 24049 24061 24071 24077 24083 +24091 24097 24103 24107 24109 24113 24121 24133 24137 24151 24169 24179 +24181 24197 24203 24223 24229 24239 24247 24251 24281 24317 24329 24337 +24359 24371 24373 24379 24391 24407 24413 24419 24421 24439 24443 24469 +24473 24481 24499 24509 24517 24527 24533 24547 24551 24571 24593 24611 +24623 24631 24659 24671 24677 24683 24691 24697 24709 24733 24749 24763 +24767 24781 24793 24799 24809 24821 24841 24847 24851 24859 24877 24889 +24907 24917 24919 24923 24943 24953 24967 24971 24977 24979 24989 25013 +25031 25033 25037 25057 25073 25087 25097 25111 25117 25121 25127 25147 +25153 25163 25169 25171 25183 25189 25219 25229 25237 25243 25247 25253 +25261 25301 25303 25307 25309 25321 25339 25343 25349 25357 25367 25373 +25391 25409 25411 25423 25439 25447 25453 25457 25463 25469 25471 25523 +25537 25541 25561 25577 25579 25583 25589 25601 25603 25609 25621 25633 +25639 25643 25657 25667 25673 25679 25693 25703 25717 25733 25741 25747 +25759 25763 25771 25793 25799 25801 25819 25841 25847 25849 25867 25873 +25889 25903 25913 25919 25931 25933 25939 25943 25951 25969 25981 25997 +25999 26003 26017 26021 26029 26041 26053 26083 26099 26107 26111 26113 +26119 26141 26153 26161 26171 26177 26183 26189 26203 26209 26227 26237 +26249 26251 26261 26263 26267 26293 26297 26309 26317 26321 26339 26347 +26357 26371 26387 26393 26399 26407 26417 26423 26431 26437 26449 26459 +26479 26489 26497 26501 26513 26539 26557 26561 26573 26591 26597 26627 +26633 26641 26647 26669 26681 26683 26687 26693 26699 26701 26711 26713 +26717 26723 26729 26731 26737 26759 26777 26783 26801 26813 26821 26833 +26839 26849 26861 26863 26879 26881 26891 26893 26903 26921 26927 26947 +26951 26953 26959 26981 26987 26993 27011 27017 27031 27043 27059 27061 +27067 27073 27077 27091 27103 27107 27109 27127 27143 27179 27191 27197 +27211 27239 27241 27253 27259 27271 27277 27281 27283 27299 27329 27337 +27361 27367 27397 27407 27409 27427 27431 27437 27449 27457 27479 27481 +27487 27509 27527 27529 27539 27541 27551 27581 27583 27611 27617 27631 +27647 27653 27673 27689 27691 27697 27701 27733 27737 27739 27743 27749 +27751 27763 27767 27773 27779 27791 27793 27799 27803 27809 27817 27823 +27827 27847 27851 27883 27893 27901 27917 27919 27941 27943 27947 27953 +27961 27967 27983 27997 28001 28019 28027 28031 28051 28057 28069 28081 +28087 28097 28099 28109 28111 28123 28151 28163 28181 28183 28201 28211 +28219 28229 28277 28279 28283 28289 28297 28307 28309 28319 28349 28351 +28387 28393 28403 28409 28411 28429 28433 28439 28447 28463 28477 28493 +28499 28513 28517 28537 28541 28547 28549 28559 28571 28573 28579 28591 +28597 28603 28607 28619 28621 28627 28631 28643 28649 28657 28661 28663 +28669 28687 28697 28703 28711 28723 28729 28751 28753 28759 28771 28789 +28793 28807 28813 28817 28837 28843 28859 28867 28871 28879 28901 28909 +28921 28927 28933 28949 28961 28979 29009 29017 29021 29023 29027 29033 +29059 29063 29077 29101 29123 29129 29131 29137 29147 29153 29167 29173 +29179 29191 29201 29207 29209 29221 29231 29243 29251 29269 29287 29297 +29303 29311 29327 29333 29339 29347 29363 29383 29387 29389 29399 29401 +29411 29423 29429 29437 29443 29453 29473 29483 29501 29527 29531 29537 +29567 29569 29573 29581 29587 29599 29611 29629 29633 29641 29663 29669 +29671 29683 29717 29723 29741 29753 29759 29761 29789 29803 29819 29833 +29837 29851 29863 29867 29873 29879 29881 29917 29921 29927 29947 29959 +29983 29989 30011 30013 30029 30047 30059 30071 30089 30091 30097 30103 +30109 30113 30119 30133 30137 30139 30161 30169 30181 30187 30197 30203 +30211 30223 30241 30253 30259 30269 30271 30293 30307 30313 30319 30323 +30341 30347 30367 30389 30391 30403 30427 30431 30449 30467 30469 30491 +30493 30497 30509 30517 30529 30539 30553 30557 30559 30577 30593 30631 +30637 30643 30649 30661 30671 30677 30689 30697 30703 30707 30713 30727 +30757 30763 30773 30781 30803 30809 30817 30829 30839 30841 30851 30853 +30859 30869 30871 30881 30893 30911 30931 30937 30941 30949 30971 30977 +30983 31013 31019 31033 31039 31051 31063 31069 31079 31081 31091 31121 +31123 31139 31147 31151 31153 31159 31177 31181 31183 31189 31193 31219 +31223 31231 31237 31247 31249 31253 31259 31267 31271 31277 31307 31319 +31321 31327 31333 31337 31357 31379 31387 31391 31393 31397 31469 31477 +31481 31489 31511 31513 31517 31531 31541 31543 31547 31567 31573 31583 +31601 31607 31627 31643 31649 31657 31663 31667 31687 31699 31721 31723 +31727 31729 31741 31751 31769 31771 31793 31799 31817 31847 31849 31859 +31873 31883 31891 31907 31957 31963 31973 31981 31991 32003 32009 32027 +32029 32051 32057 32059 32063 32069 32077 32083 32089 32099 32117 32119 +32141 32143 32159 32173 32183 32189 32191 32203 32213 32233 32237 32251 +32257 32261 32297 32299 32303 32309 32321 32323 32327 32341 32353 32359 +32363 32369 32371 32377 32381 32401 32411 32413 32423 32429 32441 32443 +32467 32479 32491 32497 32503 32507 32531 32533 32537 32561 32563 32569 +32573 32579 32587 32603 32609 32611 32621 32633 32647 32653 32687 32693 +32707 32713 32717 32719 32749 32771 32779 32783 32789 32797 32801 32803 +32831 32833 32839 32843 32869 32887 32909 32911 32917 32933 32939 32941 +32957 32969 32971 32983 32987 32993 32999 33013 33023 33029 33037 33049 +33053 33071 33073 33083 33091 33107 33113 33119 33149 33151 33161 33179 +33181 33191 33199 33203 33211 33223 33247 33287 33289 33301 33311 33317 +33329 33331 33343 33347 33349 33353 33359 33377 33391 33403 33409 33413 +33427 33457 33461 33469 33479 33487 33493 33503 33521 33529 33533 33547 +33563 33569 33577 33581 33587 33589 33599 33601 33613 33617 33619 33623 +33629 33637 33641 33647 33679 33703 33713 33721 33739 33749 33751 33757 +33767 33769 33773 33791 33797 33809 33811 33827 33829 33851 33857 33863 +33871 33889 33893 33911 33923 33931 33937 33941 33961 33967 33997 34019 +34031 34033 34039 34057 34061 34123 34127 34129 34141 34147 34157 34159 +34171 34183 34211 34213 34217 34231 34253 34259 34261 34267 34273 34283 +34297 34301 34303 34313 34319 34327 34337 34351 34361 34367 34369 34381 +34403 34421 34429 34439 34457 34469 34471 34483 34487 34499 34501 34511 +34513 34519 34537 34543 34549 34583 34589 34591 34603 34607 34613 34631 +34649 34651 34667 34673 34679 34687 34693 34703 34721 34729 34739 34747 +34757 34759 34763 34781 34807 34819 34841 34843 34847 34849 34871 34877 +34883 34897 34913 34919 34939 34949 34961 34963 34981 35023 35027 35051 +35053 35059 35069 35081 35083 35089 35099 35107 35111 35117 35129 35141 +35149 35153 35159 35171 35201 35221 35227 35251 35257 35267 35279 35281 +35291 35311 35317 35323 35327 35339 35353 35363 35381 35393 35401 35407 +35419 35423 35437 35447 35449 35461 35491 35507 35509 35521 35527 35531 +35533 35537 35543 35569 35573 35591 35593 35597 35603 35617 35671 35677 +35729 35731 35747 35753 35759 35771 35797 35801 35803 35809 35831 35837 +35839 35851 35863 35869 35879 35897 35899 35911 35923 35933 35951 35963 +35969 35977 35983 35993 35999 36007 36011 36013 36017 36037 36061 36067 +36073 36083 36097 36107 36109 36131 36137 36151 36161 36187 36191 36209 +36217 36229 36241 36251 36263 36269 36277 36293 36299 36307 36313 36319 +36341 36343 36353 36373 36383 36389 36433 36451 36457 36467 36469 36473 +36479 36493 36497 36523 36527 36529 36541 36551 36559 36563 36571 36583 +36587 36599 36607 36629 36637 36643 36653 36671 36677 36683 36691 36697 +36709 36713 36721 36739 36749 36761 36767 36779 36781 36787 36791 36793 +36809 36821 36833 36847 36857 36871 36877 36887 36899 36901 36913 36919 +36923 36929 36931 36943 36947 36973 36979 36997 37003 37013 37019 37021 +37039 37049 37057 37061 37087 37097 37117 37123 37139 37159 37171 37181 +37189 37199 37201 37217 37223 37243 37253 37273 37277 37307 37309 37313 +37321 37337 37339 37357 37361 37363 37369 37379 37397 37409 37423 37441 +37447 37463 37483 37489 37493 37501 37507 37511 37517 37529 37537 37547 +37549 37561 37567 37571 37573 37579 37589 37591 37607 37619 37633 37643 +37649 37657 37663 37691 37693 37699 37717 37747 37781 37783 37799 37811 +37813 37831 37847 37853 37861 37871 37879 37889 37897 37907 37951 37957 +37963 37967 37987 37991 37993 37997 38011 38039 38047 38053 38069 38083 +38113 38119 38149 38153 38167 38177 38183 38189 38197 38201 38219 38231 +38237 38239 38261 38273 38281 38287 38299 38303 38317 38321 38327 38329 +38333 38351 38371 38377 38393 38431 38447 38449 38453 38459 38461 38501 +38543 38557 38561 38567 38569 38593 38603 38609 38611 38629 38639 38651 +38653 38669 38671 38677 38693 38699 38707 38711 38713 38723 38729 38737 +38747 38749 38767 38783 38791 38803 38821 38833 38839 38851 38861 38867 +38873 38891 38903 38917 38921 38923 38933 38953 38959 38971 38977 38993 +39019 39023 39041 39043 39047 39079 39089 39097 39103 39107 39113 39119 +39133 39139 39157 39161 39163 39181 39191 39199 39209 39217 39227 39229 +39233 39239 39241 39251 39293 39301 39313 39317 39323 39341 39343 39359 +39367 39371 39373 39383 39397 39409 39419 39439 39443 39451 39461 39499 +39503 39509 39511 39521 39541 39551 39563 39569 39581 39607 39619 39623 +39631 39659 39667 39671 39679 39703 39709 39719 39727 39733 39749 39761 +39769 39779 39791 39799 39821 39827 39829 39839 39841 39847 39857 39863 +39869 39877 39883 39887 39901 39929 39937 39953 39971 39979 39983 39989 +40009 40013 40031 40037 40039 40063 40087 40093 40099 40111 40123 40127 +40129 40151 40153 40163 40169 40177 40189 40193 40213 40231 40237 40241 +40253 40277 40283 40289 40343 40351 40357 40361 40387 40423 40427 40429 +40433 40459 40471 40483 40487 40493 40499 40507 40519 40529 40531 40543 +40559 40577 40583 40591 40597 40609 40627 40637 40639 40693 40697 40699 +40709 40739 40751 40759 40763 40771 40787 40801 40813 40819 40823 40829 +40841 40847 40849 40853 40867 40879 40883 40897 40903 40927 40933 40939 +40949 40961 40973 40993 41011 41017 41023 41039 41047 41051 41057 41077 +41081 41113 41117 41131 41141 41143 41149 41161 41177 41179 41183 41189 +41201 41203 41213 41221 41227 41231 41233 41243 41257 41263 41269 41281 +41299 41333 41341 41351 41357 41381 41387 41389 41399 41411 41413 41443 +41453 41467 41479 41491 41507 41513 41519 41521 41539 41543 41549 41579 +41593 41597 41603 41609 41611 41617 41621 41627 41641 41647 41651 41659 +41669 41681 41687 41719 41729 41737 41759 41761 41771 41777 41801 41809 +41813 41843 41849 41851 41863 41879 41887 41893 41897 41903 41911 41927 +41941 41947 41953 41957 41959 41969 41981 41983 41999 42013 42017 42019 +42023 42043 42061 42071 42073 42083 42089 42101 42131 42139 42157 42169 +42179 42181 42187 42193 42197 42209 42221 42223 42227 42239 42257 42281 +42283 42293 42299 42307 42323 42331 42337 42349 42359 42373 42379 42391 +42397 42403 42407 42409 42433 42437 42443 42451 42457 42461 42463 42467 +42473 42487 42491 42499 42509 42533 42557 42569 42571 42577 42589 42611 +42641 42643 42649 42667 42677 42683 42689 42697 42701 42703 42709 42719 +42727 42737 42743 42751 42767 42773 42787 42793 42797 42821 42829 42839 +42841 42853 42859 42863 42899 42901 42923 42929 42937 42943 42953 42961 +42967 42979 42989 43003 43013 43019 43037 43049 43051 43063 43067 43093 +43103 43117 43133 43151 43159 43177 43189 43201 43207 43223 43237 43261 +43271 43283 43291 43313 43319 43321 43331 43391 43397 43399 43403 43411 +43427 43441 43451 43457 43481 43487 43499 43517 43541 43543 43573 43577 +43579 43591 43597 43607 43609 43613 43627 43633 43649 43651 43661 43669 +43691 43711 43717 43721 43753 43759 43777 43781 43783 43787 43789 43793 +43801 43853 43867 43889 43891 43913 43933 43943 43951 43961 43963 43969 +43973 43987 43991 43997 44017 44021 44027 44029 44041 44053 44059 44071 +44087 44089 44101 44111 44119 44123 44129 44131 44159 44171 44179 44189 +44201 44203 44207 44221 44249 44257 44263 44267 44269 44273 44279 44281 +44293 44351 44357 44371 44381 44383 44389 44417 44449 44453 44483 44491 +44497 44501 44507 44519 44531 44533 44537 44543 44549 44563 44579 44587 +44617 44621 44623 44633 44641 44647 44651 44657 44683 44687 44699 44701 +44711 44729 44741 44753 44771 44773 44777 44789 44797 44809 44819 44839 +44843 44851 44867 44879 44887 44893 44909 44917 44927 44939 44953 44959 +44963 44971 44983 44987 45007 45013 45053 45061 45077 45083 45119 45121 +45127 45131 45137 45139 45161 45179 45181 45191 45197 45233 45247 45259 +45263 45281 45289 45293 45307 45317 45319 45329 45337 45341 45343 45361 +45377 45389 45403 45413 45427 45433 45439 45481 45491 45497 45503 45523 +45533 45541 45553 45557 45569 45587 45589 45599 45613 45631 45641 45659 +45667 45673 45677 45691 45697 45707 45737 45751 45757 45763 45767 45779 +45817 45821 45823 45827 45833 45841 45853 45863 45869 45887 45893 45943 +45949 45953 45959 45971 45979 45989 46021 46027 46049 46051 46061 46073 +46091 46093 46099 46103 46133 46141 46147 46153 46171 46181 46183 46187 +46199 46219 46229 46237 46261 46271 46273 46279 46301 46307 46309 46327 +46337 46349 46351 46381 46399 46411 46439 46441 46447 46451 46457 46471 +46477 46489 46499 46507 46511 46523 46549 46559 46567 46573 46589 46591 +46601 46619 46633 46639 46643 46649 46663 46679 46681 46687 46691 46703 +46723 46727 46747 46751 46757 46769 46771 46807 46811 46817 46819 46829 +46831 46853 46861 46867 46877 46889 46901 46919 46933 46957 46993 46997 +47017 47041 47051 47057 47059 47087 47093 47111 47119 47123 47129 47137 +47143 47147 47149 47161 47189 47207 47221 47237 47251 47269 47279 47287 +47293 47297 47303 47309 47317 47339 47351 47353 47363 47381 47387 47389 +47407 47417 47419 47431 47441 47459 47491 47497 47501 47507 47513 47521 +47527 47533 47543 47563 47569 47581 47591 47599 47609 47623 47629 47639 +47653 47657 47659 47681 47699 47701 47711 47713 47717 47737 47741 47743 +47777 47779 47791 47797 47807 47809 47819 47837 47843 47857 47869 47881 +47903 47911 47917 47933 47939 47947 47951 47963 47969 47977 47981 48017 +48023 48029 48049 48073 48079 48091 48109 48119 48121 48131 48157 48163 +48179 48187 48193 48197 48221 48239 48247 48259 48271 48281 48299 48311 +48313 48337 48341 48353 48371 48383 48397 48407 48409 48413 48437 48449 +48463 48473 48479 48481 48487 48491 48497 48523 48527 48533 48539 48541 +48563 48571 48589 48593 48611 48619 48623 48647 48649 48661 48673 48677 +48679 48731 48733 48751 48757 48761 48767 48779 48781 48787 48799 48809 +48817 48821 48823 48847 48857 48859 48869 48871 48883 48889 48907 48947 +48953 48973 48989 48991 49003 49009 49019 49031 49033 49037 49043 49057 +49069 49081 49103 49109 49117 49121 49123 49139 49157 49169 49171 49177 +49193 49199 49201 49207 49211 49223 49253 49261 49277 49279 49297 49307 +49331 49333 49339 49363 49367 49369 49391 49393 49409 49411 49417 49429 +49433 49451 49459 49463 49477 49481 49499 49523 49529 49531 49537 49547 +49549 49559 49597 49603 49613 49627 49633 49639 49663 49667 49669 49681 +49697 49711 49727 49739 49741 49747 49757 49783 49787 49789 49801 49807 +49811 49823 49831 49843 49853 49871 49877 49891 49919 49921 49927 49937 +49939 49943 49957 49991 49993 49999 50021 50023 50033 50047 50051 50053 +50069 50077 50087 50093 50101 50111 50119 50123 50129 50131 50147 50153 +50159 50177 50207 50221 50227 50231 50261 50263 50273 50287 50291 50311 +50321 50329 50333 50341 50359 50363 50377 50383 50387 50411 50417 50423 +50441 50459 50461 50497 50503 50513 50527 50539 50543 50549 50551 50581 +50587 50591 50593 50599 50627 50647 50651 50671 50683 50707 50723 50741 +50753 50767 50773 50777 50789 50821 50833 50839 50849 50857 50867 50873 +50891 50893 50909 50923 50929 50951 50957 50969 50971 50989 50993 51001 +51031 51043 51047 51059 51061 51071 51109 51131 51133 51137 51151 51157 +51169 51193 51197 51199 51203 51217 51229 51239 51241 51257 51263 51283 +51287 51307 51329 51341 51343 51347 51349 51361 51383 51407 51413 51419 +51421 51427 51431 51437 51439 51449 51461 51473 51479 51481 51487 51503 +51511 51517 51521 51539 51551 51563 51577 51581 51593 51599 51607 51613 +51631 51637 51647 51659 51673 51679 51683 51691 51713 51719 51721 51749 +51767 51769 51787 51797 51803 51817 51827 51829 51839 51853 51859 51869 +51871 51893 51899 51907 51913 51929 51941 51949 51971 51973 51977 51991 +52009 52021 52027 52051 52057 52067 52069 52081 52103 52121 52127 52147 +52153 52163 52177 52181 52183 52189 52201 52223 52237 52249 52253 52259 +52267 52289 52291 52301 52313 52321 52361 52363 52369 52379 52387 52391 +52433 52453 52457 52489 52501 52511 52517 52529 52541 52543 52553 52561 +52567 52571 52579 52583 52609 52627 52631 52639 52667 52673 52691 52697 +52709 52711 52721 52727 52733 52747 52757 52769 52783 52807 52813 52817 +52837 52859 52861 52879 52883 52889 52901 52903 52919 52937 52951 52957 +52963 52967 52973 52981 52999 53003 53017 53047 53051 53069 53077 53087 +53089 53093 53101 53113 53117 53129 53147 53149 53161 53171 53173 53189 +53197 53201 53231 53233 53239 53267 53269 53279 53281 53299 53309 53323 +53327 53353 53359 53377 53381 53401 53407 53411 53419 53437 53441 53453 +53479 53503 53507 53527 53549 53551 53569 53591 53593 53597 53609 53611 +53617 53623 53629 53633 53639 53653 53657 53681 53693 53699 53717 53719 +53731 53759 53773 53777 53783 53791 53813 53819 53831 53849 53857 53861 +53881 53887 53891 53897 53899 53917 53923 53927 53939 53951 53959 53987 +53993 54001 54011 54013 54037 54049 54059 54083 54091 54101 54121 54133 +54139 54151 54163 54167 54181 54193 54217 54251 54269 54277 54287 54293 +54311 54319 54323 54331 54347 54361 54367 54371 54377 54401 54403 54409 +54413 54419 54421 54437 54443 54449 54469 54493 54497 54499 54503 54517 +54521 54539 54541 54547 54559 54563 54577 54581 54583 54601 54617 54623 +54629 54631 54647 54667 54673 54679 54709 54713 54721 54727 54751 54767 +54773 54779 54787 54799 54829 54833 54851 54869 54877 54881 54907 54917 +54919 54941 54949 54959 54973 54979 54983 55001 55009 55021 55049 55051 +55057 55061 55073 55079 55103 55109 55117 55127 55147 55163 55171 55201 +55207 55213 55217 55219 55229 55243 55249 55259 55291 55313 55331 55333 +55337 55339 55343 55351 55373 55381 55399 55411 55439 55441 55457 55469 +55487 55501 55511 55529 55541 55547 55579 55589 55603 55609 55619 55621 +55631 55633 55639 55661 55663 55667 55673 55681 55691 55697 55711 55717 +55721 55733 55763 55787 55793 55799 55807 55813 55817 55819 55823 55829 +55837 55843 55849 55871 55889 55897 55901 55903 55921 55927 55931 55933 +55949 55967 55987 55997 56003 56009 56039 56041 56053 56081 56087 56093 +56099 56101 56113 56123 56131 56149 56167 56171 56179 56197 56207 56209 +56237 56239 56249 56263 56267 56269 56299 56311 56333 56359 56369 56377 +56383 56393 56401 56417 56431 56437 56443 56453 56467 56473 56477 56479 +56489 56501 56503 56509 56519 56527 56531 56533 56543 56569 56591 56597 +56599 56611 56629 56633 56659 56663 56671 56681 56687 56701 56711 56713 +56731 56737 56747 56767 56773 56779 56783 56807 56809 56813 56821 56827 +56843 56857 56873 56891 56893 56897 56909 56911 56921 56923 56929 56941 +56951 56957 56963 56983 56989 56993 56999 57037 57041 57047 57059 57073 +57077 57089 57097 57107 57119 57131 57139 57143 57149 57163 57173 57179 +57191 57193 57203 57221 57223 57241 57251 57259 57269 57271 57283 57287 +57301 57329 57331 57347 57349 57367 57373 57383 57389 57397 57413 57427 +57457 57467 57487 57493 57503 57527 57529 57557 57559 57571 57587 57593 +57601 57637 57641 57649 57653 57667 57679 57689 57697 57709 57713 57719 +57727 57731 57737 57751 57773 57781 57787 57791 57793 57803 57809 57829 +57839 57847 57853 57859 57881 57899 57901 57917 57923 57943 57947 57973 +57977 57991 58013 58027 58031 58043 58049 58057 58061 58067 58073 58099 +58109 58111 58129 58147 58151 58153 58169 58171 58189 58193 58199 58207 +58211 58217 58229 58231 58237 58243 58271 58309 58313 58321 58337 58363 +58367 58369 58379 58391 58393 58403 58411 58417 58427 58439 58441 58451 +58453 58477 58481 58511 58537 58543 58549 58567 58573 58579 58601 58603 +58613 58631 58657 58661 58679 58687 58693 58699 58711 58727 58733 58741 +58757 58763 58771 58787 58789 58831 58889 58897 58901 58907 58909 58913 +58921 58937 58943 58963 58967 58979 58991 58997 59009 59011 59021 59023 +59029 59051 59053 59063 59069 59077 59083 59093 59107 59113 59119 59123 +59141 59149 59159 59167 59183 59197 59207 59209 59219 59221 59233 59239 +59243 59263 59273 59281 59333 59341 59351 59357 59359 59369 59377 59387 +59393 59399 59407 59417 59419 59441 59443 59447 59453 59467 59471 59473 +59497 59509 59513 59539 59557 59561 59567 59581 59611 59617 59621 59627 +59629 59651 59659 59663 59669 59671 59693 59699 59707 59723 59729 59743 +59747 59753 59771 59779 59791 59797 59809 59833 59863 59879 59887 59921 +59929 59951 59957 59971 59981 59999 60013 60017 60029 60037 60041 60077 +60083 60089 60091 60101 60103 60107 60127 60133 60139 60149 60161 60167 +60169 60209 60217 60223 60251 60257 60259 60271 60289 60293 60317 60331 +60337 60343 60353 60373 60383 60397 60413 60427 60443 60449 60457 60493 +60497 60509 60521 60527 60539 60589 60601 60607 60611 60617 60623 60631 +60637 60647 60649 60659 60661 60679 60689 60703 60719 60727 60733 60737 +60757 60761 60763 60773 60779 60793 60811 60821 60859 60869 60887 60889 +60899 60901 60913 60917 60919 60923 60937 60943 60953 60961 61001 61007 +61027 61031 61043 61051 61057 61091 61099 61121 61129 61141 61151 61153 +61169 61211 61223 61231 61253 61261 61283 61291 61297 61331 61333 61339 +61343 61357 61363 61379 61381 61403 61409 61417 61441 61463 61469 61471 +61483 61487 61493 61507 61511 61519 61543 61547 61553 61559 61561 61583 +61603 61609 61613 61627 61631 61637 61643 61651 61657 61667 61673 61681 +61687 61703 61717 61723 61729 61751 61757 61781 61813 61819 61837 61843 +61861 61871 61879 61909 61927 61933 61949 61961 61967 61979 61981 61987 +61991 62003 62011 62017 62039 62047 62053 62057 62071 62081 62099 62119 +62129 62131 62137 62141 62143 62171 62189 62191 62201 62207 62213 62219 +62233 62273 62297 62299 62303 62311 62323 62327 62347 62351 62383 62401 +62417 62423 62459 62467 62473 62477 62483 62497 62501 62507 62533 62539 +62549 62563 62581 62591 62597 62603 62617 62627 62633 62639 62653 62659 +62683 62687 62701 62723 62731 62743 62753 62761 62773 62791 62801 62819 +62827 62851 62861 62869 62873 62897 62903 62921 62927 62929 62939 62969 +62971 62981 62983 62987 62989 63029 63031 63059 63067 63073 63079 63097 +63103 63113 63127 63131 63149 63179 63197 63199 63211 63241 63247 63277 +63281 63299 63311 63313 63317 63331 63337 63347 63353 63361 63367 63377 +63389 63391 63397 63409 63419 63421 63439 63443 63463 63467 63473 63487 +63493 63499 63521 63527 63533 63541 63559 63577 63587 63589 63599 63601 +63607 63611 63617 63629 63647 63649 63659 63667 63671 63689 63691 63697 +63703 63709 63719 63727 63737 63743 63761 63773 63781 63793 63799 63803 +63809 63823 63839 63841 63853 63857 63863 63901 63907 63913 63929 63949 +63977 63997 64007 64013 64019 64033 64037 64063 64067 64081 64091 64109 +64123 64151 64153 64157 64171 64187 64189 64217 64223 64231 64237 64271 +64279 64283 64301 64303 64319 64327 64333 64373 64381 64399 64403 64433 +64439 64451 64453 64483 64489 64499 64513 64553 64567 64577 64579 64591 +64601 64609 64613 64621 64627 64633 64661 64663 64667 64679 64693 64709 +64717 64747 64763 64781 64783 64793 64811 64817 64849 64853 64871 64877 +64879 64891 64901 64919 64921 64927 64937 64951 64969 64997 65003 65011 +65027 65029 65033 65053 65063 65071 65089 65099 65101 65111 65119 65123 +65129 65141 65147 65167 65171 65173 65179 65183 65203 65213 65239 65257 +65267 65269 65287 65293 65309 65323 65327 65353 65357 65371 65381 65393 +65407 65413 65419 65423 65437 65447 65449 65479 65497 65519 65521 ); + +my $l; +my @used; +my @gens; + +sub rsaparams { + my (%params) = @_; + @used = (); + my %paramsrsa = (%params, (Relprime => 1)); + my $p = maurer (%paramsrsa); print "\n" if $params{Verbosity}; + my $q = maurer (%paramsrsa); print "\n" if $params{Verbosity}; + return { p => $p, q => $q, e => 65537 } +} + +sub maurer { + + my ( %params ) = @_; + + my $k = $params { Size }; #-- bitsize of the required prime. + my $v = $params { Verbosity }; #-- process reporting verbosity. + #-- whether to find intermediate generators. + my $p0 = 20; #-- generate primes of bitsize less + #-- than $p0 with nextprime(). + my $maxfact = 140; #-- bitsize of the biggest number we + #-- can factor easily. + $| = 1; + + if ( $k <= $p0 ) { + my $spr = makerandom Size => $k; + return Math::Pari::nextprime ( $spr ); + } + + my $c_opt = 0.09; my $m = 20; + my $B = floor ( $c_opt * ( $k ** 2 ) ); + my $r = PARI ( 2 ** ( ( rand ) - 1 ) ); + srand ( makerandom ( Size => 32, Strength => 0 ) ); + + if ( $k > ( 2 * $m ) ) { + my $frs = 0; until ( $frs ) { + $r = 2 ** ( (rand) - 1 ); + my $rbits = $k-($r*$k); + $frs = 1 if $rbits > $m; + $frs = 0 if ($params{Generator} && ($rbits > $maxfact)); + } + } else { + $r = 0.5; + } + + my $q = maurer ( Size => floor ( $r * $k ) + 2, Verbosity => $v, + Generator => $params{Generator}, Intermediates => $params{Intermediates} ); + if ($params{Relprime}) { + while ((grep /$q/, @used)) { + print "<" if $v == 1; + $q = maurer ( Size => floor ( $r * $k ) + 2, Verbosity => $v, Relprime => 1, + Generator => $params{Generator}, Intermediates => $params{Intermediates} ); + } + } + $q = $q->{Prime} if (ref $q eq 'HASH'); + + print "B = $B, r = $r, k = $k, q = $q\n" if $v == 2; + push @used, $q; + + my $o1 = PARI ( 2 * $q ); + my $o2 = PARI '2' ** PARI "@{[$k - 1]}"; + my $I = floor ( $o2 / $o1 ); + my $n = PARI (); + + while (1) { + + my $R = PARI ( makerandom_itv ( Lower => $I + 1, Upper => 2 * $I ) ); + $n = floor( 2 * $R * $q + 1 ); + print "n = $n\n" if $v == 2; + print "." if $v == 1; + + my $a = PARI(); + if ( trialdiv ( $n, $B ) ) { + BASE: { + print "(passes trial division)\n" if $v == 2; print "+" if $v == 1; + $a = makerandom_itv( Lower => 2, Upper=> $n - 2 ); + $a = makerandom_itv( Lower => 2, Upper=> $R ) if $params{Generator}; + my $t1 = Mod (2, $n); my $t2 = Mod ($a, $n); + my $b = $t2 ** ( $n - 1 ); + if ( ($b == 1) && ( $q > $n ** (1/3.0) ) ) { + print "$n is prime! a = $a, R = $R\n" if $v == 2; + print "($k)" if $v == 1; + my @s; + if ($params{Generator}) { + print "computing a generator...\n" if $v == 2; + print "# " if $v == 1; + @s = Math::Pari::factor($R) =~ m:[\[\(\;](\d+)(?=,):g; + push @s, ($q,2); my $p = PARI (1); for (@s) { $p *= $_ }; + for (@s) { my $b = Mod ($a, $p) ** PARI($p/$_); + if ($b == 1) { + print "@!" if $v == 1; + print "$a is not a generator\n" if $v == 2; + next BASE; + } + } + } + my @factors = ( Factors => \@s, R => $R ) if $params{Factors}; + my @intermediates = ( Intermediates => \@used ) if $params{Intermediates}; + return { @factors, @intermediates, Prime => $n, Generator => $a } if $params{Generator}; + return { @factors, @intermediates, Prime => $n } if $params{Factors} or $params{Intermediates}; + return $n; + } + } + + } + + } + +} + + +sub trialdiv { + + my ( $n, $limit, $v ) = @_; + + my $end = _trialdiv_limit ( $n, $limit ); + for ( $i=0; $i <= $end; $i++ ) { + return undef unless Math::Pari::gmod ( $n, $PRIMES[ $i ] ); + } + + return 1; + +} + + +sub _trialdiv_limit { + + my ($n, $limit) = @_; + my $start = 0; + my $mid; + my $end = $#PRIMES; + $limit = int(sqrt($n)) unless $limit; + + if ( $limit <= $PRIMES[ $end ] ) { + while ( ( $start + 1 ) != $end ) { + use integer; + $mid = int (( $end + $start ) / 2); + no integer; + $start = $mid if $limit > $PRIMES[ $mid ]; + $end = $mid if $limit <= $PRIMES[ $mid ]; + } + } + + return $end; + +} + +"True Value"; + + +=head1 NAME + +Crypt::Primes - Provable Prime Number Generator suitable for Cryptographic Applications. + +=head1 VERSION + + $Revision: 0.49 $ + $Date: 2001/06/11 01:04:23 $ + +=head1 SYNOPSIS + + # generate a random, provable 512-bit prime. + + use Crypt::Primes qw(maurer); + my $prime = maurer (Size => 512); + + # generate a random, provable 2048-bit prime and report + # progress on console. + + my $another_prime = maurer ( + Size => 2048, + Verbosity => 1 + ); + + + # generate a random 1024-bit prime and a group + # generator of Z*(n). + + my $hash_ref = maurer ( + Size => 1024, + Generator => 1, + Verbosity => 1 + ); + +=head1 WARNING + +The codebase is stable, but the API will most definitely change in a future +release. + +=head1 DESCRIPTION + +This module implements Ueli Maurer's algorithm for generating large +I<provable> primes and secure parameters for public-key cryptosystems. The +generated primes are almost uniformly distributed over the set of primes of +the specified bitsize and expected time for generation is less than the time +required for generating a pseudo-prime of the same size with Miller-Rabin +tests. Detailed description and running time analysis of the algorithm can +be found in Maurer's paper[1]. + +Crypt::Primes is a pure perl implementation. It uses Math::Pari for +multiple precision integer arithmetic and number theoretic functions. +Random numbers are gathered with Crypt::Random, a perl interface to +/dev/u?random devices found on most modern Unix operating systems. + +=head1 FUNCTIONS + +The following functions are availble for import. They must be explicitely +imported. + +=over 4 + +=item B<maurer(%params)> + +Generates a prime number of the specified bitsize. Takes a hash as +parameter and returns a Math::Pari object (prime number) or a hash reference +(prime number and generator) when group generator computation is requested. +Following hash keys are understood: + +=back + +=over 0 + +=item B<Size> + +Bitsize of the required prime number. + +=item B<Verbosity> + +Level of verbosity of progress reporting. Report is printed on STDOUT. +Level of 1 indicates normal, terse reporting. Level of 2 prints lots of +intermediate computations, useful for debugging. + +=item B<Generator> + +When Generator key is set to a non-zero value, a group generator of Z*(n) is +computed. Group generators are required key material in public-key +cryptosystems like Elgamal and Diffie-Hellman that are based on +intractability of the discrete logarithm problem. When this option is +present, maurer() returns a hash reference that contains two keys, Prime and +Generator. + +=item B<Relprime> + +When set to 1, maurer() stores intermediate primes in a class array, and +ensures they are not used during construction of primes in the future calls +to maurer() with Reprime => 1. This is used by rsaparams(). + +=item B<Intermediates> + +When set to 1, maurer() returns a hash reference that contains +(corresponding to the key 'Intermediates') a reference to an array of +intermediate primes generated. + +=item B<Factors> + +When set to 1, maurer() returns a hash reference that contains +(corresponding to the key 'Factors') a reference to an array of +factors of p-1 where p is the prime generated, and also (corresponding +to the key 'R') a divisor of p. + +=back + +=over 4 + +=item B<rsaparams(%params)> + +Generates two primes (p,q) and public exponent (e) of a RSA key pair. The +key pair generated with this method is resistant to iterative encryption +attack. See Appendix 2 of +[1] for more information. + +rsaparams() takes the same arguments as maurer() with the exception of +`Generator' and `Relprime'. Size specifies the common bitsize of p an q. +Returns a hash reference with keys p, q and e. + +=item B<trialdiv($n,$limit)> + +Performs trial division on $n to ensure it's not divisible by any prime +smaller than or equal to $limit. The module maintains a lookup table of +primes (from 2 to 65521) for this purpose. If $limit is not provided, a +suitable value is computed automatically. trialdiv() is used by maurer() to +weed out composite random numbers before performing computationally +intensive modular exponentiation tests. It is, however, documented should +you need to use it directly. + +=back + +=head1 IMPLEMENTATION NOTE + +This module implements a modified FastPrime, as described in [1], to +facilitate group generator computation. (Refer to [1] and [2] for +description and pseudo-code of FastPrime). The modification involves +introduction of an additional constraint on relative size r of q. While +computing r, we ensure k * r is always greater than maxfact, where maxfact +is the bitsize of the largest number we can factor easily. This value +defaults to 140 bits. As a result, R is always smaller than maxfact, which +allows us to get a complete factorization of 2Rq and use it to find a +generator of the cyclic group Z*(2Rq). + +=head1 RUNNING TIME + +Crypt::Primes generates 512-bit primes in 7 seconds (on average), and +1024-bit primes in 37 seconds (on average), on my PII 300 Mhz notebook. +There are no computational limits by design; primes upto 8192-bits were +generated to stress test the code. For detailed runtime analysis see [1]. + +=head1 SEE ALSO + +largeprimes(1), Crypt::Random(3), Math::Pari(3) + +=head1 BIBLIOGRAPHY + +=over 4 + +=item 1 Fast Generation of Prime Numbers and Secure Public-Key Cryptographic +Parameters, Ueli Maurer (1994). + +=item 2 Corrections to Fast Generation of Prime Numbers and Secure Public-Key +Cryptographic Parameters, Ueli Maurer (1996). + +=item 3 Handbook of Applied Cryptography by Menezes, Paul C. van Oorschot +and Scott Vanstone (1997). + +=item Documents 1 & 2 can be found under docs/ of the source distribution. + +=back + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=cut + +=head1 LICENSE + +Copyright (c) 1998-2001, Vipul Ved Prakash. All rights reserved. This code +is free software; you can redistribute it and/or modify it under the same +terms as Perl itself. + +=head1 TODO + +Maurer's algorithm generates primes of progressively larger bitsize using +a recursive construction method. The algorithm enters recursion with a +prime number and bitsize of the next prime to be generated. (Bitsizes of +the intermediate primes are computed using a probability distribution that +ensures generated primes are sufficiently random.) This recursion can be +distributed over multiple machines, participating in a competitive +computation model, to achieve close to best running time of the algorithm. +Support for this will be implemented some day, possibly when the next +version of Penguin hits CPAN. + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RIPEMD160.pm b/Master/tlpkg/tlperl/lib/Crypt/RIPEMD160.pm new file mode 100755 index 00000000000..001e76ef4b5 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RIPEMD160.pm @@ -0,0 +1,280 @@ +package Crypt::RIPEMD160; + +use strict; +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); + +require Exporter; +require DynaLoader; +require AutoLoader; +@ISA = qw(Exporter AutoLoader DynaLoader); + +# Items to export into callers namespace by default +@EXPORT = qw(); + +@EXPORT_OK = qw(); + +$VERSION = '0.04'; + +bootstrap Crypt::RIPEMD160 $VERSION; + +#package RIPEMD160; # Package-Definition like in Crypt::IDEA + +#use strict; +use Carp; + +sub addfile +{ + no strict 'refs'; + my ($self, $handle) = @_; + my ($package, $file, $line) = caller; + my ($data); + + if (!ref($handle)) { + $handle = $package . "::" . $handle unless ($handle =~ /(\:\:|\')/); + } + while (read($handle, $data, 8192)) { + $self->add($data); + } +} + +sub hexdigest +{ + my ($self) = shift; + my ($tmp); + + $tmp = unpack("H*", ($self->digest())); + return(substr($tmp, 0,8) . " " . substr($tmp, 8,8) . " " . + substr($tmp,16,8) . " " . substr($tmp,24,8) . " " . + substr($tmp,32,8)); +} + +sub hash +{ + my($self, $data) = @_; + + if (ref($self)) { + $self->reset(); + } else { + $self = new Crypt::RIPEMD160; + } + $self->add($data); + $self->digest(); +} + +sub hexhash +{ + my($self, $data) = @_; + + if (ref($self)) { + $self->reset(); + } else { + $self = new Crypt::RIPEMD160; + } + $self->add($data); + $self->hexdigest(); +} + +1; +__END__ +# Below is the stub of documentation for your module. You better edit it! + +=head1 NAME + +Crypt::RIPEMD160 - Perl extension for the RIPEMD-160 Hash function + +=head1 SYNOPSIS + + use Crypt::RIPEMD160; + + $context = new Crypt::RIPEMD160; + $context->reset(); + + $context->add(LIST); + $context->addfile(HANDLE); + + $digest = $context->digest(); + $string = $context->hexdigest(); + + $digest = Crypt::RIPEMD160->hash(SCALAR); + $string = Crypt::RIPEMD160->hexhash(SCALAR); + +=head1 DESCRIPTION + +The B<Crypt::RIPEMD160> module allows you to use the RIPEMD160 +Message Digest algorithm from within Perl programs. + +The module is based on the implementation from Antoon Bosselaers from +Katholieke Universiteit Leuven. + +A new RIPEMD160 context object is created with the B<new> operation. +Multiple simultaneous digest contexts can be maintained, if desired. +The context is updated with the B<add> operation which adds the +strings contained in the I<LIST> parameter. Note, however, that +C<add('foo', 'bar')>, C<add('foo')> followed by C<add('bar')> and +C<add('foobar')> should all give the same result. + +The final message digest value is returned by the B<digest> operation +as a 20-byte binary string. This operation delivers the result of +B<add> operations since the last B<new> or B<reset> operation. Note +that the B<digest> operation is effectively a destructive, read-once +operation. Once it has been performed, the context must be B<reset> +before being used to calculate another digest value. + +Several convenience functions are also provided. The B<addfile> +operation takes an open file-handle and reads it until end-of file in +8192 byte blocks adding the contents to the context. The file-handle +can either be specified by name or passed as a type-glob reference, as +shown in the examples below. The B<hexdigest> operation calls +B<digest> and returns the result as a printable string of hexdecimal +digits. This is exactly the same operation as performed by the +B<unpack> operation in the examples below. + +The B<hash> operation can act as either a static member function (ie +you invoke it on the RIPEMD160 class as in the synopsis above) or as a +normal virtual function. In both cases it performs the complete RIPEMD160 +cycle (reset, add, digest) on the supplied scalar value. This is +convenient for handling small quantities of data. When invoked on the +class a temporary context is created. When invoked through an already +created context object, this context is used. The latter form is +slightly more efficient. The B<hexhash> operation is analogous to +B<hexdigest>. + +=head1 EXAMPLES + + use Crypt::RIPEMD160; + + $ripemd160 = new Crypt::RIPEMD160; + $ripemd160->add('foo', 'bar'); + $ripemd160->add('baz'); + $digest = $ripemd160->digest(); + + print("Digest is " . unpack("H*", $digest) . "\n"); + +The above example would print out the message + + Digest is f137cb536c05ec2bc97e73327937b6e81d3a4cc9 + +provided that the implementation is working correctly. + +Remembering the Perl motto ("There's more than one way to do it"), the +following should all give the same result: + + use Crypt::RIPEMD160; + $ripemd160 = new Crypt::RIPEMD160; + + die "Can't open /etc/passwd ($!)\n" unless open(P, "/etc/passwd"); + + seek(P, 0, 0); + $ripemd160->reset; + $ripemd160->addfile(P); + $d = $ripemd160->hexdigest; + print "addfile (handle name) = $d\n"; + + seek(P, 0, 0); + $ripemd160->reset; + $ripemd160->addfile(\*P); + $d = $ripemd160->hexdigest; + print "addfile (type-glob reference) = $d\n"; + + seek(P, 0, 0); + $ripemd160->reset; + while (<P>) + { + $ripemd160->add($_); + } + $d = $ripemd160->hexdigest; + print "Line at a time = $d\n"; + + seek(P, 0, 0); + $ripemd160->reset; + $ripemd160->add(<P>); + $d = $ripemd160->hexdigest; + print "All lines at once = $d\n"; + + seek(P, 0, 0); + $ripemd160->reset; + while (read(P, $data, (rand % 128) + 1)) + { + $ripemd160->add($data); + } + $d = $ripemd160->hexdigest; + print "Random chunks = $d\n"; + + seek(P, 0, 0); + $ripemd160->reset; + undef $/; + $data = <P>; + $d = $ripemd160->hexhash($data); + print "Single string = $d\n"; + + close(P); + +=head1 NOTE + +The RIPEMD160 extension may be redistributed under the same terms as Perl. +The RIPEMD160 algorithm is published in "Fast Software Encryption, LNCS 1039, +D. Gollmann (Ed.), pp.71-82". + +The basic C code implementing the algorithm is covered by the +following copyright: + +=over 1 + +C< +/********************************************************************\ + * + * FILE: rmd160.c + * + * CONTENTS: A sample C-implementation of the RIPEMD-160 + * hash-function. + * TARGET: any computer with an ANSI C compiler + * + * AUTHOR: Antoon Bosselaers, ESAT-COSIC + * DATE: 1 March 1996 + * VERSION: 1.0 + * + * Copyright (c) Katholieke Universiteit Leuven + * 1996, All Rights Reserved + * +\********************************************************************/ +> + +=back + +=head1 RIPEMD-160 test suite results (ASCII): + +C< +* message: "" (empty string) + hashcode: 9c1185a5c5e9fc54612808977ee8f548b2258d31 +* message: "a" + hashcode: 0bdc9d2d256b3ee9daae347be6f4dc835a467ffe +* message: "abc" + hashcode: 8eb208f7e05d987a9b044a8e98c6b087f15a0bfc +* message: "message digest" + hashcode: 5d0689ef49d2fae572b881b123a85ffa21595f36 +* message: "abcdefghijklmnopqrstuvwxyz" + hashcode: f71c27109c692c1b56bbdceb5b9d2865b3708dbc +* message: "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" + hashcode: 12a053384a9c0c88e405a06c27dcf49ada62eb2b +* message: "A...Za...z0...9" + hashcode: b0e20b6e3116640286ed3a87a5713079b21f5189 +* message: 8 times "1234567890" + hashcode: 9b752e45573d4b39f4dbd3323cab82bf63326bfb +* message: 1 million times "a" + hashcode: 52783243c1697bdbe16d37f97f68f08325dc1528 +> + +This copyright does not prohibit distribution of any version of Perl +containing this extension under the terms of the GNU or Artistic +licences. + +=head1 AUTHOR + +The RIPEMD-160 interface was written by Christian H. Geuer-Pollmann (CHGEUER) +(C<geuer-pollmann@nue.et-inf.uni.siegen.de>) and Ken Neighbors (C<ken@nsds.com>). + +=head1 SEE ALSO + +MD5(3pm) and SHA(1). + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/RIPEMD160/MAC.pm b/Master/tlpkg/tlperl/lib/Crypt/RIPEMD160/MAC.pm new file mode 100755 index 00000000000..092d4a45a7b --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RIPEMD160/MAC.pm @@ -0,0 +1,162 @@ +package Crypt::RIPEMD160::MAC; + +use Crypt::RIPEMD160 0.03; + +use strict; +use vars qw($VERSION @ISA @EXPORT); + +require Exporter; +@ISA = qw(Exporter); + +# Items to export into callers namespace by default +@EXPORT = qw(); +$VERSION = '0.01'; + +sub new { + my($pkg, $key) = @_; + + my $self = { + 'key' => $key, + 'hash' => new Crypt::RIPEMD160, + 'k_ipad' => chr(0x36) x 64, + 'k_opad' => chr(0x5c) x 64, + }; + + bless $self, $pkg; + + if (length($self->{'key'}) > 64) { + $self->{'key'} = Crypt::RIPEMD160->hash($self->{'key'}); + } + + $self->{'k_ipad'} ^= $self->{'key'}; + $self->{'k_opad'} ^= $self->{'key'}; + + $self->{'hash'}->add($self->{'k_ipad'}); + + return $self; +} + +sub reset { + my($self) = @_; + + $self->{'hash'}->reset(); + $self->{'k_ipad'} = chr(0x36) x 64; + $self->{'k_opad'} = chr(0x5c) x 64; + + if (length($self->{'key'}) > 64) { + $self->{'key'} = Crypt::RIPEMD160->hash($self->{'key'}); + } + + $self->{'k_ipad'} ^= $self->{'key'}; + $self->{'k_opad'} ^= $self->{'key'}; + + $self->{'hash'}->add($self->{'k_ipad'}); + + return $self; +} + +sub add { + my($self, @data) = @_; + + $self->{'hash'}->add(@data); +} + +sub addfile +{ + no strict 'refs'; + my ($self, $handle) = @_; + my ($package, $file, $line) = caller; + my ($data); + + if (!ref($handle)) { + $handle = $package . "::" . $handle unless ($handle =~ /(\:\:|\')/); + } + while (read($handle, $data, 8192)) { + $self->{'hash'}->add($data); + } +} + +sub mac { + my($self) = @_; + + my($inner) = $self->{'hash'}->digest(); + + my($outer) = Crypt::RIPEMD160->hash($self->{'k_opad'}.$inner); + + $self->{'key'} = ""; + $self->{'k_ipad'} = ""; + $self->{'k_opad'} = ""; + + return($outer); +} + +sub hexmac { + my($self) = @_; + + my($inner) = $self->{'hash'}->digest(); + + my($outer) = Crypt::RIPEMD160->hexhash($self->{'k_opad'}.$inner); + + $self->{'key'} = ""; + $self->{'k_ipad'} = ""; + $self->{'k_opad'} = ""; + + return($outer); +} + +1; +__END__ +# Below is the stub of documentation for your module. You better edit it! + +=head1 NAME + +Crypt::RIPEMD160::MAC - Perl extension for RIPEMD-160 MAC function + +=head1 SYNOPSIS + + use Crypt::RIPEMD160::MAC; + + $key = "This is the secret key"; + + $mac = new Crypt::RIPEMD160::MAC($key); + + $mac->reset(); + + $mac->add(LIST); + $mac->addfile(HANDLE); + + $digest = $mac->mac(); + $string = $mac->hexmac(); + +=head1 DESCRIPTION + +The B<Crypt::RIPEMD160> module allows you to use the RIPEMD160 +Message Digest algorithm from within Perl programs. + +=head1 EXAMPLES + + use Crypt::RIPEMD160; + + $ripemd160 = new Crypt::RIPEMD160; + $ripemd160->add('foo', 'bar'); + $ripemd160->add('baz'); + $digest = $ripemd160->digest(); + + print("Digest is " . unpack("H*", $digest) . "\n"); + +The above example would print out the message + + Digest is f137cb536c05ec2bc97e73327937b6e81d3a4cc9 + +provided that the implementation is working correctly. + +=head1 AUTHOR + +The RIPEMD-160 interface was written by Christian H. Geuer +(C<christian.geuer@crypto.gun.de>). + +=head1 SEE ALSO + +MD5(3pm) and SHA(1). + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA.pm new file mode 100755 index 00000000000..5a3d3bcfb9e --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA.pm @@ -0,0 +1,617 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA - Pure-perl implementation of RSA encryption/signing +## algorithms. +## +## Copyright (c) 2000-2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: RSA.pm,v 1.48 2001/09/25 12:44:55 vipul Exp $ + +package Crypt::RSA; +use FindBin qw($Bin); +use lib "$Bin/../../lib"; +use strict; +use base 'Class::Loader'; +use base 'Crypt::RSA::Errorhandler'; +use Crypt::RSA::Key; +use Crypt::RSA::DataFormat qw(steak octet_len); +use Convert::ASCII::Armour; +use Carp; + +$Crypt::RSA::VERSION = '1.99'; # change this elsewhere too! + +my %DEFAULTS = ( + 'ES' => { Name => 'OAEP_ES' }, + 'SS' => { Name => 'PSS_SS' }, + 'PP' => { Name => 'ASCII_PP' }, +); + + +my %KNOWNMAP = ( + + # ENCRYPTION SCHEMES + + OAEP_ES => { Module => "Crypt::RSA::ES::OAEP" }, + PKCS1v21_ES => { Module => "Crypt::RSA::ES::OAEP" }, + PKCS1v15_ES => { Module => "Crypt::RSA::ES::PKCS1v15" }, + + # SIGNATURE SCHEMES + + PSS_SS => { Module => "Crypt::RSA::SS::PSS" }, + PKCS1v21_SS => { Module => "Crypt::RSA::SS::PSS" }, + PKCS1v15_SS => { Module => "Crypt::RSA::SS::PKCS1v15" }, + + # POST PROCESSORS + + ASCII_PP => { Module => "Convert::ASCII::Armour" }, + +); + + +sub new { + + my ($class, %params) = @_; + my %self = (%DEFAULTS, %params); + my $self = bless \%self, $class; + + $self->_storemap (%KNOWNMAP); + + for (qw(ES SS PP)) { + $$self{$_} = { Name => $$self{$_} . "_$_" } unless ref $$self{$_}; + $$self{lc($_)} = $self->_load ( %{$$self{$_}} ); + } + + $$self{keychain} = new Crypt::RSA::Key; + + return bless \%self, $class; + +} + + +sub keygen { + + my ($self, %params) = @_; + $params{KF} = $$self{KF} if $$self{KF}; + + my @keys; + return (@keys = $self->{keychain}->generate (%params)) + ? @keys + : $self->error ($self->{keychain}->errstr); + +} + + +sub encrypt { + + my ($self, %params) = @_; + my $plaintext = $params{Message} || $params{Plaintext}; + my $key = $params{Key}; + + return $self->error ($key->errstr, \%params, $key, \$plaintext) + unless $key->check(); + + my $blocksize = blocksize ( $$self{es}->encryptblock (Key => $key), + length($plaintext) + ); + + return $self->error("Message too long.", \$key, \%params) if $blocksize <= 0; + + my $cyphertext; + my @segments = steak ($plaintext, $blocksize); + for (@segments) { + $cyphertext .= $self->{es}->encrypt (Message => $_, Key => $key) + || return $self->error ($self->{es}->errstr, \$key, \%params); + } + + if ($params{Armour} || $params{Armor}) { + $cyphertext = $self->{pp}->armour ( + Object => 'RSA ENCRYPTED MESSAGE', + Headers => { + Scheme => $$self{ES}{Module} || ${$KNOWNMAP{$$self{ES}{Name}}}{Module}, + Version => $self->{es}->version() + }, + Content => { Cyphertext => $cyphertext }, + Compress => 1, + ); + } + + return $cyphertext; + +} + + +sub decrypt { + + my ($self , %params) = @_; + my $cyphertext = $params{Cyphertext} || $params{Ciphertext}; + my $key = $params{Key}; + + return $self->error ($key->errstr, \%params, $key) unless $key->check(); + + if ($params{Armour} || $params{Armor}) { + my $decoded = $self->{pp}->unarmour ($cyphertext) || + return $self->error ($self->{pp}->errstr()); + $cyphertext = $$decoded{Content}{Cyphertext} + } + + my $plaintext; + my $blocksize = blocksize ( $$self{es}->decryptblock (Key => $key), + length($cyphertext) + ); + + return $self->error("Message too long.") if $blocksize <= 0; + + my @segments = steak ($cyphertext, $blocksize); + for (@segments) { + $plaintext .= $self->{es}->decrypt (Cyphertext=> $_, Key => $key) + || return $self->error ($self->{es}->errstr, \$key, \%params); + } + + return $plaintext; + +} + + +sub sign { + + my ($self, %params) = @_; + my $signature = $self->{ss}->sign (%params) + || return $self->error ($self->{ss}->errstr, + $params{Key}, \%params); + + if ($params{Armour} || $params{Armor}) { + $signature = $self->{pp}->armour ( + Object => "RSA SIGNATURE", + Headers => { + Scheme => $$self{SS}{Module} || ${$KNOWNMAP{$$self{SS}{Name}}}{Module}, + Version => $self->{ss}->version() }, + Content => { Signature => $signature }, + ); + } + + return $signature; + +} + + +sub verify { + + my ($self, %params) = @_; + + if ($params{Armour} || $params{Armor}) { + my $decoded = $self->{pp}->unarmour ($params{Signature}) || + return $self->error ($self->{pp}->errstr()); + $params{Signature} = $$decoded{Content}{Signature} + } + + my $verify = $self->{ss}->verify (%params) || + return $self->error ($self->{ss}->errstr, $params{Key}, \%params); + + return $verify; + +} + + +sub blocksize { + + my ($blocksize, $ptsize) = @_; + return $ptsize if $blocksize == -1; + return 0 if $blocksize < 1; + return $blocksize; + +} + +1; + + +=head1 NAME + +Crypt::RSA - RSA public-key cryptosystem. + +=head1 SYNOPSIS + + my $rsa = new Crypt::RSA; + + my ($public, $private) = + $rsa->keygen ( + Identity => 'Lord Macbeth <macbeth@glamis.com>', + Size => 1024, + Password => 'A day so foul & fair', + Verbosity => 1, + ) or die $rsa->errstr(); + + + my $cyphertext = + $rsa->encrypt ( + Message => $message, + Key => $public, + Armour => 1, + ) || die $rsa->errstr(); + + + my $plaintext = + $rsa->decrypt ( + Cyphertext => $cyphertext, + Key => $private, + Armour => 1, + ) || die $rsa->errstr(); + + + my $signature = + $rsa->sign ( + Message => $message, + Key => $private + ) || die $rsa->errstr(); + + + my $verify = + $rsa->verify ( + Message => $message, + Signature => $signature, + Key => $public + ) || die $rsa->errstr(); + +=head1 NOTE + +This manual assumes familiarity with public-key cryptography and the RSA +algorithm. If you don't know what these are or how they work, please refer +to the sci.crypt FAQ[15]. A formal treatment of RSA can be found in [1]. + +=head1 DESCRIPTION + +Crypt::RSA is a pure-perl, cleanroom implementation of the RSA public-key +cryptosystem. It uses Math::Pari(3), a perl interface to the blazingly +fast PARI library, for big integer arithmetic and number theoretic +computations. + +Crypt::RSA provides arbitrary size key-pair generation, plaintext-aware +encryption (OAEP) and digital signatures with appendix (PSS). For +compatibility with SSLv3, RSAREF2, PGP and other applications that follow +the PKCS #1 v1.5 standard, it also provides PKCS #1 v1.5 encryption and +signatures. + +Crypt::RSA is structured as bundle of modules that encapsulate different +parts of the RSA cryptosystem. The RSA algorithm is implemented in +Crypt::RSA::Primitives(3). Encryption schemes, located under +Crypt::RSA::ES, and signature schemes, located under Crypt::RSA::SS, use +the RSA algorithm to build encryption/signature schemes that employ secure +padding. (See the note on Security of Padding Schemes.) + +The key generation engine and other functions that work on both components +of the key-pair are encapsulated in Crypt::RSA::Key(3). +Crypt::RSA::Key::Public(3) & Crypt::RSA::Key::Private(3) provide +mechanisms for storage & retrival of keys from disk, decoding & encoding +of keys in certain formats, and secure representation of keys in memory. +Finally, the Crypt::RSA module provides a convenient, DWIM wrapper around +the rest of the modules in the bundle. + +=head1 SECURITY OF PADDING SCHEMES + +It has been conclusively shown that textbook RSA is insecure[3,7]. Secure +RSA requires that plaintext is padded in a specific manner before +encryption and signing. There are four main standards for padding: PKCS +#1 v1.5 encryption & signatures, and OAEP encryption & PSS signatures. +Crypt::RSA implements these as four modules that +provide overloaded encrypt(), decrypt(), sign() and verify() methods that +add padding functionality to the basic RSA operations. + +Crypt::RSA::ES::PKCS1v15(3) implements PKCS #1 v1.5 encryption, +Crypt::RSA::SS::PKCS1v15(3) implements PKCS #1 v1.5 signatures, +Crypt::RSA::ES::OAEP(3) implements Optimal Asymmetric Encryption and +Crypt::RSA::SS::PSS(3) Probabilistic Signatures. + +PKCS #1 v1.5 schemes are older and hence more widely deployed, but PKCS #1 +v1.5 encryption has certain flaws that make it vulnerable to +chosen-cyphertext attacks[9]. Even though Crypt::RSA works around these +vulnerabilities, it is recommended that new applications use OAEP and PSS, +both of which are provably secure[13]. In any event, +Crypt::RSA::Primitives (without padding) should never be used directly. + +That said, there exists a scheme called Simple RSA[16] that provides +security without padding. However, Crypt::RSA doesn't implement this +scheme yet. + +=head1 METHODS + +=over 4 + +=item B<new()> + +The constructor. When no arguments are provided, new() returns an object +loaded with default values. This object can be customized by specifying +encryption & signature schemes, key formats and post processors. For +details see the section on B<Customizing the Crypt::RSA +object> later in this manpage. + +=item B<keygen()> + +keygen() generates and returns an RSA key-pair of specified bitsize. +keygen() is a synonym for Crypt::RSA::Key::generate(). Parameters and +return values are described in the Crypt::RSA::Key(3) manpage. + +=item B<encrypt()> + +encrypt() performs RSA encryption on a string of arbitrary length with a +public key using the encryption scheme bound to the object. The default +scheme is OAEP. encrypt() returns cyphertext (a string) on success and +undef on failure. It takes a hash as argument with following keys: + +=over 4 + +=item B<Message> + +An arbitrary length string to be encrypted. + +=item B<Key> + +Public key of the recipient, a Crypt::RSA::Key::Public(3) or +compatible object. + +=item B<Armour> + +A boolean parameter that forces cyphertext through a post processor after +encrpytion. The default post processor is Convert::ASCII::Armour(3) that +encodes binary octets in 6-bit clean ASCII messages. The cyphertext is +returned as-is, when the Armour key is not present. + +=back + +=item B<decrypt()> + +decrypt() performs RSA decryption with a private key using the encryption +scheme bound to the object. The default scheme is OAEP. decrypt() returns +plaintext on success and undef on failure. It takes a hash as argument +with following keys: + +=over 4 + +=item B<Cyphertext> + +Cyphertext of arbitrary length. + +=item B<Key> + +Private key, a Crypt::RSA::Key::Private(3) or compatible object. + +=item B<Armour> + +Boolean parameter that specifies whether the Cyphertext is encoded with a +post processor. + +=back + +=item B<sign()> + +sign() creates an RSA signature on a string with a private key using the +signature scheme bound to the object. The default scheme is +PSS. sign() returns a signature on success and undef on failure. It takes +a hash as argument with following keys: + +=over 4 + +=item B<Message> + +A string of arbitrary length to be signed. + +=item B<Key> + +Private key of the sender, a Crypt::RSA::Key::Private(3) or +compatible object. + +=item B<Armour> + +A boolean parameter that forces the computed signature to be post +processed. + +=back + +=item B<verify()> + +verify() verifies an RSA signature with a public key using the signature +scheme bound to the object. The default scheme is PSS. verify() returns a +true value on success and undef on failure. It takes a hash as argument +with following keys: + +=over 4 + +=item B<Message> + +A signed message, a string of arbitrary length. + +=item B<Key> + +Public key of the signer, a Crypt::RSA::Key::Public(3) or +compatible object. + +=item B<Sign> + +A signature computed with sign(). + +=item B<Armour> + +Boolean parameter that specifies whether the Signature has been +post processed. + +=back + +=back + +=head1 MODULES + +Apart from Crypt::RSA, the following modules are intended for application +developer and end-user consumption: + +=over 4 + +=item B<Crypt::RSA::Key> + +RSA key pair generator. + +=item B<Crypt::RSA::Key::Public> + +RSA Public Key Management. + +=item B<Crypt::RSA::Key::Private> + +RSA Private Key Management. + +=item B<Crypt::RSA::ES::OAEP> + +Plaintext-aware encryption with RSA. + +=item B<Crypt::RSA::SS::PSS> + +Probabilistic Signature Scheme based on RSA. + +=item B<Crypt::RSA::ES::PKCS1v15> + +PKCS #1 v1.5 encryption scheme. + +=item B<Crypt::RSA::SS::PKCS1v15> + +PKCS #1 v1.5 signature scheme. + +=back + +=head1 CUSTOMISING A CRYPT::RSA OBJECT + +A Crypt::RSA object can be customized by passing any of the following keys +in a hash to new(): ES to specify the encryption scheme, SS to specify the +signature scheme, PP to specify the post processor, and KF to specify the +key format. The value associated with these keys can either be a name (a +string) or a hash reference that specifies a module name, its constructor, +and constructor arguments. For example: + + my $rsa = new Crypt::RSA ( ES => 'OAEP' ); + + or + + my $rsa = new Crypt::RSA ( ES => { Module => 'Crypt::RSA::ES::OAEP' } ); + +A module thus specified need not be included in the Crypt::RSA bundle, but +it must be interface compatible with the ones provided with Crypt::RSA. + +As of this writing, the following names are recognised: + +=over 4 + +=item B<ES> (Encryption Scheme) + + 'OAEP', 'PKCS1v15' + +=item B<SS> (Signature Scheme) + + 'PSS', 'PKCS1v15' + +=item B<KF> (Key Format) + + 'Native', 'SSH' + +=item B<PP> (Post Processor) + + 'ASCII' + +=back + +=head1 ERROR HANDLING + +All modules in the Crypt::RSA bundle use a common error handling method +(implemented in Crypt::RSA::Errorhandler(3)). When a method fails it +returns undef and calls $self->error() with the error message. This error +message is available to the caller through the errstr() method. For more +details see the Crypt::RSA::Errorhandler(3) manpage. + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=head1 ACKNOWLEDGEMENTS + +Thanks to Ilya Zakharevich for help with Math::Pari, Benjamin Trott for +several patches including SSH key support, Genèche Ramanoudjame for +extensive testing and numerous bug reports, Shizukesa on #perl for +suggesting the error handling method used in this module, and Dave Paris +for good advice. + +=head1 LICENSE + +Copyright (c) 2000-2008, Vipul Ved Prakash. This code is free software; +it is distributed under the same license as Perl itself. + +I have received requests for commercial licenses of +Crypt::RSA, from those who desire contractual support and +indemnification. I'd be happy to provide a commercial license +if you need one. Please send me mail at C<mail@vipul.net> with +the subject "Crypt::RSA license". Please don't send me mail +asking if you need a commercial license. You don't, if +Artistic of GPL suit you fine. + +=head1 SEE ALSO + +Crypt::RSA::Primitives(3), Crypt::RSA::DataFormat(3), +Crypt::RSA::Errorhandler(3), Crypt::RSA::Debug(3), Crypt::Primes(3), +Crypt::Random(3), Crypt::CBC(3), Crypt::Blowfish(3), +Tie::EncryptedHash(3), Convert::ASCII::Armour(3), Math::Pari(3), +Class::Loader(3), crypt-rsa-interoperability(3), +crypt-rsa-interoperability-table(3). + +=head1 REPORTING BUGS + +All bug reports related to Crypt::RSA should go to rt.cpan.org +at C<http://rt.cpan.org/Dist/Display.html?Queue=Crypt-RSA> + +Crypt::RSA is considered to be stable. If you are running into a +problem, it's likely of your own making. Please check your code +and consult the documentation before posting a bug report. A +google search with the error message might also shed light if it +is a common mistake that you've made. + +If the module installation fails with a "Segmentation Fault" or +"Bus Error", it is likely a Math::Pari issue. Please consult +Math::Pari bugs on rt.cpan.org or open a bug there. There have +been known issues on HP-UX and SunOS systems (with Math::Pari), +so if you are on those OSes, please consult Math::Pari +resources before opening a Crypt::RSA bug. + +=head1 BIBLIOGRAPHY + +Chronologically sorted (for the most part). + +=over 4 + +=item 1 B<R. Rivest, A. Shamir, L. Aldeman.> A Method for Obtaining Digital Signatures and Public-Key Cryptosystems (1978). + +=item 2 B<U. Maurer.> Fast Generation of Prime Numbers and Secure Public-Key Cryptographic Parameters (1994). + +=item 3 B<M. Bellare, P. Rogaway.> Optimal Asymmetric Encryption - How to Encrypt with RSA (1995). + +=item 4 B<M. Bellare, P. Rogaway.> The Exact Security of Digital Signatures - How to sign with RSA and Rabin (1996). + +=item 5 B<B. Schneier.> Applied Cryptography, Second Edition (1996). + +=item 6 B<A. Menezes, P. Oorschot, S. Vanstone.> Handbook of Applied Cryptography (1997). + +=item 7 B<D. Boneh.> Twenty Years of Attacks on the RSA Cryptosystem (1998). + +=item 8 B<D. Bleichenbacher, M. Joye, J. Quisquater.> A New and Optimal Chosen-message Attack on RSA-type Cryptosystems (1998). + +=item 9 B<B. Kaliski, J. Staddon.> Recent Results on PKCS #1: RSA Encryption Standard, RSA Labs Bulletin Number 7 (1998). + +=item 10 B<B. Kaliski, J. Staddon.> PKCS #1: RSA Cryptography Specifications v2.0, RFC 2437 (1998). + +=item 11 B<SSH Communications Security.> SSH 1.2.7 source code (1998). + +=item 12 B<S. Simpson.> PGP DH vs. RSA FAQ v1.5 (1999). + +=item 13 B<RSA Laboratories.> Draft I, PKCS #1 v2.1: RSA Cryptography Standard (1999). + +=item 14 B<E. Young, T. Hudson, OpenSSL Team.> OpenSSL 0.9.5a source code (2000). + +=item 15 B<Several Authors.> The sci.crypt FAQ at +http://www.faqs.org/faqs/cryptography-faq/part01/index.html + +=item 16 B<Victor Shoup.> A Proposal for an ISO Standard for Public Key Encryption (2001). + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/DataFormat.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/DataFormat.pm new file mode 100755 index 00000000000..07edffd5340 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/DataFormat.pm @@ -0,0 +1,194 @@ +#!/usr/bin/perl -s +## +## Crypt::RSA::DataFormat -- Functions for converting, shaping and +## creating and reporting data formats. +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: DataFormat.pm,v 1.13 2001/05/20 23:37:45 vipul Exp $ + +package Crypt::RSA::DataFormat; +use vars qw(@ISA); +use Math::Pari qw(PARI pari2pv floor pari2num); +use Crypt::Random qw(makerandom); +use Digest::SHA1 qw(sha1); +use Carp; +require Exporter; +@ISA = qw(Exporter); + +@EXPORT_OK = qw(i2osp os2ip h2osp octet_xor octet_len bitsize + generate_random_octet mgf1 steak); + + +sub i2osp { + my $num = PARI(shift); + my $d = $num; + my $l = shift || 0; + my $base = PARI(256); my $result = ''; + if ($l) { return if $num > $base ** $l } + + do { + my $r = $d % $base; + $d = ($d-$r) / $base; + $result = chr($r) . $result; + } until ($d < $base); + $result = chr($d) . $result if $d != 0; + + if (length($result) < $l) { + $result = chr(0)x($l-length($result)) . $result; + } + return $result; +} + + +sub os2ip { + my $string = shift; + my $base = PARI(256); + my $result = 0; + my $l = length($string); + for (0 .. $l-1) { + my ($c) = unpack "x$_ a", $string; + my $a = int(ord($c)); + my $val = int($l-$_-1); + $result += $a * ($base**$val); + } + return $result; +} + + +sub h2osp { + my $hex = shift; + $hex =~ s/[ \n]//ig; + my $num = Math::Pari::_hex_cvt($hex); + return i2osp ($num); +} + + +sub generate_random_octet { + my ( $l, $str ) = @_; + my $r = makerandom ( Size => int($l*8), Strength => $str ); + return i2osp ($r, $l); +} + + +sub bitsize ($) { + return pari2num(floor(Math::Pari::log(shift)/Math::Pari::log(2)) + 1); +} + + +sub octet_len { + return pari2num(floor(PARI((bitsize(shift)+7)/8))); +} + + +sub octet_xor { + my ($a, $b) = @_; my @xor; + my @ba = split //, unpack "B*", $a; + my @bb = split //, unpack "B*", $b; + if (@ba != @bb) { + if (@ba < @bb) { + for (1..@bb-@ba) { unshift @ba, '0' } + } else { + for (1..@ba-@bb) { unshift @bb, '0' } + } + } + for (0..$#ba) { + $xor[$_] = ($ba[$_] xor $bb[$_]) || 0; + } + return pack "B*", join '',@xor; +} + + +sub mgf1 { + my ($seed, $l) = @_; + my $hlen = 20; my ($T, $i) = ("",0); + while ($i <= $l) { + my $C = i2osp (int($i), 4); + $T .= sha1("$seed$C"); + $i += $hlen; + } + my ($output) = unpack "a$l", $T; + return $output; +} + + +sub steak { + my ($text, $blocksize) = @_; + my $textsize = length($text); + my $chunkcount = $textsize % $blocksize + ? int($textsize/$blocksize) + 1 : $textsize/$blocksize; + my @segments = unpack "a$blocksize"x$chunkcount, $text; + return @segments; +} + +1; + +=head1 NAME + +Crypt::RSA::DataFormat - Data creation, conversion and reporting primitives. + +=head1 DESCRIPTION + +This module implements several data creation, conversion and reporting +primitives used throughout the Crypt::RSA implementation. Primitives are +available as exportable functions. + +=head1 FUNCTIONS + +=over 4 + +=item B<i2osp> Integer, Length + +Integer To Octet String Primitive. Converts an integer into its +equivalent octet string representation of length B<Length>. If +necessary, the resulting string is prefixed with nulls. If +B<Length> is not provided, returns an octet string of shortest +possible length. + +=item B<h2osp> Hex String + +Hex To Octet String Primitive. Converts a I<hex string> into its +equivalent octet string representation and returns an octet +string of shortest possible length. The hex string is not +prefixed with C<0x>, etc. + +=item B<os2ip> String + +Octet String to Integer Primitive. Converts an octet string into its +equivalent integer representation. + +=item B<generate_random_octet> Length, Strength + +Generates a random octet string of length B<Length>. B<Strength> specifies +the degree of randomness. See Crypt::Random(3) for an explanation of the +B<Strength> parameter. + +=item B<bitsize> Integer + +Returns the length of the B<Integer> in bits. + +=item B<octet_len> Integer + +Returns the octet length of the integer. If the length is not a whole +number, the fractional part is dropped to make it whole. + +=item B<octet_xor> String1, String2 + +Returns the result of B<String1> XOR B<String2>. + +=item B<steak> String, Length + +Returns an array of segments of length B<Length> from B<String>. The final +segment can be smaller than B<Length>. + +=back + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/Debug.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/Debug.pm new file mode 100755 index 00000000000..f264088102c --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/Debug.pm @@ -0,0 +1,84 @@ +#!/usr/bin/perl -s +## +## Crypt::RSA::Debug +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: Debug.pm,v 1.9 2001/04/09 22:21:49 vipul Exp $ + +package Crypt::RSA::Debug; +use strict; +use vars qw(@ISA @EXPORT_OK); +require Exporter; +@ISA = qw(Exporter); + +@EXPORT_OK = qw(debug debuglevel); + +my $DEBUG = 0; + +sub debug{ + return undef unless $DEBUG; + my ($caller, undef) = caller; + my (undef,undef,$line,$sub) = caller(1); $sub =~ s/.*://; + $sub = sprintf "%12s()%4d", $sub, $line; + $sub .= " | " . (shift); + $sub =~ s/\x00/[0]/g; + $sub =~ s/\x01/[1]/g; + $sub =~ s/\x02/[2]/g; + $sub =~ s/\x04/[4]/g; + $sub =~ s/\x05/[5]/g; + $sub =~ s/\xff/[-]/g; + $sub =~ s/[\x00-\x1f]/\./g; + $sub =~ s/[\x7f-\xfe]/_/g; + print "$sub\n"; +} + + +sub debuglevel { + + my ($level) = shift; + $DEBUG = $level; + +} + + +=head1 NAME + +Crypt::RSA::Debug - Debug routine for Crypt::RSA. + +=head1 SYNOPSIS + + use Crypt::RSA::Debug qw(debug); + debug ("oops!"); + +=head1 DESCRIPTION + +The module provides support for the I<print> method of debugging! + +=head1 FUNCTION + +=over 4 + +=item B<debug> String + +Prints B<String> on STDOUT, along with caller's function name and line number. + +=item B<debuglevel> Integer + +Sets the class data I<debuglevel> to specified value. The value +defaults to 0. Callers can use the debuglevel facility by +comparing $Crypt::RSA::DEBUG to the desired debug level before +generating a debug statement. + +=back + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=cut + +1; + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/ES/OAEP.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/ES/OAEP.pm new file mode 100755 index 00000000000..98b980c0575 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/ES/OAEP.pm @@ -0,0 +1,289 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA::ES::OAEP +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: OAEP.pm,v 1.24 2001/06/22 23:27:37 vipul Exp $ + +package Crypt::RSA::ES::OAEP; +use strict; +use base 'Crypt::RSA::Errorhandler'; +use Crypt::Random qw(makerandom_octet); +use Crypt::RSA::DataFormat qw(bitsize os2ip i2osp octet_xor mgf1 octet_len); +use Crypt::RSA::Primitives; +use Crypt::RSA::Debug qw(debug); +use Digest::SHA1 qw(sha1); +use Math::Pari qw(floor); +use Sort::Versions qw(versioncmp); +use Carp; + +$Crypt::RSA::ES::OAEP::VERSION = '1.99'; + +sub new { + my ($class, %params) = @_; + my $self = bless { primitives => new Crypt::RSA::Primitives, + P => "", + hlen => 20, + VERSION => $Crypt::RSA::ES::OAEP::VERSION, + }, $class; + if ($params{Version}) { + if (versioncmp($params{Version}, '1.15') == -1) { + $$self{P} = "Crypt::RSA"; + $$self{VERSION} = $params{Version}; + } elsif (versioncmp($params{Version}, $$self{VERSION}) == 1) { + croak "Required version ($params{Version}) greater than installed version ($$self{VERSION}) of $class.\n"; + } + } + return $self; +} + + +sub encrypt { + my ($self, %params) = @_; + my $key = $params{Key}; my $M = $params{Message} || $params{Plaintext}; + return $self->error ("Missing Message or Plaintext parameter", \$key, \%params) unless $M; + return $self->error ($key->errstr, \$M, $key, \%params) unless $key->check; + my $k = octet_len ($key->n); debug ("octet_len of modulus: $k"); + my $em = $self->encode ($M, $self->{P}, $k-1) || + return $self->error ($self->errstr, \$M, $key, \%params); + my $m = os2ip ($em); + my $c = $self->{primitives}->core_encrypt ( Plaintext => $m, Key => $key ); + my $ec = i2osp ($c, $k); debug ("ec: $ec"); + return $ec; +} + + +sub decrypt { + my ($self, %params) = @_; + my $key = $params{Key}; my $C = $params{Cyphertext} || $params{Ciphertext}; + return $self->error ("Missing Cyphertext or Ciphertext parameter", \$key, \%params) unless $C; + return $self->error ($key->errstr, $key, \%params) unless $key->check; + my $k = octet_len ($key->n); + my $c = os2ip ($C); + if (bitsize($c) > bitsize($key->n)) { + return $self->error ("Decryption error.", $key, \%params) + } + my $m = $self->{primitives}->core_decrypt (Cyphertext => $c, Key => $key) || + return $self->error ("Decryption error.", $key, \%params); + my $em = i2osp ($m, $k-1) || + return $self->error ("Decryption error.", $key, \%params); + my $M; $self->errstrrst; # reset the errstr + unless ($M = $self->decode ($em, $$self{P})) { + return $self->error ("Decryption error.", $key, \%params) if $self->errstr(); + return $M; + } + return $M; +} + + +sub encode { + my ($self, $M, $P, $emlen) = @_; + my $hlen = $$self{hlen}; + my $mlen = length($M); + return $self->error ("Message too long.", \$P, \$M) if $mlen > $emlen-(2*$hlen)-1; + my ($PS, $pslen) = ("", 0); + if ($pslen = $emlen-(2*$hlen+1+$mlen)) { + $PS = chr(0)x$pslen; + } + my $phash = $self->hash ($P); + my $db = $phash . $PS . chr(1) . $M; + my $seed = makerandom_octet (Length => $hlen); + my $dbmask = $self->mgf ($seed, $emlen-$hlen); + my $maskeddb = octet_xor ($db, $dbmask); + my $seedmask = $self->mgf ($maskeddb, $hlen); + my $maskedseed = octet_xor ($seed, $seedmask); + my $em = $maskedseed . $maskeddb; + + debug ("emlen == $emlen"); + debug ("M == $M [" . length($M) . "]"); + debug ("PS == $PS [$pslen]"); + debug ("phash == $phash [" . length($phash) . "]"); + debug ("seed == $seed [" . length($seed) . "]"); + debug ("seedmask == $seedmask [" . length($seedmask) . "]"); + debug ("db == $db [" . length($db) . "]"); + debug ("dbmask == $dbmask [" . length($dbmask) . "]"); + debug ("maskeddb == $maskeddb [" . length($maskeddb) . "]"); + debug ("em == $em [" . length($em) . "]"); + + return $em; +} + + +sub decode { + my ($self, $em, $P) = @_; + my $hlen = $$self{hlen}; + + debug ("P == $P"); + return $self->error ("Decoding error.", \$P) if length($em) < 2*$hlen+1; + my $maskedseed = substr $em, 0, $hlen; + my $maskeddb = substr $em, $hlen; + my $seedmask = $self->mgf ($maskeddb, $hlen); + my $seed = octet_xor ($maskedseed, $seedmask); + my $dbmask = $self->mgf ($seed, length($em) - $hlen); + my $db = octet_xor ($maskeddb, $dbmask); + my $phash = $self->hash ($P); + + debug ("em == $em [" . length($em) . "]"); + debug ("phash == $phash [" . length($phash) . "]"); + debug ("seed == $seed [" . length($seed) . "]"); + debug ("seedmask == $seedmask [" . length($seedmask) . "]"); + debug ("maskedseed == $maskedseed [" . length($maskedseed) . "]"); + debug ("db == $db [" . length($db) . "]"); + debug ("maskeddb == $maskeddb [" . length($maskeddb) . "]"); + debug ("dbmask == $dbmask [" . length($dbmask) . "]"); + + my ($phashorig) = substr $db, 0, $hlen; + debug ("phashorig == $phashorig [" . length($phashorig) . "]"); + return $self->error ("Decoding error.", \$P) unless $phashorig eq $phash; + $db = substr $db, $hlen; + my ($chr0, $chr1) = (chr(0), chr(1)); + my ($ps, $m); + debug ("db == $db [" . length($db) . "]"); + unless ( ($ps, undef, $m) = $db =~ /^($chr0*)($chr1)(.*)$/s ) { + return $self->error ("Decoding error.", \$P); + } + + return $m; +} + + +sub hash { + my ($self, $data) = @_; + return sha1 ($data); +} + + +sub mgf { + my ($self, @data) = @_; + return mgf1 (@data); +} + + +sub encryptblock { + my ($self, %params) = @_; + return octet_len ($params{Key}->n) - 42; +} + + +sub decryptblock { + my ($self, %params) = @_; + return octet_len ($params{Key}->n); +} + + +# should be able to call this as a class method. +sub version { + my $self = shift; + return $self->{VERSION}; +} + + +1; + +=head1 NAME + +Crypt::RSA::ES::OAEP - Plaintext-aware encryption with RSA. + +=head1 SYNOPSIS + + my $oaep = new Crypt::RSA::ES::OAEP; + + my $ct = $oaep->encrypt( Key => $key, Message => $message ) || + die $oaep->errstr; + + my $pt = $oaep->decrypt( Key => $key, Cyphertext => $ct ) || + die $oaep->errstr; + +=head1 DESCRIPTION + +This module implements Optimal Asymmetric Encryption, a plaintext-aware +encryption scheme based on RSA. The notion of plaintext-aware implies it's +computationally infeasible to obtain full or partial information about a +message from a cyphertext, and computationally infeasible to generate a +valid cyphertext without knowing the corresponding message. +Plaintext-aware schemes, such as OAEP, are semantically secure, +non-malleable and secure against chosen-ciphertext attack. For more +information on OAEP and plaintext-aware encryption, see [3], [9] & [13]. + +=head1 METHODS + +=head2 B<new()> + +Constructor. + +=head2 B<version()> + +Returns the version number of the module. + +=head2 B<encrypt()> + +Encrypts a string with a public key and returns the encrypted string +on success. encrypt() takes a hash argument with the following +mandatory keys: + +=over 4 + +=item B<Message> + +A string to be encrypted. The length of this string should not exceed k-42 +octets, where k is the octet length of the RSA modulus. If Message is +longer than k-42, the method will fail and set $self->errstr to "Message +too long." This means the key must be at least _336_ bits long if you are +to use OAEP. + +=item B<Key> + +Public key of the recipient, a Crypt::RSA::Key::Public object. + +=back + +=head2 B<decrypt()> + +Decrypts cyphertext with a private key and returns plaintext on +success. $self->errstr is set to "Decryption Error." or appropriate +error on failure. decrypt() takes a hash argument with the following +mandatory keys: + +=over 4 + +=item B<Cyphertext> + +A string encrypted with encrypt(). The length of the cyphertext must be k +octets, where k is the length of the RSA modulus. + +=item B<Key> + +Private key of the receiver, a Crypt::RSA::Key::Private object. + +=item B<Version> + +Version of the module that was used for creating the Cyphertext. This is +an optional argument. When present, decrypt() will ensure before +proceeding that the installed version of the module can successfully +decrypt the Cyphertext. + +=back + +=head1 ERROR HANDLING + +See ERROR HANDLING in Crypt::RSA(3) manpage. + +=head1 BIBLIOGRAPHY + +See BIBLIOGRAPHY in Crypt::RSA(3) manpage. + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=head1 SEE ALSO + +Crypt::RSA(3), Crypt::RSA::Primitives(3), Crypt::RSA::Keys(3), +Crypt::RSA::SSA::PSS(3) + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/ES/PKCS1v15.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/ES/PKCS1v15.pm new file mode 100755 index 00000000000..345c8dc4e14 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/ES/PKCS1v15.pm @@ -0,0 +1,215 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA::ES::PKCS1v15 +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: PKCS1v15.pm,v 1.10 2001/06/22 23:27:37 vipul Exp $ + +package Crypt::RSA::ES::PKCS1v15; +use strict; +use base 'Crypt::RSA::Errorhandler'; +use Crypt::Random qw(makerandom_octet); +use Crypt::RSA::DataFormat qw(bitsize octet_len os2ip i2osp); +use Crypt::RSA::Primitives; +use Crypt::RSA::Debug qw(debug); +use Math::Pari qw(floor); +use Sort::Versions qw(versioncmp); +use Carp; + +$Crypt::RSA::ES::PKCS1v15::VERSION = '1.99'; + +sub new { + my ($class, %params) = @_; + my $self = bless { primitives => new Crypt::RSA::Primitives, + VERSION => $Crypt::RSA::ES::PKCS1v15::VERSION, + }, $class; + if ($params{Version}) { + # do versioning here. + } + return $self; +} + + +sub encrypt { + my ($self, %params) = @_; + my $key = $params{Key}; my $M = $params{Message} || $params{Plaintext}; + return $self->error ("No Message or Plaintext parameter", \$key, \%params) unless $M; + return $self->error ($key->errstr, \$M, $key, \%params) unless $key->check; + my $k = octet_len ($key->n); debug ("octet_len of modulus: $k"); + my $em = $self->encode ($M, $k-1) || + return $self->error ($self->errstr, \$M, $key, \%params); + debug ("encoded: $em"); + my $m = os2ip ($em); + my $c = $self->{primitives}->core_encrypt (Plaintext => $m, Key => $key); + my $ec = i2osp ($c, $k); debug ("cyphertext: $ec"); + return $ec; +} + + +sub decrypt { + my ($self, %params) = @_; + my $key = $params{Key}; my $C = $params{Cyphertext} || $params{Ciphertext}; + return $self->error ("No Cyphertext or Ciphertext parameter", \$key, \%params) unless $C; + return $self->error ($key->errstr, $key, \%params) unless $key->check; + my $k = octet_len ($key->n); + my $c = os2ip ($C); + debug ("bitsize(c): " . bitsize($c)); + debug ("bitsize(n): " . bitsize($key->n)); + if (bitsize($c) > bitsize($key->n)) { + return $self->error ("Decryption error.", $key, \%params) + } + my $m = $self->{primitives}->core_decrypt (Cyphertext => $c, Key => $key) || + return $self->error ("Decryption error.", $key, \%params); + my $em = i2osp ($m, $k-1) || + return $self->error ("Decryption error.", $key, \%params); + my $M; $self->errstrrst; # reset the errstr + unless ($M = $self->decode ($em)) { + return $self->error ("Decryption error.", $key, \%params) if $self->errstr(); + return $M; + } + return $M; +} + + +sub encode { + my ($self, $M, $emlen) = @_; + $M = $M || ""; my $mlen = length($M); + return $self->error ("Message too long.", \$M) if $mlen > $emlen-10; + my ($PS, $pslen) = ("", 0); + + $pslen = $emlen-$mlen-2; + $PS = makerandom_octet (Length => $pslen, Skip => chr(0)); + my $em = chr(2).$PS.chr(0).$M; + return $em; +} + + +sub decode { + my ($self, $em) = @_; + + return $self->error ("Decoding error.") if length($em) < 10; + + debug ("to decode: $em"); + my ($chr0, $chr2) = (chr(0), chr(2)); + my ($ps, $M); + unless ( ($ps, $M) = $em =~ /^$chr2(.*?)$chr0(.*)$/s ) { + return $self->error ("Decoding error."); + } + return $self->error ("Decoding error.") if length($ps) < 8; + return $M; +} + + +sub encryptblock { + my ($self, %params) = @_; + return octet_len ($params{Key}->n) - 11; +} + + +sub decryptblock { + my ($self, %params) = @_; + return octet_len ($params{Key}->n); +} + + +sub version { + my $self = shift; + return $self->{VERSION}; +} + + +1; + +=head1 NAME + +Crypt::RSA::ES::PKCS1v15 - PKCS #1 v1.5 padded encryption scheme based on RSA. + +=head1 SYNOPSIS + + my $pkcs = new Crypt::RSA::ES::PKCS1v15; + + my $ct = $pkcs->encrypt( Key => $key, Message => $message ) || + die $pkcs->errstr; + + my $pt = $pkcs->decrypt( Key => $key, Cyphertext => $ct ) || + die $pkcs->errstr; + +=head1 DESCRIPTION + +This module implements PKCS #1 v1.5 padded encryption scheme based on RSA. +See [13] for details on the encryption scheme. + +=head1 METHODS + +=head2 B<new()> + +Constructor. + +=head2 B<version()> + +Returns the version number of the module. + +=head2 B<encrypt()> + +Encrypts a string with a public key and returns the encrypted string +on success. encrypt() takes a hash argument with the following +mandatory keys: + +=over 4 + +=item B<Message> + +A string to be encrypted. The length of this string should not exceed k-10 +octets, where k is the octet length of the RSA modulus. If Message is +longer than k-10, the method will fail and set $self->errstr to "Message +too long." + +=item B<Key> + +Public key of the recipient, a Crypt::RSA::Key::Public object. + +=back + +=head2 B<decrypt()> + +Decrypts cyphertext with a private key and returns plaintext on +success. $self->errstr is set to "Decryption Error." or appropriate +error on failure. decrypt() takes a hash argument with the following +mandatory keys: + +=over 4 + +=item B<Cyphertext> + +A string encrypted with encrypt(). The length of the cyphertext must be k +octets, where k is the length of the RSA modulus. + +=item B<Key> + +Private key of the receiver, a Crypt::RSA::Key::Private object. + +=back + +=head1 ERROR HANDLING + +See ERROR HANDLING in Crypt::RSA(3) manpage. + +=head1 BIBLIOGRAPHY + +See BIBLIOGRAPHY in Crypt::RSA(3) manpage. + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=head1 SEE ALSO + +Crypt::RSA(3), Crypt::RSA::Primitives(3), Crypt::RSA::Keys(3), +Crypt::RSA::SSA::PSS(3) + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/Errorhandler.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/Errorhandler.pm new file mode 100755 index 00000000000..87df0e00b0b --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/Errorhandler.pm @@ -0,0 +1,135 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA::Errorhandler -- Base class that provides error +## handling functionality. +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: Errorhandler.pm,v 1.5 2001/06/22 23:27:35 vipul Exp $ + +package Crypt::RSA::Errorhandler; +use strict; + +sub new { + bless {}, shift +} + + +sub error { + my ($self, $errstr, @towipe) = @_; + $$self{errstr} = "$errstr\n"; + for (@towipe) { + my $var = $_; + if (ref($var) =~ /Crypt::RSA/) { + $var->DESTROY(); + } elsif (ref($var) eq "SCALAR") { + $$var = ""; + } elsif (ref($var) eq "ARRAY") { + @$var = (); + } elsif (ref($var) eq "HASH") { + %$var = (); + } + } + return; +} + + +sub errstr { + my $self = shift; + return $$self{errstr}; +} + +sub errstrrst { + my $self = shift; + $$self{errstr} = ""; +} + +1; + + +=head1 NAME + +Crypt::RSA::Errorhandler - Error handling mechanism for Crypt::RSA. + +=head1 SYNOPSIS + + package Foo; + + use Crypt::RSA::Errorhandler; + @ISA = qw(Crypt::RSA::Errorhandler); + + sub alive { + .. + .. + return + $self->error ("Awake, awake! Ring the alarum bell. \ + Murther and treason!", $dagger) + if $self->murdered($king); + } + + + package main; + + use Foo; + my $foo = new Foo; + $foo->alive($king) or print $foo->errstr(); + # prints "Awake, awake! ... " + +=head1 DESCRIPTION + +Crypt::RSA::Errorhandler encapsulates the error handling mechanism used +by the modules in Crypt::RSA bundle. Crypt::RSA::Errorhandler doesn't +have a constructor and is meant to be inherited. The derived modules use +its two methods, error() and errstr(), to communicate error messages to +the caller. + +When a method of the derived module fails, it calls $self->error() and +returns undef to the caller. The error message passed to error() is made +available to the caller through the errstr() accessor. error() also +accepts a list of sensitive data that it wipes out (undef'es) before +returning. + +The caller should B<never> call errstr() to check for errors. errstr() +should be called only when a method indicates (usually through an undef +return value) that an error has occured. This is because errstr() is +never overwritten and will always contain a value after the occurance of +first error. + +=head1 METHODS + +=over 4 + +=item B<new()> + +Barebones constructor. + +=item B<error($mesage, ($wipeme, $wipemetoo))> + +The first argument to error() is $message which is placed in $self- +>{errstr} and the remaining arguments are interpretted as +variables containing sensitive data that are wiped out from the +memory. error() always returns undef. + +=item B<errstr()> + +errstr() is an accessor method for $self->{errstr}. + +=item B<errstrrst()> + +This method sets $self->{errstr} to an empty string. + +=back + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=head1 SEE ALSO + +Crypt::RSA(3) + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/Key.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/Key.pm new file mode 100755 index 00000000000..caee6cdb5d0 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/Key.pm @@ -0,0 +1,231 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA::Keys +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: Key.pm,v 1.13 2001/05/25 00:20:40 vipul Exp $ + +package Crypt::RSA::Key; +use strict; +use base 'Class::Loader'; +use base 'Crypt::RSA::Errorhandler'; +use Crypt::Primes qw(rsaparams); +use Crypt::RSA::DataFormat qw(bitsize); +use Math::Pari qw(PARI Mod lift); +use Crypt::RSA::Key::Private; +use Crypt::RSA::Key::Public; + +$Crypt::RSA::Key::VERSION = '1.99'; + +my %MODMAP = ( + Native_PKF => { Module => "Crypt::RSA::Key::Public" }, + Native_SKF => { Module => "Crypt::RSA::Key::Private" }, + SSH_PKF => { Module => "Crypt::RSA::Key::Public::SSH" }, + SSH_SKF => { Module => "Crypt::RSA::Key::Private::SSH" }, +); + + +sub new { + my $class = shift; + my $self = {}; + bless $self, $class; + $self->_storemap ( %MODMAP ); + return $self; +} + + +sub generate { + + my ($self, %params) = @_; + + my $key; + unless ($params{q} && $params{p} && $params{e}) { + + return $self->error ("Missing argument.") unless $params{Size}; + + return $self->error ("Keysize too small.") if + $params{Size} < 48; + + return $self->error ("Odd keysize.") if + $params{Size} % 2; + + my $size = int($params{Size}/2); + my $verbosity = $params{Verbosity} || 0; + + my $cbitsize = 0; + while (!($cbitsize)) { + $key = rsaparams ( Size => $size, Verbosity => $verbosity ); + my $n = $$key{p} * $$key{q}; + $cbitsize = 1 if bitsize($n) == $params{Size} + } + + } + + if ($params{KF}) { + $params{PKF} = { Name => "$params{KF}_PKF" }; + $params{SKF} = { Name => "$params{KF}_SKF" } + } + + my $pubload = $params{PKF} ? $params{PKF} : { Name => "Native_PKF" }; + my $priload = $params{SKF} ? $params{SKF} : { Name => "Native_SKF" }; + + my $pubkey = $self->_load (%$pubload) || + return $self->error ("Couldn't load the public key module."); + my $prikey = $self->_load ((%$priload), Args => ['Cipher' => $params{Cipher}, 'Password', $params{Password} ]) || + return $self->error ("Couldn't load the private key module."); + $pubkey->Identity ($params{Identity}); + $prikey->Identity ($params{Identity}); + + $pubkey->e ($$key{e} || $params{e}); + $prikey->e ($$key{e} || $params{e}); + $prikey->p ($$key{p} || $params{p}); + $prikey->q ($$key{q} || $params{q}); + + $prikey->phi (($prikey->p - 1) * ($prikey->q - 1)); + my $m = Mod (1, $prikey->phi); + + $prikey->d (lift($m/$pubkey->e)); + $prikey->n ($prikey->p * $prikey->q); + $pubkey->n ($prikey->n); + + $prikey->dp ($prikey->d % ($prikey->p - 1)); + $prikey->dq ($prikey->d % ($prikey->q - 1)); + $prikey->u (mod_inverse($prikey->p, $prikey->q)); + + return $self->error ("d is too small. Regenerate.") if + bitsize($prikey->d) < 0.25 * bitsize($prikey->n); + + $$key{p} = 0; $$key{q} = 0; $$key{e} = 0; $m = 0; + + if ($params{Filename}) { + $pubkey->write (Filename => "$params{Filename}.public"); + $prikey->write (Filename => "$params{Filename}.private"); + } + + return ($pubkey, $prikey); + +} + + +sub mod_inverse { + my($a, $n) = @_; + my $m = Mod(1, $n); + lift($m / $a); +} + + +1; + +=head1 NAME + +Crypt::RSA::Key - RSA Key Pair Generator. + +=head1 SYNOPSIS + + my $keychain = new Crypt::RSA::Key; + my ($public, $private) = $keychain->generate ( + Identity => 'Lord Macbeth <macbeth@glamis.com>', + Size => 2048, + Password => 'A day so foul & fair', + Verbosity => 1, + ) or die $keychain->errstr(); + +=head1 DESCRIPTION + +This module provides a method to generate an RSA key pair. + +=head1 METHODS + +=head2 new() + +Constructor. + +=head2 generate() + +generate() generates an RSA key of specified bitsize. It returns a list of +two elements, a Crypt::RSA::Key::Public object that holds the public part +of the key pair and a Crypt::RSA::Key::Private object that holds that +private part. On failure, it returns undef and sets $self->errstr to +appropriate error string. generate() takes a hash argument with the +following keys: + +=over 4 + +=item B<Size> + +Bitsize of the key to be generated. This should be an even integer > 48. +Bitsize is a mandatory argument. + +=item B<Password> + +String with which the private key will be encrypted. If Password is not +provided the key will be stored unencrypted. + +=item B<Identity> + +A string that identifies the owner of the key. This string usually takes +the form of a name and an email address. The identity is not bound to the +key with a signature. However, a future release or another module will +provide this facility. + +=item B<Cipher> + +The block cipher which is used for encrypting the private key. Defaults to +`Blowfish'. Cipher could be set to any value that works with Crypt::CBC(3) +and Tie::EncryptedHash(3). + +=item B<Verbosity> + +When set to 1, generate() will draw a progress display on STDOUT. + +=item B<Filename> + +The generated key pair will be written to disk, in $Filename.public and +$Filename.private files, if this argument is provided. Disk writes can be +deferred by skipping this argument and achieved later with the write() +method of Crypt::RSA::Key::Public(3) and Crypt::RSA::Key::Private(3). + +=item B<KF> + +A string that specifies the key format. As of this writing, two key +formats, `Native' and `SSH', are supported. KF defaults to `Native'. + +=item B<SKF> + +Secret (Private) Key Format. Instead of specifying KF, the user could +choose to specify secret and public key formats separately. The value for +SKF can be a string ("Native" or "SSH") or a hash reference that specifies +a module name, its constructor and constructor arguments. The specified +module is loaded with Class::Loader(3) and must be interface compatible +with Crypt::RSA::Key::Private(3). + +=item B<PKF> + +Public Key Format. This option is like SKF but for the public key. + +=back + +=head1 ERROR HANDLING + +See B<ERROR HANDLING> in Crypt::RSA(3) manpage. + +=head1 BUGS + +There's an inefficiency in the way generate() ensures the key pair is +exactly Size bits long. This will be fixed in a future release. + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=head1 SEE ALSO + +Crypt::RSA(3), Crypt::RSA::Key::Public(3), Crypt::RSA::Key::Private(3), +Crypt::Primes(3), Tie::EncryptedHash(3), Class::Loader(3) + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Private.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Private.pm new file mode 100755 index 00000000000..36dc51d0dd6 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Private.pm @@ -0,0 +1,339 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA::Key::Private +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: Private.pm,v 1.15 2001/09/25 14:11:22 vipul Exp $ + +package Crypt::RSA::Key::Private; +use strict; +use vars qw($AUTOLOAD $VERSION); +use base 'Crypt::RSA::Errorhandler'; +use Tie::EncryptedHash; +use Data::Dumper; +use Math::Pari qw(PARI pari2pv Mod isprime lcm lift); +use Carp; + +$Crypt::RSA::Key::Private::VERSION = '1.99'; + +sub new { + + my ($class, %params) = @_; + my $self = { Version => $Crypt::RSA::Key::Private::VERSION }; + if ($params{Filename}) { + bless $self, $class; + $self = $self->read (%params); + return bless $self, $class; + } else { + bless $self, $class; + $self->Identity ($params{Identity}) if $params{Identity}; + $self->Cipher ($params{Cipher}||"Blowfish"); + $self->Password ($params{Password}) if $params{Password}; + return $self; + } + +} + + +sub AUTOLOAD { + + my ($self, $value) = @_; + my $key = $AUTOLOAD; $key =~ s/.*:://; + if ($key =~ /^(e|n|d|p|q|dp|dq|u|phi)$/) { + if (ref $value eq 'Math::Pari') { + $self->{private}{"_$key"} = $value; + $self->{Checked} = 0; + } elsif ($value && !(ref $value)) { + if ($value =~ /^0x/) { + $self->{private}->{"_$key"} = + Math::Pari::_hex_cvt($value); + $self->{Checked} = 0; + } else { $self->{private}{"_$key"} = PARI($value) } + } + return $self->{private}{"_$key"} || + $self->{private_encrypted}{"_$key"} || + ""; + } elsif ($key =~ /^Identity|Cipher|Password$/) { + $self->{$key} = $value if $value; + return $self->{$key}; + } elsif ($key =~ /^Checked$/) { + my ($package) = caller(); + $self->{Checked} = $value if ($value && $package eq "Crypt::RSA::Key::Private") ; + return $self->{Checked}; + } +} + + +sub hide { + + my ($self) = @_; + + return undef unless $$self{Password}; + + $self->{private_encrypted} = new Tie::EncryptedHash + __password => $self->{Password}, + __cipher => $self->{Cipher}; + + for (keys %{$$self{private}}) { + $$self{private_encrypted}{$_} = pari2pv($$self{private}{$_}); + } + + my $private = $self->{private_encrypted}; + delete $private->{__password}; + delete $$self{private}; + delete $$self{Password}; + +} + + +sub reveal { + + my ($self, %params) = @_; + $$self{Password} = $params{Password} if $params{Password}; + return undef unless $$self{Password}; + $$self{private_encrypted}{__password} = $params{Password}; + for (keys %{$$self{private_encrypted}}) { + $$self{private}{$_} = PARI($$self{private_encrypted}{$_}); + } + +} + + +sub check { + + my ($self) = @_; + + return 1 if $self->{Checked}; + + return $self->error ("Incomplete key.") unless + ($self->n && $self->d) || ($self->n && $self->p && $self->q); + + if ($self->p && $self->q) { + return $self->error ("n is not a number.") if $self->n =~ /\D/; + return $self->error ("p is not a number.") if $self->p =~ /\D/; + return $self->error ("p is not a number.") if $self->p =~ /\D/; + return $self->error ("n is not p*q." ) unless $self->n == $self->p * $self->q; + return $self->error ("p is not prime.") unless isprime($self->p); + return $self->error ("q is not prime.") unless isprime($self->q); + } + + if ($self->e) { + # d * e == 1 mod lcm(p-1, q-1) + return $self->error ("e is not a number.") if $self->e =~ /\D/; + my $k = lcm (($self->p -1), ($self->q -1)); + my $K = Mod (1, $k); my $KI = lift($K * $self->d * $self->e); + return $self->error ("Bad `d'.") unless $KI == 1; + } + + if ($self->dp) { + # dp == d mod (p-1) + return $self->error ("Bad `dp'.") unless $self->dp == $self->d % ($self->p - 1); + } + + if ($self->dq) { + # dq == d mod (q-1) + return $self->error ("Bad `dq'.") unless $self->dq == $self->d % ($self->q - 1); + } + + if ($self->u && $self->q && $self->p) { + my $m = Mod (1,$self->q); $m = lift ($m / $self->p); + return $self->error ("Bad `u'.") unless $self->u == $m; + } + + $self->Checked(1); + return 1; + +} + + +sub DESTROY { + + my $self = shift; + delete $$self{private_encrypted}{__password}; + delete $$self{private_encrypted}; + delete $$self{private}; + delete $$self{Password}; + undef $self; + +} + + +sub write { + + my ($self, %params) = @_; + $self->hide(); + my $string = $self->serialize (%params); + open DISK, ">$params{Filename}" or + croak "Can't open $params{Filename} for writing."; + binmode DISK; + print DISK $string; + close DISK; + +} + + +sub read { + my ($self, %params) = @_; + open DISK, $params{Filename} or + croak "Can't open $params{Filename} to read."; + binmode DISK; + my @key = <DISK>; + close DISK; + $self = $self->deserialize (String => \@key); + $self->reveal(%params); + return $self; +} + + +sub serialize { + + my ($self, %params) = @_; + if ($$self{private}) { # this is an unencrypted key + for (keys %{$$self{private}}) { + $$self{private}{$_} = pari2pv($$self{private}{$_}); + } + } + return Dumper $self; + +} + + +sub deserialize { + + my ($self, %params) = @_; + my $string = join'', @{$params{String}}; + $string =~ s/\$VAR1 =//; + $self = eval $string; + if ($$self{private}) { # the key is unencrypted + for (keys %{$$self{private}}) { + $$self{private}{$_} = PARI($$self{private}{$_}); + } + return $self; + } + my $private = new Tie::EncryptedHash; + %$private = %{$$self{private_encrypted}}; + $self->{private_encrypted} = $private; + return $self; + +} + + +1; + +=head1 NAME + +Crypt::RSA::Key::Private -- RSA Private Key Management. + +=head1 SYNOPSIS + + $key = new Crypt::RSA::Key::Private ( + Identity => 'Lord Banquo <banquo@lochaber.com>', + Password => 'The earth hath bubbles', + ); + + $key->hide(); + + $key->write( Filename => 'rsakeys/banquo.private' ); + + $akey = new Crypt::RSA::Key::Private ( + Filename => 'rsakeys/banquo.private' + ); + + $akey->reveal ( Password => 'The earth hath bubbles' ); + +=head1 DESCRIPTION + +Crypt::RSA::Key::Private provides basic private key management +functionality for Crypt::RSA private keys. Following methods are +available: + +=over 4 + +=item B<new()> + +The constructor. Takes a hash, usually with two arguments: C<Filename> and +C<Password>. C<Filename> indicates a file from which the private key +should be read. More often than not, private keys are kept encrypted with +a symmetric cipher and MUST be decrypted before use. When a C<Password> +argument is provided, the key is also decrypted before it is returned by +C<new()>. Here's a complete list of arguments accepted by C<new()> (all of +which are optional): + +=over 4 + +=item Identity + +A string identifying the owner of the key. Canonically, a name and +email address. + +=item Filename + +Name of the file that contains the private key. + +=item Password + +Password with which the private key is encrypted, or should be encrypted +(in case of a new key). + +=item Cipher + +Name of the symmetric cipher in which the private key is encrypted (or +should be encrypted). The default is "Blowfish" and possible values +include DES, IDEA, Twofish and other ciphers supported by Crypt::CBC. + +=back + +=item B<reveal()> + +If the key is not decrypted at C<new()>, it can be decrypted by +calling C<reveal()> with a C<Password> argument. + +=item B<hide()> + +C<hide()> causes the key to be encrypted by the chosen symmetric cipher +and password. + +=item B<write()> + +Causes the key to be written to a disk file specified by the +C<Filename> argument. C<write()> will call C<hide()> before +writing the key to disk. If you wish to store the key in plain, +don't specify a password at C<new()>. + +=item B<read()> + +Causes the key to be read from a disk file specified by +C<Filename> into the object. If C<Password> is provided, the +method automatically calls reveal() to decrypt the key. + +=item B<serialize()> + +Creates a Data::Dumper(3) serialization of the private key and +returns the string representation. + +=item B<deserialize()> + +Accepts a serialized key under the C<String> parameter and +coverts it into the perl representation stored in the object. + +=item C<check()> + +Check the consistency of the key. If the key checks out, it sets +$self->{Checked} = 1. Returns undef on failure. + +=back + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=head1 SEE ALSO + +Crypt::RSA::Key(3), Crypt::RSA::Public(3) + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Private/SSH.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Private/SSH.pm new file mode 100755 index 00000000000..e777d211ec9 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Private/SSH.pm @@ -0,0 +1,180 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA::Key::Private::SSH +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: SSH.pm,v 1.1 2001/05/20 23:37:47 vipul Exp $ + +package Crypt::RSA::Key::Private::SSH::Buffer; +use strict; +use Crypt::RSA::DataFormat qw( os2ip bitsize i2osp ); +use Data::Buffer; +use base qw( Data::Buffer ); + +sub get_mp_int { + my $buf = shift; + my $off = $buf->{offset}; + my $bits = unpack "n", $buf->bytes($off, 2); + my $bytes = int(($bits+7)/8); + my $p = os2ip( $buf->bytes($off+2, $bytes) ); + $buf->{offset} += 2 + $bytes; + $p; +} + +sub put_mp_int { + my $buf = shift; + my $int = shift; + my $bits = bitsize($int); + $buf->put_int16($bits); + $buf->put_chars( i2osp($int) ); +} + + +package Crypt::RSA::Key::Private::SSH; +use FindBin qw($Bin); +use lib "$Bin/../../../../../lib"; +use strict; +use constant PRIVKEY_ID => "SSH PRIVATE KEY FILE FORMAT 1.1\n"; +use vars qw( %CIPHERS ); + +BEGIN { + %CIPHERS = ( + 1 => 'IDEA', + 2 => 'DES', + 3 => 'DES3', + 4 => 'ARCFOUR', + 6 => 'Blowfish', + ); +} + +use Carp qw( croak ); +use Data::Buffer; +use Crypt::CBC; +use Crypt::RSA::Key::Private; +use base qw( Crypt::RSA::Key::Private ); + +sub deserialize { + my($key, %params) = @_; + my $blob = join '', @{$params{String}}; + my $passphrase = $params{Passphrase} || ''; + + my $buffer = new Crypt::RSA::Key::Private::SSH::Buffer; + $buffer->append($blob); + + my $id = $buffer->bytes(0, length(PRIVKEY_ID), ''); + croak "Bad key file format" unless $id eq PRIVKEY_ID; + $buffer->bytes(0, 1, ''); + + my $cipher_type = $buffer->get_int8; + $buffer->get_int32; ## Reserved data. + + $buffer->get_int32; ## Private key bits. + $key->n( $buffer->get_mp_int ); + $key->e( $buffer->get_mp_int ); + + $key->Identity( $buffer->get_str ); ## Comment. + + if ($cipher_type != 0) { + my $cipher_name = $CIPHERS{$cipher_type} or + croak "Unknown cipher '$cipher_type' used in key file"; + my $class = 'Crypt::' . $cipher_name; + eval { require $class }; + if ($@) { croak "Unsupported cipher '$cipher_name': $@" } + + my $cipher = Crypt::CBC->new($passphrase, $cipher_name); + my $decrypted = + $cipher->decrypt($buffer->bytes($buffer->offset)); + $buffer->empty; + $buffer->append($decrypted); + } + + my $check1 = $buffer->get_int8; + my $check2 = $buffer->get_int8; + unless ($check1 == $buffer->get_int8 && + $check2 == $buffer->get_int8) { + croak "Bad passphrase supplied for key file"; + } + + $key->d( $buffer->get_mp_int ); + $key->u( $buffer->get_mp_int ); + $key->p( $buffer->get_mp_int ); + $key->q( $buffer->get_mp_int ); + + $key; +} + + +sub serialize { + my($key, %params) = @_; + my $passphrase = $params{Password} || ''; + my $cipher_type = $passphrase eq '' ? 0 : + $params{Cipher} || 3; + + my $buffer = new Crypt::RSA::Key::Private::SSH::Buffer; + my($check1, $check2); + $buffer->put_int8($check1 = int rand 255); + $buffer->put_int8($check2 = int rand 255); + $buffer->put_int8($check1); + $buffer->put_int8($check2); + + $buffer->put_mp_int($key->d); + $buffer->put_mp_int($key->u); + $buffer->put_mp_int($key->p); + $buffer->put_mp_int($key->q); + + $buffer->put_int8(0) + while $buffer->length % 8; + + my $encrypted = new Crypt::RSA::Key::Private::SSH::Buffer; + $encrypted->put_chars(PRIVKEY_ID); + $encrypted->put_int8(0); + $encrypted->put_int8($cipher_type); + $encrypted->put_int32(0); + + $encrypted->put_int32(Crypt::RSA::DataFormat::bitsize($key->n)); + $encrypted->put_mp_int($key->n); + $encrypted->put_mp_int($key->e); + $encrypted->put_str($key->Identity || ''); + + if ($cipher_type) { + my $cipher_name = $CIPHERS{$cipher_type}; + my $class = 'Crypt::' . $cipher_name; + eval { require $class }; + if ($@) { croak "Unsupported cipher '$cipher_name': $@" } + + my $cipher = Crypt::CBC->new($passphrase, $cipher_name); + $encrypted->append( $cipher->encrypt($buffer->bytes) ); + } + else { + $encrypted->append($buffer->bytes); + } + + $encrypted->bytes; +} + + +sub hide {} + +=head1 NAME + +Crypt::RSA::Key::Private::SSH - SSH Private Key Import + +=head1 SYNOPSIS + + Crypt::RSA::Key::Private::SSH is a class derived from + Crypt::RSA::Key::Private that provides serialize() and + deserialze() methods for SSH 2.x keys. + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=cut + + + + +1; diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Public.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Public.pm new file mode 100755 index 00000000000..b9086b77300 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Public.pm @@ -0,0 +1,184 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA::Key::Public +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: Public.pm,v 1.8 2001/09/25 14:11:23 vipul Exp $ + +package Crypt::RSA::Key::Public; +use strict; +use vars qw($AUTOLOAD); +use Carp; +use Data::Dumper; +use base 'Crypt::RSA::Errorhandler'; +use Math::Pari qw(PARI pari2pv); + +$Crypt::RSA::Key::Public::VERSION = '1.99'; + +sub new { + + my ($class, %params) = @_; + my $self = { Version => $Crypt::RSA::Key::Public::VERSION }; + if ($params{Filename}) { + bless $self, $class; + $self = $self->read (%params); + return bless $self, $class; + } else { + return bless $self, $class; + } + +} + + +sub AUTOLOAD { + my ($self, $value) = @_; + my $key = $AUTOLOAD; $key =~ s/.*:://; + if ($key =~ /^n|e$/) { + if (ref $value eq 'Math::Pari') { + $self->{$key} = pari2pv($value) + } elsif ($value && !(ref $value)) { + if ($value =~ /^0x/) { + $self->{$key} = pari2pv(Math::Pari::_hex_cvt($value)); + } else { $self->{$key} = $value } + } + my $return = $self->{$key} || ""; + $return = PARI("$return") if $return =~ /^\d+$/; + return $return; + } elsif ($key =~ /^Identity$/) { + $self->{$key} = $value if $value; + return $self->{$key}; + } + +} + + +sub DESTROY { + + my $self = shift; + undef $self; + +} + + +sub check { + + my $self = shift; + return $self->error ("Incomplete key.") unless $self->n && $self->e; + return 1; + +} + + +sub write { + + my ($self, %params) = @_; + $self->hide(); + my $string = $self->serialize (%params); + open DISK, ">$params{Filename}" or + croak "Can't open $params{Filename} for writing."; + binmode DISK; + print DISK $string; + close DISK; + +} + + +sub read { + my ($self, %params) = @_; + open DISK, $params{Filename} or + croak "Can't open $params{Filename} to read."; + binmode DISK; + my @key = <DISK>; + close DISK; + $self = $self->deserialize (String => \@key); + return $self; +} + + +sub serialize { + + my ($self, %params) = @_; + return Dumper $self; + +} + + +sub deserialize { + + my ($self, %params) = @_; + my $string = join'', @{$params{String}}; + $string =~ s/\$VAR1 =//; + $self = eval $string; + return $self; + +} + + +1; + +=head1 NAME + +Crypt::RSA::Key::Public -- RSA Public Key Management. + +=head1 SYNOPSIS + + $key = new Crypt::RSA::Key::Public; + $key->write ( Filename => 'rsakeys/banquo.public' ); + + $akey = new Crypt::RSA::Key::Public ( + Filename => 'rsakeys/banquo.public' + ); + + +=head1 DESCRIPTION + +Crypt::RSA::Key::Public provides basic key management functionality for +Crypt::RSA public keys. Following methods are available: + +=over 4 + +=item B<new()> + +The constructor. Reads the public key from a disk file when +called with a C<Filename> argument. + +=item B<write()> + +Causes the key to be written to a disk file specified by the +C<Filename> argument. + +=item B<read()> + +Causes the key to be read from a disk file specified by +C<Filename> into the object. + +=item B<serialize()> + +Creates a Data::Dumper(3) serialization of the private key and +returns the string representation. + +=item B<deserialize()> + +Accepts a serialized key under the C<String> parameter and +coverts it into the perl representation stored in the object. + +=item C<check()> + +Check the consistency of the key. Returns undef on failure. + +=back + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=head1 SEE ALSO + +Crypt::RSA::Key(3), Crypt::RSA::Key::Private(3) + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Public/SSH.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Public/SSH.pm new file mode 100755 index 00000000000..ffb85c84b7a --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/Key/Public/SSH.pm @@ -0,0 +1,52 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA::Key::Private::SSH +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: SSH.pm,v 1.1 2001/05/20 23:37:48 vipul Exp $ + +package Crypt::RSA::Key::Public::SSH; +use strict; +use Crypt::RSA::DataFormat qw(bitsize); +use Crypt::RSA::Key::Public; +use vars qw(@ISA); +@ISA = qw(Crypt::RSA::Key::Public); + +sub deserialize { + my ($self, %params) = @_; + my ($bitsize, $e, $n, $ident) = split /\s/, join'',@{$params{String}}; + $self->n ($n); + $self->e ($e); + $self->Identity ($ident); + return $self; +} + +sub serialize { + my ($self, %params) = @_; + my $bitsize = bitsize ($self->n); + my $string = join ' ', $bitsize, $self->e, $self->n, $self->Identity; + return $string; +} + +1; + +=head1 NAME + +Crypt::RSA::Key::Public::SSH - SSH Public Key Import + +=head1 SYNOPSIS + + Crypt::RSA::Key::Public::SSH is a class derived from + Crypt::RSA::Key::Public that provides serialize() and + deserialze() methods for SSH 2.x keys. + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/Primitives.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/Primitives.pm new file mode 100755 index 00000000000..0fd2ed8b1b0 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/Primitives.pm @@ -0,0 +1,149 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA::Primitives -- Cryptography and encoding primitives +## used by Crypt::RSA. +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: Primitives.pm,v 1.14 2001/06/22 23:27:35 vipul Exp $ + +package Crypt::RSA::Primitives; +use strict; +use base 'Crypt::RSA::Errorhandler'; +use Crypt::RSA::Debug qw(debug); +use Math::Pari qw(PARI Mod lift); +use Carp; + +sub new { + return bless {}, shift; +} + + +sub core_encrypt { + + # procedure: + # c = (m ** e) mod n + + my ($self, %params) = @_; + my $key = $params{Key}; + $self->error ("Bad key.", \%params, $key) unless $key->check(); + my $plaintext = $params{Message} || $params{Plaintext}; + debug ("pt == $plaintext"); + + my $e = $key->e; my $n = $key->n; + return $self->error ("Numeric representation of plaintext is out of bound.", + \$plaintext, $key, \%params) if $plaintext > $n; + my $c = mod_exp($plaintext, $e, $n); + debug ("ct == $c"); + $n = undef; $e = undef; + return $c; + +} + + +sub core_decrypt { + + # procedure: + # p = (c ** d) mod n + + + my ($self, %params) = @_; + my $key = $params{Key}; + $self->error ("Bad key.") unless $key->check(); + + my $cyphertext = $params{Cyphertext} || $params{Ciphertext}; + my $n = $key->n; + return $self->error ("Decryption error.") if $cyphertext > $n; + + my $pt; + if ($key->p && $key->q) { + my($p, $q, $d) = ($key->p, $key->q, $key->d); + $key->u (mod_inverse($p, $q)) unless $key->u; + $key->dp ($d % ($p-1)) unless $key->dp; + $key->dq ($d % ($q-1)) unless $key->dq; + my $p2 = mod_exp($cyphertext % $p, $key->dp, $p); + my $q2 = mod_exp($cyphertext % $q, $key->dq, $q); + $pt = $p2 + ($p * ((($q2 - $p2) * $key->u) % $q)); + } + else { + $pt = mod_exp ($cyphertext, $key->d, $n); + } + + debug ("ct == $cyphertext"); + debug ("pt == $pt"); + return $pt; + +} + + +sub core_sign { + + my ($self, %params) = @_; + $params{Cyphertext} = $params{Message} || $params{Plaintext}; + return $self->core_decrypt (%params); + +} + + +sub core_verify { + + my ($self, %params) = @_; + $params{Plaintext} = $params{Signature}; + return $self->core_encrypt (%params); + +} + + +sub mod_inverse { + my($a, $n) = @_; + my $m = Mod(1, $n); + lift($m / $a); +} + + +sub mod_exp { + my($a, $exp, $n) = @_; + my $m = Mod($a, $n); + lift($m ** $exp); +} + + +1; + +=head1 NAME + +Crypt::RSA::Primitives - RSA encryption, decryption, signature and verification primitives. + +=head1 SYNOPSIS + + my $prim = new Crypt::RSA::Primitives; + my $ctxt = $prim->core_encrypt (Key => $key, Plaintext => $string); + my $ptxt = $prim->core_decrypt (Key => $key, Cyphertext => $ctxt); + my $sign = $prim->core_sign (Key => $key, Message => $string); + my $vrfy = $prim->core_verify (Key => $key, Signature => $sig); + +=head1 DESCRIPTION + +This module implements RSA encryption, decryption, signature and +verfication primitives. These primitives should only be used in the +context of an encryption or signing scheme. See Crypt::RSA::ES::OAEP(3), +and Crypt::RSA::SS::PSS(3) for the implementation of two such schemes. + +=head1 ERROR HANDLING + +See B<ERROR HANDLING> in Crypt::RSA(3) manpage. + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=head1 SEE ALSO + +Crypt::RSA(3), Crypt::RSA::Key(3), Crypt::RSA::ES::OAEP(3), +Crypt::RSA::SS::PSS(3) + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/SS/PKCS1v15.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/SS/PKCS1v15.pm new file mode 100755 index 00000000000..07373f7cd99 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/SS/PKCS1v15.pm @@ -0,0 +1,247 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA::SS:PKCS1v15 +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: PKCS1v15.pm,v 1.6 2001/06/22 23:27:38 vipul Exp $ + +package Crypt::RSA::SS::PKCS1v15; +use strict; +use base 'Crypt::RSA::Errorhandler'; +use Crypt::RSA::DataFormat qw(octet_len os2ip i2osp h2osp); +use Crypt::RSA::Primitives; +use Crypt::RSA::Debug qw(debug); +use Digest::SHA1 qw(sha1); +use Digest::MD5 qw(md5); +use Digest::MD2 qw(md2); +use Math::Pari qw(floor); + +$Crypt::RSA::SS::PKCS1v15::VERSION = '1.99'; + +sub new { + + my ($class, %params) = @_; + my $self = bless { + primitives => new Crypt::RSA::Primitives, + digest => $params{Digest} || 'SHA1', + encoding => { + MD2 => "0x 30 20 30 0C 06 08 2A 86 48 + 86 F7 0D 02 02 05 00 04 10", + MD5 => "0x 30 20 30 0C 06 08 2A 86 48 + 86 F7 0D 02 05 05 00 04 10", + SHA1 => "0x 30 21 30 09 06 05 2B 0E 03 + 02 1A 05 00 04 14", + }, + VERSION => $Crypt::RSA::SS::PKCS1v15::VERSION, + }, $class; + if ($params{Version}) { + # do versioning here + } + return $self; + +} + + +sub sign { + + my ($self, %params) = @_; + my $key = $params{Key}; my $M = $params{Message} || $params{Plaintext}; + return $self->error ("No Message or Plaintext parameter", \$key, \%params) unless $M; + return $self->error ("No Key parameter", \$M, \%params) unless $key; + my $k = octet_len ($key->n); + + my $em; + unless ($em = $self->encode ($M, $k-1)) { + return $self->error ($self->errstr, \$key, \%params, \$M) + if $self->errstr eq "Message too long."; + return $self->error ("Modulus too short.", \$key, \%params, \$M) + if $self->errstr eq "Intended encoded message length too short"; + } + + my $m = os2ip ($em); + my $sig = $self->{primitives}->core_sign (Key => $key, Message => $m); + return i2osp ($sig, $k); + +} + + +sub verify { + + my ($self, %params) = @_; + my $key = $params{Key}; my $M = $params{Message} || $params{Plaintext}; + my $S = $params{Signature}; + return $self->error ("No Message or Plaintext parameter", \$key, \%params) unless $M; + return $self->error ("No Key parameter", \$M, \$S, \%params) unless $key; + return $self->error ("No Signature parameter", \$key, \$M, \%params) unless $S; + my $k = octet_len ($key->n); + return $self->error ("Invalid signature.", \$key, \$M, \%params) if length($S) != $k; + my $s = os2ip ($S); + my $m = $self->{primitives}->core_verify (Key => $key, Signature => $s) || + $self->error ("Invalid signature.", \$M, $key, \%params); + my $em = i2osp ($m, $k-1) || + return $self->error ("Invalid signature.", \$M, \$S, $key, \%params); + my $em1; + unless ($em1 = $self->encode ($M, $k-1)) { + return $self->error ($self->errstr, \$key, \%params, \$M) + if $self->errstr eq "Message too long."; + return $self->error ("Modulus too short.", \$key, \%params, \$M) + if $self->errstr eq "Intended encoded message length too short."; + } + + debug ("em: $em"); debug ("em1: $em1"); + + return 1 if $em eq $em1; + return $self->error ("Invalid signature.", \$M, \$key, \%params); + +} + + +sub encode { + + my ($self, $M, $emlen) = @_; + + my $H; + if ($self->{digest} eq "SHA1") { $H = sha1 ($M) } + elsif ($self->{digest} eq "MD5" ) { $H = md5 ($M) } + elsif ($self->{digest} eq "MD2" ) { $H = md2 ($M) } + + my $alg = h2osp($self->{encoding}->{$self->{digest}}); + my $T = $alg . $H; + $self->error ("Intended encoded message length too short.", \$M) if $emlen < length($T) + 10; + my $pslen = $emlen - length($T) - 2; + my $PS = chr(0xff) x $pslen; + my $em = chr(1) . $PS . chr(0) . $T; + return $em; + +} + + +sub version { + my $self = shift; + return $self->{VERSION}; +} + + +sub signblock { + return -1; +} + + +sub verifyblock { + my ($self, %params) = @_; + return octet_len($params{Key}->n); +} + + +1; + +=head1 NAME + +Crypt::RSA::SS::PKCS1v15 - PKCS #1 v1.5 signatures. + +=head1 SYNOPSIS + + my $pkcs = new Crypt::RSA::SS::PKCS1v15 ( + Digest => 'MD5' + ); + + my $signature = $pkcs->sign ( + Message => $message, + Key => $private, + ) || die $pss->errstr; + + my $verify = $pkcs->verify ( + Message => $message, + Key => $key, + Signature => $signature, + ) || die $pss->errstr; + + +=head1 DESCRIPTION + +This module implements PKCS #1 v1.5 signatures based on RSA. See [13] +for details on the scheme. + +=head1 METHODS + +=head2 B<new()> + +Constructor. Takes a hash as argument with the following key: + +=over 4 + +=item B<Digest> + +Name of the Message Digest algorithm. Three Digest algorithms are +supported: MD2, MD5 and SHA1. Digest defaults to SHA1. + +=back + + +=head2 B<version()> + +Returns the version number of the module. + +=head2 B<sign()> + +Computes a PKCS #1 v1.5 signature on a message with the private key of the +signer. sign() takes a hash argument with the following mandatory keys: + +=over 4 + +=item B<Message> + +Message to be signed, a string of arbitrary length. + +=item B<Key> + +Private key of the signer, a Crypt::RSA::Key::Private object. + +=back + +=head2 B<verify()> + +Verifies a signature generated with sign(). Returns a true value on +success and false on failure. $self->errstr is set to "Invalid signature." +or appropriate error on failure. verify() takes a hash argument with the +following mandatory keys: + +=over 4 + +=item B<Key> + +Public key of the signer, a Crypt::RSA::Key::Public object. + +=item B<Message> + +The original signed message, a string of arbitrary length. + +=item B<Signature> + +Signature computed with sign(), a string. + +=back + +=head1 ERROR HANDLING + +See ERROR HANDLING in Crypt::RSA(3) manpage. + +=head1 BIBLIOGRAPHY + +See BIBLIOGRAPHY in Crypt::RSA(3) manpage. + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=head1 SEE ALSO + +Crypt::RSA(3), Crypt::RSA::Primitives(3), Crypt::RSA::Keys(3), +Crypt::RSA::EME::OAEP(3) + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/RSA/SS/PSS.pm b/Master/tlpkg/tlperl/lib/Crypt/RSA/SS/PSS.pm new file mode 100755 index 00000000000..b6727020246 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/RSA/SS/PSS.pm @@ -0,0 +1,274 @@ +#!/usr/bin/perl -sw +## +## Crypt::RSA::SS:PSS +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: PSS.pm,v 1.5 2001/06/22 23:27:38 vipul Exp $ + +package Crypt::RSA::SS::PSS; +use strict; +use base 'Crypt::RSA::Errorhandler'; +use Crypt::Random qw(makerandom_octet); +use Crypt::RSA::DataFormat qw(octet_len os2ip i2osp octet_xor mgf1); +use Crypt::RSA::Primitives; +use Crypt::RSA::Debug qw(debug); +use Digest::SHA1 qw(sha1); +use Math::Pari qw(floor); + +$Crypt::RSA::SS::PSS::VERSION = '1.99'; + +sub new { + my ($class, %params) = @_; + my $self = bless { primitives => new Crypt::RSA::Primitives, + hlen => 20, + VERSION => $Crypt::RSA::SS::PSS::VERSION, + }, $class; + if ($params{Version}) { + # do versioning here + } + return $self; +} + + +sub sign { + my ($self, %params) = @_; + my $key = $params{Key}; my $M = $params{Message} || $params{Plaintext}; + return $self->error("No Key parameter", \$M, \%params) unless $key; + return $self->error("No Message or Plaintext parameter", \$key, \%params) unless $M; + my $k = octet_len ($key->n); + my $salt = makerandom_octet (Length => $self->{hlen}); + my $em = $self->encode ($M, $salt, $k-1); + my $m = os2ip ($em); + my $sig = $self->{primitives}->core_sign (Key => $key, Message => $m); + my $S = i2osp ($sig, $k); + return ($S, $salt) if wantarray; + return $S; +} + + +sub verify_with_salt { + my ($self, %params) = @_; + my $key = $params{Key}; my $M = $params{Message} || $params{Plaintext}; + my $S = $params{Signature}; my $salt = $params{Salt}; + return $self->error("No Key parameter", \$S, \%params) unless $key; + return $self->error("No Signature parameter", \$key, \%params) unless $S; + my $k = octet_len ($key->n); + my $em; + unless ($em = $self->encode ($M, $salt, $k-1)) { + return if $self->errstr eq "Message too long."; + return $self->error ("Modulus too short.", \$M, \$S, \$key, \%params) if + $self->errstr eq "Intended encoded message length too short."; + } + return $self->error ("Invalid signature.", \$M, \$S, $key, \%params) if length($S) < $k; + my $s = os2ip ($S); + my $m = $self->{primitives}->core_verify (Key => $key, Signature => $s) || + $self->error ("Invalid signature.", \$M, \$S, $key, \%params); + my $em1 = i2osp ($m, $k-1) || + return $self->error ("Invalid signature.", \$M, \$S, $key, \%params); + return 1 if $em eq $em1; + return $self->error ("Invalid signature.", \$M, \$S, $key, \%params); +} + + +sub verify { + my ($self, %params) = @_; + my $key = $params{Key}; my $M = $params{Message} || $params{Plaintext}; + my $S = $params{Signature}; + return $self->error("No Key parameter", \$S, \$M, \%params) unless $key; + return $self->error("No Signature parameter", \$key, \$M, \%params) unless $S; + return $self->error("No Message or Plaintext parameter", \$key, \$S, \%params) unless $M; + my $k = octet_len ($key->n); + my $s = os2ip ($S); + my $m = $self->{primitives}->core_verify (Key => $key, Signature => $s) || + $self->error ("Invalid signature.", \$M, \$S, $key, \%params); + my $em1 = i2osp ($m, $k-1) || + return $self->error ("Invalid signature.", \$M, \$S, $key, \%params); + return 1 if $self->verify_with_salt_recovery ($M, $em1); + return $self->error ("Invalid signature.", \$M, \$S, $key, \%params); +} + + +sub encode { + my ($self, $M, $salt, $emlen) = @_; + return $self->error ("Intended encoded message length too short.", \$M, \$salt ) + if $emlen < 2 * $self->{hlen}; + my $H = $self->hash ("$salt$M"); + my $padlength = $emlen - (2*$$self{hlen}); + my $PS = chr(0)x$padlength; + my $db = $salt . $PS; + my $dbmask = $self->mgf ($H, $emlen - $self->{hlen}); + my $maskeddb = octet_xor ($db, $dbmask); + my $em = $H . $maskeddb; + return $em; +} + + +sub verify_with_salt_recovery { + my ($self, $M, $EM) = @_; + my $hlen = $$self{hlen}; + my $emlen = length ($EM); + return $self->error ("Encoded message too short.", \$M, \$EM) if $emlen < (2*$hlen); + my $H = substr $EM, 0, $hlen; + my $maskeddb = substr $EM, $hlen; + my $dbmask = $self->mgf ($H, $emlen-$hlen); + my $db = octet_xor ($maskeddb, $dbmask); + my $salt = substr $db, 0, $hlen; + my $PS = substr $db, $hlen; + my $check = chr(0) x ($emlen-(2*$hlen)); debug ("PS: $PS"); + return $self->error ("Inconsistent.") unless $check eq $PS; + my $H1 = $self->hash ("$salt$M"); + return 1 if $H eq $H1; + return $self->error ("Inconsistent."); +} + + +sub hash { + my ($self, $data) = @_; + return sha1 ($data); +} + + +sub mgf { + my ($self, @data) = @_; + return mgf1 (@data); +} + + +sub version { + my $self = shift; + return $self->{VERSION}; +} + + +sub signblock { + return -1; +} + + +sub verifyblock { + my ($self, %params) = @_; + return octet_len($params{Key}->n); +} + + +1; + +=head1 NAME + +Crypt::RSA::SS::PSS - Probabilistic Signature Scheme based on RSA. + +=head1 SYNOPSIS + + my $pss = new Crypt::RSA::SS::PSS; + + my $signature = $pss->sign ( + Message => $message, + Key => $private, + ) || die $pss->errstr; + + my $verify = $pss->verify ( + Message => $message, + Key => $key, + Signature => $signature, + ) || die $pss->errstr; + + +=head1 DESCRIPTION + +PSS (Probabilistic Signature Scheme) is a provably secure method of +creating digital signatures with RSA. "Provable" means that the +difficulty of forging signatures can be directly related to inverting +the RSA function. "Probabilistic" alludes to the randomly generated salt +value included in the signature to enhance security. For more details +on PSS, see [4] & [13]. + +=head1 METHODS + +=head2 B<new()> + +Constructor. + +=head2 B<version()> + +Returns the version number of the module. + +=head2 B<sign()> + +Computes a PSS signature on a message with the private key of the signer. +In scalar context, sign() returns the computed signature. In array +context, it returns the signature and the random salt. The signature can +verified with verify() or verify_with_salt(). sign() takes a hash argument +with the following mandatory keys: + +=over 4 + +=item B<Message> + +Message to be signed, a string of arbitrary length. + +=item B<Key> + +Private key of the signer, a Crypt::RSA::Key::Private object. + +=back + +=head2 B<verify()> + +Verifies a signature generated with sign(). The salt is recovered from the +signature and need not be passed. Returns a true value on success and +false on failure. $self->errstr is set to "Invalid signature." or +appropriate error on failure. verify() takes a hash argument with the +following mandatory keys: + +=over 4 + +=item B<Key> + +Public key of the signer, a Crypt::RSA::Key::Public object. + +=item B<Message> + +The original signed message, a string of arbitrary length. + +=item B<Signature> + +Signature computed with sign(), a string. + +=item B<Version> + +Version of the module that was used for creating the Signature. This is an +optional argument. When present, verify() will ensure before proceeding +that the installed version of the module can successfully verify the +Signature. + +=back + +=head2 B<verify_with_salt()> + +Verifies a signature given the salt. Takes the same arguments as verify() +in addition to B<Salt>, which is a 20-byte string returned by sign() in +array context. + +=head1 ERROR HANDLING + +See ERROR HANDLING in Crypt::RSA(3) manpage. + +=head1 BIBLIOGRAPHY + +See BIBLIOGRAPHY in Crypt::RSA(3) manpage. + +=head1 AUTHOR + +Vipul Ved Prakash, E<lt>mail@vipul.netE<gt> + +=head1 SEE ALSO + +Crypt::RSA(3), Crypt::RSA::Primitives(3), Crypt::RSA::Keys(3), +Crypt::RSA::EME::OAEP(3) + +=cut + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/Random.pm b/Master/tlpkg/tlperl/lib/Crypt/Random.pm new file mode 100755 index 00000000000..dc573d5b405 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/Random.pm @@ -0,0 +1,267 @@ +#!/usr/bin/perl -s +## +## Crypt::Random -- Interface to /dev/random and /dev/urandom. +## +## Copyright (c) 1998, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: Random.pm,v 1.11 2001/07/12 15:59:47 vipul Exp $ + +package Crypt::Random; +require Exporter; +use vars qw($VERSION @EXPORT_OK); + +BEGIN { + *import = \&Exporter::import; + @EXPORT_OK = qw( makerandom makerandom_itv makerandom_octet ); +} + +use Math::Pari qw(PARI floor Mod pari2pv pari2num lift); +use Carp; +use Data::Dumper; +use Class::Loader; +use Crypt::Random::Generator; + +$VERSION = 1.25; + + +sub _pickprovider { + + my (%params) = @_; + + return $params{Provider} if $params{Provider}; + $params{Strength} ||= 0; + my $gen = new Crypt::Random::Generator Strength => $params{Strength}; + return $gen->{Provider}; + +} + +sub makerandom { + + my ( %params ) = @_; + + $params{Verbosity} = 0 unless $params{Verbosity}; + my $uniform = $params{Uniform} || 0; + local $| = 1; + + my $provider = _pickprovider(%params); + my $loader = new Class::Loader; + my $po = $loader->_load ( Module => "Crypt::Random::Provider::$provider", + Args => [ map { $_ => $params{$_} } + qw(Strength Provider) ] ) + + or die "Unable to load module Crypt::Random::Provider::$provider - $!"; + my $r = $po->get_data( %params ); + + my $size = $params{Size}; + my $down = $size - 1; + + unless ($uniform) { + + # We always set the high bit of the random number if + # we want the result to occupy exactly $size bits. + + $y = unpack "H*", pack "B*", '0' x ( $size%8 ? 8-$size % 8 : 0 ). '1'. + unpack "b$down", $r; + + } else { + + # If $uniform is set $size of 2 could return 00 + # and 01 in addition to 10 and 11. 00 and 01 can + # be represented in less than 2 bits, but + # the result of this generation is uniformally + # distributed. + + $y = unpack "H*", pack "B*", '0' x ( $size%8 ? 8-$size % 8 : 0 ). + unpack "b$size", $r; + + } + + return Math::Pari::_hex_cvt ( "0x$y" ); + +} + + +sub makerandom_itv { + + my ( %params ) = @_; + + my $a = $params{ Lower } || 0; $a = PARI ( $a ); + my $b = $params{ Upper }; $b = PARI ( $b ); + + my $itv = Mod ( 0, $b - $a ); + my $size = length ( $itv ) * 5; + my $random = makerandom %params, Size => $size; + + do { $random = makerandom %params, Size => $size } + while ( $random >= (PARI(2)**$size) - ((PARI(2)**$size) % lift($b-$a))); + + $itv += $random; + my $r = PARI ( lift ( $itv ) + $a ); + + undef $itv; undef $a; undef $b; + return "$r"; + +} + + +sub makerandom_octet { + + my ( %params ) = @_; + + $params{Verbosity} = 0 unless $params{Verbosity}; + + my $provider = _pickprovider(%params); + my $loader = new Class::Loader; + my $po = $loader->_load ( Module => "Crypt::Random::Provider::$provider", + Args => [ %params ] ); + return $po->get_data( %params ); + + +} + + +'True Value'; + +=head1 NAME + +Crypt::Random - Cryptographically Secure, True Random Number Generator. + +=head1 VERSION + + $Revision: 1.11 $ + $Date: 2001/07/12 15:59:47 $ + +=head1 SYNOPSIS + + use Crypt::Random qw( makerandom ); + my $r = makerandom ( Size => 512, Strength => 1 ); + +=head1 DESCRIPTION + +Crypt::Random is an interface module to the /dev/random device found on +most modern unix systems. It also interfaces with egd, a user space +entropy gathering daemon, available for systems where /dev/random (or +similar) devices are not available. When Math::Pari is installed, +Crypt::Random can generate random integers of arbritary size of a given +bitsize or in a specified interval. + +=head1 BLOCKING BEHAVIOUR + +The /dev/random driver maintains an estimate of true randomness in the +pool and decreases it every time random strings are requested for use. +When the estimate goes down to zero, the routine blocks and waits for the +occurrence of non-deterministic events to refresh the pool. + +When the routine is blocked, Crypt::Random's read() will be blocked till +desired amount of random bytes have been read off of the device. The +/dev/random kernel module also provides another interface, /dev/urandom, +that does not wait for the entropy-pool to recharge and returns as many +bytes as requested. For applications that must not block (for a +potentially long time) should use /dev/urandom. /dev/random should be +reserved for instances where very high quality randomness is desired. + +=head1 HARDWARE RNG + +If there's a hardware random number generator available, for instance the +Intel i8x0 random number generator, please use it instead of /dev/random!. +It'll be high quality, a lot faster and it won't block! Usually your OS +will provide access to the RNG as a device, eg (/dev/intel_rng). + +=head1 METHODS + +=over 4 + +=item B<makerandom()> + +Generates a random number of requested bitsize in base 10. Following +arguments can be specified. + +=over 4 + +=item B<Size> + +Bitsize of the random number. + +=item B<Strength> 0 || 1 + +Value of 1 implies that /dev/random should be used +for requesting random bits while 0 implies /dev/urandom. + +=item B<Device> + +Alternate device to request random bits from. + +=item B<Uniform> 0 || 1 + +Value of 0 (default) implies that the high bit of the generated random +number is always set, ensuring the bitsize of the generated random will be +exactly Size bits. For uniformally distributed random numbers, Uniform +should be set to 1. + +=back + +=item B<makerandom_itv()> + +Generates a random number in the specified interval. In addition +to the arguments to makerandom() following attributes can be +specified. + +=over 4 + +=item B<Lower> + +Inclusive Lower limit. + +=item B<Upper> + +Exclusive Upper limit. + +=back + +=item B<makerandom_octet()> + +Generates a random octet string of specified length. In addition to +B<Strength>, B<Device> and B<Verbosity>, following arguments can be +specified. + +=over 4 + +=item B<Length> + +Length of the desired octet string. + +=item B<Skip> + +An octet string consisting of characters to be skipped while reading from +the random device. + +=back + +=back + +=head1 DEPENDENCIES + +Crypt::Random needs Math::Pari 2.001802 or higher. As of this writing, the +latest version of Math::Pari isn't available from CPAN. Fetch it from +ftp://ftp.math.ohio-state.edu/pub/users/ilya/perl/modules/ + +=head1 BIBLIOGRAPHY + +=over 4 + +=item 1 random.c by Theodore Ts'o. Found in drivers/char directory of +the Linux kernel sources. + +=item 2 Handbook of Applied Cryptography by Menezes, Paul C. van Oorschot +and Scott Vanstone. + +=back + +=head1 AUTHOR + +Vipul Ved Prakash, <mail@vipul.net> + +=cut + diff --git a/Master/tlpkg/tlperl/lib/Crypt/Random/Generator.pm b/Master/tlpkg/tlperl/lib/Crypt/Random/Generator.pm new file mode 100755 index 00000000000..8833b0e7679 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/Random/Generator.pm @@ -0,0 +1,101 @@ +#!/usr/bin/perl -sw +## +## +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: Generator.pm,v 1.2 2001/06/22 03:43:51 vipul Exp $ + +package Crypt::Random::Generator; +use Crypt::Random qw(makerandom makerandom_itv makerandom_octet); +use Carp; + +my @PROVIDERS = qw(devrandom devurandom egd rand); +my %STRENGTH = ( 0 => [ qw(devurandom egd rand) ], 1 => [ qw(devrandom egd rand) ] ); + +sub new { + + my ($class, %params) = @_; + + my $self = { _STRENGTH => \%STRENGTH, _PROVIDERS => \@PROVIDERS }; + + $$self{Strength} = $params{Strength} || 0; + $$self{Provider} = $params{Provider} || ""; + $$self{ProviderParams} = $params{ProviderParams} || ""; + + bless $self, $class; + + unless ($$self{Provider}) { + SELECT_PROVIDER: for ($self->strength_order($$self{Strength})) { + my $pname = $_; my $fqpname = "Crypt::Random::Provider::$pname"; + if (eval "use $fqpname; $fqpname->available()") { + if (grep { $pname eq $_ } $self->providers) { + $$self{Provider} = $pname; + last SELECT_PROVIDER; + } + } + } + } + + croak "No provider available.\n" unless $$self{Provider}; + return $self; + +} + + +sub providers { + + my ($self, @args) = @_; + if (@args) { $$self{_PROVIDERS} = [@args] } + return @{$$self{_PROVIDERS}}; + +} + + +sub strength_order { + + my ($self, $strength, @args) = @_; + if (@args) { $$self{_STRENGTH}{$strength} = [@args] } + return @{$$self{_STRENGTH}{$strength}} + +} + + +sub integer { + + my ($self, %params) = @_; + if ($params{Size}) { + return makerandom ( + Size => $params{Size}, + Provider => $$self{Provider}, + Verbosity => $params{Verbosity} || $$self{Verbosity}, + %{$$self{ProviderParams}}, + ) + } elsif ($params{Upper}) { + return makerandom_itv ( + Lower => $params{Lower} || 0, + Upper => $params{Upper}, + Provider => $$self{Provider}, + Verbosity => $params{Verbosity} || $$self{Verbosity}, + %{$$self{ProviderParams}}, + ) + } + +} + + +sub string { + + my ($self, %params) = @_; + return makerandom_octet ( + %params, + Provider => $$self{Provider}, + Verbosity => $params{Verbosity} || $$self{Verbosity}, + %{$$self{ProviderParams}}, + ) + +} + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/File.pm b/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/File.pm new file mode 100755 index 00000000000..816f8054d07 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/File.pm @@ -0,0 +1,62 @@ +package Crypt::Random::Provider::File; +use strict; +use Carp; +use Math::Pari qw(pari2num); +use Fcntl; + +sub _defaultsource { + return; +} + + +sub new { + + my ($class, %args) = @_; + my $self = { Source => $args{File} || $args{Device} || $args{Filename} || $class->_defaultsource() }; + return bless $self, $class; + +} + + +sub get_data { + + my ($self, %params) = @_; + $self = {} unless ref $self; + + my $size = $params{Size}; + my $skip = $params{Skip} || $$self{Skip} || ''; + my $q_skip = quotemeta($skip); + + if ($size && ref $size eq "Math::Pari") { + $size = pari2num($size); + } + + my $bytes = $params{Length} || (int($size / 8) + 1); + + sysopen RANDOM, $$self{Source}, O_RDONLY; + + my($r, $read, $rt) = ('', 0); + while ($read < $bytes) { + my $howmany = sysread RANDOM, $rt, $bytes - $read; + next unless $howmany; + if ($howmany == -1) { + croak "Error while reading from $$self{Source}. $!" + } + $rt =~ s/[$q_skip]//g if $skip; + $r .= $rt; + $read = length $r; + } + + $r; + +} + + +sub available { + my ($class) = @_; + return -e $class->_defaultsource(); +} + + +1; + diff --git a/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/devrandom.pm b/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/devrandom.pm new file mode 100755 index 00000000000..a25f59ab14c --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/devrandom.pm @@ -0,0 +1,21 @@ +#!/usr/bin/perl -sw +## +## +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: devrandom.pm,v 1.2 2001/06/22 18:16:29 vipul Exp $ + +package Crypt::Random::Provider::devrandom; +use strict; +use lib qw(lib); +use Crypt::Random::Provider::File; +use vars qw(@ISA); +@ISA = qw(Crypt::Random::Provider::File); + +sub _defaultsource { return "/dev/random" } + +1; + diff --git a/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/devurandom.pm b/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/devurandom.pm new file mode 100755 index 00000000000..d24d4b064ac --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/devurandom.pm @@ -0,0 +1,21 @@ +#!/usr/bin/perl -sw +## +## +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: devurandom.pm,v 1.2 2001/06/22 18:16:29 vipul Exp $ + +package Crypt::Random::Provider::devurandom; +use strict; +use lib qw(lib); +use Crypt::Random::Provider::File; +use vars qw(@ISA); +@ISA = qw(Crypt::Random::Provider::File); + +sub _defaultsource { return "/dev/urandom" } + +1; + diff --git a/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/egd.pm b/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/egd.pm new file mode 100755 index 00000000000..869180c9a49 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/egd.pm @@ -0,0 +1,90 @@ +#!/usr/bin/perl -sw +## +## +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: egd.pm,v 1.5 2001/07/12 15:59:48 vipul Exp $ + +package Crypt::Random::Provider::egd; +use strict; + +use IO::Socket; +use Carp; +use Math::Pari qw(pari2num); + + +sub _defaultsource { + + my $source; + for my $d (qw( /var/run/egd-pool /dev/egd-pool /etc/entropy )) { + if (IO::Socket::UNIX->new(Peer => $d)) { $source = $d; last } + } + return $source; + +} + + +sub new { + + my ($class, %args) = @_; + my $self = { Source => $args{Source} || $args{Device} || $args{Filename} }; + $$self{Source} = $class->_defaultsource() unless $$self{Source}; + croak "egd entropy pool file not found.\n" unless $$self{Source}; + return bless $self, $class; + +} + + +sub get_data { + + my ( $self, %params ) = @_; + my $class = ref $self || $self; + $self = {} unless ref $self; + + my $bytes = $params{Length} || + (int( pari2num($params{ Size }) / 8) + 1); + my $dev = $params{Source} || $$self{Source}; + my $skip = $params{Skip}; + + croak "$dev doesn't exist. aborting." unless $dev && -e $dev; + + my $s = IO::Socket::UNIX->new(Peer => $dev); + croak "couldn't talk to egd. $!" unless $s; + + my($r, $read) = ('', 0); + while ($read < $bytes) { + my $msg = pack "CC", 0x01, 1; + $s->syswrite($msg, length $msg); + my $rt; + my $nread = $s->sysread($rt, 1); + croak "read from entropy socket failed" unless $nread == 1; + my $count = unpack("C", $rt); + $nread = $s->sysread($rt, $count); + croak "couldn't get all the requested entropy. aborting." + unless $nread == $count; + unless ($skip && $skip =~ /\Q$rt\E/) { + if ($params{Verbosity}) { print '.' unless $read % 2 } + $r .= $rt; + $read++; + } + } + + $r; +} + + +sub available { + + my $class = shift; + return 1 if $class->_defaultsource(); + return; + +} + + +1; + + diff --git a/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/rand.pm b/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/rand.pm new file mode 100755 index 00000000000..8f34f193f57 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/Random/Provider/rand.pm @@ -0,0 +1,60 @@ +#!/usr/bin/perl -sw +## +## Crypt::Random::Provider::rand +## +## Copyright (c) 2001, Vipul Ved Prakash. All rights reserved. +## This code is free software; you can redistribute it and/or modify +## it under the same terms as Perl itself. +## +## $Id: rand.pm,v 1.2 2001/06/22 18:16:29 vipul Exp $ + +package Crypt::Random::Provider::rand; +use strict; +use Math::Pari qw(pari2num); + +sub new { + + my ($class, %params) = @_; + my $self = { Source => $params{Source} || sub { return rand($_[0]) } }; + return bless $self, $class; + +} + + +sub get_data { + + my ($self, %params) = @_; + $self = {} unless ref $self; + + my $size = $params{Size}; + my $skip = $params{Skip} || $$self{Skip}; + + if ($size && ref $size eq "Math::Pari") { + $size = pari2num($size); + } + + my $bytes = $params{Length} || (int($size / 8) + 1); + my $source = $$self{Source} || sub { rand($_[0]) }; + + my($r, $read, $rt) = ('', 0); + while ($read < $bytes) { + $rt = chr(int(&$source(256))); + unless ($skip && $skip =~ /\Q$rt\E/) { + $r .= $rt; $read++; + } + } + + $r; + +} + + +sub available { + + return 1; + +} + + +1; + diff --git a/Master/tlpkg/tlperl/lib/Crypt/Rijndael.pm b/Master/tlpkg/tlperl/lib/Crypt/Rijndael.pm new file mode 100755 index 00000000000..e1991fad532 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/Rijndael.pm @@ -0,0 +1,135 @@ +=head1 NAME + +Crypt::Rijndael - Crypt::CBC compliant Rijndael encryption module + +=head1 SYNOPSIS + + use Crypt::Rijndael; + + # keysize() is 32, but 24 and 16 are also possible + # blocksize() is 16 + + $cipher = Crypt::Rijndael->new( "a" x 32, Crypt::Rijndael::MODE_CBC() ); + + $cipher->set_iv($iv); + $crypted = $cipher->encrypt($plaintext); + # - OR - + $plaintext = $cipher->decrypt($crypted); + +=head1 DESCRIPTION + +This module implements the Rijndael cipher, which has just been selected +as the Advanced Encryption Standard. + +=over 4 + +=cut + +package Crypt::Rijndael; +use strict; +use vars qw( $VERSION @ISA ); + +use warnings; +no warnings; + +require DynaLoader; + +$VERSION = '1.09'; +@ISA = qw/DynaLoader/; + +bootstrap Crypt::Rijndael $VERSION; + +=item keysize + +Returns the keysize, which is 32 (bytes). The Rijndael cipher +actually supports keylengths of 16, 24 or 32 bytes, but there is no +way to communicate this to C<Crypt::CBC>. + +=item blocksize + +The blocksize for Rijndael is 16 bytes (128 bits), although the +algorithm actually supports any blocksize that is any multiple of +our bytes. 128 bits, is however, the AES-specified block size, +so this is all we support. + +=item $cipher = Crypt::Rijndael->new( $key [, $mode] ) + +Create a new C<Crypt::Rijndael> cipher object with the given key +(which must be 128, 192 or 256 bits long). The additional C<$mode> +argument is the encryption mode, either C<MODE_ECB> (electronic +codebook mode, the default), C<MODE_CBC> (cipher block chaining, the +same that C<Crypt::CBC> does), C<MODE_CFB> (128-bit cipher feedback), +C<MODE_OFB> (128-bit output feedback), or C<MODE_CTR> (counter mode). + +ECB mode is very insecure (read a book on cryptography if you dont +know why!), so you should probably use CBC mode. + +=item $cipher->set_iv($iv) + +This allows you to change the initial value vector used by the +chaining modes. It is not relevant for ECB mode. + +=item $cipher->encrypt($data) + +Encrypt data. The size of C<$data> must be a multiple of C<blocksize> +(16 bytes), otherwise this function will croak. Apart from that, it +can be of (almost) any length. + +=item $cipher->decrypt($data) + +Decrypts C<$data>. + +=back + +=head2 Encryption modes + +Use these constants to select the cipher type: + +=over 4 + +=item MODE_CBC - Cipher Block Chaining + +=item MODE_CFB - Cipher feedback + +=item MODE_CTR - Counter mode + +=item MODE_ECB - Electronic cookbook mode + +=item MODE_OFB - Output feedback + +=item MODE_PCBC - ignore this one for now :) + +=back + +=head1 SEE ALSO + +L<Crypt::CBC>, http://www.csrc.nist.gov/encryption/aes/ + +=head1 BUGS + +Should EXPORT or EXPORT_OK the MODE constants. + +=head1 AUTHOR + +Currently maintained by brian d foy, C<< <bdfoy@cpan.org> >>. + +Original code by Rafael R. Sevilla. + +The Rijndael Algorithm was developed by Vincent Rijmen and Joan Daemen, +and has been selected as the US Government's Advanced Encryption Standard. + +=head1 SOURCE + +This code is in Github: + + git://github.com/briandfoy/crypt-rijndael.git + +=head1 LICENSE + +This software is licensed under the Lesser GNU Public License. See the included +COPYING file for details. + +=cut + +1; + diff --git a/Master/tlpkg/tlperl/lib/Crypt/SSLeay.pm b/Master/tlpkg/tlperl/lib/Crypt/SSLeay.pm new file mode 100755 index 00000000000..4a9ee5a2c6f --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/SSLeay.pm @@ -0,0 +1,423 @@ +package Crypt::SSLeay; + +use strict; +use vars '$VERSION'; +$VERSION = '0.57'; + +eval { + require XSLoader; + XSLoader::load('Crypt::SSLeay', $VERSION); + 1; +} +or do { + require DynaLoader; + use vars '@ISA'; # not really locally scoped, it just looks that way + @ISA = qw(DynaLoader); + bootstrap Crypt::SSLeay $VERSION; +}; + +use vars qw(%CIPHERS); +%CIPHERS = ( + 'NULL-MD5' => "No encryption with a MD5 MAC", + 'RC4-MD5' => "128 bit RC4 encryption with a MD5 MAC", + 'EXP-RC4-MD5' => "40 bit RC4 encryption with a MD5 MAC", + 'RC2-CBC-MD5' => "128 bit RC2 encryption with a MD5 MAC", + 'EXP-RC2-CBC-MD5' => "40 bit RC2 encryption with a MD5 MAC", + 'IDEA-CBC-MD5' => "128 bit IDEA encryption with a MD5 MAC", + 'DES-CBC-MD5' => "56 bit DES encryption with a MD5 MAC", + 'DES-CBC-SHA' => "56 bit DES encryption with a SHA MAC", + 'DES-CBC3-MD5' => "192 bit EDE3 DES encryption with a MD5 MAC", + 'DES-CBC3-SHA' => "192 bit EDE3 DES encryption with a SHA MAC", + 'DES-CFB-M1' => "56 bit CFB64 DES encryption with a one byte MD5 MAC", +); + +use Crypt::SSLeay::X509; + +# A xsupp bug made this nessesary +sub Crypt::SSLeay::CTX::DESTROY { shift->free; } +sub Crypt::SSLeay::Conn::DESTROY { shift->free; } +sub Crypt::SSLeay::X509::DESTROY { shift->free; } + +1; + +__END__ + +=head1 NAME + +Crypt::SSLeay - OpenSSL support for LWP + +=head1 SYNOPSIS + + lwp-request https://www.example.com + + use LWP::UserAgent; + my $ua = LWP::UserAgent->new; + my $req = HTTP::Request->new('GET', 'https://www.example.com/'); + my $res = $ua->request($req); + print $res->content, "\n"; + +=head1 DESCRIPTION + +This document describes C<Crypt::SSLeay> version 0.57, released +2007-09-17. + +This perl module provides support for the https protocol under LWP, +to allow an C<LWP::UserAgent> object to perform GET, HEAD and POST +requests. Please see LWP for more information on POST requests. + +The C<Crypt::SSLeay> package provides C<Net::SSL>, which is loaded +by C<LWP::Protocol::https> for https requests and provides the +necessary SSL glue. + +This distribution also makes following deprecated modules available: + + Crypt::SSLeay::CTX + Crypt::SSLeay::Conn + Crypt::SSLeay::X509 + +Work on Crypt::SSLeay has been continued only to provide https +support for the LWP (libwww-perl) libraries. + +=head1 ENVIRONMENT VARIABLES + +The following environment variables change the way +C<Crypt::SSLeay> and C<Net::SSL> behave. + + # proxy support + $ENV{HTTPS_PROXY} = 'http://proxy_hostname_or_ip:port'; + + # proxy_basic_auth + $ENV{HTTPS_PROXY_USERNAME} = 'username'; + $ENV{HTTPS_PROXY_PASSWORD} = 'password'; + + # debugging (SSL diagnostics) + $ENV{HTTPS_DEBUG} = 1; + + # default ssl version + $ENV{HTTPS_VERSION} = '3'; + + # client certificate support + $ENV{HTTPS_CERT_FILE} = 'certs/notacacert.pem'; + $ENV{HTTPS_KEY_FILE} = 'certs/notacakeynopass.pem'; + + # CA cert peer verification + $ENV{HTTPS_CA_FILE} = 'certs/ca-bundle.crt'; + $ENV{HTTPS_CA_DIR} = 'certs/'; + + # Client PKCS12 cert support + $ENV{HTTPS_PKCS12_FILE} = 'certs/pkcs12.pkcs12'; + $ENV{HTTPS_PKCS12_PASSWORD} = 'PKCS12_PASSWORD'; + +=head1 INSTALL + +=head2 OpenSSL + +You must have OpenSSL or SSLeay installed before compiling +this module. You can get the latest OpenSSL package from: + + http://www.openssl.org/ + +On Debian systems, you will need to install the libssl-dev package, +at least for the duration of the build (it may be removed afterwards). + +Other package-based systems may require something similar. The key +is that Crypt::SSLeay makes calls to the OpenSSL library, and how +to do so is specified in the C header files that come with the +library. Some systems break out the header files into a separate +package from that of the libraries. Once the program has been built, +you don't need the headers any more. + +When installing openssl make sure your config looks like: + + ./config --openssldir=/usr/local/openssl + or + ./config --openssldir=/usr/local/ssl + +If you are planning on upgrading the default OpenSSL libraries on +a system like RedHat, (not recommended), then try something like: + + ./config --openssldir=/usr --shared + +The --shared option to config will set up building the .so +shared libraries which is important for such systems. This is +followed by: + + make + make test + make install + +This way Crypt::SSLeay will pick up the includes and +libraries automatically. If your includes end up +going into a separate directory like /usr/local/include, +then you may need to symlink /usr/local/openssl/include +to /usr/local/include + +=head2 Crypt::SSLeay + +The latest Crypt::SSLeay can be found at your nearest CPAN, +as well as: + + http://search.cpan.org/dist/Crypt-SSLeay/ + +Once you have downloaded it, Crypt::SSLeay installs easily +using the C<make> * commands as shown below. + + perl Makefile.PL + make + make test + make install + + * use nmake or dmake on Win32 + +For unattended (batch) installations, to be absolutely certain that +F<Makefile.PL> does not prompt for questions on STDIN, set the +following environment variable beforehand: + + PERL_MM_USE_DEFAULT=1 + +(This is true for any CPAN module that uses C<ExtUtils::MakeMaker>). + +=head3 Windows + +C<Crypt::SSLeay> builds correctly with Strawberry Perl. + +For Activestate users, the ActiveState company does not have a +permit from the Canadian Federal Government to distribute cryptographic +software. This prevents C<Crypt::SSLeay> from being distributed as +a PPM package from their repository. See +L<http://aspn.activestate.com/ASPN/docs/ActivePerl/5.8/faq/ActivePerl-faq2.html#crypto_packages> +for more information on this issue. + +You may download it from Randy Kobes's PPM repository by using +the following command: + + ppm install http://theoryx5.uwinnipeg.ca/ppms/Crypt-SSLeay.ppd + +An alternative is to add the uwinnipeg.ca PPM repository to your +local installation. See L<http://cpan.uwinnipeg.ca/htdocs/faqs/ppm.html> +for more details. + +=head3 VMS + +It is assumed that the OpenSSL installation is located at +C</ssl$root>. Define this logical to point to the appropriate +place in the filesystem. + +=head1 PROXY SUPPORT + +LWP::UserAgent and Crypt::SSLeay have their own versions of +proxy support. Please read these sections to see which one +is appropriate. + +=head2 LWP::UserAgent proxy support + +LWP::UserAgent has its own methods of proxying which may work for +you and is likely to be incompatible with Crypt::SSLeay proxy support. +To use LWP::UserAgent proxy support, try something like: + + my $ua = new LWP::UserAgent; + $ua->proxy([qw( https http )], "$proxy_ip:$proxy_port"); + +At the time of this writing, libwww v5.6 seems to proxy https +requests fine with an Apache mod_proxy server. It sends a line like: + + GET https://www.example.com HTTP/1.1 + +to the proxy server, which is not the CONNECT request that +some proxies would expect, so this may not work with other +proxy servers than mod_proxy. The CONNECT method is used +by Crypt::SSLeay's internal proxy support. + +=head2 Crypt::SSLeay proxy support + +For native Crypt::SSLeay proxy support of https requests, +you need to set the environment variable C<HTTPS_PROXY> to your +proxy server and port, as in: + + # proxy support + $ENV{HTTPS_PROXY} = 'http://proxy_hostname_or_ip:port'; + $ENV{HTTPS_PROXY} = '127.0.0.1:8080'; + +Use of the C<HTTPS_PROXY> environment variable in this way +is similar to C<LWP::UserAgent->env_proxy()> usage, but calling +that method will likely override or break the Crypt::SSLeay +support, so do not mix the two. + +Basic auth credentials to the proxy server can be provided +this way: + + # proxy_basic_auth + $ENV{HTTPS_PROXY_USERNAME} = 'username'; + $ENV{HTTPS_PROXY_PASSWORD} = 'password'; + +For an example of LWP scripting with C<Crypt::SSLeay> native proxy +support, please look at the F<eg/lwp-ssl-test> script in the +C<Crypt::SSLeay> distribution. + +=head1 CLIENT CERTIFICATE SUPPORT + +Client certificates are supported. PEM0encoded certificate and +private key files may be used like this: + + $ENV{HTTPS_CERT_FILE} = 'certs/notacacert.pem'; + $ENV{HTTPS_KEY_FILE} = 'certs/notacakeynopass.pem'; + +You may test your files with the F<eg/net-ssl-test> program, +bundled with the distribution, by issuing a command like: + + perl eg/net-ssl-test -cert=certs/notacacert.pem \ + -key=certs/notacakeynopass.pem -d GET $HOST_NAME + +Additionally, if you would like to tell the client where +the CA file is, you may set these. + + $ENV{HTTPS_CA_FILE} = "some_file"; + $ENV{HTTPS_CA_DIR} = "some_dir"; + +There is no sample CA cert file at this time for testing, +but you may configure F<eg/net-ssl-test> to use your CA cert +with the -CAfile option. (TODO: then what is the ./certs +directory in the distribution?) + +=head2 Creating a test certificate + +To create simple test certificates with OpenSSL, you may +run the following command: + + openssl req -config /usr/local/openssl/openssl.cnf \ + -new -days 365 -newkey rsa:1024 -x509 \ + -keyout notacakey.pem -out notacacert.pem + +To remove the pass phrase from the key file, run: + + openssl rsa -in notacakey.pem -out notacakeynopass.pem + +=head2 PKCS12 support + +The directives for enabling use of PKCS12 certificates is: + + $ENV{HTTPS_PKCS12_FILE} = 'certs/pkcs12.pkcs12'; + $ENV{HTTPS_PKCS12_PASSWORD} = 'PKCS12_PASSWORD'; + +Use of this type of certificate takes precedence over previous +certificate settings described. (TODO: unclear? Meaning "the +presence of this type of certificate??) + +=head1 SSL versions + +Crypt::SSLeay tries very hard to connect to I<any> SSL web server +accomodating servers that are buggy, old or simply +not standards-compliant. To this effect, this module will +try SSL connections in this order: + + SSL v23 - should allow v2 and v3 servers to pick their best type + SSL v3 - best connection type + SSL v2 - old connection type + +Unfortunately, some servers seem not to handle a reconnect +to SSL v3 after a failed connect of SSL v23 is tried, +so you may set before using LWP or Net::SSL: + + $ENV{HTTPS_VERSION} = 3; + +to force a version 3 SSL connection first. At this time only a +version 2 SSL connection will be tried after this, as the connection +attempt order remains unchanged by this setting. + +=head1 ACKNOWLEDGEMENTS + +Many thanks to Gisle Aas for writing this module and many others +including libwww, for perl. The web will never be the same :) + +Ben Laurie deserves kudos for his excellent patches for better error +handling, SSL information inspection, and random seeding. + +Thanks to Dongqiang Bai for host name resolution fix when using a +proxy. + +Thanks to Stuart Horner of Core Communications, Inc. who found the +need for building --shared OpenSSL libraries. + +Thanks to Pavel Hlavnicka for a patch for freeing memory when using +a pkcs12 file, and for inspiring more robust read() behavior. + +James Woodyatt is a champ for finding a ridiculous memory leak that +has been the bane of many a Crypt::SSLeay user. + +Thanks to Bryan Hart for his patch adding proxy support, +and thanks to Tobias Manthey for submitting another approach. + +Thanks to Alex Rhomberg for Alpha linux ccc patch. + +Thanks to Tobias Manthey for his patches for client certificate +support. + +Thanks to Daisuke Kuroda for adding PKCS12 certificate support. + +Thanks to Gamid Isayev for CA cert support and insights into error +messaging. + +Thanks to Jeff Long for working through a tricky CA cert SSLClientVerify +issue. + +Thanks to Chip Turner for patch to build under perl 5.8.0. + +Thanks to Joshua Chamas for the time he spent maintaining the +module. + +Thanks to Jeff Lavallee for help with alarms on read failures (CPAN +bug #12444). + +Thanks to Guenter Knauf for significant improvements in configuring +things in Win32 and Netware lands and Jan Dubois for various +suggestions for improvements. + +=head1 SEE ALSO + +=over 4 + +=item Net::SSL + +If you have downloaded this distribution as of a dependency +of another distribution, it's probably due to this module +(which is included in this distribution). + +=item Net::SSLeay + +A module that offers access to the OpenSSL API directly from Perl. + + http://search.cpan.org/dist/Net_SSLeay.pm/ + +=item http://www.openssl.org/related/binaries.html + +Pointers on where to find OpenSSL binary packages (Windows). + +=back + +=head1 SUPPORT + +For use of Crypt::SSLeay & Net::SSL with perl's LWP, please +send email to C<libwww@perl.org>. + +For OpenSSL or general SSL support please email the +openssl user mailing list at C<openssl-users@openssl.org>. +This includes issues associated with building and installing +OpenSSL on one's system. + +Please report all bugs at +L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Crypt-SSLeay>. + +This module was originally written by Gisle Aas, and was subsequently +maintained by Joshua Chamas. It is currently maintained by David +Landgren. + +=head1 COPYRIGHT + + Copyright (c) 2006-2007 David Landgren. + Copyright (c) 1999-2003 Joshua Chamas. + Copyright (c) 1998 Gisle Aas. + +This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +=cut diff --git a/Master/tlpkg/tlperl/lib/Crypt/SSLeay/CTX.pm b/Master/tlpkg/tlperl/lib/Crypt/SSLeay/CTX.pm new file mode 100755 index 00000000000..8712ba81887 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/SSLeay/CTX.pm @@ -0,0 +1,4 @@ +package Crypt::SSLeay::CTX; +require Crypt::SSLeay; +use strict; +1; diff --git a/Master/tlpkg/tlperl/lib/Crypt/SSLeay/Conn.pm b/Master/tlpkg/tlperl/lib/Crypt/SSLeay/Conn.pm new file mode 100755 index 00000000000..80abd4f46a9 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/SSLeay/Conn.pm @@ -0,0 +1,4 @@ +package Crypt::SSLeay::Conn; +require Crypt::SSLeay; +use strict; +1; diff --git a/Master/tlpkg/tlperl/lib/Crypt/SSLeay/Err.pm b/Master/tlpkg/tlperl/lib/Crypt/SSLeay/Err.pm new file mode 100755 index 00000000000..013e4a6b082 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/SSLeay/Err.pm @@ -0,0 +1,4 @@ +package Crypt::SSLeay::Err; +require Crypt::SSLeay; +use strict; +1; diff --git a/Master/tlpkg/tlperl/lib/Crypt/SSLeay/MainContext.pm b/Master/tlpkg/tlperl/lib/Crypt/SSLeay/MainContext.pm new file mode 100755 index 00000000000..fd019364e81 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/SSLeay/MainContext.pm @@ -0,0 +1,42 @@ +package Crypt::SSLeay::MainContext; + +# maintains a single instance of the Crypt::SSLeay::CTX class + +use strict; +use Carp (); + +require Crypt::SSLeay::CTX; + +my $ctx = &main_ctx(); + +sub main_ctx { + my $ssl_version = shift || 23; + + my $ctx = Crypt::SSLeay::CTX->new($ssl_version); + $ctx->set_cipher_list($ENV{CRYPT_SSLEAY_CIPHER}) + if $ENV{CRYPT_SSLEAY_CIPHER}; + + $ctx; +} + +my %sub_cache = ('main_ctx' => \&main_ctx ); + +sub import { + my $pkg = shift; + my $callpkg = caller(); + my @func = @_; + for (@func) { + s/^&//; + Carp::croak("Can't export $_ from $pkg") if /\W/;; + my $sub = $sub_cache{$_}; + unless ($sub) { + my $method = $_; + $method =~ s/^main_ctx_//; # optional prefix + $sub = $sub_cache{$_} = sub { $ctx->$method(@_) }; + } + no strict 'refs'; + *{"${callpkg}::$_"} = $sub; + } +} + +1; diff --git a/Master/tlpkg/tlperl/lib/Crypt/SSLeay/X509.pm b/Master/tlpkg/tlperl/lib/Crypt/SSLeay/X509.pm new file mode 100755 index 00000000000..5fd50ca6cb7 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/SSLeay/X509.pm @@ -0,0 +1,26 @@ +package Crypt::SSLeay::X509; + +use strict; + +sub not_before { + my $cert = shift; + not_string2time($cert->get_notBeforeString); +} + +sub not_after { + my $cert = shift; + not_string2time($cert->get_notAfterString); +} + +sub not_string2time { + my $string = shift; + # $string has the form 021019235959Z + my($year, $month, $day, $hour, $minute, $second, $GMT)= + $string=~m/(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(Z)?/; + $year += 2000; + my $time="$year-$month-$day $hour:$minute:$second"; + $time .= " GMT" if $GMT; + $time; +} + +1; diff --git a/Master/tlpkg/tlperl/lib/Crypt/Twofish.pm b/Master/tlpkg/tlperl/lib/Crypt/Twofish.pm new file mode 100755 index 00000000000..ed4b125a051 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Crypt/Twofish.pm @@ -0,0 +1,159 @@ +# $Id: Twofish.pm,v 2.12 2001/05/21 17:38:01 ams Exp $ +# Copyright 2001 Abhijit Menon-Sen <ams@toroid.org> + +package Crypt::Twofish; + +use strict; +use Carp; +use DynaLoader; +use vars qw( @ISA $VERSION ); + +@ISA = qw( DynaLoader ); +$VERSION = '2.13'; + +bootstrap Crypt::Twofish $VERSION; + +sub keysize () { 16 } +sub blocksize () { 16 } + +sub new +{ + my ($class, $key) = @_; + + croak "Usage: ".__PACKAGE__."->new(\$key)" unless $key; + return Crypt::Twofish::setup($key); +} + +sub encrypt +{ + my ($self, $data) = @_; + + croak "Usage: \$cipher->encrypt(\$data)" unless ref($self) && $data; + $self->crypt($data, $data, 0); +} + +sub decrypt +{ + my ($self, $data) = @_; + + croak "Usage: \$cipher->decrypt(\$data)" unless ref($self) && $data; + $self->crypt($data, $data, 1); +} + +# The functions below provide an interface that is call-compatible with +# the Crypt::Twofish 1.0 module. They do not, however, behave in exactly +# the same way: they don't pad keys, and cannot decrypt ciphertext which +# was written by the old module. +# +# (This interface is deprecated. Please use the documented interface +# instead). + +sub Encipher +{ + my ($key, $keylength, $plaintext) = @_; + + require Crypt::CBC; + my $cipher = Crypt::CBC->new($key, "Twofish"); + return $cipher->encrypt($plaintext); +} + +sub Decipher +{ + my ($key, $keylength, $ciphertext, $cipherlength) = @_; + + require Crypt::CBC; + my $cipher = Crypt::CBC->new($key, "Twofish"); + return $cipher->decrypt($ciphertext); +} + +sub LastError { ""; } +sub CheckTwofish { undef; } + +1; + +__END__ + +=head1 NAME + +Crypt::Twofish - The Twofish Encryption Algorithm + +=head1 SYNOPSIS + +use Crypt::Twofish; + +$cipher = Crypt::Twofish->new($key); + +$ciphertext = $cipher->encrypt($plaintext); + +$plaintext = $cipher->decrypt($ciphertext); + +=head1 DESCRIPTION + +Twofish is a 128-bit symmetric block cipher with a variable length (128, +192, or 256-bit) key, developed by Counterpane Labs. It is unpatented +and free for all uses, as described at +<URL:http://www.counterpane.com/twofish.html>. + +This module implements Twofish encryption. It supports the Crypt::CBC +interface, with the functions described below. It also provides an +interface that is call-compatible with Crypt::Twofish 1.0, but its use +in new code is strongly discouraged. + +=head2 Functions + +=over + +=item blocksize + +Returns the size (in bytes) of the block (16, in this case). + +=item keysize + +Returns the size (in bytes) of the key. Although the module understands +128, 192, and 256-bit keys, it returns 16 for compatibility with +Crypt::CBC. + +=item new($key) + +This creates a new Crypt::Twofish object with the specified key (which +should be 16, 24, or 32 bytes long). + +=item encrypt($data) + +Encrypts blocksize() bytes of $data and returns the corresponding +ciphertext. + +=item decrypt($data) + +Decrypts blocksize() bytes of $data and returns the corresponding +plaintext. + +=back + +=head1 SEE ALSO + +Crypt::CBC, Crypt::Blowfish, Crypt::TEA + +=head1 ACKNOWLEDGEMENTS + +=over 4 + +=item Nishant Kakani + +For writing Crypt::Twofish 1.0 (this version is a complete rewrite). + +=item Tony Cook + +For making the module work under Activeperl, testing on several +platforms, and suggesting that I probe for features via %Config. + +=back + +=head1 AUTHOR + +Abhijit Menon-Sen <ams@toroid.org> + +Copyright 2001 Abhijit Menon-Sen. + +This module is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. |