]>
Commit | Line | Data |
---|---|---|
8d1ebff4 RS |
1 | #! /usr/bin/env perl |
2 | # Copyright 2008-2016 The OpenSSL Project Authors. All Rights Reserved. | |
3 | # | |
4 | # Licensed under the OpenSSL license (the "License"). You may not use | |
5 | # this file except in compliance with the License. You can obtain a copy | |
6 | # in the file LICENSE in the source distribution or at | |
7 | # https://www.openssl.org/source/license.html | |
8 | ||
9 | # Run the tests specified in bntests.txt, as a check against OpenSSL. | |
10 | use strict; | |
11 | use warnings; | |
12 | use Math::BigInt; | |
13 | ||
14 | my $EXPECTED_FAILURES = 0; | |
15 | my $failures = 0; | |
16 | ||
17 | sub bn | |
18 | { | |
19 | my $x = shift; | |
20 | my ($sign, $hex) = ($x =~ /^([+\-]?)(.*)$/); | |
21 | ||
22 | $hex = '0x' . $hex if $hex !~ /^0x/; | |
23 | return Math::BigInt->from_hex($sign.$hex); | |
24 | } | |
25 | ||
26 | sub evaluate | |
27 | { | |
28 | my $lineno = shift; | |
29 | my %s = @_; | |
30 | ||
31 | if ( defined $s{'Sum'} ) { | |
32 | # Sum = A + B | |
33 | my $sum = bn($s{'Sum'}); | |
34 | my $a = bn($s{'A'}); | |
35 | my $b = bn($s{'B'}); | |
36 | return if $sum == $a + $b; | |
37 | } elsif ( defined $s{'LShift1'} ) { | |
38 | # LShift1 = A * 2 | |
39 | my $lshift1 = bn($s{'LShift1'}); | |
40 | my $a = bn($s{'A'}); | |
41 | return if $lshift1 == $a->bmul(2); | |
42 | } elsif ( defined $s{'LShift'} ) { | |
43 | # LShift = A * 2**N | |
44 | my $lshift = bn($s{'LShift'}); | |
45 | my $a = bn($s{'A'}); | |
46 | my $n = bn($s{'N'}); | |
47 | return if $lshift == $a->blsft($n); | |
48 | } elsif ( defined $s{'RShift'} ) { | |
49 | # RShift = A / 2**N | |
50 | my $rshift = bn($s{'RShift'}); | |
51 | my $a = bn($s{'A'}); | |
52 | my $n = bn($s{'N'}); | |
53 | return if $rshift == $a->brsft($n); | |
54 | } elsif ( defined $s{'Square'} ) { | |
55 | # Square = A * A | |
56 | my $square = bn($s{'Square'}); | |
57 | my $a = bn($s{'A'}); | |
58 | return if $square == $a->bmul($a); | |
59 | } elsif ( defined $s{'Product'} ) { | |
60 | # Product = A * B | |
61 | my $product = bn($s{'Product'}); | |
62 | my $a = bn($s{'A'}); | |
63 | my $b = bn($s{'B'}); | |
64 | return if $product == $a->bmul($b); | |
65 | } elsif ( defined $s{'Quotient'} ) { | |
66 | # Quotient = A / B | |
67 | # Remainder = A - B * Quotient | |
68 | my $quotient = bn($s{'Quotient'}); | |
69 | my $remainder = bn($s{'Remainder'}); | |
70 | my $a = bn($s{'A'}); | |
71 | my $b = bn($s{'B'}); | |
72 | ||
73 | # First the remainder test. | |
74 | $b->bmul($quotient); | |
75 | my $rempassed = $remainder == $a->bsub($b) ? 1 : 0; | |
76 | ||
77 | # Math::BigInt->bdiv() is documented to do floored division, | |
78 | # i.e. 1 / -4 = -1, while OpenSSL BN_div does truncated | |
79 | # division, i.e. 1 / -4 = 0. We need to make the operation | |
80 | # work like OpenSSL's BN_div to be able to verify. | |
81 | $a = bn($s{'A'}); | |
82 | $b = bn($s{'B'}); | |
83 | my $neg = $a->is_neg() ? !$b->is_neg() : $b->is_neg(); | |
84 | $a->babs(); | |
85 | $b->babs(); | |
86 | $a->bdiv($b); | |
87 | $a->bneg() if $neg; | |
88 | return if $rempassed && $quotient == $a; | |
89 | } elsif ( defined $s{'ModMul'} ) { | |
90 | # ModMul = (A * B) mod M | |
91 | my $modmul = bn($s{'ModMul'}); | |
92 | my $a = bn($s{'A'}); | |
93 | my $b = bn($s{'B'}); | |
94 | my $m = bn($s{'M'}); | |
95 | $a->bmul($b); | |
96 | return if $modmul == $a->bmod($m); | |
97 | } elsif ( defined $s{'ModExp'} ) { | |
98 | # ModExp = (A ** E) mod M | |
99 | my $modexp = bn($s{'ModExp'}); | |
100 | my $a = bn($s{'A'}); | |
101 | my $e = bn($s{'E'}); | |
102 | my $m = bn($s{'M'}); | |
103 | return if $modexp == $a->bmodpow($e, $m); | |
104 | } elsif ( defined $s{'Exp'} ) { | |
105 | my $exp = bn($s{'Exp'}); | |
106 | my $a = bn($s{'A'}); | |
107 | my $e = bn($s{'E'}); | |
108 | return if $exp == $a ** $e; | |
109 | } elsif ( defined $s{'ModSqrt'} ) { | |
110 | # (ModSqrt * ModSqrt) mod P = A mod P | |
111 | my $modsqrt = bn($s{'ModSqrt'}); | |
112 | my $a = bn($s{'A'}); | |
113 | my $p = bn($s{'P'}); | |
114 | $modsqrt->bmul($modsqrt); | |
115 | $modsqrt->bmod($p); | |
116 | $a->bmod($p); | |
117 | return if $modsqrt == $a; | |
118 | } else { | |
119 | print "# Unknown test: "; | |
120 | } | |
121 | $failures++; | |
122 | print "# #$failures Test (before line $lineno) failed\n"; | |
123 | foreach ( keys %s ) { | |
124 | print "$_ = $s{$_}\n"; | |
125 | } | |
126 | print "\n"; | |
127 | } | |
128 | ||
129 | my $infile = shift || 'bntests.txt'; | |
130 | die "No such file, $infile" unless -f $infile; | |
131 | open my $IN, $infile || die "Can't read $infile, $!\n"; | |
132 | ||
133 | my %stanza = (); | |
134 | my $l = 0; | |
135 | while ( <$IN> ) { | |
136 | $l++; | |
137 | s|\R$||; | |
138 | next if /^#/; | |
139 | if ( /^$/ ) { | |
140 | if ( keys %stanza ) { | |
141 | evaluate($l, %stanza); | |
142 | %stanza = (); | |
143 | } | |
144 | next; | |
145 | } | |
146 | # Parse 'key = value' | |
147 | if ( ! /\s*([^\s]*)\s*=\s*(.*)\s*/ ) { | |
148 | print "Skipping $_\n"; | |
149 | next; | |
150 | } | |
151 | $stanza{$1} = $2; | |
152 | }; | |
153 | evaluate($l, %stanza) if keys %stanza; | |
154 | die "Got $failures, expected $EXPECTED_FAILURES" | |
155 | if $infile eq 'bntests.txt' and $failures != $EXPECTED_FAILURES; | |
156 | close($IN) |