#!/usr/bin/env perl
use warnings;
use strict;
use Math::BigInt lib=>"GMP,Pari";
use Math::Prime::Util qw/:all/;
use Time::HiRes qw(gettimeofday tv_interval);
use Getopt::Long;
$|++;
# MPU and PRIMO certificate verification.
# Written by Dana Jacobsen, 2013.
# Requires Math::Prime::Util v0.30 or later.
# Will be very slow without Math:::Prime::Util::GMP for EC operations.
# Exits with:
# 0 all numbers verified prime
# 1 at least one number verified composite
# 2 incorrect or incomplete conditions. Cannot verify.
# 3 certificate file cannot be parsed or no number found
# The candidate number is always checked against is_prime first. That
# performs an extra-strong Lucas pseudoprime test followed by at least
# one additional M-R test using a random base.
my $verbose = 2;
my $quiet;
my $verb;
my $timing;
GetOptions("verbose+" => \$verb,
"quiet" => \$quiet,
"timing" => \$timing,
) or die "Error in option parsing\n";
$verbose = $verb if defined $verb;
$verbose = 0 if $quiet;
sub error ($) {
my $message = shift;
warn "\n$message\n" if $verbose;
exit(3); # error in certificate
}
sub fail ($) {
my $message = shift;
warn "\n$message\n" if $verbose;
exit(2); # Failed a condition
}
my $orig_N;
my $N;
my %parts; # Map of "N is prime if Q is prime"
my %proof_funcs = (
ECPP => \&prove_ecpp, # Standard ECPP proof
ECPP3 => \&prove_ecpp3, # Primo type 3
ECPP4 => \&prove_ecpp4, # Primo type 4
BLS15 => \&prove_bls15, # basic n+1, includes Primo type 2
BLS3 => \&prove_bls3, # basic n-1
BLS5 => \&prove_bls5, # much better n-1
SMALL => \&prove_small, # n <= 2^64
POCKLINGTON => \&prove_pock, # simple n-1, Primo type 1
LUCAS => \&prove_lucas, # n-1 completely factored
);
my $smallval = Math::BigInt->new(2)->bpow(64);
my $step = 1;
my $base = 10;
my $cert_type = 'Unknown';
my $start_time;
while (<>) {
next if /^\s*#/ or /^\s*$/; # Skip comments and blank lines
chomp;
if (/^\[(\S+) - Primality Certificate\]/) {
error "Unknown certificate type: $1" unless $1 eq 'MPU' || $1 eq 'PRIMO';
$cert_type = $1;
next;
}
if ( ($cert_type eq 'PRIMO' && /^\[Candidate\]/) || ($cert_type eq 'MPU' && /^Proof for:/) ) {
if (defined $N) {
# Done with this number, starting the next.
print " " x 60, "\r" if $verbose == 2;
if (final_verify($N)) {
print "PRIME\n" if $verbose;
} else {
print "NOT PROVEN\n" if $verbose;
exit(2);
}
undef $N;
undef %parts;
$step = 1;
}
if ($cert_type eq 'PRIMO') {
($N) = primo_read_vars('Candidate', qw/N/);
} else {
($N) = read_vars('Proof for', qw/N/);
}
$start_time = [gettimeofday];
$orig_N = $N;
if ($verbose == 1) { print "N $N"; }
elsif ($verbose == 2) { print "$N\n"; }
if (!is_prime($N)) {
print "COMPOSITE\n" if $verbose;
exit(1);
}
next;
}
if ($cert_type eq 'PRIMO') {
if (/^Type\s*=\s*(\d+)/) {
my $type = $1;
error("Starting type without telling me the N value!") unless defined $N;
if ($type == 4) {
my ($n, $f) = verify_ecpp4( $N, primo_read_vars('4', qw/S R J T/) );
$N = $f;
} elsif ($type == 3) {
my ($n, $f) = verify_ecpp3( $N, primo_read_vars('3', qw/S R A B T/) );
$N = $f;
} elsif ($type == 2) {
my ($s, $r, $q) = primo_read_vars('2', qw/S R Q/);
my $p = ($q->is_odd()) ? 2 : 1;
my ($n, $f) = verify_bls15( $N, $r, $p, $q );
$N = $f;
} elsif ($type == 1) {
my ($s, $r, $b) = primo_read_vars('1', qw/S R B/);
fail "Type 1: $N failed SR + 1 = N" unless $s*$r+1 == $N;
my ($n, $f) = verify_pock( $N, $r, $b ); # S = (N-1)/r
$N = $f;
} elsif ($type == 0) {
# Final
} else {
error "Unknown type: $type";
}
if ($verbose == 1) { print "."; }
elsif ($verbose == 2) { printf "step %2d: %4d digits type %d\r", $step++, length($N), $type; }
}
} elsif ($cert_type eq 'MPU') {
if (/^Base (\d+)/) {
$base = $1;
error "Invalid base: $base" unless $base == 10 || $base == 16 || $base == 62;
error "Sorry, only base 10 implemented in this version" unless $base == 10;
} elsif (/^Type (.*?)\s*$/) {
error("Starting type without telling me the N value!") unless defined $N;
my $type = $1;
$type =~ tr/a-z/A-Z/;
error("Unknown type: $type") unless defined $proof_funcs{$type};
my ($n, @q) = $proof_funcs{$type}->();
$parts{$n} = [@q];
if ($verbose == 1) { print "."; }
elsif ($verbose == 2) { printf "step %2d: %4d digits type %-12s\r", $step++, length($n), $type; }
}
}
}
error("No N found") unless defined $N;
print " " x 60, "\r" if $verbose == 2;
if (final_verify($N)) {
print "PRIME\n" if $verbose;
exit(0);
} else {
print "NOT PROVEN\n" if $verbose;
exit(2);
}
sub final_verify {
my $n = shift;
die "Internal error: argument not defined" unless defined $n;
if ($timing) {
my $seconds = tv_interval($start_time);
printf "%7.6f seconds for verification of %d digit number\n", $seconds, length($orig_N);
}
if ($cert_type eq 'PRIMO') {
fail "Type 0: $n failed N > 18" unless $n > 18;
fail "Type 0: $n failed N < 34 * 10^13" unless $n < (34*10**13);
fail "Type 0: $n failed spsp(2,3,5,7,11,13,17)" unless is_strong_pseudoprime($n,2,3,5,7,11,13,17);
return 1;
}
my @qs = ($n);
while (@qs) {
my $q = shift @qs;
# Check that this q has a chain
if (!defined $parts{$q}) {
# Auto-small: handle small q right here.
if ($q <= $smallval) {
fail "Small n $q does not pass BPSW" unless is_prime($q);
next;
} else {
error "q value $q has no proof\n";
}
}
die "Internal error: Invalid parts entry" unless ref($parts{$q}) eq 'ARRAY';
# q is prime if all it's chains are prime.
push @qs, @{$parts{$q}};
}
1;
}
##############################################################################
# MPU Proof handlers
##############################################################################
sub prove_ecpp {
verify_ecpp( read_vars('ECPP', qw/N A B M Q X Y/) );
}
sub prove_ecpp3 {
verify_ecpp3( read_vars('ECPP3', qw/N S R A B T/) );
}
sub prove_ecpp4 {
verify_ecpp4( read_vars('ECPP4', qw/N S R J T/) );
}
sub prove_bls15 {
verify_bls15( read_vars('BLS15', qw/N Q LP LQ/) );
}
sub prove_bls3 {
verify_bls3( read_vars('BLS3', qw/N Q A/) );
}
sub prove_pock {
verify_pock( read_vars('POCKLINGTON', qw/N Q A/) );
}
sub prove_small {
verify_small( read_vars('Small', qw/N/) );
}
sub prove_bls5 {
# No good way to do this using read_vars
my ($n, @Q, @A);
my $index = 0;
$Q[0] = Math::BigInt->new(2); # 2 is implicit
while (1) {
my $line = <>;
error("end of file during type BLS5") unless defined $line;
# Skip comments and blank lines
next if $line =~ /^\s*#/ or $line =~ /^\s*$/;
# Stop when we see a line starting with -.
last if $line =~ /^-/;
chomp($line);
if ($line =~ /^N\s+(\d+)/) {
error("BLS5: N redefined") if defined $n;
$n = Math::BigInt->new("$1");
} elsif ($line =~ /^Q\[(\d+)\]\s+(\d+)/) {
$index++;
error("BLS5: Invalid index: $1") unless $1 == $index;
$Q[$1] = Math::BigInt->new("$2");
} elsif ($line =~ /^A\[(\d+)\]\s+(\d+)/) {
error("BLS5: Invalid index: A[$1]") unless $1 >= 0 && $1 <= $index;
$A[$1] = Math::BigInt->new("$2");
} else {
error("Unrecognized line: $line");
}
}
verify_bls5($n, \@Q, \@A);
}
sub prove_lucas {
# No good way to do this using read_vars
my ($n, @Q, $a);
my $index = 0;
while (1) {
my $line = <>;
error("end of file during type Lucas") unless defined $line;
# Skip comments and blank lines
next if $line =~ /^\s*#/ or $line =~ /^\s*$/;
chomp($line);
if ($line =~ /^N\s+(\d+)/) {
error("Lucas: N redefined") if defined $n;
$n = Math::BigInt->new("$1");
} elsif ($line =~ /^Q\[(\d+)\]\s+(\d+)/) {
$index++;
error("Lucas: Invalid index: $1") unless $1 == $index;
$Q[$1] = Math::BigInt->new("$2");
} elsif ($line =~ /^A\s+(\d+)/) {
$a = Math::BigInt->new("$1");
last;
} else {
error("Unrecognized line: $line");
}
}
verify_lucas($n, \@Q, $a);
}
##############################################################################
# Proof verifications
##############################################################################
sub verify_ecpp {
my ($n, $a, $b, $m, $q, $x, $y) = @_;
$a %= $n if $a < 0;
$b %= $n if $b < 0;
fail "ECPP: $n failed N > 0" unless $n > 0;
fail "ECPP: $n failed gcd(N, 6) = 1" unless Math::BigInt::bgcd($n, 6) == 1;
fail "ECPP: $n failed gcd(4*a^3 + 27*b^2, N) = 1"
unless Math::BigInt::bgcd(4*$a*$a*$a+27*$b*$b,$n) == 1;
fail "ECPP: $n failed Y^2 = X^3 + A*X + B mod N"
unless ($y*$y) % $n == ($x*$x*$x + $a*$x + $b) % $n;
fail "ECPP: $n failed M >= N - 2*sqrt(N) + 1" unless $m >= $n - 2*$n->copy->bsqrt() + 1;
fail "ECPP: $n failed M <= N + 2*sqrt(N) + 1" unless $m <= $n + 2*$n->copy->bsqrt() + 1;
fail "ECPP: $n failed Q > (N^(1/4)+1)^2" unless $q > $n->copy->broot(4)->badd(1)->bpow(2);
fail "ECPP: $n failed Q < N" unless $q < $n;
fail "ECPP: $n failed M != Q" unless $m != $q;
my ($mdivq, $rem) = $m->copy->bdiv($q);
fail "ECPP: $n failed Q divides M" unless $rem == 0;
# Now verify the elliptic curve
my $correct_point = 0;
if (prime_get_config->{'gmp'} && defined &Math::Prime::Util::GMP::_validate_ecpp_curve) {
$correct_point = Math::Prime::Util::GMP::_validate_ecpp_curve($a, $b, $n, $x, $y, $m, $q);
} else {
if (!defined $Math::Prime::Util::ECAffinePoint::VERSION) {
eval { require Math::Prime::Util::ECAffinePoint; 1; }
or do { die "Cannot load Math::Prime::Util::ECAffinePoint"; };
}
my $ECP = Math::Prime::Util::ECAffinePoint->new($a, $b, $n, $x, $y);
# Compute U = (m/q)P, check U != point at infinity
$ECP->mul( $m->copy->bdiv($q)->as_int );
if (!$ECP->is_infinity) {
# Compute V = qU, check V = point at infinity
$ECP->mul( $q );
$correct_point = 1 if $ECP->is_infinity;
}
}
fail "ECPP: $n failed elliptic curve conditions" unless $correct_point;
($n, $q);
}
sub verify_ecpp3 {
my ($n, $s, $r, $a, $b, $t) = @_;
fail "ECPP3: $n failed |A| <= N/2" unless 2*abs($a) <= $n;
fail "ECPP3: $n failed |B| <= N/2" unless 2*abs($b) <= $n;
fail "ECPP3: $n failed T >= 0" unless $t >= 0;
fail "ECPP3: $n failed T < N" unless $t < $n;
my $l = ($t*$t*$t + $a*$t + $b) % $n;
verify_ecpp( $n,
($a * $l*$l) % $n,
($b * $l*$l*$l) % $n,
$r*$s,
$r,
($t*$l) % $n,
($l*$l) % $n );
}
sub verify_ecpp4 {
my ($n, $s, $r, $j, $t) = @_;
fail "ECPP4: $n failed |J| <= N/2" unless 2*abs($j) <= $n;
fail "ECPP4: $n failed T >= 0" unless $t >= 0;
fail "ECPP4: $n failed T < N" unless $t < $n;
my $a = 3 * $j * (1728 - $j);
my $b = 2 * $j * (1728 - $j) * (1728 - $j);
my $l = ($t*$t*$t + $a*$t + $b) % $n;
verify_ecpp( $n,
($a * $l*$l) % $n,
($b * $l*$l*$l) % $n,
$r*$s,
$r,
($t*$l) % $n,
($l*$l) % $n );
}
sub verify_bls15 {
my ($n, $q, $lp, $lq) = @_;
fail "BLS15: $n failed Q odd" unless $q->is_odd();
fail "BLS15: $n failed Q > 2" unless $q > 2;
my ($m, $rem) = ($n+1)->copy->bdiv($q);
fail "BLS15: $n failed Q divides N+1" unless $rem == 0;
fail "BLS15: $n failed MQ-1 = N" unless $m*$q-1 == $n;
fail "BLS15: $n failed M > 0" unless $m > 0;
fail "BLS15: $n failed 2Q-1 > sqrt(N)" unless 2*$q-1 > $n->copy->bsqrt();
my $D = $lp*$lp - 4*$lq;
fail "BLS15: $n failed D != 0" unless $D != 0;
fail "BLS15: $n failed jacobi(D,N) = -1" unless kronecker($D,$n) == -1;
fail "BLS15: $n failed V_{m/2} mod N != 0"
unless (lucas_sequence($n, $lp, $lq, $m/2))[1] != 0;
fail "BLS15: $n failed V_{(N+1)/2} mod N == 0"
unless (lucas_sequence($n, $lp, $lq, ($n+1)/2))[1] == 0;
($n, $q);
}
sub verify_bls3 {
my ($n, $q, $a) = @_;
fail "BLS3: $n failed Q odd" unless $q->is_odd();
fail "BLS3: $n failed Q > 2" unless $q > 2;
my ($m, $rem) = ($n-1)->copy->bdiv($q);
fail "BLS3: $n failed Q divides N-1" unless $rem == 0;
fail "BLS3: $n failed MQ+1 = N" unless $m*$q+1 == $n;
fail "BLS3: $n failed M > 0" unless $m > 0;
fail "BLS3: $n failed 2Q+1 > sqrt(n)" unless 2*$q+1 > $n->copy->bsqrt();
fail "BLS3: $n failed A^((N-1)/2) = N-1 mod N" unless $a->copy->bmodpow(($n-1)/2, $n) == $n-1;
fail "BLS3: $n failed A^(M/2) != N-1 mod N" unless $a->copy->bmodpow($m/2,$n) != $n-1;
($n, $q);
}
sub verify_pock {
my ($n, $q, $a) = @_;
my ($m, $rem) = ($n-1)->copy->bdiv($q);
fail "Pocklington: $n failed Q divides N-1" unless $rem == 0;
fail "Pocklington: $n failed M is even" unless $m->is_even();
fail "Pocklington: $n failed M > 0" unless $m > 0;
fail "Pocklington: $n failed M < Q" unless $m < $q;
fail "Pocklington: $n failed MQ+1 = N" unless $m*$q+1 == $n;
fail "Pocklington: $n failed A > 1" unless $a > 1;
fail "Pocklington: $n failed A^(N-1) mod N = 1"
unless $a->copy->bmodpow($n-1, $n) == 1;
fail "Pocklington: $n failed gcd(A^M - 1, N) = 1"
unless Math::BigInt::bgcd($a->copy->bmodpow($m, $n)-1, $n) == 1;
($n, $q);
}
sub verify_small {
my ($n) = @_;
fail "Small n $n is > 2^64\n" unless $n <= $smallval;
fail "Small n $n does not pass BPSW" unless is_prime($n);
($n);
}
sub verify_bls5 {
my ($n, $Qr, $Ar) = @_;
my @Q = @{$Qr};
my @A = @{$Ar};
my $nm1 = $n - 1;
my $F = Math::BigInt->bone;
my $R = $nm1->copy;
my $index = $#Q;
foreach my $i (0 .. $index) {
error "BLS5: $n failed Q[$i] doesn't exist" unless defined $Q[$i];
$A[$i] = Math::BigInt->new(2) unless defined $A[$i];
fail "BLS5: $n failed Q[$i] > 1" unless $Q[$i] > 1;
fail "BLS5: $n failed Q[$i] < N-1" unless $Q[$i] < $nm1;
fail "BLS5: $n failed A[$i] > 1" unless $A[$i] > 1;
fail "BLS5: $n failed A[$i] < N" unless $A[$i] < $n;
fail "BLS5: $n failed Q[$i] divides N-1" unless ($nm1 % $Q[$i]) == 0;
while (($R % $Q[$i]) == 0) {
$F *= $Q[$i];
$R /= $Q[$i];
}
}
die "BLS5: Internal error R != (N-1)/F\n" unless $R == $nm1/$F;
fail "BLS5: $n failed F is even" unless $F->is_even();
fail "BLS5: $n failed gcd(F, R) = 1\n" unless Math::BigInt::bgcd($F,$R) == 1;
my ($s, $r) = $R->copy->bdiv(2*$F);
my $P = ($F+1) * (2 * $F * $F + ($r-1)*$F + 1);
fail "BLS5: $n failed n < P" unless $n < $P;
fail "BLS5: $n failed s=0 OR r^2-8s not a perfect square"
unless $s == 0 or !_is_perfect_square($r*$r - 8*$s);
foreach my $i (0 .. $index) {
my $a = $A[$i];
my $q = $Q[$i];
fail "BLS5: $n failed A[i]^(N-1) mod N = 1"
unless $a->copy->bmodpow($nm1, $n) == 1;
fail "BLS5: $n failed gcd(A[i]^((N-1)/Q[i])-1, N) = 1"
unless Math::BigInt::bgcd($a->copy->bmodpow($nm1/$q, $n)-1, $n) == 1;
}
($n, @Q);
}
sub verify_lucas {
my ($n, $Qr, $a) = @_;
my @Q = @{$Qr};
my $index = $#Q;
fail "Lucas: $n failed A > 1" unless $a > 1;
fail "Lucas: $n failed A < N" unless $a < $n;
my $nm1 = $n - 1;
my $F = Math::BigInt->bone;
my $R = $nm1->copy;
fail "Lucas: $n failed A^(N-1) mod N = 1"
unless $a->copy->bmodpow($nm1, $n) == 1;
foreach my $i (1 .. $index) {
error "Lucas: $n failed Q[$i] doesn't exist" unless defined $Q[$i];
fail "Lucas: $n failed Q[$i] > 1" unless $Q[$i] > 1;
fail "Lucas: $n failed Q[$i] < N-1" unless $Q[$i] < $nm1;
fail "Lucas: $n failed Q[$i] divides N-1" unless ($nm1 % $Q[$i]) == 0;
fail "Lucas: $n failed A^((N-1)/Q[$i]) mod N != 1"
unless $a->copy->bmodpow($nm1/$Q[$i], $n) != 1;
while (($R % $Q[$i]) == 0) {
$F *= $Q[$i];
$R /= $Q[$i];
}
}
fail("Lucas: $n failed N-1 has only factors Q") unless $R == 1 && $F == $nm1;
shift @Q; # Remove Q[0]
($n, @Q);
}
##############################################################################
# Utility functions
##############################################################################
sub read_vars {
my $type = shift;
my %vars = map { $_ => 1 } @_;
my %return;
while (scalar keys %vars) {
my $line = <>;
error("end of file during type $type") unless defined $line;
# Skip comments and blank lines
next if $line =~ /^\s*#/ or $line =~ /^\s*$/;
chomp($line);
error("Still missing values in type $type") if $line =~ /^Type /;
if ($line =~ /^(\S+)\s+(-?\d+)/) {
my ($var, $val) = ($1, $2);
$var =~ tr/a-z/A-Z/;
error("Type $type: repeated or inappropriate var: $line") unless defined $vars{$var};
$return{$var} = $val;
delete $vars{$var};
} else {
error("Unrecognized line: $line");
}
}
# Now return them in the order given, turned into bigints.
return map { Math::BigInt->new("$return{$_}") } @_;
}
sub primo_read_vars {
my $type = shift;
my %vars = map { $_ => 1 } @_;
my %return;
while (scalar keys %vars) {
my $line = <>;
error("end of file during type $type") unless defined $line;
error("blank line during type $type") if $line =~ /^\s*$/;
chomp($line);
error("Still missing values in type $type") if $line =~ /^Type=/;
if ($line =~ /^(\S+)\s*=\s*(\S+)/) {
my ($var, $val) = ($1, $2);
$var =~ tr/a-z/A-Z/;
$val = "0x$val" if $var =~ s/\$$//;
# For Primo, just skip things we don't understand.
next unless defined $vars{$var};
$return{$var} = $val;
delete $vars{$var};
} else {
error("Unrecognized line: $line");
}
}
# Now return them in the order given, turned into bigints.
my @ret;
foreach my $var (@_) {
my $sign = 1;
$sign = -1 if $return{$var} =~ s/^(0x)?-/$1/;
push @ret, Math::BigInt->new($return{$var}) * $sign;
}
return @ret;
}
sub _is_perfect_square {
my($n) = @_;
if (ref($n) eq 'Math::BigInt') {
my $mc = int(($n & 31)->bstr);
if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) {
my $sq = $n->copy->bsqrt->bfloor;
$sq->bmul($sq);
return 1 if $sq == $n;
}
} else {
my $mc = $n & 31;
if ($mc==0||$mc==1||$mc==4||$mc==9||$mc==16||$mc==17||$mc==25) {
my $sq = int(sqrt($n));
return 1 if ($sq*$sq) == $n;
}
}
0;
}