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   472 use strict;
  8         23  
  8         183  
6 8     8   30 use warnings;
  8         15  
  8         164  
7              
8 8     8   34 use Crypt::Perl::BigInt ();
  8         11  
  8         5851  
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 18005 my ($n, $p) = @_;
20              
21 122         819 _make_bigints($n, $p);
22              
23 122 50       982 return 0 if $n->is_zero();
24              
25 122 50       2639 die "prime must be odd" if $p->beq(2);
26              
27 122 50       14184 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       503 if ( $p->copy()->bmod(4)->beq(3) ) {
33 105         25318 return $n->copy()->bmodpow( $p->copy()->binc()->brsft(2), $p );
34             }
35              
36 17         4522 my $Si = 0;
37 17         118 my $Q = $p->copy()->bdec();
38 17         1562 while ( $Q->is_even() ) {
39 608         6575 $Q->brsft(1);
40 608         102107 $Si++;
41             }
42              
43 17         291 my $Z = Crypt::Perl::BigInt->new(2);
44 17         632 while (1) {
45 88 100       2617 last if jacobi($Z, $p) == -1;
46 71         314 $Z->binc();
47             }
48              
49 17         111 my $C = $Z->copy()->bmodpow($Q, $p);
50              
51 17         1772468 my $t1 = $Q->copy()->binc()->brsft(1);
52              
53 17         5418 my $R = $n->copy()->bmodpow($t1, $p);
54              
55 17         1349447 my $T = $n->copy()->bmodpow($Q, $p);
56              
57 17         1819647 my $Mi = $Si;
58              
59 17         99 while (1) {
60 295         746 my $i = 0;
61              
62 295         1215 $t1 = $T->copy();
63              
64 295         5741 while (1) {
65 13856 100       30824 last if $t1->is_one();
66 13561         158795 $t1->bmodpow(2, $p);
67 13561         18912620 $i++;
68             }
69              
70 295 100       4815 return $R if $i == 0;
71              
72 278         1287 $t1 = _bi2()->bmodpow($Mi - $i - 1, $p);
73              
74 278         79110 $t1 = $C->bmodpow($t1, $p);
75              
76 278         386671 $C = $t1->copy()->bmodpow(2, $p);
77 278         389768 $R->bmul($t1)->bmod($p);
78 278         200197 $T->bmul($C)->bmod($p);
79 278         187547 $Mi = $i;
80             }
81             }
82              
83             my $BI2;
84             sub _bi2 {
85 278   66 278   1309 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 36633 my ($a, $n) = @_;
94              
95 242         647 _make_bigints($a, $n);
96              
97 242         431 my $ret = 1;
98              
99             #This loop avoids deep recursion.
100 242         591 while (1) {
101 10381         20371 my ($ret2, $help) = _jacobi_backend($a, $n);
102              
103 10381         18970 $ret *= $ret2;
104              
105 10381 100       19206 last if !$help;
106              
107 10139         33740 ($a, $n) = @$help;
108             }
109              
110 242         1386 return $ret;
111             }
112              
113             sub _make_bigints {
114 364   66 364   2239 ref || ($_ = _bi($_)) for @_;
115             }
116              
117             sub _jacobi_backend {
118 10381     10381   16282 my ($a, $n) = @_;
119              
120 10381 50       25321 die "“a” can’t be negative!" if $a < 0;
121              
122 10381 50       1404943 die "“n” must be positive!" if $n <= 0;
123              
124             #step 1
125 10381 100       1331926 if ($a->is_zero()) {
126 5 50       67 return $n->is_one() ? 1 : 0;
127             }
128              
129             #step 2
130 10376 100       109820 return 1 if $a->is_one();
131              
132             #default
133 10318         102819 my $si = 0;
134              
135 10318         19208 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         166595 my $ki = _count_lsb($a1);
140              
141 10318         31500 $a1->brsft($ki);
142              
143             #step 4
144 10318 100       1657769 if (($ki & 1) == 0) {
145 6574         10021 $si = 1;
146             }
147             else {
148 3744         8722 my $residue = $n->copy()->band(7)->numify();
149              
150 3744 100 100     944080 if ( $residue == 1 || $residue == 7 ) {
    50 66        
151 1913         3385 $si = 1;
152             }
153             elsif ( $residue == 3 || $residue == 5 ) {
154 1831         3379 $si = -1;
155             }
156             }
157              
158             #step 5
159 10318 100 100     21024 if ( $n->copy()->band(3)->beq(3) && $a1->copy()->band(3)->beq(3) ) {
160 2587         1606463 $si = 0 - $si;
161             }
162              
163 10318 100       3255855 return $si if $a1->is_one();
164              
165 10139         112776 my $p1 = $n->copy()->bmod($a1);
166              
167 10139         1872424 return( $si, [$p1, $a1] );
168             }
169              
170             #cf. mp_cnt_lsb()
171             sub _count_lsb {
172 10318     10318   16467 my ($num) = @_;
173              
174             #sprintf('%b',$num) =~ m<(0*)\z>;
175 10318         20938 $num->as_bin() =~ m<(0*)\z>;
176              
177 10318         4837758 return length $1;
178             }
179              
180 16     16   334 sub _bi { return Crypt::Perl::BigInt->new(@_) }
181              
182             1;