• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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.
10use strict;
11use warnings;
12use Math::BigInt;
13
14my $EXPECTED_FAILURES = 0;
15my $failures = 0;
16
17sub 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
26sub 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
129my $infile = shift || 'bntests.txt';
130die "No such file, $infile" unless -f $infile;
131open my $IN, $infile || die "Can't read $infile, $!\n";
132
133my %stanza = ();
134my $l = 0;
135while ( <$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};
153evaluate($l, %stanza) if keys %stanza;
154die "Got $failures, expected $EXPECTED_FAILURES"
155    if $infile eq 'bntests.txt' and $failures != $EXPECTED_FAILURES;
156close($IN)
157