File Coverage

blib/lib/Crypt/Perl/Ed25519/Math.pm
Criterion Covered Total %
statement 249 252 98.8
branch 19 22 86.3
condition 6 9 66.6
subroutine 36 36 100.0
pod 0 10 0.0
total 310 329 94.2


line stmt bran cond sub pod time code
1             package Crypt::Perl::Ed25519::Math;
2              
3 5     5   57176 use strict;
  5         15  
  5         99  
4 5     5   19 use warnings;
  5         34  
  5         82  
5              
6 5     5   1896 use Math::Utils ();
  5         10485  
  5         3809  
7              
8             sub reduce {
9 51     51 0 8163 my ($r) = @_;
10              
11 51         63 my @x;
12              
13 51         113 for my $i ( 0 .. 63 ) {
14 3264         3115 $x[$i] = $r->[$i];
15 3264         3238 $r->[$i] = 0;
16             }
17              
18 51         215 modL( $r, \@x );
19              
20 51         151 return;
21             }
22              
23             # p and q are arrays of arrays; s is an array of numbers
24             sub scalarmult {
25 71     71 0 145 my ($p, $q, $s) = @_;
26              
27 71         509 @{$p}[0 .. 3] = ( [ gf0() ], [ gf1() ], [ gf1() ], [ gf0() ] );
  71         184  
28              
29 71         226 my $b;
30              
31 71         223 for my $i ( reverse( 0 .. 255 ) ) {
32 18176         35555 $b = ( $s->[ ( $i >> 3 ) | 0 ] >> ($i & 7) ) & 1;
33 18176         29392 _cswap( $p, $q, $b );
34 18176         33692 add( $q, $p );
35 18176         31410 add( $p, $p );
36 18176         29447 _cswap( $p, $q, $b );
37             }
38              
39 71         489 return;
40             }
41              
42             # p is an array of arrays; s is an array of numbers
43             sub scalarbase {
44 50     50 0 130 my ($p, $s) = @_;
45              
46 50         485 my @q = ( [ X() ], [ Y() ], [ gf1() ], [ gf0() ] );
47              
48 50         288 _M( $q[3], [X()], [Y()] );
49              
50 50         208 scalarmult($p, \@q, $s);
51             }
52              
53             # p is an array of arrays
54             sub pack {
55 50     50 0 123 my ($p) = @_;
56              
57 50         150 my $tx = [ gf0() ];
58 50         132 my $ty = [ gf0() ];
59 50         123 my $zi = [ gf0() ];
60              
61 50         182 _inv25519( $zi, $p->[2] );
62              
63 50         163 _M( $tx, $p->[0], $zi );
64 50         146 _M( $ty, $p->[1], $zi );
65              
66 50         96 my $r = _pack25519($ty);
67              
68 50         120 $r->[31] ^= (_par25519($tx) << 7);
69              
70 50         408 return $r;
71             }
72              
73             sub add {
74 36373     36373 0 44090 my ($p, $q) = @_;
75              
76 36373         103558 my $a = [ gf0() ];
77 36373         76292 my $b = [ gf0() ];
78 36373         74892 my $c = [ gf0() ];
79 36373         72638 my $d = [ gf0() ];
80 36373         72424 my $e = [ gf0() ];
81 36373         70265 my $f = [ gf0() ];
82 36373         71509 my $g = [ gf0() ];
83 36373         67581 my $h = [ gf0() ];
84 36373         68632 my $t = [ gf0() ];
85              
86 36373         68615 _Z($a, $p->[1], $p->[0]);
87 36373         60388 _Z($t, $q->[1], $q->[0]);
88 36373         55762 _M($a, $a, $t);
89 36373         64786 _A($b, $p->[0], $p->[1]);
90 36373         60135 _A($t, $q->[0], $q->[1]);
91 36373         56348 _M($b, $b, $t);
92 36373         61112 _M($c, $p->[3], $q->[3]);
93 36373         102041 _M($c, $c, [ D2() ]);
94 36373         81090 _M($d, $p->[2], $q->[2]);
95 36373         64115 _A($d, $d, $d);
96 36373         54379 _Z($e, $b, $a);
97 36373         53741 _Z($f, $d, $c);
98 36373         52404 _A($g, $d, $c);
99 36373         54961 _A($h, $b, $a);
100              
101 36373         53328 _M($p->[0], $e, $f);
102 36373         58307 _M($p->[1], $h, $g);
103 36373         57993 _M($p->[2], $g, $f);
104 36373         55918 _M($p->[3], $e, $h);
105             }
106              
107             sub modL {
108 66     66 0 1593 my ($r, $x) = @_;
109              
110 66         82 my ($k);
111              
112 66         169 for my $i ( reverse( 32 .. 63 ) ) {
113 2112         2126 my $carry = 0;
114              
115 2112         2138 my ($j, $k);
116              
117 2112         2788 for (
118             ($j = $i - 32), ($k = $i - 12);
119             $j < $k;
120             ++$j
121             ) {
122 42240         54989 $x->[$j] += $carry - 16 * $x->[$i] * (L())[$j - ($i - 32)];
123              
124             # originally “>> 8” rather than “/ 256”;
125 42240         54509 $carry = Math::Utils::floor( ($x->[$j] + 128) / 256 );
126              
127 42240         124516 $x->[$j] -= $carry * 256;
128             }
129              
130 2112         1978 $x->[$j] += $carry;
131 2112         2688 $x->[$i] = 0;
132             }
133              
134 66         88 my $carry = 0;
135              
136             # In Perl, -98 >> 4 = 1152921504606846969. :-<
137 66         128 my $x31_rshift_4 = Math::Utils::floor( $x->[31] / 16 );
138              
139 66         240 for my $j ( 0 .. 31 ) {
140 2112         2441 $x->[$j] += $carry - $x31_rshift_4 * (L())[$j];
141              
142             # originally “>> 8” rather than “/ 256”; we also need floor
143 2112         2859 $carry = Math::Utils::floor( $x->[$j] / 256 );
144              
145 2112         5582 $x->[$j] &= 255;
146             }
147              
148 66         703 $x->[$_] -= $carry * (L())[$_] for 0 .. 31;
149              
150 66         95 for my $i ( 0 .. 31 ) {
151 2112         2127 $x->[$i + 1] += $x->[$i] >> 8;
152 2112         2245 $r->[$i] = $x->[$i] & 255;
153             }
154              
155 66         164 return;
156             }
157              
158 5     5   34 use constant gf0 => (0) x 16;
  5         42  
  5         424  
