File Coverage

blib/lib/Crypt/DSA/Util.pm
Criterion Covered Total %
statement 39 98 39.8
branch 2 32 6.2
condition 0 6 0.0
subroutine 13 17 76.4
pod 5 9 55.5
total 59 162 36.4


line stmt bran cond sub pod time code
1             package Crypt::DSA::Util;
2              
3 4     4   75171 use strict;
  4         9  
  4         150  
4 4     4   20 use Math::BigInt 1.78 try => 'GMP, Pari';
  4         78  
  4         24  
5 4     4   5435 use Fcntl;
  4         9  
  4         1474  
6 4     4   21 use Carp qw( croak );
  4         10  
  4         196  
7              
8 4     4   20 use vars qw( $VERSION @ISA @EXPORT_OK );
  4         7  
  4         503  
9 4     4   22 use Exporter;
  4         14  
  4         303  
10             BEGIN {
11 4     4   34 $VERSION = '1.17';
12 4         68 @ISA = qw( Exporter );
13 4         2221 @EXPORT_OK = qw( bitsize bin2mp mp2bin mod_inverse mod_exp makerandom isprime );
14             }
15              
16             ## Nicked from Crypt::RSA::DataFormat.
17             ## Copyright (c) 2001, Vipul Ved Prakash.
18             sub bitsize {
19 4     4 1 5497 length(Math::BigInt->new($_[0])->as_bin) - 2;
20             }
21              
22             sub bin2mp {
23 3     3 1 210 my $s = shift;
24 3 100       27 $s eq '' ?
25             Math::BigInt->new(0) :
26             Math::BigInt->new("0b" . unpack("B*", $s));
27             }
28              
29             sub mp2bin {
30 3     3 1 3623 my $p = Math::BigInt->new(shift);
31 3         88 my $base = Math::BigInt->new(256);
32 3         103 my $res = '';
33 3         13 while ($p != 0) {
34 41         6626 my $r = $p % $base;
35 41         3588 $p = ($p-$r) / $base;
36 41         8580 $res = chr($r) . $res;
37             }
38 3         424 $res;
39             }
40              
41             sub mod_exp {
42 1     1 1 153 my($a, $exp, $n) = @_;
43 1         8 $a->copy->bmodpow($exp, $n);
44             }
45              
46             sub mod_inverse {
47 1     1 1 2168 my($a, $n) = @_;
48 1         5 $a->copy->bmodinv($n);
49             }
50              
51             sub makerandom {
52 0     0 0   my %param = @_;
53 0           my $size = $param{Size};
54 0           my $bytes = int($size / 8) + 1;
55 0           my $r = '';
56 0 0         if ( sysopen my $fh, '/dev/random', O_RDONLY ) {
    0          
57 0           my $read = 0;
58 0           while ($read < $bytes) {
59 0           my $got = sysread $fh, my($chunk), $bytes - $read;
60 0 0         next unless $got;
61 0 0         die "Error: $!" if $got == -1;
62 0           $r .= $chunk;
63 0           $read = length $r;
64             }
65 0           close $fh;
66             }
67             elsif ( require Data::Random ) {
68 0           $r .= Data::Random::rand_chars( set=>'numeric' ) for 1..$bytes;
69             }
70             else {
71 0           croak "makerandom requires /dev/random or Data::Random";
72             }
73 0           my $down = $size - 1;
74 0 0         $r = unpack 'H*', pack 'B*', '0' x ( $size % 8 ? 8 - $size % 8 : 0 ) .
75             '1' . unpack "b$down", $r;
76 0           Math::BigInt->new('0x' . $r);
77             }
78              
79             # For testing, let us choose our isprime function:
80             *isprime = \&isprime_algorithms_with_perl;
81              
82             # from the book "Mastering Algorithms with Perl" by Jon Orwant,
83             # Jarkko Hietaniemi, and John Macdonald
84             sub isprime_algorithms_with_perl {
85 4     4   24 use integer;
  4         6  
  4         35  
86 0     0 0   my $n = shift;
87 0           my $n1 = $n - 1;
88 0           my $one = $n - $n1; # not just 1, but a bigint
89 0           my $witness = $one * 100;
90              
91             # find the power of two for the top bit of $n1
92 0           my $p2 = $one;
93 0           my $p2index = -1;
94 0           ++$p2index, $p2 *= 2
95             while $p2 <= $n1;
96 0           $p2 /= 2;
97              
98             # number of interations: 5 for 260-bit numbers, go up to 25 for smaller
99 0           my $last_witness = 5;
100 0 0         $last_witness += (260 - $p2index) / 13 if $p2index < 260;
101              
102 0           for my $witness_count (1..$last_witness) {
103 0           $witness *= 1024;
104 0           $witness += int(rand(1024)); # XXXX use good rand
105 0 0         $witness = $witness % $n if $witness > $n;
106 0 0         $witness = $one * 100, redo if $witness == 0;
107              
108 0           my $prod = $one;
109 0           my $n1bits = $n1;
110 0           my $p2next = $p2;
111              
112             # compute $witness ** ($n - 1)
113 0           while (1) {
114 0   0       my $rootone = $prod == 1 || $prod == $n1;
115 0           $prod = ($prod * $prod) % $n;
116 0 0 0       return 0 if $prod == 1 && ! $rootone;
117 0 0         if ($n1bits >= $p2next) {
118 0           $prod = ($prod * $witness) % $n;
119 0           $n1bits -= $p2next;
120             }
121 0 0         last if $p2next == 1;
122 0           $p2next /= 2;
123             }
124 0 0         return 0 unless $prod == 1;
125             }
126 0           return 1;
127             }
128              
129             sub isprime_gp_pari {
130 0     0 0   my $n = shift;
131              
132 0           my $sn = "$n";
133 0 0         die if $sn =~ /\D/;
134              
135 0           my $is_prime = `echo "isprime($sn)" | gp -f -q`;
136 0 0         die "No gp installed?" if $?;
137              
138 0           chomp $is_prime;
139 0           return $is_prime;
140             }
141              
142             sub isprime_paranoid {
143 0     0 0   my $n = shift;
144              
145 0           my $perl = isprime_algorithms_with_perl($n);
146 0           my $pari = isprime_gp_pari($n);
147              
148 0 0         die "Perl vs. PARI don't match on '$n'\n" unless $perl == $pari;
149 0           return $perl;
150             }
151              
152             1;
153             __END__