File Coverage

lib/Crypt/Perl/ECDSA/Math.pm
Criterion Covered Total %
statement 80 81 98.7
branch 29 36 80.5
condition 12 15 80.0
subroutine 10 10 100.0
pod 0 2 0.0
total 131 144 90.9


line stmt bran cond sub pod time code
1             package Crypt::Perl::ECDSA::Math;
2              
3             #Math that’s really only useful for us in the context of ECDSA.
4              
5 8     8   383 use strict;
  8         14  
  8         169  
6 8     8   29 use warnings;
  8         14  
  8         136  
7              
8 8     8   30 use Crypt::Perl::BigInt ();
  8         14  
  8         5394  
9              
10             #A port of libtomcrypt’s mp_sqrtmod_prime().
11             #The return value will be a Crypt::Perl::BigInt reference.
12             #
13             #See also implementations at:
14             # https://rosettacode.org/wiki/Tonelli-Shanks_algorithm
15             #
16             #See “Handbook of Applied Cryptography”, algorithms 3.34 and 3.36,
17             #for reference.
18             sub tonelli_shanks {
19 122     122 0 15204 my ($n, $p) = @_;
20              
21 122         922 _make_bigints($n, $p);
22              
23 122 50       604 return 0 if $n->is_zero();
24              
25 122 50       2240 die "prime must be odd" if $p->beq(2);
26              
27 122 50       13084 if (jacobi($n, $p) == -1) {
28 0         0 die sprintf( "jacobi(%s, %s) must not be -1", $n->as_hex(), $p->as_hex());
29             }
30              
31             #HAC 3.36
32 122 100       410 if ( $p->copy()->bmod(4)->beq(3) ) {
33 105         22325 return $n->copy()->bmodpow( $p->copy()->binc()->brsft(2), $p );
34             }
35              
36 17         3542 my $Si = 0;
37 17         88 my $Q = $p->copy()->bdec();
38 17         1229 while ( $Q->is_even() ) {
39 608         5390 $Q->brsft(1);
40 608         82496 $Si++;
41             }
42              
43 17         183 my $Z = Crypt::Perl::BigInt->new(2);
44 17         498 while (1) {
45 88 100       2149 last if jacobi($Z, $p) == -1;
46 71         223 $Z->binc();
47             }
48              
49 17         90 my $C = $Z->copy()->bmodpow($Q, $p);
50              
51 17         1502762 my $t1 = $Q->copy()->binc()->brsft(1);
52              
53 17         4641 my $R = $n->copy()->bmodpow($t1, $p);
54              
55 17         1150256 my $T = $n->copy()->bmodpow($Q, $p);
56              
57 17         1555623 my $Mi = $Si;
58              
59 17         99 while (1) {
60 295         672 my $i = 0;
61              
62 295         945 $t1 = $T->copy();
63              
64 295         4983 while (1) {
65 13856 100       28666 last if $t1->is_one();
66 13561         138652 $t1->bmodpow(2, $p);
67 13561         16644568 $i++;
68             }
69              
70 295 100       4096 return $R if $i == 0;
71              
72 278         1137 $t1 = _bi2()->bmodpow($Mi - $i - 1, $p);
73              
74 278         68383 $t1 = $C->bmodpow($t1, $p);
75              
76 278         339126 $C = $t1->copy()->bmodpow(2, $p);
77 278         344193 $R->bmul($t1)->bmod($p);
78 278         176254 $T->bmul($C)->bmod($p);
79 278         165189 $Mi = $i;
80             }
81             }
82              
83             my $BI2;
84             sub _bi2 {
85 278   66 278   1332 return( ($BI2 ||= Crypt::Perl::BigInt->new(2))->copy() );
86             }
87              
88             #cf. mp_jacobi()
89             #
90             #The return value is a plain scalar (-1, 0, or 1).
91             #
92             sub jacobi {
93 242     242 0 30665 my ($a, $n) = @_;
94              
95 242         561 _make_bigints($a, $n);
96              
97 242         560 my $ret = 1;
98              
99             #This loop avoids deep recursion.
100 242         557 while (1) {
101 10381         19043 my ($ret2, $help) = _jacobi_backend($a, $n);
102              
103 10381         17730 $ret *= $ret2;
104              
105 10381 100       18210 last if !$help;
106              
107 10139         32126 ($a, $n) = @$help;
108             }
109              
110 242         944 return $ret;
111             }
112              
113             sub _make_bigints {
114 364   66 364   1570 ref || ($_ = _bi($_)) for @_;
115             }
116              
117             sub _jacobi_backend {
118 10381     10381   14977 my ($a, $n) = @_;
119              
120 10381 50       24089 die "“a” can’t be negative!" if $a < 0;
121              
122 10381 50       1298108 die "“n” must be positive!" if $n <= 0;
123              
124             #step 1
125 10381 100       1229114 if ($a->is_zero()) {
126 5 50       58 return $n->is_one() ? 1 : 0;
127             }
128              
129             #step 2
130 10376 100       99891 return 1 if $a->is_one();
131              
132             #default
133 10318         93263 my $si = 0;
134              
135 10318         18040 my $a1 = $a->copy();
136              
137             #Determine $a1’s greatest factor that is a power of 2,
138             #which is the number of lest-significant 0 bits.
139 10318         155214 my $ki = _count_lsb($a1);
140              
141 10318         29741 $a1->brsft($ki);
142              
143             #step 4
144 10318 100       1535107 if (($ki & 1) == 0) {
145 6574         9172 $si = 1;
146             }
147             else {
148 3744         9150 my $residue = $n->copy()->band(7)->numify();
149              
150 3744 100 100     887712 if ( $residue == 1 || $residue == 7 ) {
    50 66        
151 1913         3172 $si = 1;
152             }
153             elsif ( $residue == 3 || $residue == 5 ) {
154 1831         3543 $si = -1;
155             }
156             }
157              
158             #step 5
159 10318 100 100     19252 if ( $n->copy()->band(3)->beq(3) && $a1->copy()->band(3)->beq(3) ) {
160 2587         1496989 $si = 0 - $si;
161             }
162              
163 10318 100       3025557 return $si if $a1->is_one();
164              
165 10139         101878 my $p1 = $n->copy()->bmod($a1);
166              
167 10139         1731894 return( $si, [$p1, $a1] );
168             }
169              
170             #cf. mp_cnt_lsb()
171             sub _count_lsb {
172 10318     10318   14641 my ($num) = @_;
173              
174             #sprintf('%b',$num) =~ m<(0*)\z>;
175 10318         18890 $num->as_bin() =~ m<(0*)\z>;
176              
177 10318         4481419 return length $1;
178             }
179              
180 16     16   281 sub _bi { return Crypt::Perl::BigInt->new(@_) }
181              
182             1;