159              
160             #----------------------------------------------------------------------
161              
162 5     5   25 use constant gf1 => ( 1, (0) x 15 );
  5         14  
  5         301  
163              
164 5         301 use constant L => (
165             0xed, 0xd3, 0xf5, 0x5c, 0x1a, 0x63, 0x12, 0x58,
166             0xd6, 0x9c, 0xf7, 0xa2, 0xde, 0xf9, 0xde, 0x14,
167             (0) x 15, 0x10,
168 5     5   31 );
  5         6  
169              
170 5         283 use constant D2 => (
171             0xf159, 0x26b2, 0x9b94, 0xebd6, 0xb156, 0x8283, 0x149a, 0x00e0,
172             0xd130, 0xeef3, 0x80f2, 0x198e, 0xfce7, 0x56df, 0xd9dc, 0x2406,
173 5     5   26 );
  5         7  
174              
175 5         331 use constant X => (
176             0xd51a, 0x8f25, 0x2d60, 0xc956, 0xa7b2, 0x9525, 0xc760, 0x692c,
177             0xdc5c, 0xfdd6, 0xe231, 0xc0a4, 0x53fe, 0xcd6e, 0x36d3, 0x2169,
178 5     5   23 );
  5         8  
179              
180 5         5764 use constant Y => (
181             0x6658, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666,
182             0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666, 0x6666,
183 5     5   26 );
  5         6  
