diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Crypt/DSA/KeyChain.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/Crypt/DSA/KeyChain.pm | 257 |
1 files changed, 257 insertions, 0 deletions
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 |