File Coverage

blib/lib/Crypt/DSA/Util.pm
Criterion Covered Total %
statement 88 107 82.2
branch 16 30 53.3
condition 5 6 83.3
subroutine 18 21 85.7
pod 5 10 50.0
total 132 174 75.8


line stmt bran cond sub pod time code
1             package Crypt::DSA::Util;
2              
3 8     8   140981 use strict;
  8         12  
  8         237  
4 8     8   25 use warnings;
  8         11  
  8         382  
5 8     8   28 use Math::BigInt 1.78 try => 'GMP, Pari';
  8         124  
  8         43  
6 8     8   964 use Crypt::SysRandom qw (random_bytes);
  8         4504  
  8         432  
7              
8 8     8   46 use Fcntl;
  8         25  
  8         1762  
9 8     8   35 use Carp qw( croak );
  8         10  
  8         492  
10              
11             our $VERSION = '1.24'; #VERSION
12              
13 8     8   33 use vars qw( $VERSION @ISA @EXPORT_OK );
  8         13  
  8         396  
14 8     8   46 use Exporter;
  8         37  
  8         540  
15              
16             BEGIN {
17 8     8   142 @ISA = qw( Exporter );
18 8         4411 @EXPORT_OK = qw( bitsize bin2mp mp2bin mod_inverse mod_exp makerandom randombelow isprime );
19             }
20              
21             ## Nicked from Crypt::RSA::DataFormat.
22             ## Copyright (c) 2001, Vipul Ved Prakash.
23             sub bitsize {
24 294     294 1 6262 length(Math::BigInt->new($_[0])->as_bin) - 2;
25             }
26              
27             sub bin2mp {
28 987     987 1 141253 my $s = shift;
29 987 100       5828 $s eq '' ?
30             Math::BigInt->new(0) :
31             Math::BigInt->new("0b" . unpack("B*", $s));
32             }
33              
34             sub mp2bin {
35 3     3 1 2942 my $p = Math::BigInt->new(shift);
36 3         233 my $base = Math::BigInt->new(256);
37 3         220 my $res = '';
38 3         10 while ($p != 0) {
39 41         6429 my $r = $p % $base;
40 41         3846 $p = ($p-$r) / $base;
41 41         11232 $res = chr($r) . $res;
42             }
43 3         456 $res;
44             }
45              
46             sub mod_exp {
47 6     6 1 303 my($a, $exp, $n) = @_;
48 6         26 $a->copy->bmodpow($exp, $n);
49             }
50              
51             sub mod_inverse {
52 3     3 1 2235 my($a, $n) = @_;
53 3         17 $a->copy->bmodinv($n);
54             }
55              
56             sub makerandom {
57 0     0 0 0 my %param = @_;
58 0         0 my $size = $param{Size};
59 0         0 my $bytes = int($size / 8) + 1;
60 0         0 my $r = random_bytes($bytes);
61 0         0 my $down = $size - 1;
62 0 0       0 $r = unpack 'H*', pack 'B*', '0' x ( $size % 8 ? 8 - $size % 8 : 0 ) .
63             '1' . unpack "b$down", $r;
64 0         0 Math::BigInt->new('0x' . $r);
65             }
66              
67             # Uniform random integer in [0, $n-1] with no modulo bias (rejection
68             # sampling). Unlike makerandom(), this does NOT force the high bit, so
69             # it is correct for DSA nonces and private keys, which must be uniform
70             # in [1, q-1]. makerandom() forces the high bit to obtain an exactly
71             # N-bit value for prime search, which biases a nonce/key: folding its
72             # output with "v -= q if v >= q" leaves the band [2^N-q, 2^(N-1)-1]
73             # unreachable (CWE-330, biased-nonce -> lattice key recovery).
74             sub randombelow {
75 2     2 0 12 my $n = shift;
76 2 50       7 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt';
77 2 50       23 croak "randombelow: argument must be > 0" unless $n > 0;
78 2         318 my $bits = length($n->as_bin) - 2;
79 2         794 my $bytes = int(($bits + 7) / 8) + 1; # one byte of headroom
80 2         12 my $rmax = Math::BigInt->new(2) ** (8 * $bytes);
81 2         1399 my $limit = $rmax - ($rmax % $n); # largest multiple of $n <= rmax
82 2         709 my $r;
83 2         289 do {
84 2         53 $r = Math::BigInt->new('0x' . unpack('H*', random_bytes($bytes)));
85             } while $r >= $limit;
86 2         1493 $r % $n;
87             }
88              
89             # For testing, let us choose our isprime function:
90             *isprime = \&isprime_algorithms_with_perl;
91              
92             # CSPRNG-drawn Miller-Rabin base, uniform enough in [2, n-2]. A witness
93             # only has to be a random base in range for the strong-pseudoprime test
94             # to be sound, so (unlike a secret nonce) a plain draw with a few extra
95             # bytes of headroom is fine -- the modulo bias is immaterial here.
96             sub _random_base {
97 289     289   604 my ($n) = @_;
98 289         942 my $range = $n - 3; # 0 .. n-4
99 289         65942 my $bytes = int(bitsize($n) / 8) + 8; # headroom keeps bias negligible
100 289         487554 my $r = Math::BigInt->new('0x' . unpack 'H*', random_bytes($bytes));
101 289         568376 ($r % $range) + 2; # 2 .. n-2
102             }
103              
104             # from the book "Mastering Algorithms with Perl" by Jon Orwant,
105             # Jarkko Hietaniemi, and John Macdonald
106             sub isprime_algorithms_with_perl {
107 8     8   46 use integer;
  8         10  
  8         51  
108 274     274 0 8695 my $n = shift;
109 274 50       921 return 0 if $n < 2;
110 274 50       35388 return 1 if $n < 4; # 2 and 3 are prime
111 274 50       31468 return 0 unless $n % 2; # even n > 2 (also keeps _random_base's
112             # [2, n-2] range non-degenerate)
113 274         54967 my $n1 = $n - 1;
114 274         52652 my $one = $n - $n1; # not just 1, but a bigint
115              
116             # find the power of two for the top bit of $n1
117 274         47968 my $p2 = $one;
118 274         484 my $p2index = -1;
119 274         762 ++$p2index, $p2 *= 2
120             while $p2 <= $n1;
121 274         22757005 $p2 /= 2;
122              
123             # number of iterations: 5 for 260-bit numbers, go up to 25 for smaller
124 274         87537 my $last_witness = 5;
125 274 100       1100 $last_witness += (260 - $p2index) / 13 if $p2index < 260;
126              
127 274         643 for my $witness_count (1..$last_witness) {
128             # Fresh, independent CSPRNG witness every round. The old code
129             # accumulated witnesses from int(rand(1024)) -- Perl's predictable
130             # Mersenne-Twister PRNG, and correlated round-to-round -- which
131             # both weakens each round and breaks the independence the
132             # Miller-Rabin error bound assumes.
133 289         2659 my $witness = _random_base($n);
134              
135 289         173009 my $prod = $one;
136 289         455 my $n1bits = $n1;
137 289         447 my $p2next = $p2;
138              
139             # compute $witness ** ($n - 1)
140 289         392 while (1) {
141 130720   100     32769213 my $rootone = $prod == 1 || $prod == $n1;
142 130720         19084612 $prod = ($prod * $prod) % $n;
143 130720 50 66     236411593 return 0 if $prod == 1 && ! $rootone;
144 130720 100       16822390 if ($n1bits >= $p2next) {
145 65363         1957887 $prod = ($prod * $witness) % $n;
146 65363         116391617 $n1bits -= $p2next;
147             }
148 130720 100       9312670 last if $p2next == 1;
149 130431         15914717 $p2next /= 2;
150             }
151 289 100       32943 return 0 unless $prod == 1;
152             }
153 2         266 return 1;
154             }
155              
156             sub isprime_gp_pari {
157 0     0 0   my $n = shift;
158              
159 0           my $sn = "$n";
160 0 0         die if $sn =~ /\D/;
161              
162 0           my $is_prime = `echo "isprime($sn)" | gp -f -q`;
163 0 0         die "No gp installed?" if $?;
164              
165 0           chomp $is_prime;
166 0           return $is_prime;
167             }
168              
169             sub isprime_paranoid {
170 0     0 0   my $n = shift;
171              
172 0           my $perl = isprime_algorithms_with_perl($n);
173 0           my $pari = isprime_gp_pari($n);
174              
175 0 0         die "Perl vs. PARI don't match on '$n'\n" unless $perl == $pari;
176 0           return $perl;
177             }
178              
179             1;
180             __END__