home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / KeyChain.pm < prev    next >
Encoding:
Perl POD Document  |  2001-05-02  |  5.1 KB  |  206 lines

  1. # $Id: KeyChain.pm,v 1.6 2001/03/27 02:02:51 btrott Exp $
  2.  
  3. package Crypt::DSA::KeyChain;
  4. use strict;
  5.  
  6. use Math::Pari qw( PARI isprime );
  7. use Digest::SHA1 qw( sha1 );
  8. use Crypt::Random qw( makerandom );
  9. use Carp qw( croak );
  10.  
  11. use Crypt::DSA::Key;
  12. use Crypt::DSA::Util qw( bin2mp bitsize mod_exp );
  13.  
  14. sub new {
  15.     my $class = shift;
  16.     bless { @_ }, $class;
  17. }
  18.  
  19. sub generate_params {
  20.     my $keygen = shift;
  21.     my %param = @_;
  22.  
  23.     my $bits = PARI($param{Size});
  24.     croak "Number of bits (Size) is too small" unless $bits;
  25.     delete $param{Seed} if $param{Seed} && length $param{Seed} != 20;
  26.     my $v = $param{Verbosity};
  27.  
  28.     my($counter, $q, $p, $seed, $seedp1) = (0);
  29.  
  30.     ## Generate q.
  31.     {
  32.         print STDERR "." if $v;
  33.         $seed = $param{Seed} ? delete $param{Seed} :
  34.             join '', map chr rand 255, 1..20;
  35.         $seedp1 = _seed_plus_one($seed);
  36.         my $md = sha1($seed) ^ sha1($seedp1);
  37.         vec($md, 0, 8) |= 0x80;
  38.         vec($md, 19, 8) |= 0x01;
  39.         $q = bin2mp($md);
  40.         redo unless isprime($q);
  41.     }
  42.  
  43.     print STDERR "*\n" if $v;
  44.     my $n = int(("$bits"-1) / 160);
  45.     my $b = ($bits-1)-PARI($n)*160;
  46.     my $p_test = PARI(1); $p_test <<= ($bits-1);
  47.  
  48.     ## Generate p.
  49.     {
  50.         print STDERR "." if $v;
  51.         my $W = PARI(0);
  52.         for my $k (0..$n) {
  53.             $seedp1 = _seed_plus_one($seedp1);
  54.             my $r0 = bin2mp(sha1($seedp1));
  55.             $r0 %= PARI(2) ** $b
  56.                 if $k == $n;
  57.             $W += $r0 << (PARI(160) * $k);
  58.         }
  59.         my $X = $W + $p_test;
  60.         $p = $X - ($X % (2 * $q) - 1);
  61.         last if $p >= $p_test && isprime($p);
  62.         redo unless ++$counter >= 4096;
  63.     }
  64.  
  65.     print STDERR "*" if $v;
  66.     my $e = ($p - 1) / $q;
  67.     my $h = PARI(2);
  68.     my $g;
  69.     {
  70.         $g = mod_exp($h, $e, $p);
  71.         $h++, redo if $g == 1;
  72.     }
  73.     print STDERR "\n" if $v;
  74.  
  75.     my $key = Crypt::DSA::Key->new;
  76.     $key->p($p);
  77.     $key->q($q);
  78.     $key->g($g);
  79.  
  80.     return wantarray ? ($key, $counter, "$h", $seed) : $key;
  81. }
  82.  
  83. sub generate_keys {
  84.     my $keygen = shift;
  85.     my $key = shift;
  86.     my($priv_key, $pub_key);
  87.     {
  88.         my $i = bitsize($key->q);
  89.         $priv_key = makerandom(Size => $i, Strength => 0);
  90.         $priv_key -= $key->q if $priv_key >= $key->q;
  91.         redo if $priv_key == 0;
  92.     }
  93.     $pub_key = mod_exp($key->g, $priv_key, $key->p);
  94.     $key->priv_key($priv_key);
  95.     $key->pub_key($pub_key);
  96. }
  97.  
  98. sub _seed_plus_one {
  99.     my($s, $i) = ($_[0]);
  100.     for ($i=19; $i>=0; $i--) {
  101.         vec($s, $i, 8)++;
  102.         last unless vec($s, $i, 8) == 0;
  103.     }
  104.     $s;
  105. }
  106.  
  107. 1;
  108. __END__
  109.  
  110. =head1 NAME
  111.  
  112. Crypt::DSA::KeyChain - DSA key generation system
  113.  
  114. =head1 SYNOPSIS
  115.  
  116.     use Crypt::DSA::KeyChain;
  117.     my $keychain = Crypt::DSA::KeyChain->new;
  118.  
  119.     my $key = $keychain->generate_params(
  120.                     Size      => 512,
  121.                     Seed      => $seed,
  122.                     Verbosity => 1,
  123.               );
  124.  
  125.     $keychain->generate_keys($key);
  126.  
  127. =head1 DESCRIPTION
  128.  
  129. I<Crypt::DSA::KeyChain> is a lower-level interface to key
  130. generation than the interface in I<Crypt::DSA> (the I<keygen>
  131. method). It allows you to separately generate the I<p>, I<q>,
  132. and I<g> key parameters, given an optional starting seed, and
  133. a mandatory bit size for I<p> (I<q> and I<g> are 160 bits each).
  134.  
  135. You can then call I<generate_keys> to generate the public and
  136. private portions of the key.
  137.  
  138. =head1 USAGE
  139.  
  140. =head2 $keychain = Crypt::DSA::KeyChain->new
  141.  
  142. Constructs a new I<Crypt::DSA::KeyChain> object. At the moment
  143. this isn't particularly useful in itself, other than being the
  144. object you need in order to call the other methods.
  145.  
  146. Returns the new object.
  147.  
  148. =head2 $key = $keychain->generate_params(%arg)
  149.  
  150. Generates a set of DSA parameters: the I<p>, I<q>, and I<g>
  151. values of the key. This involves finding primes, and as such
  152. it can be a relatively long process.
  153.  
  154. When invoked in scalar context, returns a new
  155. I<Crypt::DSA::Key> object.
  156.  
  157. In list context, returns the new I<Crypt::DSA::Key> object,
  158. along with: the value of the internal counter when a suitable
  159. prime I<p> was found; the value of I<h> when I<g> was derived;
  160. and the value of the seed (a 20-byte string) when I<q> was
  161. found. These values aren't particularly useful in normal
  162. circumstances, but they could be useful.
  163.  
  164. I<%arg> can contain:
  165.  
  166. =over 4
  167.  
  168. =item * Size
  169.  
  170. The size in bits of the I<p> value to generate. The I<q> and
  171. I<g> values are always 160 bits each.
  172.  
  173. This argument is mandatory.
  174.  
  175. =item * Seed
  176.  
  177. A seed with which I<q> generation will begin. If this seed does
  178. not lead to a suitable prime, it will be discarded, and a new
  179. random seed chosen in its place, until a suitable prime can be
  180. found.
  181.  
  182. This is entirely optional, and if not provided a random seed will
  183. be generated automatically.
  184.  
  185. =item * Verbosity
  186.  
  187. Should be either 0 or 1. A value of 1 will give you a progress
  188. meter during I<p> and I<q> generation--this can be useful, since
  189. the process can be relatively long.
  190.  
  191. The default is 0.
  192.  
  193. =back
  194.  
  195. =head2 $keychain->generate_keys($key)
  196.  
  197. Generates the public and private portions of the key I<$key>,
  198. a I<Crypt::DSA::Key> object.
  199.  
  200. =head1 AUTHOR & COPYRIGHT
  201.  
  202. Please see the Crypt::DSA manpage for author, copyright,
  203. and license information.
  204.  
  205. =cut
  206.