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