xref: /freebsd/sys/contrib/openzfs/scripts/convert_wycheproof.pl (revision 61145dc2b94f12f6a47344fb9aac702321880e43) 
1#!/usr/bin/env perl
2
3# SPDX-License-Identifier: MIT
4#
5# Copyright (c) 2025, Rob Norris <robn@despairlabs.com>
6#
7# Permission is hereby granted, free of charge, to any person obtaining a copy
8# of this software and associated documentation files (the "Software"), to
9# deal in the Software without restriction, including without limitation the
10# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
11# sell copies of the Software, and to permit persons to whom the Software is
12# furnished to do so, subject to the following conditions:
13#
14# The above copyright notice and this permission notice shall be included in
15# all copies or substantial portions of the Software.
16#
17# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
18# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
19# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
20# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
21# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
22# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
23# IN THE SOFTWARE.
24
25#
26# This programs converts AEAD test vectors from Project Wycheproof into a
27# format that can be consumed more easily by tests/zfs-tests/cmd/crypto_test.
28# See tests/zfs-tests/tests/functional/crypto/README for more info.
29#
30
31use 5.010;
32use warnings;
33use strict;
34use JSON qw(decode_json);
35
36sub usage {
37  say "usage: $0 <infile> [<outfile>]";
38  exit 1;
39}
40
41my ($infile, $outfile) = @ARGV;
42
43usage() if !defined $infile;
44
45open my $infh, '<', $infile or die "E: $infile: $!\n";
46my $json = do { local $/; <$infh> };
47close $infh;
48
49my $data = decode_json $json;
50
51select STDERR;
52
53# 0.8 had a slightly different format. 0.9* is current, stabilising for 1.0
54my $version = $data->{generatorVersion} // "[unknown]";
55if ("$version" !~ m/^0\.9[^0-9]/) {
56	warn
57	    "W: this converter was written for Wycheproof 0.9 test vectors\n".
58	    "     input file has version: $version\n".
59	    "   bravely continuing, but expect crashes or garbled output\n";
60}
61
62# we only support AEAD tests
63my $schema = $data->{schema} // "[unknown]";
64if ("$schema" ne 'aead_test_schema.json') {
65	warn
66	    "W: this converter is expecting AEAD test vectors\n".
67	    "     input file has schema: $schema\n".
68	    "  bravely continuing, but expect crashes or garbled output\n";
69}
70
71# sanity check; algorithm is provided
72my $algorithm = $data->{algorithm};
73if (!defined $algorithm) {
74	die "E: $infile: required field 'algorithm' not found\n";
75}
76
77# sanity check; test count is present and correct
78my $ntests = 0;
79$ntests += $_ for map { scalar @{$_->{tests}} } @{$data->{testGroups}};
80if (!exists $data->{numberOfTests}) {
81	warn "W: input file has no test count, using mine: $ntests\n";
82} elsif ($data->{numberOfTests} != $ntests) {
83	warn
84	    "W: input file has incorrect test count: $data->{numberOfTests}\n".
85	    "   using my own count: $ntests\n";
86}
87
88say "  version: $version";
89say "   schema: $schema";
90say "algorithm: $algorithm";
91say "   ntests: $ntests";
92
93my $skipped = 0;
94
95my @tests;
96
97# tests are grouped into "test groups". groups have the same type and IV, key
98# and tag sizes. we can infer this info from the tests themselves, but it's
99# useful for sanity checks
100#
101#  "testGroups" : [
102#    {
103#      "ivSize" : 96,
104#      "keySize" : 128,
105#      "tagSize" : 128,
106#      "type" : "AeadTest",
107#      "tests" : [ ... ]
108#
109for my $group (@{$data->{testGroups}}) {
110	# skip non-AEAD test groups
111	my $type = $group->{type} // "[unknown]";
112	if ($type ne 'AeadTest') {
113	    warn "W: group has unexpected type '$type', skipping it\n";
114	    $skipped += @{$data->{tests}};
115	    next;
116	}
117
118	my ($iv_size, $key_size, $tag_size) =
119	    @$group{qw(ivSize keySize tagSize)};
120
121	# a typical test:
122	#
123	# {
124	#   "tcId" : 48,
125	#   "comment" : "Flipped bit 63 in tag",
126	#   "flags" : [
127	#     "ModifiedTag"
128	#   ],
129	#   "key" : "000102030405060708090a0b0c0d0e0f",
130	#   "iv" : "505152535455565758595a5b",
131	#   "aad" : "",
132	#   "msg" : "202122232425262728292a2b2c2d2e2f",
133	#   "ct" : "eb156d081ed6b6b55f4612f021d87b39",
134	#   "tag" : "d8847dbc326a066988c77ad3863e6083",
135	#   "result" : "invalid"
136	# },
137	#
138	# we include everything in the output. the id is useful output so the
139	# user can go back to the original test. comment and flags are useful
140	# for output in a failing test
141	#
142	for my $test (@{$group->{tests}}) {
143		my ($id, $comment, $iv, $key, $msg, $ct, $aad, $tag, $result) =
144		    @$test{qw(tcId comment iv key msg ct aad tag result)};
145
146		# sanity check; iv and key must have the length declared by the
147		# group params.
148		unless (
149		    length_check($id, 'iv', $iv, $iv_size) &&
150		    length_check($id, 'key', $key, $key_size)) {
151			$skipped++;
152			next;
153		}
154
155		# sanity check; tag must have the length declared by the group
156		# param, but only for valid tests (invalid tests should be
157		# rejected, and so can't produce a tag anyway)
158		unless (
159		    $result eq 'invalid' ||
160		    length_check($id, 'tag', $tag, $tag_size)) {
161			$skipped++;
162			next;
163		}
164
165		# flatten and sort the flags into a single string
166		my $flags;
167		if ($test->{flags}) {
168			$flags = join(' ', sort @{$test->{flags}});
169		}
170
171		# the completed test record. we'll emit this later once we're
172		# finished with the input; the output file is not open yet.
173		push @tests, [
174		    [ id => $id ],
175		    [ comment => $comment ],
176		    (defined $flags ? [ flags => $flags ] : ()),
177		    [ iv => $iv ],
178		    [ key => $key ],
179		    [ msg => $msg ],
180		    [ ct => $ct ],
181		    [ aad => $aad ],
182		    [ tag => $tag ],
183		    [ result => $result ],
184		];
185	}
186}
187
188if ($skipped) {
189	$ntests -= $skipped;
190	warn "W: skipped $skipped tests; new test count: $ntests\n";
191}
192if ($ntests == 0) {
193	die "E: no tests extracted, sorry!\n";
194}
195
196my $outfh;
197if ($outfile) {
198	open $outfh, '>', $outfile or die "E: $outfile: $!\n";
199} else {
200	$outfh = *STDOUT;
201}
202
203# the "header" record has the algorithm and count of tests
204say $outfh "algorithm: $algorithm";
205say $outfh "tests: $ntests";
206
207#
208for my $test (@tests) {
209	# blank line is a record separator
210	say $outfh "";
211
212	# output the test data in a simple record of 'key: value' lines
213	#
214	# id: 48
215	# comment: Flipped bit 63 in tag
216	# flags: ModifiedTag
217	# iv: 505152535455565758595a5b
218	# key: 000102030405060708090a0b0c0d0e0f
219	# msg: 202122232425262728292a2b2c2d2e2f
220	# ct: eb156d081ed6b6b55f4612f021d87b39
221	# aad:
222	# tag: d8847dbc326a066988c77ad3863e6083
223	# result: invalid
224	for my $row (@$test) {
225		my ($k, $v) = @$row;
226		say $outfh "$k: $v";
227	}
228}
229
230close $outfh;
231
232# check that the length of hex string matches the wanted number of bits
233sub length_check {
234	my ($id, $name, $hexstr, $wantbits) = @_;
235	my $got = length($hexstr)/2;
236	my $want = $wantbits/8;
237	return 1 if $got == $want;
238	my $gotbits = $got*8;
239	say
240	    "W: $id: '$name' has incorrect len, skipping test:\n".
241	    "        got $got bytes ($gotbits bits)\n".
242	    "        want $want bytes ($wantbits bits)\n";
243	return;
244}
245