Commit | Line | Data |
---|---|---|
1047c205 MW |
1 | #! /usr/bin/perl -w |
2 | ### | |
3 | ### Import/update crypto implementations from Catacomb. | |
4 | ||
5 | ### This file is part of secnet. | |
6 | ### See README for full list of copyright holders. | |
7 | ### | |
8 | ### secnet is free software; you can redistribute it and/or modify it | |
9 | ### under the terms of the GNU General Public License as published by | |
10 | ### the Free Software Foundation; either version d of the License, or | |
11 | ### (at your option) any later version. | |
12 | ### | |
13 | ### secnet is distributed in the hope that it will be useful, but | |
14 | ### WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | ### General Public License for more details. | |
17 | ### | |
18 | ### You should have received a copy of the GNU General Public License | |
19 | ### version 3 along with secnet; if not, see | |
20 | ### https://www.gnu.org/licenses/gpl.html. | |
21 | ||
22 | use autodie; | |
23 | ||
24 | use IPC::System::Simple qw{runx capturex $EXITVAL}; | |
25 | ||
26 | use Data::Dumper; | |
27 | ||
28 | my $DONOR_VERSION = "UNKNOWN"; | |
29 | my $DONOR_REVISION = "UNKNOWN"; | |
30 | my $DONOR_DIR = "../catacomb"; | |
31 | ||
32 | (my $PROG = $0) =~ s{^.*/}{}; | |
33 | ||
34 | my @with_dir = ("sh", "-c", 'dir=$1; shift; cd "$dir" && exec "$@"', "."); | |
35 | ||
36 | sub moan ($) { print STDERR "$PROG: $_[0]\n"; } | |
37 | ||
38 | ###-------------------------------------------------------------------------- | |
39 | ### Building commit messages. | |
40 | ||
41 | my %DONOR_PATH_MAP = (); | |
42 | my %DONOR_REV_MAP = (); | |
43 | my $RECIP_CACHE = (); | |
44 | ||
45 | sub note_path ($$) { | |
46 | my ($donor, $recip) = @_; | |
47 | ||
48 | my $recip_rev = capturex "git", "rev-list", "--max-count=1", | |
49 | "HEAD", "--", $recip; chomp $recip_rev; | |
50 | ||
51 | my $donor_rev; | |
52 | if ($recip_rev eq "") | |
53 | { $donor_rev = undef; } | |
54 | elsif (exists $RECIP_CACHE{$recip_rev}) | |
55 | { $donor_rev = $RECIP_CACHE{$recip_rev}; } | |
56 | else { | |
57 | chomp (my @msg = capturex "git", "cat-file", "commit", $recip_rev); | |
58 | ||
59 | my $trail = ""; | |
60 | LINE: for (;;) { | |
61 | last LINE unless @msg; | |
62 | my $line = pop @msg; | |
63 | next LINE if $trail eq "" && $line =~ /^\s*$/; | |
64 | $trail = $line . $trail; | |
65 | next LINE if $trail =~ /^\s/; | |
66 | last LINE | |
67 | unless $trail =~ /^ ([^:\s]+) \s* : \s* (| \S | \S .* \S) \s* $/x; | |
68 | my $k = $1; my $v = $2; | |
69 | if ($k eq "Upstream-Revision") { | |
70 | if ($v !~ /^ [A-Fa-f0-9]+ $/x) { | |
71 | moan "ignoring bad `Upstream-Revision' `$v' in commit $recip_rev"; | |
72 | next LINE; | |
73 | } | |
74 | $donor_rev = $v; | |
75 | last LINE; | |
76 | } | |
77 | } | |
78 | defined $donor_rev or | |
79 | moan "failed to find upstream version in commit $recip_rev"; | |
80 | $RECIP_CACHE{$recip_rev} = $donor_rev; | |
81 | } | |
82 | $DONOR_PATH_MAP{$donor} = $recip; | |
83 | $DONOR_REV_MAP{$donor} = $donor_rev; | |
84 | } | |
85 | ||
86 | sub commit_changes () { | |
87 | my $msg = ""; | |
88 | my $any_changes = 0; | |
89 | ||
90 | ## Stage updated files for commit. | |
91 | my %recip_map; | |
92 | for my $path (keys %DONOR_PATH_MAP) | |
93 | { push @{$recip_map{$DONOR_PATH_MAP{$path}}}, $path; } | |
94 | runx "git", "update-index", "--add", "--", keys %recip_map; | |
95 | ||
96 | ## Inspect the changed files. Notice whether we've actually changed or | |
97 | ## added files. | |
98 | chomp (my @diff = capturex "git", "diff-index", "--cached", "HEAD"); | |
99 | my %changed = (); | |
100 | my %new = (); | |
101 | for my $line (@diff) { | |
102 | $line =~ /^ : | |
103 | [0-7]+ \ [0-7]+ \ # | |
104 | ([A-Fa-f0-9]+) \ ([A-Fa-f0-9]+) \ # | |
105 | ([ACDMRTUX])\d* \t | |
106 | ([^\t]+) (?: \t ([^\t]+))? $/x | |
107 | or die "incomprehensible git-diff line `$line'"; | |
108 | my $path = ($3 eq "C" or $3 eq "R") ? $5 : $4; | |
109 | $changed{$path} = 1; $new{$path} = ($1 !~ /[^0]/); | |
110 | } | |
111 | ||
112 | ## Files which haven't changed aren't interesting any more. | |
113 | for my $path (keys %DONOR_PATH_MAP) { | |
114 | my $recip = $DONOR_PATH_MAP{$path}; | |
115 | if (!$changed{$recip}) { | |
116 | delete $recip_map{$recip}; | |
117 | delete $DONOR_REV_MAP{$path}; | |
118 | } | |
119 | } | |
120 | if (!%recip_map) { moan "no changes to import"; return ""; } | |
121 | ||
122 | ## Build the commit preamble. | |
123 | $msg .= "Update crypto code from Catacomb $DONOR_VERSION.\n\n"; | |
124 | $msg .= "This change committed automatically by `$PROG'.\n\n"; | |
125 | ||
126 | ## Construct the summary of changes. | |
127 | my @recip = sort keys %recip_map; | |
128 | for my $recip (@recip) { | |
129 | my $disp = $new{$recip} ? "new" : "updated"; | |
130 | my $line = " * Import $disp `$recip' from upstream"; | |
131 | my @p = sort @{$recip_map{$recip}}; | |
132 | for (my $i = 0; $i < @p; $i++) { | |
133 | my $p = $p[$i]; | |
134 | if (!$i) { } | |
135 | else { | |
136 | @p == 2 or $line .= ","; | |
137 | if ($i == @p - 1) { | |
138 | if (length($line) + 4 > 72) | |
139 | { $msg .= $line . "\n"; $line = " "; } | |
140 | $line .= " and"; | |
141 | } | |
142 | } | |
143 | if (length($line) + length($p) + 3 > 72) | |
144 | { $msg .= $line . "\n"; $line = " "; } | |
145 | $line .= " `$p'" | |
146 | } | |
147 | $msg .= $line . ".\n"; | |
148 | } | |
149 | ||
150 | ## Now the detailed list of upstream commits. | |
151 | $msg .= "\nDetailed list of changes:\n"; | |
152 | my @paths; my @roots; | |
153 | for my $path (keys %DONOR_REV_MAP) { | |
154 | my $rev = $DONOR_REV_MAP{$path}; | |
155 | if (defined $rev) { push @paths, $path; push @roots, $rev; } | |
156 | } | |
157 | chomp (my @revs = capturex @with_dir, $DONOR_DIR, | |
158 | "git", "rev-list", "--reverse", | |
159 | "HEAD", "--not", @roots, "--", @paths); | |
160 | ||
161 | for my $rev (@revs) { | |
162 | my @affected = (); | |
163 | for my $path (@paths) { | |
164 | runx [0, 1], @with_dir, $DONOR_DIR, | |
165 | "git", "merge-base", "--is-ancestor", | |
166 | $DONOR_REV_MAP{$path}, $rev; | |
167 | push @affected, $path if !$EXITVAL; | |
168 | } | |
169 | $msg .= "\n" . join "", | |
170 | grep { s/\s+$/\n/ } | |
171 | map { " " . $_ } | |
172 | capturex @with_dir, $DONOR_DIR, | |
173 | "git", "show", "--stat", $rev, "--", @affected; | |
174 | } | |
175 | ||
176 | ## The trailer, so that we can see where we left off. | |
177 | $msg .= "\nUpstream-Revision: $DONOR_REVISION\n"; | |
178 | ||
179 | ## Commit everything. | |
180 | runx "git", "commit", "--edit", "--message", $msg, @recip; | |
181 | } | |
182 | ||
183 | ###-------------------------------------------------------------------------- | |
184 | ### Converting C sources and headers. | |
185 | ||
186 | sub convert_c ($$) { | |
187 | my ($from, $to) = @_; | |
188 | ## Convert a C source or header file. FROM is the source file name; TO is | |
189 | ## the destination file name. Also clobbers `TO.new'. | |
190 | ||
191 | (my $file = $from) =~ s{^ .* / ([^/]+ / [^/]+) $}{$1}x; | |
192 | ||
193 | open my $in, "<", $from; | |
194 | open my $out, ">", "$to.new"; | |
195 | ||
196 | ## Control state. | |
197 | my $pending_blank = 0; # waiting to output a blank line? | |
198 | my $skip_reason = ""; # why should we skip output? | |
199 | my $trim_spaces = -1; # number of leading spaces to trim - 1 | |
200 | ||
201 | my $if_open = 0; # current `#if' emitted to output? | |
202 | my $if_skippable = 0; # current `#if' not propagated? | |
203 | my $if_skipping = 0; # current `#if' body being skipped? | |
204 | my $if_unindent = 0; # indent level removed by this `#if' | |
205 | my @if_stack = (); # stack of previous `$if_...' vars | |
206 | my $if_level = 0; # current `#if' nesting level | |
207 | ||
208 | my @lookahead = (); # stack of lines to be read again | |
209 | ||
210 | LINE: for (;;) { | |
211 | my $line; | |
212 | if (@lookahead) { $line = pop @lookahead; } | |
213 | else { $line = <$in>; defined $line or last LINE; chomp $line; } | |
214 | ||
215 | ## Track blank lines so that we don't leave huge gaps. Also, if this is | |
216 | ## a blank line and we were skipping a paragraph, then we've reached the | |
217 | ## end. | |
218 | if ($line =~ /^\s*$/) { | |
219 | if ($skip_reason eq "para") { $skip_reason = ""; } | |
220 | $pending_blank = 1; next LINE; | |
221 | } | |
222 | ||
223 | ## If we're skipping a defun, and this is the end of it, then stop | |
224 | ## skipping. (But swallow the line.) | |
225 | if ($skip_reason eq "defun" && $line =~ /^\}/) | |
226 | { $skip_reason = ""; next LINE; } | |
227 | ||
228 | ## If this is a stanza heading, inspect the stanza. | |
229 | if ($line =~ m{^/\* --- (.*) --- \*/?$}) { | |
230 | my $stanza = $1; | |
231 | ||
232 | ## If we're skipping a stanza, then stop skipping. | |
233 | if ($skip_reason eq "stanza") { $skip_reason = ""; } | |
234 | ||
235 | ## On the other hand, there are stanze we don't want. | |
236 | if ($stanza eq '@sha3_{224,256,384,512}_set@' || | |
237 | $stanza eq '@sha3_state@' || | |
238 | $stanza eq '@shake_mask@' || | |
239 | $stanza eq '@shake{128,256}_rand@' || | |
240 | $stanza eq '@cshake{128,256}_rand@' || | |
241 | $stanza eq "Generic hash interface" || | |
242 | $stanza eq "Hash interface" || | |
243 | $stanza eq "Generic cipher interface" || | |
244 | $stanza eq "Cipher interface" || | |
245 | $stanza eq "Random generator interface") | |
246 | { $skip_reason = "stanza"; } | |
247 | } | |
248 | ||
249 | ## If this is a section heading, inspect the heading. | |
250 | if ($line =~ m{^/\*-{5} (.*) -{5,}\*/?$}) { | |
251 | my $sect = $1; | |
252 | ||
253 | ## If we're skipping a section or a stanza, then stop skipping. | |
254 | if ($skip_reason eq "section" || $skip_reason eq "stanza") | |
255 | { | |
256 | $skip_reason = ""; } | |
257 | ||
258 | ## On the other hand, there are sections we don't want. | |
259 | if ($sect eq "Signed integer types") { | |
260 | $skip_reason = "section"; | |
261 | print $out <<EOF; | |
262 | /*----- Signed integer types ----------------------------------------------*/ | |
263 | ||
264 | typedef int32_t int32; | |
265 | typedef int64_t int64; | |
266 | #define HAVE_INT64 1 | |
267 | EOF | |
268 | $pending_blank = 1; | |
269 | } elsif ($sect eq "Test rig" || | |
270 | $sect eq "Key fetching" || | |
271 | $sect eq "The KMAC variable-length PRF") | |
272 | { $skip_reason = "section"; } | |
273 | } | |
274 | ||
275 | ## Handle `#if' and friends. This is not especially principled. | |
276 | if ($line =~ /^ (\s* \# \s*) | |
277 | (if|elif|ifdef|ifndef) | |
278 | (\s+) | |
279 | (\S|\S.*\S) | |
280 | (\s*) | |
281 | $/x) { | |
282 | my $hash = $1; my $kw = $2; my $s1 = $3; my $cond = $4; | |
283 | ||
284 | ## Categorize the conditional directive. | |
285 | my $test; my $sense; | |
286 | if ($kw eq "if" || $kw eq "elif") { $test = "if"; $sense = 1; } | |
287 | elsif ($kw eq "ifdef") { $test = "ifdef"; $sense = 1; } | |
288 | elsif ($kw eq "ifndef") { $test = "ifdef"; $sense = 0; } | |
289 | else { die "confused!"; } | |
290 | ||
291 | ## Now analyse the condition and decide what we should do about it. | |
292 | my $skip = undef; my $unindent = 0; | |
293 | ||
294 | if ($test eq "ifdef" && $cond eq "HAVE_UINT64") | |
295 | { $skip = 0; $unindent = 2; } | |
296 | ||
297 | elsif ($test eq "if" && | |
298 | $cond eq "!defined(F25519_IMPL) && defined(HAVE_INT64)") | |
299 | { $skip = 1; } | |
300 | elsif ($test eq "ifdef" && $cond eq "F25519_IMPL") { $skip = 0; } | |
301 | elsif ($test eq "if" && $cond eq "F25519_IMPL == 26") { $skip = 0; } | |
302 | elsif ($test eq "if" && $cond eq "F25519_IMPL == 10") { $skip = 1; } | |
303 | ||
304 | elsif ($test eq "if" && | |
305 | $cond eq "!defined(FGOLDI_IMPL) && defined(HAVE_INT64)") | |
306 | { $skip = 1; } | |
307 | elsif ($test eq "if" && $cond eq "FGOLDI_IMPL == 28") { $skip = 0; } | |
308 | elsif ($test eq "if" && $cond eq "FGOLDI_IMPL == 12") { $skip = 1; } | |
309 | elsif ($test eq "ifdef" && $cond eq "FGOLDI_IMPL") { $skip = 0; } | |
310 | ||
311 | elsif ($test eq "ifdef" && $cond eq "SCAF_IMPL") { $skip = 0; } | |
312 | elsif ($test eq "if" && $cond eq "SCAF_IMPL == 32") { $skip = 0; } | |
313 | elsif ($test eq "if" && $cond eq "SCAF_IMPL == 16") { $skip = 1; } | |
314 | ||
315 | elsif ($test eq "if" && $cond =~ /^(.*) \|\| defined\(TEST_RIG\)/) | |
316 | { $cond = $1; } | |
317 | ||
318 | elsif ($test eq "ifdef" && ($cond eq "CATACOMB_GCIPHER_H" || | |
319 | $cond eq "CATACOMB_GHASH_H" || | |
320 | $cond eq "CATACOMB_GMAC_H" || | |
321 | $cond eq "CATACOMB_GRAND_H" || | |
322 | $cond eq "CATACOMB_KEY_H")) | |
323 | { $skip = 0; } | |
324 | ||
325 | elsif ($test eq "ifdef" && $cond eq "NEG_TWOC") | |
326 | { $skip = 0; $unindent = 2 if $file eq "math/qfarith.h"; } | |
327 | ||
328 | ## Adjust the processor state to do something sensible. | |
329 | if (!$sense && defined $skip) { $skip = !$skip; } | |
330 | ||
331 | if ($kw eq "elif") { | |
332 | $trim_spaces -= $if_unindent; | |
333 | if ($if_skipping) { $skip_reason = ""; } | |
334 | if (!$if_open && !defined $skip) { $kw = "if"; $if_open = 1; } | |
335 | elsif ($if_open && defined $skip) | |
336 | { $if_open = 0; print "${hash}endif\n" unless $skip_reason; } | |
337 | } else { | |
338 | $if_level++; | |
339 | push @if_stack, | |
340 | [$if_open, $if_skippable, $if_skipping, $if_unindent]; | |
341 | $if_open = !defined $skip; | |
342 | } | |
343 | $if_skippable = defined $skip; $if_skipping = $skip && !$skip_reason; | |
344 | if ($if_skipping && !$skip_reason) | |
345 | { $skip_reason = "if.$if_level"; } | |
346 | $if_unindent = $unindent; $trim_spaces += $unindent; | |
347 | ||
348 | ## Maybe produce some output. | |
349 | if (defined $skip) { next LINE; } | |
350 | else { $line = $hash . $kw . $s1 . $cond; } | |
351 | } elsif ($line =~ /^ \s* \# \s* else \s* $/x) { | |
352 | if ($if_skippable) { | |
353 | if ($if_skipping) { | |
354 | $if_skipping = 0; | |
355 | $skip_reason = "" if $skip_reason eq "if.$if_level"; | |
356 | } else { | |
357 | $if_skipping = 1; | |
358 | $skip_reason = "if.$if_level" if !$skip_reason; | |
359 | } | |
360 | next LINE; | |
361 | } | |
362 | } elsif ($line =~ /^ \s* \# \s* endif \s* $/x) { | |
363 | my $was_open = $if_open; | |
364 | if ($if_skipping) | |
365 | { $skip_reason = "" if $skip_reason eq "if.$if_level"; } | |
366 | $trim_spaces -= $if_unindent; | |
367 | ($if_open, $if_skippable, $if_skipping, $if_unindent) = | |
368 | @{ pop @if_stack }; | |
369 | $if_level--; | |
370 | if (!$was_open) { next LINE; } | |
371 | } | |
372 | ||
373 | ## If we're skipping something, then do that. | |
374 | if ($skip_reason) { next LINE; } | |
375 | ||
376 | ## Inspect header inclusions. | |
377 | if ($line =~ /^ (\s* \# \s* include \s+) (["<] [^">]* [">]) \s* $/x) { | |
378 | my $incl = $1; my $hdr = $2; | |
379 | if ($hdr eq '<mLib/bits.h>') { $hdr = '"fake-mLib-bits.h"'; } | |
380 | elsif ($hdr eq '"hash.h"' || $hdr eq '"ghash-def.h"') { next LINE; } | |
381 | elsif ($hdr eq '"ct.h"') { next LINE; } | |
382 | $line = $incl . $hdr; | |
383 | } | |
384 | ||
385 | ## We don't have Catacomb's `config.h'. | |
386 | if ($line =~ /^ \# \s* include \s+ "config\.h" \s* $/x) | |
387 | { next LINE; } | |
388 | ||
389 | ## Zap the 16-bit implementations. | |
390 | if ($line =~ /^ int16 (p10\[26\]|p12\[40\])\;$/) | |
391 | { next LINE; } | |
392 | ||
393 | ## Maybe trim leading indentation. | |
394 | if ($trim_spaces > 0) { | |
395 | $line =~ s/^ (\#?) \ ? \ {$trim_spaces}/$1/x | |
396 | or $trim_spaces = -1; | |
397 | } | |
398 | ||
399 | ## Other random lines we don't want. | |
400 | if ($line eq "extern const octet shake128_keysz[], shake256_keysz[];") | |
401 | { next LINE; } | |
402 | ||
403 | if ($line eq "const octet") { | |
404 | die "fixme: read from lookahead" if @lookahead; | |
405 | my $line1 = <$in>; chomp $line1; | |
406 | my $line2 = <$in>; chomp $line2; | |
407 | if ($line1 =~ /^ shake128_keysz\[] = .*,/ && | |
408 | $line2 =~ /^ shake256_keysz\[] = .*;/) | |
409 | { next LINE; } | |
410 | else | |
411 | { push @lookahead, $line2, $line1; } | |
412 | } | |
413 | ||
414 | ## Other random tweaks. | |
415 | $line =~ s/ct_memeq/consttime_memeq/g; | |
416 | $line =~ s/\bSHA512_HASHSZ\b/SHA512_DIGEST_SIZE/g; | |
417 | $line =~ s/\bsha512_ctx\b/struct sha512_ctx/g; | |
418 | $line =~ s/\bsha512_init\b/sha512_init_ctx/g; | |
419 | $line =~ s{\b sha512_hash \( ([^,]+) (,\s*) ([^,]+) (,\s*) ([^)]+) \)} | |
420 | {sha512_process_bytes($3$2$5$2$1)}gx; | |
421 | $line =~ s/\bsha512_done\b/sha512_finish_ctx/g; | |
422 | ||
423 | ## Fix the provenance note. | |
424 | if ($line =~ /^ \* This file is part of Catacomb/) { | |
425 | print $out <<EOF; | |
426 | * This file is part of secnet. | |
427 | * See README for full list of copyright holders. | |
428 | * | |
429 | * secnet is free software; you can redistribute it and/or modify it | |
430 | * under the terms of the GNU General Public License as published by | |
431 | * the Free Software Foundation; either version d of the License, or | |
432 | * (at your option) any later version. | |
433 | * | |
434 | * secnet is distributed in the hope that it will be useful, but | |
435 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
436 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
437 | * General Public License for more details. | |
438 | * | |
439 | * You should have received a copy of the GNU General Public License | |
440 | * version 3 along with secnet; if not, see | |
441 | * https://www.gnu.org/licenses/gpl.html. | |
442 | * | |
443 | * This file was originally part of Catacomb, but has been automatically | |
444 | * modified for incorporation into secnet: see `import-catacomb-crypto' | |
445 | * for details. | |
446 | EOF | |
447 | next LINE; | |
448 | } | |
449 | ||
450 | ## Print the line. | |
451 | if ($pending_blank && $line !~ /^\s*\}\s*/) { print $out "\n"; } | |
452 | print $out "$line\n"; $pending_blank = 0; | |
453 | } | |
454 | ||
455 | ## Done. | |
456 | close $in; | |
457 | close $out; rename "$to.new", "$to"; | |
458 | } | |
459 | ||
460 | ###-------------------------------------------------------------------------- | |
461 | ### Converting a test-vector file. | |
462 | ||
463 | sub convert_test ($$$) { | |
464 | my ($from, $to, $varmap) = @_; | |
465 | ## Convert a test vector file . FROM is a listref of source | |
466 | ## specifications; TO is the destination file name. `TO.new' is also | |
467 | ## clobbered. The VARMAP is a listref containing test specifications. | |
468 | ## | |
469 | ## A source specification is a string of one of the following forms. | |
470 | ## | |
471 | ## * `=HEAD-COMMENT' -- set the first-line comment. (Otherwise it's | |
472 | ## taken from the first comment line of the first input file.) | |
473 | ## | |
474 | ## * `[FORMAT:]PATH -- read test data from the PATH, and parse it | |
475 | ## according to FORMAT. | |
476 | ## | |
477 | ## FORMATs supported are `std' (Catacomb's native format), `ed25519djb' | |
478 | ## (Bernstein's Ed25519 test vector file, and `sha3' (NIST's CAVP format | |
479 | ## for SHA3 test vectors). | |
480 | ## | |
481 | ## A test specification is a /pair/ of items (the list as a whole is | |
482 | ## suitable for conversion into a Perl hash): each key names a kind of | |
483 | ## test; and each value is either a listref of register names or a coderef | |
484 | ## for a formatting function, called as FMT(OUTREF, FIELDS), where OUTREF | |
485 | ## is a scalar-ref of the output to build, and FIELDS is the list of | |
486 | ## test-vector fields. | |
487 | ## | |
488 | ## Yes, this is quite hairy. | |
489 | ||
490 | ## Convert the VARMAP into an actual hash. (We want the list version | |
491 | ## because it has the correct output order.) | |
492 | my %varmap = @$varmap; | |
493 | ||
494 | ## Global control state. | |
495 | my $filehead = ""; # first-line comment | |
496 | my %testout = (); # map tests to output buffers | |
497 | ||
498 | ## Work through each input spec. | |
499 | INPUT: for my $input (@$from) { | |
500 | ||
501 | ## Handle a headline comment. | |
502 | if ($input =~ /^=(.*)$/) { | |
503 | $filehead and die "two heads are not better than one"; | |
504 | $filehead = $1; next INPUT; | |
505 | } | |
506 | ||
507 | ## Split the format specifier from the pathname. | |
508 | my $fmt = "std"; | |
509 | if ($input =~ /^([^:]*):(.*)$/) { $fmt = $1; $input = $2; } | |
510 | ||
511 | ## Get the input basename. | |
512 | (my $base = $input) =~ s{^.*/}{}; | |
513 | ||
514 | ## Open the input file. | |
515 | open my $in, "<", $input; | |
516 | ||
517 | ## Per-input control state. | |
518 | my $head = ""; # per-file comment to insert | |
519 | my $test = undef; # current test category | |
520 | my $vars = undef; # output specifier for current test | |
521 | my $sha3_kind; # SHA3 test kind: `kat' or `mct' | |
522 | my $sha3_len = 8; my $sha3_msg; # SHA3 test state | |
523 | my $sha3_prev; # ... | |
524 | my @lookahead = (); # stack of lines to be read again | |
525 | ||
526 | ## Per-format setup. | |
527 | if ($fmt eq "ed25519djb") { | |
528 | ## Just record that this from djb's reference. | |
529 | ||
530 | for my $t (qw{pubkey sign verify}) { | |
531 | $testout{$t} .= | |
532 | "## Test vectors from Dan Bernstein's reference implementation.\n\n"; | |
533 | } | |
534 | } elsif ($fmt eq "sha3") { | |
535 | ## Set up to parse the NIST CAVP test files. | |
536 | ||
537 | my $tail; | |
538 | my $alg; my $sep; my $bits; my $hex; | |
539 | ||
540 | ## Pick apart the file name. | |
541 | if ($base =~ /^SHA3_(.*)$/) | |
542 | { $tail = $1; $alg = "sha3"; $sep = "-"; $hex = "-hex"; } | |
543 | elsif ($base =~ /^SHAKE(.*)$/) | |
544 | { $tail = $1; $alg = "shake"; $sep = ""; $hex = ""; } | |
545 | else | |
546 | { die "strange `$base'"; } | |
547 | ||
548 | if ($tail =~ /^(.*)LongMsg\.rsp/) | |
549 | { $sha3_kind = "kat"; $bits = $1; } | |
550 | elsif ($tail =~ /^(.*)ShortMsg\.rsp/) | |
551 | { $sha3_kind = "kat"; $bits = $1; } | |
552 | elsif ($tail =~ /^(.*)VariableOut\.rsp/) | |
553 | { $sha3_kind = "kat"; $bits = $1; } | |
554 | elsif ($tail =~ /^(.*)Monte\.rsp/) | |
555 | { $sha3_kind = "mct"; $bits = $1; } | |
556 | ||
557 | ## Determine the test name. | |
558 | if ($sha3_kind eq "kat") { $test = $alg . $sep . $bits . $hex; } | |
559 | elsif ($sha3_kind eq "mct") { $test = $alg . $sep . $bits . "-mct"; } | |
560 | ||
561 | ## Set the per-test banner. | |
562 | $testout{$test} .= "## Converted from NIST test vectors\n"; | |
563 | } | |
564 | ||
565 | ## Work through the input file. | |
566 | LINE: for (;;) { | |
567 | my $line; | |
568 | if (@lookahead) { $line = pop @lookahead; } | |
569 | else { $line = <$in>; defined $line or last LINE; chomp $line; } | |
570 | ||
571 | ## Ignore empty lines. | |
572 | if ($line =~ /^\s*$/) { next LINE; } | |
573 | ||
574 | ## Copy comments to the output. An initial comment becomes the | |
575 | ## headline. Top-level comments get written to /every/ test chunk | |
576 | ## extracted from this input file. Comments within test chunks get | |
577 | ## added to the output chunk. | |
578 | if ($line =~ /^ \s* (?:\#+) \s* (| [^#\s] (?: .* \S)?) \s* $/x) { | |
579 | if (!$filehead) { $filehead = $1; next LINE; } | |
580 | my $buf = "## $1\n" if $1; | |
581 | COMMENT: for (;;) { | |
582 | die "fixme: read from lookahead" if @lookahead; | |
583 | $line = <$in>; defined $line or last COMMENT; chomp $line; | |
584 | last COMMENT | |
585 | unless $line =~ /^ \s* (?:\#+) \s* (| [^#\s] (?: .* \S)?) $/x; | |
586 | $buf .= "## $1\n"; | |
587 | } | |
588 | push @lookahead, $line if defined $line; | |
589 | if (defined $test) { $testout{$test} .= $buf; } | |
590 | else { $head = $buf . "\n"; } | |
591 | next LINE; | |
592 | } | |
593 | ||
594 | ## Handle strange formats. | |
595 | if ($fmt eq "ed25519djb") { | |
596 | ## Bernstein's format is strangely redundant. Pick out the | |
597 | ## interesting parts. | |
598 | ||
599 | $line =~ s/^ ([^:]{64}) ([^:]{64}) : | |
600 | \2 : | |
601 | ([^:]*) : | |
602 | ([^:]{128}) \3 : | |
603 | $/$1:$2:$3:$4/x | |
604 | or die "bogus djb line"; | |
605 | my ($k, $K, $m, $s) = ($1, $2, $3, $4); | |
606 | ||
607 | ## Test public-key generation. | |
608 | $testout{"pubkey"} .= <<EOF . "\n"; | |
609 | a $k | |
610 | A $K | |
611 | EOF | |
612 | ||
613 | ## Test signing. | |
614 | $testout{"sign"} .= <<EOF . "\n"; | |
615 | a $k | |
616 | m $m | |
617 | sig $s | |
618 | EOF | |
619 | ||
620 | ## Test successful verification. | |
621 | $testout{"verify"} .= <<EOF . "\n"; | |
622 | A $K | |
623 | m $m | |
624 | sig $s | |
625 | rc 0 | |
626 | EOF | |
627 | ||
628 | ## Test failed verification with negated key. | |
629 | (my $Kneg = $K) =~ s{([0-9a-f]{2})$} | |
630 | { sprintf "%02x", hex($1) ^ 0x80 }e; | |
631 | $testout{"verify"} .= <<EOF . "\n"; | |
632 | A $Kneg | |
633 | m $m | |
634 | sig $s | |
635 | rc -1 | |
636 | EOF | |
637 | ||
638 | ## Test failed verification with clobbered key. | |
639 | (my $Kzap = $K) =~ s{^([0-9a-f]{2})} | |
640 | { sprintf "%02x", hex($1) ^ 0xff }e; | |
641 | $testout{"verify"} .= <<EOF . "\n"; | |
642 | A $Kzap | |
643 | m $m | |
644 | sig $s | |
645 | rc -1 | |
646 | EOF | |
647 | ||
648 | ## Test failed verification with clobbered message. | |
649 | (my $mzap = $m) =~ s{^([0-9a-f]{2})} | |
650 | { sprintf "%02x", hex($1) ^ 0xff }e; | |
651 | $mzap = "00" unless $m; | |
652 | $testout{"verify"} .= <<EOF . "\n"; | |
653 | A $K | |
654 | m $mzap | |
655 | sig $s | |
656 | rc -1 | |
657 | EOF | |
658 | ||
659 | ## Test failed verification with clobbered signature. | |
660 | (my $szap = $s) =~ s{^([0-9a-f]{2})} | |
661 | { sprintf "%02x", hex($1) ^ 0xff }e; | |
662 | $testout{"verify"} .= <<EOF . "\n"; | |
663 | A $K | |
664 | m $m | |
665 | sig $szap | |
666 | rc -1 | |
667 | EOF | |
668 | next LINE; | |
669 | } elsif ($fmt eq "sha3") { | |
670 | ## Parse the wretched NIST file. Alas, there's all sorts of cruft | |
671 | ## that isn't actually very interesting, so the parsing is rather | |
672 | ## slack. | |
673 | ||
674 | if ($sha3_kind eq "kat") { | |
675 | ## Known-answer tests. | |
676 | ||
677 | if ($line =~ /^ Len \s* = \s* ([0-9]+) \s* $/x) | |
678 | { $sha3_len = $1; } | |
679 | elsif ($line =~ /^ Msg \s* = \s* ([A-Fa-f0-9]+) \s* $/x) | |
680 | { $sha3_msg = $sha3_len == 0 ? "" : lc $1; } | |
681 | elsif ($line =~ /^ (?: MD | Output) \s* = \s* | |
682 | ([A-Fa-f0-9]+) \s* $/x) { | |
683 | my $hash = lc $1; | |
684 | $sha3_len%8 == 0 and $testout{$test} .= <<EOF; | |
685 | m $sha3_msg | |
686 | h $hash | |
687 | ||
688 | EOF | |
689 | } | |
690 | } elsif ($sha3_kind eq "mct") { | |
691 | ## Monte-Carlo tests. | |
692 | ||
693 | if ($line =~ /^ MD \s* = \s* ([A-Fa-f0-9]+) \s* $/x) { | |
694 | my $hash = lc $1; | |
695 | defined $sha3_prev and $testout{$test} .= <<EOF; | |
696 | n 1000 | |
697 | m $sha3_prev | |
698 | h $hash | |
699 | ||
700 | EOF | |
701 | $sha3_prev = $hash; | |
702 | } | |
703 | } | |
704 | next LINE; | |
705 | } elsif ($fmt ne "std") { die "fmt `$fmt'?"; } | |
706 | ||
707 | ## Deal with the top-level structure. | |
708 | if (!defined $test) { | |
709 | if ($line =~ /^ \s* ([A-Za-z0-9-]+) \s* \{ \s* $/x) { | |
710 | $test = $1; | |
711 | die "unknown test `$test'" unless exists $varmap{$test}; | |
712 | $vars = $varmap{$test}; | |
713 | $testout{$test} .= $head; | |
714 | } else { | |
715 | die "junk found; expected test head in `$input'" | |
716 | } | |
717 | next LINE; | |
718 | } | |
719 | ||
720 | ## Check for the end of a test chunk. | |
721 | if ($line =~ /^ \s* \} \s* $/x) { | |
722 | $test = undef; $vars = undef; | |
723 | next LINE; | |
724 | } | |
725 | ||
726 | ## So, read a test vector. (This is not correct, but good enough.) | |
727 | my $vector = "$line"; | |
728 | VECTOR: for (;;) { | |
729 | last VECTOR if $vector =~ s/\;$//; | |
730 | die "fixme: read from lookahead" if @lookahead; | |
731 | $line = <$in>; defined $line or die "eof in test chunk"; chomp $line; | |
732 | $vector .= " $line"; | |
733 | } | |
734 | ||
735 | ## Split it into fields. We have to handle quoting, but not very well. | |
736 | my @f = (); | |
737 | FIELD: while ($vector) { | |
738 | if ($vector =~ /^ \s* $/) { last FIELD; } | |
739 | if ($vector =~ /^ \s* " ([^"]*) " (\s+ .*|) $/x) | |
740 | { push @f, $1; $vector = $2; } | |
741 | elsif ($vector =~ /^ \s* (\S+) (\s+ .*|) $/x) | |
742 | { push @f, $1; $vector = $2; } | |
743 | else | |
744 | { die "what even?"; } | |
745 | } | |
746 | ||
747 | ## Add the necessary output to the test chunk. | |
748 | if (!defined $vars) { next LINE; } | |
749 | elsif (ref($vars) eq 'CODE') { $vars->(\$testout{$test}, @f); } | |
750 | else { | |
751 | die "wrong number of fields reading `$input'" unless @f == @$vars; | |
752 | for (my $i = 0; $i < @f; $i++) | |
753 | { $testout{$test} .= "$vars->[$i] $f[$i]\n"; } | |
754 | } | |
755 | $testout{$test} .= "\n"; | |
756 | } | |
757 | ||
758 | ## Done with this file. | |
759 | close $in; | |
760 | } | |
761 | ||
762 | ## Write the output. | |
763 | open my $out, ">", "$to.new"; | |
764 | print $out "### " . $filehead . | |
765 | "\t" x ((67 - length $filehead)/8) . | |
766 | "-*-conf-*-\n"; | |
767 | print $out "### Extracted from Catacomb.\n"; | |
768 | OUT: for (my $i = 0; $i < @$varmap; $i += 2) { | |
769 | next OUT unless defined $varmap->[$i + 1]; | |
770 | my $test = $varmap->[$i]; | |
771 | exists $testout{$test} or die "missing test `$test'"; | |
772 | (my $chunk = $testout{$test}) =~ s/\n\n$/\n/; | |
773 | print $out "\n"; | |
774 | print $out "###" . "-" x 74 . "\n"; | |
775 | print $out "test " . $test . "\n\n"; | |
776 | print $out $chunk; | |
777 | } | |
778 | close $out; rename "$to.new", "$to"; | |
779 | } | |
780 | ||
781 | ###-------------------------------------------------------------------------- | |
782 | ### Main program. | |
783 | ||
784 | my @WANT_C = | |
785 | ("math/qfarith.h", | |
786 | "math/f25519.c", "math/f25519.h", | |
787 | "math/fgoldi.c", "math/fgoldi.h", | |
788 | "math/montladder.h", | |
789 | "math/scaf.c", "math/scaf.h", | |
790 | "math/scmul.h", | |
791 | "pub/x25519.c", "pub/x25519.h", | |
792 | "pub/ed25519.c", "pub/ed25519.h", | |
793 | "pub/x448.c", "pub/x448.h", | |
794 | "pub/ed448.c", "pub/ed448.h", | |
795 | "symm/keccak1600.c", "symm/keccak1600.h", | |
796 | "symm/sha3.c", "symm/sha3.h" | |
797 | ); | |
798 | ||
799 | sub hack_pickn ($$@) { | |
800 | my ($out, @f) = @_; | |
801 | ||
802 | die "want three fields" unless @f == 3; | |
803 | my @v = split ' ', $f[0]; | |
804 | for (my $i = 0; $i < @v; $i++) { $$out .= "v\[$i] $v[$i]\n"; } | |
805 | $$out .= "i $f[1]\n"; | |
806 | $$out .= "z $f[2]\n"; | |
807 | } | |
808 | ||
809 | my @fieldish_test = | |
810 | ("add" => ["x", "y", "z"], | |
811 | "sub" => ["x", "y", "z"], | |
812 | "neg" => ["x", "z"], | |
813 | "condneg" => ["x", "m", "z"], | |
814 | "pick2" => ["x", "y", "m", "z"], | |
815 | "pickn" => \&hack_pickn, | |
816 | "condswap" => ["x", "y", "m", "xx", "yy"], | |
817 | "mulconst" => ["x", "a", "z"], | |
818 | "mul" => ["x", "y", "z"], | |
819 | "sqr" => ["x", "z"], | |
820 | "inv" => ["x", "z"], | |
821 | "quosqrt" => ["x", "y", "z0", "z1"], | |
822 | "sub-mulc-add-sub-mul" => ["u", "v", "a", "w", "x", "y", "z"]); | |
823 | ||
824 | my @WANT_TEST = | |
825 | (["math/t/f25519"] => \@fieldish_test, | |
826 | ["math/t/fgoldi"] => \@fieldish_test, | |
827 | ["pub/t/x25519"] => ["x25519" => ["x", "Y", "Z"], | |
828 | "x25519-mct" => ["x", "Y", "n", "Z"]], | |
829 | ["pub/t/x25519.slow"] => ["x25519-mct" => ["x", "Y", "n", "Z"]], | |
830 | ["=Test vectors for Ed25519.", "!ed25519", | |
831 | "ed25519djb:pub/t/ed25519.djb", | |
832 | "pub/t/ed25519.local"] | |
833 | => ["pubkey" => ["a", "A"], | |
834 | "sign" => ["a", "m", "sig"], | |
835 | "verify" => ["A", "m", "sig", "rc"], | |
836 | "sign-ctx" => ["a", "ph", "ctx", "m", "sig"], | |
837 | "verify-ctx" => ["A", "ph", "ctx", "m", "sig", "rc"]], | |
838 | ["pub/t/x448"] => ["x448" => ["x", "Y", "Z"], | |
839 | "x448-mct" => ["x", "Y", "n", "Z"]], | |
840 | ["pub/t/x448.slow"] => ["x448-mct" => ["x", "Y", "n", "Z"]], | |
841 | ["pub/t/ed448"] => ["pubkey" => ["a", "A"], | |
842 | "sign" => ["a", "ph", "ctx", "m", "sig"], | |
843 | "verify" => ["A", "ph", "ctx", "m", "sig", "rc"]], | |
844 | ["symm/t/keccak1600"] => ["p" => ["x", "n", "z"]], | |
845 | ["!sha3", | |
846 | "sha3:symm/t/SHA3_224ShortMsg.rsp", | |
847 | "sha3:symm/t/SHA3_224LongMsg.rsp", | |
848 | "sha3:symm/t/SHA3_224Monte.rsp", | |
849 | "sha3:symm/t/SHA3_256ShortMsg.rsp", | |
850 | "sha3:symm/t/SHA3_256LongMsg.rsp", | |
851 | "sha3:symm/t/SHA3_256Monte.rsp", | |
852 | "sha3:symm/t/SHA3_384ShortMsg.rsp", | |
853 | "sha3:symm/t/SHA3_384LongMsg.rsp", | |
854 | "sha3:symm/t/SHA3_384Monte.rsp", | |
855 | "sha3:symm/t/SHA3_512ShortMsg.rsp", | |
856 | "sha3:symm/t/SHA3_512LongMsg.rsp", | |
857 | "sha3:symm/t/SHA3_512Monte.rsp", | |
858 | "sha3:symm/t/SHAKE128ShortMsg.rsp", | |
859 | "sha3:symm/t/SHAKE128LongMsg.rsp", | |
860 | "sha3:symm/t/SHAKE128VariableOut.rsp", | |
861 | "sha3:symm/t/SHAKE256ShortMsg.rsp", | |
862 | "sha3:symm/t/SHAKE256LongMsg.rsp", | |
863 | "sha3:symm/t/SHAKE256VariableOut.rsp", | |
864 | "symm/t/sha3.local"] | |
865 | => ["sha3-224-hex" => ["m", "h"], | |
866 | "sha3-224-mct" => ["n", "m", "h"], | |
867 | "sha3-256-hex" => ["m", "h"], | |
868 | "sha3-256-mct" => ["n", "m", "h"], | |
869 | "sha3-384-hex" => ["m", "h"], | |
870 | "sha3-384-mct" => ["n", "m", "h"], | |
871 | "sha3-512-hex" => ["m", "h"], | |
872 | "sha3-512-mct" => ["n", "m", "h"], | |
873 | "shake128" => ["m", "h"], | |
874 | "shake256" => ["m", "h"], | |
875 | "cshake128" => ["func", "perso", "m", "h"], | |
876 | "cshake256" => ["func", "perso", "m", "h"], | |
877 | "kmac128" => undef, | |
878 | "kmac256" => undef]); | |
879 | ||
880 | chomp ($DONOR_VERSION = capturex @with_dir, $DONOR_DIR, | |
881 | "git", "describe", "--abbrev=4", "--dirty=+"); | |
882 | chomp ($DONOR_REVISION = capturex @with_dir, $DONOR_DIR, | |
883 | "git", "rev-parse", "HEAD"); | |
884 | ||
885 | for my $f (@WANT_C) { | |
886 | (my $base = $f) =~ s{^.*/}{}; | |
887 | note_path $f, $base; | |
888 | convert_c "$DONOR_DIR/$f", $base; | |
889 | } | |
890 | ||
891 | for (my $i = 0; $i < @WANT_TEST; $i += 2) { | |
892 | my $src = $WANT_TEST[$i]; my $varmap = $WANT_TEST[$i + 1]; | |
893 | my $base = undef; | |
894 | my $fixed_name = 0; | |
895 | my @in = (); | |
896 | for my $j (@$src) { | |
897 | if ($j =~ s/^!//) { | |
898 | defined $base and die "too late to fix the name"; | |
899 | $base = $j; $fixed_name = 1; next; | |
900 | } elsif ($j =~ /^=/) { push @in, $j; next; } | |
901 | my $pre = ""; | |
902 | if ($j =~ /^([^:]*)\:(.*)$/) { $pre = $1 . ":"; $j = $2; } | |
903 | if (!$fixed_name) { | |
904 | (my $b = $j) =~ s{^ (?: .* /)? (.*) $}{$1}x; | |
905 | defined $base and $base ne $b and die "huh? `$b' /= `$base'"; | |
906 | $base = $b; | |
907 | } | |
908 | note_path $j, "$base-tests.in"; | |
909 | push @in, $pre . "$DONOR_DIR/$j"; | |
910 | } | |
911 | convert_test \@in, "$base-tests.in", $varmap; | |
912 | } | |
913 | ||
914 | commit_changes(); |