mirror_zfs/scripts/convert_wycheproof.pl
Rob Norris 6e89095873 convert_wycheproof: don't check tag len on invalid tests
Sponsored-by: https://despairlabs.com/sponsor/
Signed-off-by: Rob Norris <robn@despairlabs.com>
Reviewed-by: Tony Hutter <hutter2@llnl.gov>
Reviewed-by: Tino Reichardt <milky-zfs@mcmilk.de>
Reviewed-by: Attila Fülöp <attila@fueloep.org>
2025-03-18 17:09:49 -07:00

245 lines
6.8 KiB
Perl
Executable File

#!/usr/bin/env perl
# SPDX-License-Identifier: MIT
#
# Copyright (c) 2025, Rob Norris <robn@despairlabs.com>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
#
# This programs converts AEAD test vectors from Project Wycheproof into a
# format that can be consumed more easily by tests/zfs-tests/cmd/crypto_test.
# See tests/zfs-tests/tests/functional/crypto/README for more info.
#
use 5.010;
use warnings;
use strict;
use JSON qw(decode_json);
sub usage {
say "usage: $0 <infile> [<outfile>]";
exit 1;
}
my ($infile, $outfile) = @ARGV;
usage() if !defined $infile;
open my $infh, '<', $infile or die "E: $infile: $!\n";
my $json = do { local $/; <$infh> };
close $infh;
my $data = decode_json $json;
select STDERR;
# 0.8 had a slightly different format. 0.9* is current, stabilising for 1.0
my $version = $data->{generatorVersion} // "[unknown]";
if ("$version" !~ m/^0\.9[^0-9]/) {
warn
"W: this converter was written for Wycheproof 0.9 test vectors\n".
" input file has version: $version\n".
" bravely continuing, but expect crashes or garbled output\n";
}
# we only support AEAD tests
my $schema = $data->{schema} // "[unknown]";
if ("$schema" ne 'aead_test_schema.json') {
warn
"W: this converter is expecting AEAD test vectors\n".
" input file has schema: $schema\n".
" bravely continuing, but expect crashes or garbled output\n";
}
# sanity check; algorithm is provided
my $algorithm = $data->{algorithm};
if (!defined $algorithm) {
die "E: $infile: required field 'algorithm' not found\n";
}
# sanity check; test count is present and correct
my $ntests = 0;
$ntests += $_ for map { scalar @{$_->{tests}} } @{$data->{testGroups}};
if (!exists $data->{numberOfTests}) {
warn "W: input file has no test count, using mine: $ntests\n";
} elsif ($data->{numberOfTests} != $ntests) {
warn
"W: input file has incorrect test count: $data->{numberOfTests}\n".
" using my own count: $ntests\n";
}
say " version: $version";
say " schema: $schema";
say "algorithm: $algorithm";
say " ntests: $ntests";
my $skipped = 0;
my @tests;
# tests are grouped into "test groups". groups have the same type and IV, key
# and tag sizes. we can infer this info from the tests themselves, but it's
# useful for sanity checks
#
# "testGroups" : [
# {
# "ivSize" : 96,
# "keySize" : 128,
# "tagSize" : 128,
# "type" : "AeadTest",
# "tests" : [ ... ]
#
for my $group (@{$data->{testGroups}}) {
# skip non-AEAD test groups
my $type = $group->{type} // "[unknown]";
if ($type ne 'AeadTest') {
warn "W: group has unexpected type '$type', skipping it\n";
$skipped += @{$data->{tests}};
next;
}
my ($iv_size, $key_size, $tag_size) =
@$group{qw(ivSize keySize tagSize)};
# a typical test:
#
# {
# "tcId" : 48,
# "comment" : "Flipped bit 63 in tag",
# "flags" : [
# "ModifiedTag"
# ],
# "key" : "000102030405060708090a0b0c0d0e0f",
# "iv" : "505152535455565758595a5b",
# "aad" : "",
# "msg" : "202122232425262728292a2b2c2d2e2f",
# "ct" : "eb156d081ed6b6b55f4612f021d87b39",
# "tag" : "d8847dbc326a066988c77ad3863e6083",
# "result" : "invalid"
# },
#
# we include everything in the output. the id is useful output so the
# user can go back to the original test. comment and flags are useful
# for output in a failing test
#
for my $test (@{$group->{tests}}) {
my ($id, $comment, $iv, $key, $msg, $ct, $aad, $tag, $result) =
@$test{qw(tcId comment iv key msg ct aad tag result)};
# sanity check; iv and key must have the length declared by the
# group params.
unless (
length_check($id, 'iv', $iv, $iv_size) &&
length_check($id, 'key', $key, $key_size)) {
$skipped++;
next;
}
# sanity check; tag must have the length declared by the group
# param, but only for valid tests (invalid tests should be
# rejected, and so can't produce a tag anyway)
unless (
$result eq 'invalid' ||
length_check($id, 'tag', $tag, $tag_size)) {
$skipped++;
next;
}
# flatten and sort the flags into a single string
my $flags;
if ($test->{flags}) {
$flags = join(' ', sort @{$test->{flags}});
}
# the completed test record. we'll emit this later once we're
# finished with the input; the output file is not open yet.
push @tests, [
[ id => $id ],
[ comment => $comment ],
(defined $flags ? [ flags => $flags ] : ()),
[ iv => $iv ],
[ key => $key ],
[ msg => $msg ],
[ ct => $ct ],
[ aad => $aad ],
[ tag => $tag ],
[ result => $result ],
];
}
}
if ($skipped) {
$ntests -= $skipped;
warn "W: skipped $skipped tests; new test count: $ntests\n";
}
if ($ntests == 0) {
die "E: no tests extracted, sorry!\n";
}
my $outfh;
if ($outfile) {
open $outfh, '>', $outfile or die "E: $outfile: $!\n";
} else {
$outfh = *STDOUT;
}
# the "header" record has the algorithm and count of tests
say $outfh "algorithm: $algorithm";
say $outfh "tests: $ntests";
#
for my $test (@tests) {
# blank line is a record separator
say $outfh "";
# output the test data in a simple record of 'key: value' lines
#
# id: 48
# comment: Flipped bit 63 in tag
# flags: ModifiedTag
# iv: 505152535455565758595a5b
# key: 000102030405060708090a0b0c0d0e0f
# msg: 202122232425262728292a2b2c2d2e2f
# ct: eb156d081ed6b6b55f4612f021d87b39
# aad:
# tag: d8847dbc326a066988c77ad3863e6083
# result: invalid
for my $row (@$test) {
my ($k, $v) = @$row;
say $outfh "$k: $v";
}
}
close $outfh;
# check that the length of hex string matches the wanted number of bits
sub length_check {
my ($id, $name, $hexstr, $wantbits) = @_;
my $got = length($hexstr)/2;
my $want = $wantbits/8;
return 1 if $got == $want;
my $gotbits = $got*8;
say
"W: $id: '$name' has incorrect len, skipping test:\n".
" got $got bytes ($gotbits bits)\n".
" want $want bytes ($wantbits bits)\n";
return;
}