184              
185 18076     18076   22298 sub _S { _M( $_[0], $_[1], $_[1] ) }
186              
187             sub _inv25519 {
188 50     50   122 my ($o, $i) = @_;
189              
190 50         87 my $c = [ @{$i}[0 .. 15] ];
  50         109  
191              
192 50         185 for my $a ( reverse( 0 .. 253 ) ) {
193 12700         19547 _S($c, $c);
194              
195 12700 100       16225 next if $a == 2;
196 12650 100       14773 next if $a == 4;
197              
198 12600         15172 _M( $c, $c, $i );
199             }
200              
201 50         94 @{$o}[0 .. 15] = @{$c}[0 .. 15];
  50         108  
  50         128  
202              
203 50         231 return;
204             }
205              
206             sub _pack25519 {
207 205     205   304 my ($n) = @_;
208              
209 205         257 my $b;
210              
211 205         417 my $o = [];
212              
213 205         299 my $t = [ @{$n}[0 .. 15] ];
  205         568  
214              
215 205         515 my $m = [ gf0() ];
216              
217 205         381 _car25519($t) for 1 .. 3;
218              
219 205         308 for my $j (0, 1) {
220 410         482 $m->[0] = $t->[0] - 0xffed;
221              
222 410         508 for my $i ( 1 .. 14 ) {
223 5740         6173 $m->[$i] = $t->[$i] - 0xffff - (($m->[$i - 1] >> 16) & 1);
224 5740         5967 $m->[$i - 1] &= 0xffff;
225             }
226              
227 410         511 $m->[15] = $t->[15] - 0x7fff - (($m->[14] >> 16) & 1);
228              
229 410         425 $b = ($m->[15] >> 16) & 1;
230              
231 410         397 $m->[14] &= 0xffff;
232              
233 410         675 _sel25519( $t, $m, 1 - $b );
234             }
235              
236 205         297 for my $i ( 0 .. 15 ) {
237 3280         4386 $o->[2 * $i] = $t->[$i] & 0xff;
238 3280         4326 $o->[2 * $i + 1] = $t->[$i] >> 8;
239             }
240              
241 205         518 return $o;
242             }
243              
244             sub _par25519 {
245 71     71   147 my ($a) = @_;
246              
247 71         128 my $d = _pack25519($a);
248              
249 71         269 return $d->[0] & 1;
250             }
251              
252             # o, a, and b are arrays of numbers
253             sub _A {
254 181886     181886   204613 my ($o, $a, $b) = @_;
255              
256 181886         709600 $o->[$_] = $a->[$_] + $b->[$_] for 0 .. 15;
257              
258 181886         197895 return;
259             }
260              
261             # o, a, and b are arrays of numbers
262             sub _Z {
263 145528     145528   165157 my ($o, $a, $b) = @_;
264              
265 145528         589645 $o->[$_] = $a->[$_] - $b->[$_] for 0 .. 15;
266              
267 145528         156887 return;
268             }
269              
270             # o, a, and b are arrays of numbers
271             sub _M {
272 363670     363670   426320 my ($o, $a, $b) = @_;
273              
274 363670         618807 my @t = (0) x 31;
275              
276 363670         417868 for my $a_idx ( 0 .. 15 ) {
277 5818720         23171174 $t[$a_idx + $_] += $a->[$a_idx] * $b->[$_] for 0 .. 15;
278             }
279              
280             # $t->[15] left as-is
281 363670         391741 for my $t_idx ( 0 .. 14 ) {
282 5455050         5723043 $t[$t_idx] += 38 * $t[16 + $t_idx];
283             }
284              
285 363670         359016 my ($c, $v);
286              
287 363670         541579 _car25519(\@t);
288 363670         554732 _car25519(\@t);
289              
290 363670         466803 @{$o}[0 .. 15] = @t[0 .. 15];
  363670         547588  
291              
292 363670         632577 return;
293             }
294              
295             sub _car25519 {
296 727955     727955   768497 my ($o) = @_;
297              
298 727955         689635 my $c = 1;
299 727955         652793 my $v;
300              
301 727955         718607 for my $o_item ( @{$o}[0 .. 15] ) {
  727955         908838  
302 11647280         10499745 $v = $o_item + $c + 65535;
303              
304             # c = Math.floor(v / 65536)
305 11647280         11169465 $c = int( $v / 65536 );
306 11647280 100       13056773 $c-- if $v < 0;
307              
308             # t0 = v - c * 65536
309 11647280         11478537 $o_item = $v - ($c * 65536);
310             }
311              
312 727955         834980 $o->[0] += $c - 1 + 37 * ($c - 1);
313              
314 727955         812585 return;
315             }
316              
317             # p and q are arrays of numbers
318             sub _sel25519 {
319 145818     145818   164687 my ($p, $q, $b) = @_;
320              
321             # $b is either 0 or 1.
322 145818   100     225003 my $c = $b && -1;
323              
324 145818         163512 for my $i ( 0 .. 15 ) {
325 2333088   100     3001812 my $t = $c && ($c & signed_xor($p->[$i], $q->[$i]));
326              
327 2333088 100       2913026 $p->[$i] = signed_xor($p->[$i], $t) if $t;
328 2333088 100       3025744 $q->[$i] = signed_xor($q->[$i], $t) if $t;
329             }
330             }
331              
332             # p and q are arrays of arrays
333             sub _cswap {
334 36352     36352   44682 my ($p, $q, $b) = @_;
335              
336 36352         44024 for my $i ( 0 .. 3 ) {
337 145408         179288 _sel25519( $p->[$i], $q->[$i], $b );
338             }
339             }
340              
341             # Perl’s ^ operator isn’t signed-savvy,
342             # so (-60116 ^ 0) = 18446744073709491500.
343             #
344             # TODO: add tests
345             sub signed_xor {
346              
347 3453904 50 25 3453904 0 6343110 if ( ($_[0] < 0) xor ($_[1] < 0) ) {
348 0         0 return ($_[0] ^ $_[1]) - ~0 - 1;
349             }
350              
351             # signs are same -> can use native xor
352 3453904         4244546 return $_[0] ^ $_[1];
353             }
354              
355             sub signed_or {
356              
357             # signs are same -> can use native xor
358 2016 50   2016 0 2512 if ( ($_[0] < 0) eq ($_[1] < 0) ) {
359 2016         2397 return $_[0] | $_[1];
360             }
361              
362 0         0 return ($_[0] | $_[1]) - ~0 - 1;
363             }
364              
365             #----------------------------------------------------------------------
366             # Verify logic
367              
368             sub unpackneg {
369 21     21 0 62 my ($r, $p) = @_;
370              
371 21         162 $_ = [ gf0() ] for my (
372             $t,
373             $chk,
374             $num,
375             $den,
376             $den2,
377             $den4,
378             $den6,
379             );
380              
381 21         109 _set25519( $r->[2], [ gf1() ]);
382              
383 21         83 _unpack25519($r->[1], $p);
384              
385 21         61 _S($num, $r->[1]);
386 21         102 _M($den, $num, [ D() ]);
387 21         74 _Z($num, $num, $r->[2]);
388 21         60 _A($den, $r->[2], $den);
389              
390 21         62 _S($den2, $den);
391 21         39 _S($den4, $den2);
392 21         42 _M($den6, $den4, $den2);
393 21         46 _M($t, $den6, $num);
394 21         37 _M($t, $t, $den);
395              
396 21         71 _pow2523($t, $t);
397 21         107 _M($t, $t, $num);
398 21         36 _M($t, $t, $den);
399 21         43 _M($t, $t, $den);
400 21         71 _M($r->[0], $t, $den);
401              
402 21         54 _S($chk, $r->[0]);
403 21         56 _M($chk, $chk, $den);
404              
405 21 100       49 if (_neq25519($chk, $num)) {
406 6         31 _M($r->[0], $r->[0], [ I() ]);
407             }
408              
409 21         55 _S($chk, $r->[0]);
410 21         48 _M($chk, $chk, $den);
411              
412 21 50       52 if (_neq25519($chk, $num)) {
413 0         0 die "-1??";
414             }
415              
416             # “>>” appears to be safe here.
417 21 100       52 if (_par25519($r->[0]) == ($p->[31] >> 7)) {
418 15         58 _Z($r->[0], [ gf0() ], $r->[0]);
419             }
420              
421 21         63 _M( $r->[3], $r->[0], $r->[1] );
422              
423 21         167 return 0;
424             }
425              
426             sub crypto_verify_32 {
427 63     63 0 142 my ($x, $xi, $y, $yi) = @_;
428              
429 63         174 return _vn($x, $xi, $y, $yi, 32);
430             }
431              
432 5         331 use constant D => (
433             0x78a3, 0x1359, 0x4dca, 0x75eb, 0xd8ab, 0x4141, 0x0a4d, 0x0070,
434             0xe898, 0x7779, 0x4079, 0x8cc7, 0xfe73, 0x2b6f, 0x6cee, 0x5203,
435 5     5   31 );
  5         5  
