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 9     9   702 use strict;
  9         18  
  9         279  
6 9     9   97 use warnings;
  9         41  
  9         212  
7              
8 9     9   42 use Crypt::Perl::BigInt ();
  9         40  
  9         8178  
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 10687 my ($n, $p) = @_;
20              
21 122         927 _make_bigints($n, $p);
22              
23 122 50       996 return 0 if $n->is_zero();
24              
25 122 50       2446 die "prime must be odd" if $p->beq(2);
26              
27 122 50       17554 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       1057 if ( $p->copy()->bmod(4)->beq(3) ) {
33 105         33661 return $n->copy()->bmodpow( $p->copy()->binc()->brsft(2), $p );
34             }
35              
36 17         5221 my $Si = 0;
37 17         131 my $Q = $p->copy()->bdec();
38 17         1703 while ( $Q->is_even() ) {
39 608         7119 $Q->brsft(1);
40 608         217011 $Si++;
41             }
42              
43 17         318 my $Z = Crypt::Perl::BigInt->new(2);
44 17         1043 while (1) {
45 88 100       3697 last if jacobi($Z, $p) == -1;
46 71         307 $Z->binc();
47             }
48              
49 17         122 my $C = $Z->copy()->bmodpow($Q, $p);
50              
51 17         2965 my $t1 = $Q->copy()->binc()->brsft(1);
52              
53 17         7477 my $R = $n->copy()->bmodpow($t1, $p);
54              
55 17         2523 my $T = $n->copy()->bmodpow($Q, $p);
56              
57 17         2293 my $Mi = $Si;
58              
59 17         58 while (1) {
60 295         497 my $i = 0;
61              
62 295         821 $t1 = $T->copy();
63              
64 295         6282 while (1) {
65 13856 100       33271 last if $t1->is_one();
66 13561         143965 $t1->bmodpow(2, $p);
67 13561         2190581 $i++;
68             }
69              
70 295 100       3609 return $R if $i == 0;
71              
72 278         718 $t1 = _bi2()->bmodpow($Mi - $i - 1, $p);
73              
74 278         64619 $t1 = $C->bmodpow($t1, $p);
75              
76 278         18559 $C = $t1->copy()->bmodpow(2, $p);
77 278         50683 $R->bmul($t1)->bmod($p);
78 278         35348 $T->bmul($C)->bmod($p);
79 278         32760 $Mi = $i;
80             }
81             }
82              
83             my $BI2;
84             sub _bi2 {
85 278   66 278   999 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 45938 my ($a, $n) = @_;
94              
95 242         746 _make_bigints($a, $n);
96              
97 242         868 my $ret = 1;
98              
99             #This loop avoids deep recursion.
100 242         650 while (1) {
101 10381         26427 my ($ret2, $help) = _jacobi_backend($a, $n);
102              
103 10381         19770 $ret *= $ret2;
104              
105 10381 100       22058 last if !$help;
106              
107 10139         52217 ($a, $n) = @$help;
108             }
109              
110 242         2072 return $ret;
111             }
112              
113             sub _make_bigints {
114 364   66 364   1964 ref || ($_ = _bi($_)) for @_;
115             }
116              
117             sub _jacobi_backend {
118 10381     10381   17891 my ($a, $n) = @_;
119              
120 10381 50       28151 die "“a” can’t be negative!" if $a < 0;
121              
122 10381 50       1830315 die "“n” must be positive!" if $n <= 0;
123              
124             #step 1
125 10381 100       1775654 if ($a->is_zero()) {
126 5 50       66 return $n->is_one() ? 1 : 0;
127             }
128              
129             #step 2
130 10376 100       102995 return 1 if $a->is_one();
131              
132             #default
133 10318         95137 my $si = 0;
134              
135 10318         24966 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         191996 my $ki = _count_lsb($a1);
140              
141 10318         32474 $a1->brsft($ki);
142              
143             #step 4
144 10318 100       2977310 if (($ki & 1) == 0) {
145 6574         10717 $si = 1;
146             }
147             else {
148 3744         10635 my $residue = $n->copy()->band(7)->numify();
149              
150 3744 100 100     703278 if ( $residue == 1 || $residue == 7 ) {
    50 66        
151 1913         4049 $si = 1;
152             }
153             elsif ( $residue == 3 || $residue == 5 ) {
154 1831         3859 $si = -1;
155             }
156             }
157              
158             #step 5
159 10318 100 100     25293 if ( $n->copy()->band(3)->beq(3) && $a1->copy()->band(3)->beq(3) ) {
160 2587         1382794 $si = 0 - $si;
161             }
162              
163 10318 100       2807272 return $si if $a1->is_one();
164              
165 10139         108928 my $p1 = $n->copy()->bmod($a1);
166              
167 10139         978061 return( $si, [$p1, $a1] );
168             }
169              
170             #cf. mp_cnt_lsb()
171             sub _count_lsb {
172 10318     10318   17783 my ($num) = @_;
173              
174             #sprintf('%b',$num) =~ m<(0*)\z>;
175 10318         25986 $num->as_bin() =~ m<(0*)\z>;
176              
177 10318         551625 return length $1;
178             }
179              
180 16     16   560 sub _bi { return Crypt::Perl::BigInt->new(@_) }
181              
182             1;