chiark - git - mdw - secnet/blob - import-catacomb-crypto

   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();