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   147120 use strict;
  8         9  
  8         205  
4 8     8   24 use warnings;
  8         9  
  8         334  
5 8     8   25 use Math::BigInt 1.78 try => 'GMP, Pari';
  8         135  
  8         42  
6 8     8   3804 use Crypt::URandom qw (urandom);
  8         29422  
  8         449  
7              
8 8     8   46 use Fcntl;
  8         10  
  8         1529  
9 8     8   36 use Carp qw( croak );
  8         11  
  8         398  
10              
11             our $VERSION = '1.23'; #VERSION
12              
13 8     8   31 use vars qw( $VERSION @ISA @EXPORT_OK );
  8         8  
  8         384  
14 8     8   31 use Exporter;
  8         38  
  8         492  
15              
16             BEGIN {
17 8     8   104 @ISA = qw( Exporter );
18 8         4326 @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 169     169 1 7571 length(Math::BigInt->new($_[0])->as_bin) - 2;
25             }
26              
27             sub bin2mp {
28 175     175 1 139234 my $s = shift;
29 175 100       1335 $s eq '' ?
30             Math::BigInt->new(0) :
31             Math::BigInt->new("0b" . unpack("B*", $s));
32             }
33              
34             sub mp2bin {
35 3     3 1 3863 my $p = Math::BigInt->new(shift);
36 3         277 my $base = Math::BigInt->new(256);
37 3         302 my $res = '';
38 3         15 while ($p != 0) {
39 41         7248 my $r = $p % $base;
40 41         4249 $p = ($p-$r) / $base;
41 41         12277 $res = chr($r) . $res;
42             }
43 3         509 $res;
44             }
45              
46             sub mod_exp {
47 6     6 1 387 my($a, $exp, $n) = @_;
48 6         18 $a->copy->bmodpow($exp, $n);
49             }
50              
51             sub mod_inverse {
52 3     3 1 2334 my($a, $n) = @_;
53 3         14 $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 = urandom($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 5 my $n = shift;
76 2 50       12 $n = Math::BigInt->new("$n") unless ref($n) eq 'Math::BigInt';
77 2 50       8 croak "randombelow: argument must be > 0" unless $n > 0;
78 2         292 my $bits = length($n->as_bin) - 2;
79 2         846 my $bytes = int(($bits + 7) / 8) + 1; # one byte of headroom
80 2         1646 my $rmax = Math::BigInt->new(2) ** (8 * $bytes);
81 2         1321 my $limit = $rmax - ($rmax % $n); # largest multiple of $n <= rmax
82 2         747 my $r;
83 2         4 do {
84 2         10 $r = Math::BigInt->new('0x' . unpack('H*', urandom($bytes)));
85             } while $r >= $limit;
86 2         1220 $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 164     164   335 my ($n) = @_;
98 164         436 my $range = $n - 3; # 0 .. n-4
99 164         37895 my $bytes = int(bitsize($n) / 8) + 8; # headroom keeps bias negligible
100 164         92204 my $r = Math::BigInt->new('0x' . unpack 'H*', urandom($bytes));
101 164         144694 ($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   82 use integer;
  8         10  
  8         44  
108 149     149 0 495 my $n = shift;
109 149 50       611 return 0 if $n < 2;
110 149 50       20147 return 1 if $n < 4; # 2 and 3 are prime
111 149 50       17003 return 0 unless $n % 2; # even n > 2 (also keeps _random_base's
112             # [2, n-2] range non-degenerate)
113 149         30865 my $n1 = $n - 1;
114 149         29262 my $one = $n - $n1; # not just 1, but a bigint
115              
116             # find the power of two for the top bit of $n1
117 149         19110 my $p2 = $one;
118 149         270 my $p2index = -1;
119 149         338 ++$p2index, $p2 *= 2
120             while $p2 <= $n1;
121 149         4480917 $p2 /= 2;
122              
123             # number of iterations: 5 for 260-bit numbers, go up to 25 for smaller
124 149         41195 my $last_witness = 5;
125 149 100       512 $last_witness += (260 - $p2index) / 13 if $p2index < 260;
126              
127 149         355 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 164         2331 my $witness = _random_base($n);
134              
135 164         77886 my $prod = $one;
136 164         234 my $n1bits = $n1;
137 164         300 my $p2next = $p2;
138              
139             # compute $witness ** ($n - 1)
140 164         227 while (1) {
141 30112   100     7089771 my $rootone = $prod == 1 || $prod == $n1;
142 30112         4323555 $prod = ($prod * $prod) % $n;
143 30112 50 66     22963083 return 0 if $prod == 1 && ! $rootone;
144 30112 100       3746926 if ($n1bits >= $p2next) {
145 14907         429282 $prod = ($prod * $witness) % $n;
146 14907         11110524 $n1bits -= $p2next;
147             }
148 30112 100       1895616 last if $p2next == 1;
149 29948         3554211 $p2next /= 2;
150             }
151 164 100       18133 return 0 unless $prod == 1;
152             }
153 2         256 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__