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