File Coverage

blib/lib/Crypt/DSA/KeyChain.pm
Criterion Covered Total %
statement 120 120 100.0
branch 31 48 64.6
condition 8 12 66.7
subroutine 13 13 100.0
pod 3 3 100.0
total 175 196 89.3


line stmt bran cond sub pod time code
1             # $Id: KeyChain.pm 1938 2006-05-03 06:20:36Z btrott $
2              
3             package Crypt::DSA::KeyChain;
4 6     6   85 use strict;
  6         82  
  6         87  
5              
6 6     6   213 use Math::BigInt lib => 'GMP';
  6         58  
  6         85  
7 6     6   115 use Digest::SHA1 qw( sha1 );
  6         57  
  6         90  
8 6     6   92 use Carp qw( croak );
  6         57  
  6         144  
9 6     6   406 use IPC::Open3;
  6         63  
  6         200  
10 6     6   107 use File::Spec;
  6         55  
  6         233  
11 6     6   92 use Symbol qw( gensym );
  6         55  
  6         153  
12              
13 6     6   329 use Crypt::DSA::Key;
  6         67  
  6         132  
14 6     6   101 use Crypt::DSA::Util qw( bin2mp bitsize mod_exp makerandom isprime );
  6         55  
  6         114  
15              
16             sub new {
17 6     6 1 62     my $class = shift;
18 6         122     bless { @_ }, $class;
19             }
20              
21             sub generate_params {
22 6     6 1 59     my $keygen = shift;
23 6         94     my %param = @_;
24              
25 6         117     my $bits = Math::BigInt->new($param{Size});
26 6 50       95     croak "Number of bits (Size) is too small" unless $bits;
27 6 50 66     342     delete $param{Seed} if $param{Seed} && length $param{Seed} != 20;
28 6         69     my $v = $param{Verbosity};
29              
30             # try to use fast implementations found on the system, if available.
31 6 100 66     152     unless ($param{Seed} || wantarray || $param{PurePerl}) {
      66        
32              
33             # OpenSSL support
34 5 50       119         my $bin = $^O eq 'MSWin32' ? 'openssl.exe' : 'openssl';
35 5         433426         my $openssl = `which $bin`;
36 5         460         chomp $openssl;
37 5 50       391         if ($openssl) {
38 5 50       188             print STDERR "Using openssl\n" if $v;
39 5         136             my $bits_n = int($bits);
40 5         3035             open( NULL, ">", File::Spec->devnull );
41 5         590             my $pid = open3( gensym, \*OPENSSL, ">&NULL", "$openssl dsaparam -text -noout $bits_n" );
42 5         419137             my @res;
43 5         5981526             while( <OPENSSL> ) {
44 92         3164                 push @res, $_;
45                         }
46 5         269             waitpid( $pid, 0 );
47              
48 5         115             my %parts;
49 5         109             my $cur_part;
50 5         111             foreach (@res) {
51 92 100       1496                 if (/^\s+(\w):\s*$/) {
52 15         987                     $cur_part = $1;
53 15         178                     next;
54                             }
55 77 100       1999                 if (/^\s*((?:[0-9a-f]{2,2}:?)+)\s*$/) {
56 72         1233                     $parts{$cur_part} .= $1;
57                             }
58                         }
59              
60 5         87             $parts{$_} =~ s/://g for keys %parts;
  5         712  
61              
62 5 50       145             if (scalar keys %parts == 3) {
63 5         587                 my $key = Crypt::DSA::Key->new;
64 5         435                 $key->p(Math::BigInt->new("0x" . $parts{p}));
65 5         102                 $key->q(Math::BigInt->new("0x" . $parts{q}));
66 5         92                 $key->g(Math::BigInt->new("0x" . $parts{g}));
67 5         598                 return $key;
68                         }
69                     }
70              
71                 }
72              
73             # Pure Perl version:
74              
75 1         11     my($counter, $q, $p, $seed, $seedp1) = (0);
76              
77             ## Generate q.
78                 {
79 1 50       9         print STDERR "." if $v;
  1         11  
80 1 50       13         $seed = $param{Seed} ? delete $param{Seed} :
81                         join '', map chr rand 256, 1..20;
82 1         11         $seedp1 = _seed_plus_one($seed);
83 1         41         my $md = sha1($seed) ^ sha1($seedp1);
84 1         12         vec($md, 0, 8) |= 0x80;
85 1         11         vec($md, 19, 8) |= 0x01;
86 1         13         $q = bin2mp($md);
87 1 50       2429         redo unless isprime($q);
88                 }
89              
90 1 50       14     print STDERR "*\n" if $v;
91 1         10     my $n = int(("$bits"-1) / 160);
92 1         10     my $b = ($bits-1)-Math::BigInt->new($n)*160;
93 1         283     my $p_test = Math::BigInt->new(1); $p_test <<= ($bits-1);
  1         10  
94              
95             ## Generate p.
96                 {
97 1 50       3685         print STDERR "." if $v;
  106         1466  
98 106         1521         my $W = Math::BigInt->new(0);
99 106         143088         for my $k (0..$n) {
100 424         212561             $seedp1 = _seed_plus_one($seedp1);
101 424         8364             my $r0 = bin2mp(sha1($seedp1));
102 424 100       3288823             $r0 %= Math::BigInt->new(2) ** $b
103                             if $k == $n;
104 424         429478             $W += $r0 << (Math::BigInt->new(160) * $k);
105                     }
106 106         2054         my $X = $W + $p_test;
107 106         1689         $p = $X - ($X % (2 * $q) - 1);
108 106 100 66     1569         last if $p >= $p_test && isprime($p);
109 105 50       32205         redo unless ++$counter >= 4096;
110                 }
111              
112 1 50       14     print STDERR "*" if $v;
113 1         11     my $e = ($p - 1) / $q;
114 1         3326     my $h = Math::BigInt->new(2);
115 1         78     my $g;
116                 {
117 1         130         $g = mod_exp($h, $e, $p);
  1         18  
118 1 50       22         $h++, redo if $g == 1;
119                 }
120 1 50       273     print STDERR "\n" if $v;
121              
122 1         78     my $key = Crypt::DSA::Key->new;
123 1         18     $key->p($p);
124 1         47     $key->q($q);
125 1         25     $key->g($g);
126              
127 1 50       11     return wantarray ? ($key, $counter, "$h", $seed) : $key;
128             }
129              
130             sub generate_keys {
131 6     6 1 64     my $keygen = shift;
132 6         81     my $key = shift;
133 6         57     my($priv_key, $pub_key);
134                 {
135 6         60         my $i = bitsize($key->q);
  6         74  
136 6         12009         $priv_key = makerandom(Size => $i);
137 6 100       14724         $priv_key -= $key->q if $priv_key >= $key->q;
138 6 50       64         redo if $priv_key == 0;
139                 }
140 6         2554     $pub_key = mod_exp($key->g, $priv_key, $key->p);
141 6         85800174     $key->priv_key($priv_key);
142 6         80     $key->pub_key($pub_key);
143             }
144              
145             sub _seed_plus_one {
146 425     425   6604     my($s, $i) = ($_[0]);
147                 for ($i=19; $i>=0; $i--) {
148 427         5214         vec($s, $i, 8)++;
149 427 100       5393         last unless vec($s, $i, 8) == 0;
150 425         4169     }
151 425         5742     $s;
152             }
153              
154             1;
155             __END__
156            
157             =head1 NAME
158            
159             Crypt::DSA::KeyChain - DSA key generation system
160            
161             =head1 SYNOPSIS
162            
163             use Crypt::DSA::KeyChain;
164             my $keychain = Crypt::DSA::KeyChain->new;
165            
166             my $key = $keychain->generate_params(
167             Size => 512,
168             Seed => $seed,
169             Verbosity => 1,
170             );
171            
172             $keychain->generate_keys($key);
173            
174             =head1 DESCRIPTION
175            
176             I<Crypt::DSA::KeyChain> is a lower-level interface to key
177             generation than the interface in I<Crypt::DSA> (the I<keygen>
178             method). It allows you to separately generate the I<p>, I<q>,
179             and I<g> key parameters, given an optional starting seed, and
180             a mandatory bit size for I<p> (I<q> and I<g> are 160 bits each).
181            
182             You can then call I<generate_keys> to generate the public and
183             private portions of the key.
184            
185             =head1 USAGE
186            
187             =head2 $keychain = Crypt::DSA::KeyChain->new
188            
189             Constructs a new I<Crypt::DSA::KeyChain> object. At the moment
190             this isn't particularly useful in itself, other than being the
191             object you need in order to call the other methods.
192            
193             Returns the new object.
194            
195             =head2 $key = $keychain->generate_params(%arg)
196            
197             Generates a set of DSA parameters: the I<p>, I<q>, and I<g>
198             values of the key. This involves finding primes, and as such
199             it can be a relatively long process.
200            
201             When invoked in scalar context, returns a new
202             I<Crypt::DSA::Key> object.
203            
204             In list context, returns the new I<Crypt::DSA::Key> object,
205             along with: the value of the internal counter when a suitable
206             prime I<p> was found; the value of I<h> when I<g> was derived;
207             and the value of the seed (a 20-byte string) when I<q> was
208             found. These values aren't particularly useful in normal
209             circumstances, but they could be useful.
210            
211             I<%arg> can contain:
212            
213             =over 4
214            
215             =item * Size
216            
217             The size in bits of the I<p> value to generate. The I<q> and
218             I<g> values are always 160 bits each.
219            
220             This argument is mandatory.
221            
222             =item * Seed
223            
224             A seed with which I<q> generation will begin. If this seed does
225             not lead to a suitable prime, it will be discarded, and a new
226             random seed chosen in its place, until a suitable prime can be
227             found.
228            
229             This is entirely optional, and if not provided a random seed will
230             be generated automatically.
231            
232             =item * Verbosity
233            
234             Should be either 0 or 1. A value of 1 will give you a progress
235             meter during I<p> and I<q> generation--this can be useful, since
236             the process can be relatively long.
237            
238             The default is 0.
239            
240             =back
241            
242             =head2 $keychain->generate_keys($key)
243            
244             Generates the public and private portions of the key I<$key>,
245             a I<Crypt::DSA::Key> object.
246            
247             =head1 AUTHOR & COPYRIGHT
248            
249             Please see the Crypt::DSA manpage for author, copyright,
250             and license information.
251            
252             =cut
253