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 | ||
b823ca7c MW |
414 | if ($line eq "static void rightenc_sz(shake_ctx *ctx, size_t n)") |
415 | { $skip_reason = "defun"; next LINE; } | |
416 | ||
1047c205 MW |
417 | ## Other random tweaks. |
418 | $line =~ s/ct_memeq/consttime_memeq/g; | |
419 | $line =~ s/\bSHA512_HASHSZ\b/SHA512_DIGEST_SIZE/g; | |
420 | $line =~ s/\bsha512_ctx\b/struct sha512_ctx/g; | |
421 | $line =~ s/\bsha512_init\b/sha512_init_ctx/g; | |
422 | $line =~ s{\b sha512_hash \( ([^,]+) (,\s*) ([^,]+) (,\s*) ([^)]+) \)} | |
423 | {sha512_process_bytes($3$2$5$2$1)}gx; | |
424 | $line =~ s/\bsha512_done\b/sha512_finish_ctx/g; | |
b823ca7c | 425 | $line =~ s/\bdo\s*;\s*while\b/do {} while/g; |
1047c205 MW |
426 | |
427 | ## Fix the provenance note. | |
428 | if ($line =~ /^ \* This file is part of Catacomb/) { | |
429 | print $out <<EOF; | |
430 | * This file is part of secnet. | |
431 | * See README for full list of copyright holders. | |
432 | * | |
433 | * secnet is free software; you can redistribute it and/or modify it | |
434 | * under the terms of the GNU General Public License as published by | |
435 | * the Free Software Foundation; either version d of the License, or | |
436 | * (at your option) any later version. | |
437 | * | |
438 | * secnet is distributed in the hope that it will be useful, but | |
439 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
440 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
441 | * General Public License for more details. | |
442 | * | |
443 | * You should have received a copy of the GNU General Public License | |
444 | * version 3 along with secnet; if not, see | |
445 | * https://www.gnu.org/licenses/gpl.html. | |
446 | * | |
447 | * This file was originally part of Catacomb, but has been automatically | |
448 | * modified for incorporation into secnet: see `import-catacomb-crypto' | |
449 | * for details. | |
450 | EOF | |
451 | next LINE; | |
452 | } | |
453 | ||
454 | ## Print the line. | |
455 | if ($pending_blank && $line !~ /^\s*\}\s*/) { print $out "\n"; } | |
456 | print $out "$line\n"; $pending_blank = 0; | |
457 | } | |
458 | ||
459 | ## Done. | |
460 | close $in; | |
461 | close $out; rename "$to.new", "$to"; | |
462 | } | |
463 | ||
464 | ###-------------------------------------------------------------------------- | |
465 | ### Converting a test-vector file. | |
466 | ||
467 | sub convert_test ($$$) { | |
468 | my ($from, $to, $varmap) = @_; | |
469 | ## Convert a test vector file . FROM is a listref of source | |
470 | ## specifications; TO is the destination file name. `TO.new' is also | |
471 | ## clobbered. The VARMAP is a listref containing test specifications. | |
472 | ## | |
473 | ## A source specification is a string of one of the following forms. | |
474 | ## | |
475 | ## * `=HEAD-COMMENT' -- set the first-line comment. (Otherwise it's | |
476 | ## taken from the first comment line of the first input file.) | |
477 | ## | |
478 | ## * `[FORMAT:]PATH -- read test data from the PATH, and parse it | |
479 | ## according to FORMAT. | |
480 | ## | |
481 | ## FORMATs supported are `std' (Catacomb's native format), `ed25519djb' | |
482 | ## (Bernstein's Ed25519 test vector file, and `sha3' (NIST's CAVP format | |
483 | ## for SHA3 test vectors). | |
484 | ## | |
485 | ## A test specification is a /pair/ of items (the list as a whole is | |
486 | ## suitable for conversion into a Perl hash): each key names a kind of | |
487 | ## test; and each value is either a listref of register names or a coderef | |
488 | ## for a formatting function, called as FMT(OUTREF, FIELDS), where OUTREF | |
489 | ## is a scalar-ref of the output to build, and FIELDS is the list of | |
490 | ## test-vector fields. | |
491 | ## | |
492 | ## Yes, this is quite hairy. | |
493 | ||
494 | ## Convert the VARMAP into an actual hash. (We want the list version | |
495 | ## because it has the correct output order.) | |
496 | my %varmap = @$varmap; | |
497 | ||
498 | ## Global control state. | |
499 | my $filehead = ""; # first-line comment | |
500 | my %testout = (); # map tests to output buffers | |
501 | ||
502 | ## Work through each input spec. | |
503 | INPUT: for my $input (@$from) { | |
504 | ||
505 | ## Handle a headline comment. | |
506 | if ($input =~ /^=(.*)$/) { | |
507 | $filehead and die "two heads are not better than one"; | |
508 | $filehead = $1; next INPUT; | |
509 | } | |
510 | ||
511 | ## Split the format specifier from the pathname. | |
512 | my $fmt = "std"; | |
513 | if ($input =~ /^([^:]*):(.*)$/) { $fmt = $1; $input = $2; } | |
514 | ||
515 | ## Get the input basename. | |
516 | (my $base = $input) =~ s{^.*/}{}; | |
517 | ||
518 | ## Open the input file. | |
519 | open my $in, "<", $input; | |
520 | ||
521 | ## Per-input control state. | |
522 | my $head = ""; # per-file comment to insert | |
523 | my $test = undef; # current test category | |
524 | my $vars = undef; # output specifier for current test | |
525 | my $sha3_kind; # SHA3 test kind: `kat' or `mct' | |
526 | my $sha3_len = 8; my $sha3_msg; # SHA3 test state | |
527 | my $sha3_prev; # ... | |
528 | my @lookahead = (); # stack of lines to be read again | |
529 | ||
530 | ## Per-format setup. | |
531 | if ($fmt eq "ed25519djb") { | |
532 | ## Just record that this from djb's reference. | |
533 | ||
534 | for my $t (qw{pubkey sign verify}) { | |
535 | $testout{$t} .= | |
536 | "## Test vectors from Dan Bernstein's reference implementation.\n\n"; | |
537 | } | |
538 | } elsif ($fmt eq "sha3") { | |
539 | ## Set up to parse the NIST CAVP test files. | |
540 | ||
541 | my $tail; | |
542 | my $alg; my $sep; my $bits; my $hex; | |
543 | ||
544 | ## Pick apart the file name. | |
545 | if ($base =~ /^SHA3_(.*)$/) | |
546 | { $tail = $1; $alg = "sha3"; $sep = "-"; $hex = "-hex"; } | |
547 | elsif ($base =~ /^SHAKE(.*)$/) | |
548 | { $tail = $1; $alg = "shake"; $sep = ""; $hex = ""; } | |
549 | else | |
550 | { die "strange `$base'"; } | |
551 | ||
552 | if ($tail =~ /^(.*)LongMsg\.rsp/) | |
553 | { $sha3_kind = "kat"; $bits = $1; } | |
554 | elsif ($tail =~ /^(.*)ShortMsg\.rsp/) | |
555 | { $sha3_kind = "kat"; $bits = $1; } | |
556 | elsif ($tail =~ /^(.*)VariableOut\.rsp/) | |
557 | { $sha3_kind = "kat"; $bits = $1; } | |
558 | elsif ($tail =~ /^(.*)Monte\.rsp/) | |
559 | { $sha3_kind = "mct"; $bits = $1; } | |
560 | ||
561 | ## Determine the test name. | |
562 | if ($sha3_kind eq "kat") { $test = $alg . $sep . $bits . $hex; } | |
563 | elsif ($sha3_kind eq "mct") { $test = $alg . $sep . $bits . "-mct"; } | |
564 | ||
565 | ## Set the per-test banner. | |
566 | $testout{$test} .= "## Converted from NIST test vectors\n"; | |
567 | } | |
568 | ||
569 | ## Work through the input file. | |
570 | LINE: for (;;) { | |
571 | my $line; | |
572 | if (@lookahead) { $line = pop @lookahead; } | |
573 | else { $line = <$in>; defined $line or last LINE; chomp $line; } | |
574 | ||
575 | ## Ignore empty lines. | |
576 | if ($line =~ /^\s*$/) { next LINE; } | |
577 | ||
578 | ## Copy comments to the output. An initial comment becomes the | |
579 | ## headline. Top-level comments get written to /every/ test chunk | |
580 | ## extracted from this input file. Comments within test chunks get | |
581 | ## added to the output chunk. | |
582 | if ($line =~ /^ \s* (?:\#+) \s* (| [^#\s] (?: .* \S)?) \s* $/x) { | |
583 | if (!$filehead) { $filehead = $1; next LINE; } | |
584 | my $buf = "## $1\n" if $1; | |
585 | COMMENT: for (;;) { | |
586 | die "fixme: read from lookahead" if @lookahead; | |
587 | $line = <$in>; defined $line or last COMMENT; chomp $line; | |
588 | last COMMENT | |
589 | unless $line =~ /^ \s* (?:\#+) \s* (| [^#\s] (?: .* \S)?) $/x; | |
590 | $buf .= "## $1\n"; | |
591 | } | |
592 | push @lookahead, $line if defined $line; | |
593 | if (defined $test) { $testout{$test} .= $buf; } | |
594 | else { $head = $buf . "\n"; } | |
595 | next LINE; | |
596 | } | |
597 | ||
598 | ## Handle strange formats. | |
599 | if ($fmt eq "ed25519djb") { | |
600 | ## Bernstein's format is strangely redundant. Pick out the | |
601 | ## interesting parts. | |
602 | ||
603 | $line =~ s/^ ([^:]{64}) ([^:]{64}) : | |
604 | \2 : | |
605 | ([^:]*) : | |
606 | ([^:]{128}) \3 : | |
607 | $/$1:$2:$3:$4/x | |
608 | or die "bogus djb line"; | |
609 | my ($k, $K, $m, $s) = ($1, $2, $3, $4); | |
610 | ||
611 | ## Test public-key generation. | |
612 | $testout{"pubkey"} .= <<EOF . "\n"; | |
613 | a $k | |
614 | A $K | |
615 | EOF | |
616 | ||
617 | ## Test signing. | |
618 | $testout{"sign"} .= <<EOF . "\n"; | |
619 | a $k | |
620 | m $m | |
621 | sig $s | |
622 | EOF | |
623 | ||
624 | ## Test successful verification. | |
625 | $testout{"verify"} .= <<EOF . "\n"; | |
626 | A $K | |
627 | m $m | |
628 | sig $s | |
629 | rc 0 | |
630 | EOF | |
631 | ||
632 | ## Test failed verification with negated key. | |
633 | (my $Kneg = $K) =~ s{([0-9a-f]{2})$} | |
634 | { sprintf "%02x", hex($1) ^ 0x80 }e; | |
635 | $testout{"verify"} .= <<EOF . "\n"; | |
636 | A $Kneg | |
637 | m $m | |
638 | sig $s | |
639 | rc -1 | |
640 | EOF | |
641 | ||
642 | ## Test failed verification with clobbered key. | |
643 | (my $Kzap = $K) =~ s{^([0-9a-f]{2})} | |
644 | { sprintf "%02x", hex($1) ^ 0xff }e; | |
645 | $testout{"verify"} .= <<EOF . "\n"; | |
646 | A $Kzap | |
647 | m $m | |
648 | sig $s | |
649 | rc -1 | |
650 | EOF | |
651 | ||
652 | ## Test failed verification with clobbered message. | |
653 | (my $mzap = $m) =~ s{^([0-9a-f]{2})} | |
654 | { sprintf "%02x", hex($1) ^ 0xff }e; | |
655 | $mzap = "00" unless $m; | |
656 | $testout{"verify"} .= <<EOF . "\n"; | |
657 | A $K | |
658 | m $mzap | |
659 | sig $s | |
660 | rc -1 | |
661 | EOF | |
662 | ||
663 | ## Test failed verification with clobbered signature. | |
664 | (my $szap = $s) =~ s{^([0-9a-f]{2})} | |
665 | { sprintf "%02x", hex($1) ^ 0xff }e; | |
666 | $testout{"verify"} .= <<EOF . "\n"; | |
667 | A $K | |
668 | m $m | |
669 | sig $szap | |
670 | rc -1 | |
671 | EOF | |
672 | next LINE; | |
673 | } elsif ($fmt eq "sha3") { | |
674 | ## Parse the wretched NIST file. Alas, there's all sorts of cruft | |
675 | ## that isn't actually very interesting, so the parsing is rather | |
676 | ## slack. | |
677 | ||
678 | if ($sha3_kind eq "kat") { | |
679 | ## Known-answer tests. | |
680 | ||
681 | if ($line =~ /^ Len \s* = \s* ([0-9]+) \s* $/x) | |
682 | { $sha3_len = $1; } | |
683 | elsif ($line =~ /^ Msg \s* = \s* ([A-Fa-f0-9]+) \s* $/x) | |
684 | { $sha3_msg = $sha3_len == 0 ? "" : lc $1; } | |
685 | elsif ($line =~ /^ (?: MD | Output) \s* = \s* | |
686 | ([A-Fa-f0-9]+) \s* $/x) { | |
687 | my $hash = lc $1; | |
688 | $sha3_len%8 == 0 and $testout{$test} .= <<EOF; | |
689 | m $sha3_msg | |
690 | h $hash | |
691 | ||
692 | EOF | |
693 | } | |
694 | } elsif ($sha3_kind eq "mct") { | |
695 | ## Monte-Carlo tests. | |
696 | ||
697 | if ($line =~ /^ MD \s* = \s* ([A-Fa-f0-9]+) \s* $/x) { | |
698 | my $hash = lc $1; | |
699 | defined $sha3_prev and $testout{$test} .= <<EOF; | |
700 | n 1000 | |
701 | m $sha3_prev | |
702 | h $hash | |
703 | ||
704 | EOF | |
705 | $sha3_prev = $hash; | |
706 | } | |
707 | } | |
708 | next LINE; | |
709 | } elsif ($fmt ne "std") { die "fmt `$fmt'?"; } | |
710 | ||
711 | ## Deal with the top-level structure. | |
712 | if (!defined $test) { | |
713 | if ($line =~ /^ \s* ([A-Za-z0-9-]+) \s* \{ \s* $/x) { | |
714 | $test = $1; | |
715 | die "unknown test `$test'" unless exists $varmap{$test}; | |
716 | $vars = $varmap{$test}; | |
717 | $testout{$test} .= $head; | |
718 | } else { | |
719 | die "junk found; expected test head in `$input'" | |
720 | } | |
721 | next LINE; | |
722 | } | |
723 | ||
724 | ## Check for the end of a test chunk. | |
725 | if ($line =~ /^ \s* \} \s* $/x) { | |
726 | $test = undef; $vars = undef; | |
727 | next LINE; | |
728 | } | |
729 | ||
730 | ## So, read a test vector. (This is not correct, but good enough.) | |
731 | my $vector = "$line"; | |
732 | VECTOR: for (;;) { | |
733 | last VECTOR if $vector =~ s/\;$//; | |
734 | die "fixme: read from lookahead" if @lookahead; | |
735 | $line = <$in>; defined $line or die "eof in test chunk"; chomp $line; | |
736 | $vector .= " $line"; | |
737 | } | |
738 | ||
739 | ## Split it into fields. We have to handle quoting, but not very well. | |
740 | my @f = (); | |
741 | FIELD: while ($vector) { | |
742 | if ($vector =~ /^ \s* $/) { last FIELD; } | |
743 | if ($vector =~ /^ \s* " ([^"]*) " (\s+ .*|) $/x) | |
744 | { push @f, $1; $vector = $2; } | |
745 | elsif ($vector =~ /^ \s* (\S+) (\s+ .*|) $/x) | |
746 | { push @f, $1; $vector = $2; } | |
747 | else | |
748 | { die "what even?"; } | |
749 | } | |
750 | ||
751 | ## Add the necessary output to the test chunk. | |
752 | if (!defined $vars) { next LINE; } | |
753 | elsif (ref($vars) eq 'CODE') { $vars->(\$testout{$test}, @f); } | |
754 | else { | |
755 | die "wrong number of fields reading `$input'" unless @f == @$vars; | |
756 | for (my $i = 0; $i < @f; $i++) | |
757 | { $testout{$test} .= "$vars->[$i] $f[$i]\n"; } | |
758 | } | |
759 | $testout{$test} .= "\n"; | |
760 | } | |
761 | ||
762 | ## Done with this file. | |
763 | close $in; | |
764 | } | |
765 | ||
766 | ## Write the output. | |
767 | open my $out, ">", "$to.new"; | |
768 | print $out "### " . $filehead . | |
769 | "\t" x ((67 - length $filehead)/8) . | |
770 | "-*-conf-*-\n"; | |
771 | print $out "### Extracted from Catacomb.\n"; | |
772 | OUT: for (my $i = 0; $i < @$varmap; $i += 2) { | |
773 | next OUT unless defined $varmap->[$i + 1]; | |
774 | my $test = $varmap->[$i]; | |
775 | exists $testout{$test} or die "missing test `$test'"; | |
776 | (my $chunk = $testout{$test}) =~ s/\n\n$/\n/; | |
777 | print $out "\n"; | |
778 | print $out "###" . "-" x 74 . "\n"; | |
779 | print $out "test " . $test . "\n\n"; | |
780 | print $out $chunk; | |
781 | } | |
782 | close $out; rename "$to.new", "$to"; | |
783 | } | |
784 | ||
785 | ###-------------------------------------------------------------------------- | |
786 | ### Main program. | |
787 | ||
788 | my @WANT_C = | |
789 | ("math/qfarith.h", | |
790 | "math/f25519.c", "math/f25519.h", | |
791 | "math/fgoldi.c", "math/fgoldi.h", | |
792 | "math/montladder.h", | |
793 | "math/scaf.c", "math/scaf.h", | |
794 | "math/scmul.h", | |
795 | "pub/x25519.c", "pub/x25519.h", | |
796 | "pub/ed25519.c", "pub/ed25519.h", | |
797 | "pub/x448.c", "pub/x448.h", | |
798 | "pub/ed448.c", "pub/ed448.h", | |
799 | "symm/keccak1600.c", "symm/keccak1600.h", | |
800 | "symm/sha3.c", "symm/sha3.h" | |
801 | ); | |
802 | ||
803 | sub hack_pickn ($$@) { | |
804 | my ($out, @f) = @_; | |
805 | ||
806 | die "want three fields" unless @f == 3; | |
807 | my @v = split ' ', $f[0]; | |
808 | for (my $i = 0; $i < @v; $i++) { $$out .= "v\[$i] $v[$i]\n"; } | |
809 | $$out .= "i $f[1]\n"; | |
810 | $$out .= "z $f[2]\n"; | |
811 | } | |
812 | ||
813 | my @fieldish_test = | |
814 | ("add" => ["x", "y", "z"], | |
815 | "sub" => ["x", "y", "z"], | |
816 | "neg" => ["x", "z"], | |
817 | "condneg" => ["x", "m", "z"], | |
818 | "pick2" => ["x", "y", "m", "z"], | |
819 | "pickn" => \&hack_pickn, | |
820 | "condswap" => ["x", "y", "m", "xx", "yy"], | |
821 | "mulconst" => ["x", "a", "z"], | |
822 | "mul" => ["x", "y", "z"], | |
823 | "sqr" => ["x", "z"], | |
824 | "inv" => ["x", "z"], | |
825 | "quosqrt" => ["x", "y", "z0", "z1"], | |
826 | "sub-mulc-add-sub-mul" => ["u", "v", "a", "w", "x", "y", "z"]); | |
827 | ||
828 | my @WANT_TEST = | |
829 | (["math/t/f25519"] => \@fieldish_test, | |
830 | ["math/t/fgoldi"] => \@fieldish_test, | |
831 | ["pub/t/x25519"] => ["x25519" => ["x", "Y", "Z"], | |
832 | "x25519-mct" => ["x", "Y", "n", "Z"]], | |
833 | ["pub/t/x25519.slow"] => ["x25519-mct" => ["x", "Y", "n", "Z"]], | |
834 | ["=Test vectors for Ed25519.", "!ed25519", | |
835 | "ed25519djb:pub/t/ed25519.djb", | |
836 | "pub/t/ed25519.local"] | |
837 | => ["pubkey" => ["a", "A"], | |
838 | "sign" => ["a", "m", "sig"], | |
839 | "verify" => ["A", "m", "sig", "rc"], | |
840 | "sign-ctx" => ["a", "ph", "ctx", "m", "sig"], | |
841 | "verify-ctx" => ["A", "ph", "ctx", "m", "sig", "rc"]], | |
842 | ["pub/t/x448"] => ["x448" => ["x", "Y", "Z"], | |
843 | "x448-mct" => ["x", "Y", "n", "Z"]], | |
844 | ["pub/t/x448.slow"] => ["x448-mct" => ["x", "Y", "n", "Z"]], | |
845 | ["pub/t/ed448"] => ["pubkey" => ["a", "A"], | |
846 | "sign" => ["a", "ph", "ctx", "m", "sig"], | |
847 | "verify" => ["A", "ph", "ctx", "m", "sig", "rc"]], | |
848 | ["symm/t/keccak1600"] => ["p" => ["x", "n", "z"]], | |
849 | ["!sha3", | |
850 | "sha3:symm/t/SHA3_224ShortMsg.rsp", | |
851 | "sha3:symm/t/SHA3_224LongMsg.rsp", | |
852 | "sha3:symm/t/SHA3_224Monte.rsp", | |
853 | "sha3:symm/t/SHA3_256ShortMsg.rsp", | |
854 | "sha3:symm/t/SHA3_256LongMsg.rsp", | |
855 | "sha3:symm/t/SHA3_256Monte.rsp", | |
856 | "sha3:symm/t/SHA3_384ShortMsg.rsp", | |
857 | "sha3:symm/t/SHA3_384LongMsg.rsp", | |
858 | "sha3:symm/t/SHA3_384Monte.rsp", | |
859 | "sha3:symm/t/SHA3_512ShortMsg.rsp", | |
860 | "sha3:symm/t/SHA3_512LongMsg.rsp", | |
861 | "sha3:symm/t/SHA3_512Monte.rsp", | |
862 | "sha3:symm/t/SHAKE128ShortMsg.rsp", | |
863 | "sha3:symm/t/SHAKE128LongMsg.rsp", | |
864 | "sha3:symm/t/SHAKE128VariableOut.rsp", | |
865 | "sha3:symm/t/SHAKE256ShortMsg.rsp", | |
866 | "sha3:symm/t/SHAKE256LongMsg.rsp", | |
867 | "sha3:symm/t/SHAKE256VariableOut.rsp", | |
868 | "symm/t/sha3.local"] | |
869 | => ["sha3-224-hex" => ["m", "h"], | |
870 | "sha3-224-mct" => ["n", "m", "h"], | |
871 | "sha3-256-hex" => ["m", "h"], | |
872 | "sha3-256-mct" => ["n", "m", "h"], | |
873 | "sha3-384-hex" => ["m", "h"], | |
874 | "sha3-384-mct" => ["n", "m", "h"], | |
875 | "sha3-512-hex" => ["m", "h"], | |
876 | "sha3-512-mct" => ["n", "m", "h"], | |
877 | "shake128" => ["m", "h"], | |
878 | "shake256" => ["m", "h"], | |
879 | "cshake128" => ["func", "perso", "m", "h"], | |
880 | "cshake256" => ["func", "perso", "m", "h"], | |
881 | "kmac128" => undef, | |
882 | "kmac256" => undef]); | |
883 | ||
884 | chomp ($DONOR_VERSION = capturex @with_dir, $DONOR_DIR, | |
885 | "git", "describe", "--abbrev=4", "--dirty=+"); | |
886 | chomp ($DONOR_REVISION = capturex @with_dir, $DONOR_DIR, | |
887 | "git", "rev-parse", "HEAD"); | |
888 | ||
889 | for my $f (@WANT_C) { | |
890 | (my $base = $f) =~ s{^.*/}{}; | |
891 | note_path $f, $base; | |
892 | convert_c "$DONOR_DIR/$f", $base; | |
893 | } | |
894 | ||
895 | for (my $i = 0; $i < @WANT_TEST; $i += 2) { | |
896 | my $src = $WANT_TEST[$i]; my $varmap = $WANT_TEST[$i + 1]; | |
897 | my $base = undef; | |
898 | my $fixed_name = 0; | |
899 | my @in = (); | |
900 | for my $j (@$src) { | |
901 | if ($j =~ s/^!//) { | |
902 | defined $base and die "too late to fix the name"; | |
903 | $base = $j; $fixed_name = 1; next; | |
904 | } elsif ($j =~ /^=/) { push @in, $j; next; } | |
905 | my $pre = ""; | |
906 | if ($j =~ /^([^:]*)\:(.*)$/) { $pre = $1 . ":"; $j = $2; } | |
907 | if (!$fixed_name) { | |
908 | (my $b = $j) =~ s{^ (?: .* /)? (.*) $}{$1}x; | |
909 | defined $base and $base ne $b and die "huh? `$b' /= `$base'"; | |
910 | $base = $b; | |
911 | } | |
912 | note_path $j, "$base-tests.in"; | |
913 | push @in, $pre . "$DONOR_DIR/$j"; | |
914 | } | |
915 | convert_test \@in, "$base-tests.in", $varmap; | |
916 | } | |
917 | ||
918 | commit_changes(); |