436              
437 5         1717 use constant I => (
438             0xa0b0, 0x4a0e, 0x1b27, 0xc4ee, 0xe478, 0xad2f, 0x1806, 0x2f43,
439             0xd7a7, 0x3dfb, 0x0099, 0x2b4d, 0xdf0b, 0x4fc1, 0x2480, 0x2b83,
440 5     5   26 );
  5         12  
441              
442             sub _set25519 {
443 21     21   41 my ($r, $a) = @_;
444              
445 21         122 $r->[$_] = $a->[$_] | 0 for 0 .. 15;
446             }
447              
448             sub _unpack25519 {
449 21     21   29 my ($o, $n) = @_;
450              
451 21         38 for my $i (0 .. 15) {
452              
453             # originally “<< 8” rather than “256 *”
454 336         441 $o->[$i] = $n->[ 2 * $i ] + (256 * $n->[ 2 * $i + 1 ])
455             }
456              
457 21         40 $o->[15] &= 0x7fff;
458             }
459              
460             sub _pow2523 {
461 21     21   37 my ($o, $i) = @_;
462              
463 21         29 my $c = [ @{$i}[0 .. 15] ];
  21         53  
464              
465 21         67 for my $a ( reverse( 0 .. 250 ) ) {
466 5271         8288 _S( $c, $c );
467              
468 5271 100       6918 if ($a != 1) {
469 5250         5865 _M( $c, $c, $i );
470             }
471             }
472              
473 21         58 @{$o}[0 .. 15] = @{$c}[0 .. 15];
  21         53  
  21         40  
474             }
475              
476             sub _neq25519 {
477 42     42   55 my ($a, $b) = @_;
478              
479 42         82 my $c = _pack25519($a);
480 42         77 my $d = _pack25519($b);
481              
482 42         120 return crypto_verify_32($c, 0, $d, 0);
483             }
484              
485             sub _vn {
486 63     63   99 my ($x, $xi, $y, $yi, $n) = @_;
487              
488 63         76 my $d = 0;
489              
490 63         137 for my $i ( 0 .. ($n - 1) ) {
491 2016         2377 $d = signed_or( $d, signed_xor($x->[ $xi + $i ], $y->[ $yi + $i ]) );
492             }
493              
494             # Originally “>>> 8”, which appears to be JS’s equivalent
495             # operator to Perl’s >>.
496 63         266 return (1 & (($d - 1) >> 8)) - 1;
497             }
498              
499             1;