#! /usr/bin/perl -w
###
### Import/update crypto implementations from Catacomb.

### This file is part of secnet.
### See README for full list of copyright holders.
###
### secnet is free software; you can redistribute it and/or modify it
### under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version d of the License, or
### (at your option) any later version.
###
### secnet is distributed in the hope that it will be useful, but
### WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
### General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### version 3 along with secnet; if not, see
### https://www.gnu.org/licenses/gpl.html.

use autodie;

use IPC::System::Simple qw{runx capturex $EXITVAL};

use Data::Dumper;

my $DONOR_VERSION = "UNKNOWN";
my $DONOR_REVISION = "UNKNOWN";
my $DONOR_DIR = "../catacomb";

(my $PROG = $0) =~ s{^.*/}{};

my @with_dir = ("sh", "-c", 'dir=$1; shift; cd "$dir" && exec "$@"', ".");

sub moan ($) { print STDERR "$PROG: $_[0]\n"; }

###--------------------------------------------------------------------------
### Building commit messages.

my %DONOR_PATH_MAP = ();
my %DONOR_REV_MAP = ();
my $RECIP_CACHE = ();

sub note_path ($$) {
  my ($donor, $recip) = @_;

  my $recip_rev = capturex "git", "rev-list", "--max-count=1",
    "HEAD", "--", $recip; chomp $recip_rev;

  my $donor_rev;
  if ($recip_rev eq "")
    { $donor_rev = undef; }
  elsif (exists $RECIP_CACHE{$recip_rev})
    { $donor_rev = $RECIP_CACHE{$recip_rev}; }
  else {
    chomp (my @msg = capturex "git", "cat-file", "commit", $recip_rev);

    my $trail = "";
    LINE: for (;;) {
      last LINE unless @msg;
      my $line = pop @msg;
      next LINE if $trail eq "" && $line =~ /^\s*$/;
      $trail = $line . $trail;
      next LINE if $trail =~ /^\s/;
      last LINE
	unless $trail =~ /^ ([^:\s]+) \s* : \s* (| \S | \S .* \S) \s* $/x;
      my $k = $1; my $v = $2;
      if ($k eq "Upstream-Revision") {
	if ($v !~ /^ [A-Fa-f0-9]+ $/x) {
	  moan "ignoring bad `Upstream-Revision' `$v' in commit $recip_rev";
	  next LINE;
	}
	$donor_rev = $v;
	last LINE;
      }
    }
    defined $donor_rev or
      moan "failed to find upstream version in commit $recip_rev";
    $RECIP_CACHE{$recip_rev} = $donor_rev;
  }
  $DONOR_PATH_MAP{$donor} = $recip;
  $DONOR_REV_MAP{$donor} = $donor_rev;
}

sub commit_changes () {
  my $msg = "";
  my $any_changes = 0;

  ## Stage updated files for commit.
  my %recip_map;
  for my $path (keys %DONOR_PATH_MAP)
    { push @{$recip_map{$DONOR_PATH_MAP{$path}}}, $path; }
  runx "git", "update-index", "--add", "--", keys %recip_map;

  ## Inspect the changed files.  Notice whether we've actually changed or
  ## added files.
  chomp (my @diff = capturex "git", "diff-index", "--cached", "HEAD");
  my %changed = ();
  my %new = ();
  for my $line (@diff) {
    $line =~ /^ :
		[0-7]+ \ [0-7]+ \ #
		([A-Fa-f0-9]+) \ ([A-Fa-f0-9]+) \ #
		([ACDMRTUX])\d* \t
		([^\t]+) (?: \t ([^\t]+))? $/x
      or die "incomprehensible git-diff line `$line'";
    my $path = ($3 eq "C" or $3 eq "R") ? $5 : $4;
    $changed{$path} = 1; $new{$path} = ($1 !~ /[^0]/);
  }

  ## Files which haven't changed aren't interesting any more.
  for my $path (keys %DONOR_PATH_MAP) {
    my $recip = $DONOR_PATH_MAP{$path};
    if (!$changed{$recip}) {
      delete $recip_map{$recip};
      delete $DONOR_REV_MAP{$path};
    }
  }
  if (!%recip_map) { moan "no changes to import"; return ""; }

  ## Build the commit preamble.
  $msg .= "Update crypto code from Catacomb $DONOR_VERSION.\n\n";
  $msg .= "This change committed automatically by `$PROG'.\n\n";

  ## Construct the summary of changes.
  my @recip = sort keys %recip_map;
  for my $recip (@recip) {
    my $disp = $new{$recip} ? "new" : "updated";
    my $line = "  * Import $disp `$recip' from upstream";
    my @p = sort @{$recip_map{$recip}};
    for (my $i = 0; $i < @p; $i++) {
      my $p = $p[$i];
      if (!$i) { }
      else {
	@p == 2 or $line .= ",";
	if ($i == @p - 1) {
	  if (length($line) + 4 > 72)
	    { $msg .= $line . "\n"; $line = "   "; }
	  $line .= " and";
	}
      }
      if (length($line) + length($p) + 3 > 72)
	{ $msg .= $line . "\n"; $line = "   "; }
      $line .= " `$p'"
    }
    $msg .= $line . ".\n";
  }

  ## Now the detailed list of upstream commits.
  $msg .= "\nDetailed list of changes:\n";
  my @paths; my @roots;
  for my $path (keys %DONOR_REV_MAP) {
    my $rev = $DONOR_REV_MAP{$path};
    if (defined $rev) { push @paths, $path; push @roots, $rev; }
  }
  chomp (my @revs = capturex @with_dir, $DONOR_DIR,
	  "git", "rev-list", "--reverse",
	  "HEAD", "--not", @roots, "--", @paths);

  for my $rev (@revs) {
    my @affected = ();
    for my $path (@paths) {
      runx [0, 1], @with_dir, $DONOR_DIR,
	"git", "merge-base", "--is-ancestor",
	$DONOR_REV_MAP{$path}, $rev;
      push @affected, $path if !$EXITVAL;
    }
    $msg .= "\n" . join "",
      grep { s/\s+$/\n/ }
      map { "    " . $_ }
      capturex @with_dir, $DONOR_DIR,
      "git", "show", "--stat", $rev, "--", @affected;
  }

  ## The trailer, so that we can see where we left off.
  $msg .= "\nUpstream-Revision: $DONOR_REVISION\n";

  ## Commit everything.
  runx "git", "commit", "--edit", "--message", $msg, @recip;
}

