lilcrypto/wycheproof/mac.pl

69 lines
1.3 KiB
Perl
Raw Normal View History

#!/usr/bin/env perl
use v5.38;;
use strict;
use warnings;
use Getopt::Std;
use JSON::PP;
my $progname = $0 =~ s@.*/@@r;
sub slurp ($fh) { local $/; <$fh> }
sub usage ()
{
2024-06-06 19:12:41 +02:00
say STDERR "Usage: $progname [-Fv] -x runner json_file ",
"[json_files ...]";
exit 1;
}
sub main ()
{
my %opts;
my $rc = 0;
2024-06-06 19:12:41 +02:00
getopts("Fvx:", \%opts) && @ARGV > 0 or usage;
usage unless defined $opts{"x"};
for my $f (@ARGV) {
open(my $fh, "<", $f) or die "open failed: $!";
my $json = decode_json(slurp($fh));
for my $testgroup ($json->{testGroups}->@*) {
for my $test ($testgroup->{tests}->@*) {
my @args;
push(@args, $json->{algorithm});
push(@args, "-K", $testgroup->{keySize});
push(@args, "-k", $test->{key});
push(@args, "-m", $test->{msg});
push(@args, "-T", $testgroup->{tagSize});
push(@args, "-t", $test->{tag});
push(@args, "-v") if $opts{"v"};
open(my $th, "-|", $opts{"x"}, @args) or die;
my $result = slurp($th);
close($th);
chomp($result);
if ($result ne $test->{result}) {
$rc = 1;
say STDERR "case $test->{tcId}: ",
"expected $test->{result}: ",
"$test->{comment} [",
join(",", $test->{flags}->@*),
"]";
2024-06-06 19:12:41 +02:00
exit 1 if $opts{"F"};
}
}
}
close($fh);
}
say "ALL TESTS PASSED!" if $rc == 0;
return $rc;
}
exit main;