~mdw / secnet / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
ec-field-test.c: Make the field-element type use internal format.
[secnet] / import-catacomb-crypto
CommitLineData
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
22use autodie;
23
24use IPC::System::Simple qw{runx capturex $EXITVAL};
25
26use Data::Dumper;
27
28my $DONOR_VERSION = "UNKNOWN";
29my $DONOR_REVISION = "UNKNOWN";
30my $DONOR_DIR = "../catacomb";
31
32(my $PROG = $0) =~ s{^.*/}{};
33
34my @with_dir = ("sh", "-c", 'dir=$1; shift; cd "$dir" && exec "$@"', ".");
35
36sub moan ($) { print STDERR "$PROG: $_[0]\n"; }
37
38###--------------------------------------------------------------------------
39### Building commit messages.
40
41my %DONOR_PATH_MAP = ();
42my %DONOR_REV_MAP = ();
43my $RECIP_CACHE = ();
44
45sub 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
86sub 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
186sub 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
264typedef int32_t int32;
265typedef int64_t int64;
266#define HAVE_INT64 1
267EOF
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.
450EOF
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
467sub 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";
613a $k
614A $K
615EOF
616
617 ## Test signing.
618 $testout{"sign"} .= <<EOF . "\n";
619a $k
620m $m
621sig $s
622EOF
623
624 ## Test successful verification.
625 $testout{"verify"} .= <<EOF . "\n";
626A $K
627m $m
628sig $s
629rc 0
630EOF
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";
636A $Kneg
637m $m
638sig $s
639rc -1
640EOF
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";
646A $Kzap
647m $m
648sig $s
649rc -1
650EOF
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";
657A $K
658m $mzap
659sig $s
660rc -1
661EOF
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";
667A $K
668m $m
669sig $szap
670rc -1
671EOF
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;
689m $sha3_msg
690h $hash
691
692EOF
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;
700n 1000
701m $sha3_prev
702h $hash
703
704EOF
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
788my @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
803sub 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
813my @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
828my @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
884chomp ($DONOR_VERSION = capturex @with_dir, $DONOR_DIR,
885 "git", "describe", "--abbrev=4", "--dirty=+");
886chomp ($DONOR_REVISION = capturex @with_dir, $DONOR_DIR,
887 "git", "rev-parse", "HEAD");
888
889for my $f (@WANT_C) {
890 (my $base = $f) =~ s{^.*/}{};
891 note_path $f, $base;
892 convert_c "$DONOR_DIR/$f", $base;
893}
894
895for (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
918commit_changes();
Secnet virtual private network: clone of http://www.chiark.greenend.org.uk/ucgi/~ian/git/secnet.git/