###--------------------------------------------------------------------------
### Converting C sources and headers.

sub convert_c ($$) {
  my ($from, $to) = @_;
  ## Convert a C source or header file.  FROM is the source file name; TO is
  ## the destination file name.  Also clobbers `TO.new'.

  (my $file = $from) =~ s{^ .* / ([^/]+ / [^/]+) $}{$1}x;

  open my $in, "<", $from;
  open my $out, ">", "$to.new";

  ## Control state.
  my $pending_blank = 0;		# waiting to output a blank line?
  my $skip_reason = "";			# why should we skip output?
  my $trim_spaces = -1;		       # number of leading spaces to trim - 1

  my $if_open = 0;			# current `#if' emitted to output?
  my $if_skippable = 0;			# current `#if' not propagated?
  my $if_skipping = 0;			# current `#if' body being skipped?
  my $if_unindent = 0;			# indent level removed by this `#if'
  my @if_stack = ();			# stack of previous `$if_...' vars
  my $if_level = 0;			# current `#if' nesting level

  my @lookahead = ();			# stack of lines to be read again

  LINE: for (;;) {
    my $line;
    if (@lookahead) { $line = pop @lookahead; }
    else { $line = <$in>; defined $line or last LINE; chomp $line; }

    ## Track blank lines so that we don't leave huge gaps.  Also, if this is
    ## a blank line and we were skipping a paragraph, then we've reached the
    ## end.
    if ($line =~ /^\s*$/) {
      if ($skip_reason eq "para") { $skip_reason = ""; }
      $pending_blank = 1; next LINE;
    }

    ## If we're skipping a defun, and this is the end of it, then stop
    ## skipping.  (But swallow the line.)
    if ($skip_reason eq "defun" && $line =~ /^\}/)
      { $skip_reason = ""; next LINE; }

    ## If this is a stanza heading, inspect the stanza.
    if ($line =~ m{^/\* --- (.*) --- \*/?$}) {
      my $stanza = $1;

      ## If we're skipping a stanza, then stop skipping.
      if ($skip_reason eq "stanza") { $skip_reason = ""; }

      ## On the other hand, there are stanze we don't want.
      if ($stanza eq '@sha3_{224,256,384,512}_set@' ||
	  $stanza eq '@sha3_state@' ||
	  $stanza eq '@shake_mask@' ||
	  $stanza eq '@shake{128,256}_rand@' ||
	  $stanza eq '@cshake{128,256}_rand@' ||
	  $stanza eq "Generic hash interface" ||
	  $stanza eq "Hash interface" ||
	  $stanza eq "Generic cipher interface" ||
	  $stanza eq "Cipher interface" ||
	  $stanza eq "Random generator interface")
	{ $skip_reason = "stanza"; }
    }

    ## If this is a section heading, inspect the heading.
    if ($line =~ m{^/\*-{5} (.*) -{5,}\*/?$}) {
      my $sect = $1;

      ## If we're skipping a section or a stanza, then stop skipping.
      if ($skip_reason eq "section" || $skip_reason eq "stanza")
	{
	  $skip_reason = ""; }

      ## On the other hand, there are sections we don't want.
      if ($sect eq "Signed integer types") {
	$skip_reason = "section";
	print $out <<EOF;
/*----- Signed integer types ----------------------------------------------*/

typedef int32_t int32;
typedef int64_t int64;
#define HAVE_INT64 1
EOF
	$pending_blank = 1;
      } elsif ($sect eq "Test rig" ||
	       $sect eq "Key fetching" ||
	       $sect eq "The KMAC variable-length PRF")
	{ $skip_reason = "section"; }
    }

    ## Handle `#if' and friends.  This is not especially principled.
    if ($line =~ /^ (\s* \# \s*)
		    (if|elif|ifdef|ifndef)
		    (\s+)
		    (\S|\S.*\S)
		    (\s*)
		 $/x) {
      my $hash = $1; my $kw = $2; my $s1 = $3; my $cond = $4;

      ## Categorize the conditional directive.
      my $test; my $sense;
      if ($kw eq "if" || $kw eq "elif") { $test = "if"; $sense = 1; }
      elsif ($kw eq "ifdef") { $test = "ifdef"; $sense = 1; }
      elsif ($kw eq "ifndef") { $test = "ifdef"; $sense = 0; }
      else { die "confused!"; }

      ## Now analyse the condition and decide what we should do about it.
      my $skip = undef; my $unindent = 0;

      if ($test eq "ifdef" && $cond eq "HAVE_UINT64")
	{ $skip = 0; $unindent = 2; }

      elsif ($test eq "if" &&
	  $cond eq "!defined(F25519_IMPL) && defined(HAVE_INT64)")
	{ $skip = 1; }
      elsif ($test eq "ifdef" && $cond eq "F25519_IMPL") { $skip = 0; }
      elsif ($test eq "if" && $cond eq "F25519_IMPL == 26") { $skip = 0; }
      elsif ($test eq "if" && $cond eq "F25519_IMPL == 10") { $skip = 1; }

      elsif ($test eq "if" &&
	     $cond eq "!defined(FGOLDI_IMPL) && defined(HAVE_INT64)")
	{ $skip = 1; }
      elsif ($test eq "if" && $cond eq "FGOLDI_IMPL == 28") { $skip = 0; }
      elsif ($test eq "if" && $cond eq "FGOLDI_IMPL == 12") { $skip = 1; }
      elsif ($test eq "ifdef" && $cond eq "FGOLDI_IMPL") { $skip = 0; }

      elsif ($test eq "ifdef" && $cond eq "SCAF_IMPL") { $skip = 0; }
      elsif ($test eq "if" && $cond eq "SCAF_IMPL == 32") { $skip = 0; }
      elsif ($test eq "if" && $cond eq "SCAF_IMPL == 16") { $skip = 1; }

      elsif ($test eq "if" && $cond =~ /^(.*) \|\| defined\(TEST_RIG\)/)
	{ $cond = $1; }

      elsif ($test eq "ifdef" && ($cond eq "CATACOMB_GCIPHER_H" ||
				  $cond eq "CATACOMB_GHASH_H" ||
				  $cond eq "CATACOMB_GMAC_H" ||
				  $cond eq "CATACOMB_GRAND_H" ||
				  $cond eq "CATACOMB_KEY_H"))
	{ $skip = 0; }

      elsif ($test eq "ifdef" && $cond eq "NEG_TWOC")
	{ $skip = 0; $unindent = 2 if $file eq "math/qfarith.h"; }

      ## Adjust the processor state to do something sensible.
      if (!$sense && defined $skip) { $skip = !$skip; }

      if ($kw eq "elif") {
	$trim_spaces -= $if_unindent;
	if ($if_skipping) { $skip_reason = ""; }
	if (!$if_open && !defined $skip) { $kw = "if"; $if_open = 1; }
	elsif ($if_open && defined $skip)
	  { $if_open = 0; print "${hash}endif\n" unless $skip_reason; }
      } else {
	$if_level++;
	push @if_stack,
	  [$if_open, $if_skippable, $if_skipping, $if_unindent];
	$if_open = !defined $skip;
      }
      $if_skippable = defined $skip; $if_skipping = $skip && !$skip_reason;
      if ($if_skipping && !$skip_reason)
	{ $skip_reason = "if.$if_level"; }
      $if_unindent = $unindent; $trim_spaces += $unindent;

      ## Maybe produce some output.
      if (defined $skip) { next LINE; }
      else { $line = $hash . $kw . $s1 . $cond; }
    } elsif ($line =~ /^ \s* \# \s* else \s* $/x) {
      if ($if_skippable) {
	if ($if_skipping) {
	  $if_skipping = 0;
	  $skip_reason = "" if $skip_reason eq "if.$if_level";
	} else {
	  $if_skipping = 1;
	  $skip_reason = "if.$if_level" if !$skip_reason;
	}
	next LINE;
      }
    } elsif ($line =~ /^ \s* \# \s* endif \s* $/x) {
      my $was_open = $if_open;
      if ($if_skipping)
	{ $skip_reason = "" if $skip_reason eq "if.$if_level"; }
      $trim_spaces -= $if_unindent;
      ($if_open, $if_skippable, $if_skipping, $if_unindent) =
	@{ pop @if_stack };
      $if_level--;
      if (!$was_open) { next LINE; }
    }

    ## If we're skipping something, then do that.
    if ($skip_reason) { next LINE; }

    ## Inspect header inclusions.
    if ($line =~ /^ (\s* \# \s* include \s+) (["<] [^">]* [">]) \s* $/x) {
      my $incl = $1; my $hdr = $2;
      if ($hdr eq '<mLib/bits.h>') { $hdr = '"fake-mLib-bits.h"'; }
      elsif ($hdr eq '"hash.h"' || $hdr eq '"ghash-def.h"') { next LINE; }
      elsif ($hdr eq '"ct.h"') { next LINE; }
      $line = $incl . $hdr;
    }

    ## We don't have Catacomb's `config.h'.
    if ($line =~ /^ \# \s* include \s+ "config\.h" \s* $/x)
      { next LINE; }

    ## Zap the 16-bit implementations.
    if ($line =~ /^  int16 (p10\[26\]|p12\[40\])\;$/)
      { next LINE; }

    ## Maybe trim leading indentation.
    if ($trim_spaces > 0) {
      $line =~ s/^ (\#?) \ ? \ {$trim_spaces}/$1/x
	or $trim_spaces = -1;
    }

    ## Other random lines we don't want.
    if ($line eq "extern const octet shake128_keysz[], shake256_keysz[];")
      { next LINE; }

    if ($line eq "const octet") {
      die "fixme: read from lookahead" if @lookahead;
      my $line1 = <$in>; chomp $line1;
      my $line2 = <$in>; chomp $line2;
      if ($line1 =~ /^  shake128_keysz\[] = .*,/ &&
	  $line2 =~ /^  shake256_keysz\[] = .*;/)
	{ next LINE; }
      else
	{ push @lookahead, $line2, $line1; }
    }

    if ($line eq "static void rightenc_sz(shake_ctx *ctx, size_t n)")
      { $skip_reason = "defun"; next LINE; }

    ## Other random tweaks.
    $line =~ s/ct_memeq/consttime_memeq/g;
    $line =~ s/\bSHA512_HASHSZ\b/SHA512_DIGEST_SIZE/g;
    $line =~ s/\bsha512_ctx\b/struct sha512_ctx/g;
    $line =~ s/\bsha512_init\b/sha512_init_ctx/g;
    $line =~ s{\b sha512_hash \( ([^,]+) (,\s*) ([^,]+) (,\s*) ([^)]+) \)}
	      {sha512_process_bytes($3$2$5$2$1)}gx;
    $line =~ s/\bsha512_done\b/sha512_finish_ctx/g;
    $line =~ s/\bdo\s*;\s*while\b/do {} while/g;

    ## Fix the provenance note.
    if ($line =~ /^ \* This file is part of Catacomb/) {
      print $out <<EOF;
 * This file is part of secnet.
 * See README for full list of copyright holders.
 *
 * secnet is free software; you can redistribute it and/or modify it
 * under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version d of the License, or
 * (at your option) any later version.
 *
 * secnet is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * version 3 along with secnet; if not, see
 * https://www.gnu.org/licenses/gpl.html.
 *
 * This file was originally part of Catacomb, but has been automatically
 * modified for incorporation into secnet: see `import-catacomb-crypto'
 * for details.
EOF
      next LINE;
    }

    ## Print the line.
    if ($pending_blank && $line !~ /^\s*\}\s*/) { print $out "\n"; }
    print $out "$line\n"; $pending_blank = 0;
  }

  ## Done.
  close $in;
  close $out; rename "$to.new", "$to";
}

###--------------------------------------------------------------------------
### Converting a test-vector file.

sub convert_test ($$$) {
  my ($from, $to, $varmap) = @_;
  ## Convert a test vector file .  FROM is a listref of source
  ## specifications; TO is the destination file name.  `TO.new' is also
  ## clobbered.  The VARMAP is a listref containing test specifications.
  ##
  ## A source specification is a string of one of the following forms.
  ##
  ##   * `=HEAD-COMMENT' -- set the first-line comment.  (Otherwise it's
  ##     taken from the first comment line of the first input file.)
  ##
  ##   * `[FORMAT:]PATH -- read test data from the PATH, and parse it
  ##     according to FORMAT.
  ##
  ## FORMATs supported are `std' (Catacomb's native format), `ed25519djb'
  ## (Bernstein's Ed25519 test vector file, and `sha3' (NIST's CAVP format
  ## for SHA3 test vectors).
  ##
  ## A test specification is a /pair/ of items (the list as a whole is
  ## suitable for conversion into a Perl hash): each key names a kind of
  ## test; and each value is either a listref of register names or a coderef
  ## for a formatting function, called as FMT(OUTREF, FIELDS), where OUTREF
  ## is a scalar-ref of the output to build, and FIELDS is the list of
  ## test-vector fields.
  ##
  ## Yes, this is quite hairy.

  ## Convert the VARMAP into an actual hash.  (We want the list version
  ## because it has the correct output order.)
  my %varmap = @$varmap;

  ## Global control state.
  my $filehead = "";			# first-line comment
  my %testout = ();			# map tests to output buffers

  ## Work through each input spec.
  INPUT: for my $input (@$from) {

    ## Handle a headline comment.
    if ($input =~ /^=(.*)$/) {
      $filehead and die "two heads are not better than one";
      $filehead = $1; next INPUT;
    }

    ## Split the format specifier from the pathname.
    my $fmt = "std";
    if ($input =~ /^([^:]*):(.*)$/) { $fmt = $1; $input = $2; }

    ## Get the input basename.
    (my $base = $input) =~ s{^.*/}{};

    ## Open the input file.
    open my $in, "<", $input;

    ## Per-input control state.
    my $head = "";			# per-file comment to insert
    my $test = undef;			# current test category
    my $vars = undef;			# output specifier for current test
    my $sha3_kind;			# SHA3 test kind: `kat' or `mct'
    my $sha3_len = 8; my $sha3_msg;	# SHA3 test state
    my $sha3_prev;			# ...
    my @lookahead = ();			# stack of lines to be read again

    ## Per-format setup.
    if ($fmt eq "ed25519djb") {
      ## Just record that this from djb's reference.

      for my $t (qw{pubkey sign verify}) {
	$testout{$t} .=
	  "## Test vectors from Dan Bernstein's reference implementation.\n\n";
      }
    } elsif ($fmt eq "sha3") {
      ## Set up to parse the NIST CAVP test files.

      my $tail;
      my $alg; my $sep; my $bits; my $hex;

      ## Pick apart the file name.
      if ($base =~ /^SHA3_(.*)$/)
	{ $tail = $1; $alg = "sha3"; $sep = "-"; $hex = "-hex"; }
      elsif ($base =~ /^SHAKE(.*)$/)
	{ $tail = $1; $alg = "shake"; $sep = ""; $hex = ""; }
      else
	{ die "strange `$base'"; }

      if ($tail =~ /^(.*)LongMsg\.rsp/)
	{ $sha3_kind = "kat"; $bits = $1; }
      elsif ($tail =~ /^(.*)ShortMsg\.rsp/)
	{ $sha3_kind = "kat"; $bits = $1; }
      elsif ($tail =~ /^(.*)VariableOut\.rsp/)
	{ $sha3_kind = "kat"; $bits = $1; }
      elsif ($tail =~ /^(.*)Monte\.rsp/)
	{ $sha3_kind = "mct"; $bits = $1; }

      ## Determine the test name.
      if ($sha3_kind eq "kat") { $test = $alg . $sep . $bits . $hex; }
      elsif ($sha3_kind eq "mct") { $test = $alg . $sep . $bits . "-mct"; }

      ## Set the per-test banner.
      $testout{$test} .= "## Converted from NIST test vectors\n";
    }

    ## Work through the input file.
    LINE: for (;;) {
      my $line;
      if (@lookahead) { $line = pop @lookahead; }
      else { $line = <$in>; defined $line or last LINE; chomp $line; }

      ## Ignore empty lines.
      if ($line =~ /^\s*$/) { next LINE; }

      ## Copy comments to the output.  An initial comment becomes the
      ## headline.  Top-level comments get written to /every/ test chunk
      ## extracted from this input file.  Comments within test chunks get
      ## added to the output chunk.
      if ($line =~ /^ \s* (?:\#+) \s* (| [^#\s] (?: .* \S)?) \s* $/x) {
	if (!$filehead) { $filehead = $1; next LINE; }
	my $buf = "## $1\n" if $1;
	COMMENT: for (;;) {
	  die "fixme: read from lookahead" if @lookahead;
	  $line = <$in>; defined $line or last COMMENT; chomp $line;
	  last COMMENT
	    unless $line =~ /^ \s* (?:\#+) \s* (| [^#\s] (?: .* \S)?) $/x;
	  $buf .= "## $1\n";
	}
	push @lookahead, $line if defined $line;
	if (defined $test) { $testout{$test} .= $buf; }
	else { $head = $buf . "\n"; }
	next LINE;
      }

      ## Handle strange formats.
      if ($fmt eq "ed25519djb") {
	## Bernstein's format is strangely redundant.  Pick out the
	## interesting parts.

	$line =~ s/^ ([^:]{64}) ([^:]{64}) :
		     \2 :
		     ([^:]*) :
		     ([^:]{128}) \3 :
		   $/$1:$2:$3:$4/x
	  or die "bogus djb line";
	my ($k, $K, $m, $s) = ($1, $2, $3, $4);

	## Test public-key generation.
	$testout{"pubkey"} .= <<EOF . "\n";
a $k
A $K
EOF

	## Test signing.
	$testout{"sign"} .= <<EOF . "\n";
a $k
m $m
sig $s
EOF

	## Test successful verification.
	$testout{"verify"} .= <<EOF . "\n";
A $K
m $m
sig $s
rc 0
EOF

	## Test failed verification with negated key.
	(my $Kneg = $K) =~ s{([0-9a-f]{2})$}
	  { sprintf "%02x", hex($1) ^ 0x80 }e;
	$testout{"verify"} .= <<EOF . "\n";
A $Kneg
m $m
sig $s
rc -1
EOF

	## Test failed verification with clobbered key.
	(my $Kzap = $K) =~ s{^([0-9a-f]{2})}
	  { sprintf "%02x", hex($1) ^ 0xff }e;
	$testout{"verify"} .= <<EOF . "\n";
A $Kzap
m $m
sig $s
rc -1
EOF

	## Test failed verification with clobbered message.
	(my $mzap = $m) =~ s{^([0-9a-f]{2})}
	  { sprintf "%02x", hex($1) ^ 0xff }e;
	$mzap = "00" unless $m;
	$testout{"verify"} .= <<EOF . "\n";
A $K
m $mzap
sig $s
rc -1
EOF

	## Test failed verification with clobbered signature.
	(my $szap = $s) =~ s{^([0-9a-f]{2})}
	  { sprintf "%02x", hex($1) ^ 0xff }e;
	$testout{"verify"} .= <<EOF . "\n";
A $K
m $m
sig $szap
rc -1
EOF
	next LINE;
      } elsif ($fmt eq "sha3") {
	## Parse the wretched NIST file.  Alas, there's all sorts of cruft
	## that isn't actually very interesting, so the parsing is rather
	## slack.

	if ($sha3_kind eq "kat") {
	  ## Known-answer tests.

	  if ($line =~ /^ Len \s* = \s* ([0-9]+) \s* $/x)
	    { $sha3_len = $1; }
	  elsif ($line =~ /^ Msg \s* = \s* ([A-Fa-f0-9]+) \s* $/x)
	    { $sha3_msg = $sha3_len == 0 ? "" : lc $1; }
	  elsif ($line =~ /^ (?: MD | Output) \s* = \s*
			     ([A-Fa-f0-9]+) \s* $/x) {
	    my $hash = lc $1;
	    $sha3_len%8 == 0 and $testout{$test} .= <<EOF;
m $sha3_msg
h $hash

EOF
	  }
	} elsif ($sha3_kind eq "mct") {
	  ## Monte-Carlo tests.

	  if ($line =~ /^ MD \s* = \s* ([A-Fa-f0-9]+) \s* $/x) {
	    my $hash = lc $1;
	    defined $sha3_prev and $testout{$test} .= <<EOF;
n 1000
m $sha3_prev
h $hash

EOF
	    $sha3_prev = $hash;
	  }
	}
	next LINE;
      } elsif ($fmt ne "std") { die "fmt `$fmt'?"; }

      ## Deal with the top-level structure.
      if (!defined $test) {
	if ($line =~ /^ \s* ([A-Za-z0-9-]+) \s* \{ \s* $/x) {
	  $test = $1;
	  die "unknown test `$test'" unless exists $varmap{$test};
	  $vars = $varmap{$test};
	  $testout{$test} .= $head;
	} else {
	  die "junk found; expected test head in `$input'"
	}
	next LINE;
      }

      ## Check for the end of a test chunk.
      if ($line =~ /^ \s* \} \s* $/x) {
	$test = undef; $vars = undef;
	next LINE;
      }

      ## So, read a test vector.  (This is not correct, but good enough.)
      my $vector = "$line";
      VECTOR: for (;;) {
	last VECTOR if $vector =~ s/\;$//;
	die "fixme: read from lookahead" if @lookahead;
	$line = <$in>; defined $line or die "eof in test chunk"; chomp $line;
	$vector .= " $line";
      }

      ## Split it into fields.  We have to handle quoting, but not very well.
      my @f = ();
      FIELD: while ($vector) {
	if ($vector =~ /^ \s* $/) { last FIELD; }
	if ($vector =~ /^ \s* " ([^"]*) " (\s+ .*|) $/x)
	  { push @f, $1; $vector = $2; }
	elsif ($vector =~ /^ \s* (\S+) (\s+ .*|) $/x)
	  { push @f, $1; $vector = $2; }
	else
	  { die "what even?"; }
      }

      ## Add the necessary output to the test chunk.
      if (!defined $vars) { next LINE; }
      elsif (ref($vars) eq 'CODE') { $vars->(\$testout{$test}, @f); }
      else {
	die "wrong number of fields reading `$input'" unless @f == @$vars;
	for (my $i = 0; $i < @f; $i++)
	  { $testout{$test} .= "$vars->[$i] $f[$i]\n"; }
      }
      $testout{$test} .= "\n";
    }

    ## Done with this file.
    close $in;
  }

  ## Write the output.
  open my $out, ">", "$to.new";
  print $out "### " . $filehead .
    "\t" x ((67 - length $filehead)/8) .
    "-*-conf-*-\n";
  print $out "### Extracted from Catacomb.\n";
  OUT: for (my $i = 0; $i < @$varmap; $i += 2) {
    next OUT unless defined $varmap->[$i + 1];
    my $test = $varmap->[$i];
    exists $testout{$test} or die "missing test `$test'";
    (my $chunk = $testout{$test}) =~ s/\n\n$/\n/;
    print $out "\n";
    print $out "###" . "-" x 74 . "\n";
    print $out "test " . $test . "\n\n";
    print $out $chunk;
  }
  close $out; rename "$to.new", "$to";
}

###--------------------------------------------------------------------------
### Main program.

my @WANT_C =
  ("math/qfarith.h",
   "math/f25519.c", "math/f25519.h",
   "math/fgoldi.c", "math/fgoldi.h",
   "math/montladder.h",
   "math/scaf.c", "math/scaf.h",
   "math/scmul.h",
   "pub/x25519.c", "pub/x25519.h",
   "pub/ed25519.c", "pub/ed25519.h",
   "pub/x448.c", "pub/x448.h",
   "pub/ed448.c", "pub/ed448.h",
   "symm/keccak1600.c", "symm/keccak1600.h",
   "symm/sha3.c", "symm/sha3.h"
);

sub hack_pickn ($$@) {
  my ($out, @f) = @_;

  die "want three fields" unless @f == 3;
  my @v = split ' ', $f[0];
  for (my $i = 0; $i < @v; $i++) { $$out .= "v\[$i] $v[$i]\n"; }
  $$out .= "i $f[1]\n";
  $$out .= "z $f[2]\n";
}

my @fieldish_test =
  ("add" => ["x", "y", "z"],
   "sub" => ["x", "y", "z"],
   "neg" => ["x", "z"],
   "condneg" => ["x", "m", "z"],
   "pick2" => ["x", "y", "m", "z"],
   "pickn" => \&hack_pickn,
   "condswap" => ["x", "y", "m", "xx", "yy"],
   "mulconst" => ["x", "a", "z"],
   "mul" => ["x", "y", "z"],
   "sqr" => ["x", "z"],
   "inv" => ["x", "z"],
   "quosqrt" => ["x", "y", "z0", "z1"],
   "sub-mulc-add-sub-mul" => ["u", "v", "a", "w", "x", "y", "z"]);

my @WANT_TEST =
  (["math/t/f25519"] => \@fieldish_test,
   ["math/t/fgoldi"] => \@fieldish_test,
   ["pub/t/x25519"] => ["x25519" => ["x", "Y", "Z"],
			"x25519-mct" => ["x", "Y", "n", "Z"]],
   ["pub/t/x25519.slow"] => ["x25519-mct" => ["x", "Y", "n", "Z"]],
   ["=Test vectors for Ed25519.", "!ed25519",
    "ed25519djb:pub/t/ed25519.djb",
    "pub/t/ed25519.local"]
   => ["pubkey" => ["a", "A"],
       "sign" => ["a", "m", "sig"],
       "verify" => ["A", "m", "sig", "rc"],
       "sign-ctx" => ["a", "ph", "ctx", "m", "sig"],
       "verify-ctx" => ["A", "ph", "ctx", "m", "sig", "rc"]],
   ["pub/t/x448"] => ["x448" => ["x", "Y", "Z"],
		      "x448-mct" => ["x", "Y", "n", "Z"]],
   ["pub/t/x448.slow"] => ["x448-mct" => ["x", "Y", "n", "Z"]],
   ["pub/t/ed448"] => ["pubkey" => ["a", "A"],
		       "sign" => ["a", "ph", "ctx", "m", "sig"],
		       "verify" => ["A", "ph", "ctx", "m", "sig", "rc"]],
   ["symm/t/keccak1600"] => ["p" => ["x", "n", "z"]],
   ["!sha3",
    "sha3:symm/t/SHA3_224ShortMsg.rsp",
    "sha3:symm/t/SHA3_224LongMsg.rsp",
    "sha3:symm/t/SHA3_224Monte.rsp",
    "sha3:symm/t/SHA3_256ShortMsg.rsp",
    "sha3:symm/t/SHA3_256LongMsg.rsp",
    "sha3:symm/t/SHA3_256Monte.rsp",
    "sha3:symm/t/SHA3_384ShortMsg.rsp",
    "sha3:symm/t/SHA3_384LongMsg.rsp",
    "sha3:symm/t/SHA3_384Monte.rsp",
    "sha3:symm/t/SHA3_512ShortMsg.rsp",
    "sha3:symm/t/SHA3_512LongMsg.rsp",
    "sha3:symm/t/SHA3_512Monte.rsp",
    "sha3:symm/t/SHAKE128ShortMsg.rsp",
    "sha3:symm/t/SHAKE128LongMsg.rsp",
    "sha3:symm/t/SHAKE128VariableOut.rsp",
    "sha3:symm/t/SHAKE256ShortMsg.rsp",
    "sha3:symm/t/SHAKE256LongMsg.rsp",
    "sha3:symm/t/SHAKE256VariableOut.rsp",
    "symm/t/sha3.local"]
   => ["sha3-224-hex" => ["m", "h"],
       "sha3-224-mct" => ["n", "m", "h"],
       "sha3-256-hex" => ["m", "h"],
       "sha3-256-mct" => ["n", "m", "h"],
       "sha3-384-hex" => ["m", "h"],
       "sha3-384-mct" => ["n", "m", "h"],
       "sha3-512-hex" => ["m", "h"],
       "sha3-512-mct" => ["n", "m", "h"],
       "shake128" => ["m", "h"],
       "shake256" => ["m", "h"],
       "cshake128" => ["func", "perso", "m", "h"],
       "cshake256" => ["func", "perso", "m", "h"],
       "kmac128" => undef,
       "kmac256" => undef]);

chomp ($DONOR_VERSION = capturex @with_dir, $DONOR_DIR,
	"git", "describe", "--abbrev=4", "--dirty=+");
chomp ($DONOR_REVISION = capturex @with_dir, $DONOR_DIR,
	"git", "rev-parse", "HEAD");

for my $f (@WANT_C) {
  (my $base = $f) =~ s{^.*/}{};
  note_path $f, $base;
  convert_c "$DONOR_DIR/$f", $base;
}

for (my $i = 0; $i < @WANT_TEST; $i += 2) {
  my $src = $WANT_TEST[$i]; my $varmap = $WANT_TEST[$i + 1];
  my $base = undef;
  my $fixed_name = 0;
  my @in = ();
  for my $j (@$src) {
    if ($j =~ s/^!//) {
      defined $base and die "too late to fix the name";
      $base = $j; $fixed_name = 1; next;
    } elsif ($j =~ /^=/) { push @in, $j; next; }
    my $pre = "";
    if ($j =~ /^([^:]*)\:(.*)$/) { $pre = $1 . ":"; $j = $2; }
    if (!$fixed_name) {
      (my $b = $j) =~ s{^ (?: .* /)? (.*) $}{$1}x;
      defined $base and $base ne $b and die "huh? `$b' /= `$base'";
      $base = $b;
    }
    note_path $j, "$base-tests.in";
    push @in, $pre . "$DONOR_DIR/$j";
  }
  convert_test \@in, "$base-tests.in", $varmap;
}

commit_changes();