From 1047c205103e6da9fc6a317f41583147dbc11aa3 Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Wed, 25 Sep 2019 12:07:17 +0100 Subject: [PATCH] @@@ import-catacomb-crypto wip --- import-catacomb-crypto | 914 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 914 insertions(+) create mode 100755 import-catacomb-crypto diff --git a/import-catacomb-crypto b/import-catacomb-crypto new file mode 100755 index 0000000..497b299 --- /dev/null +++ b/import-catacomb-crypto @@ -0,0 +1,914 @@ +#! /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 <]* [">]) \s* $/x) { + my $incl = $1; my $hdr = $2; + if ($hdr eq '') { $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; } + } + + ## 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; + + ## Fix the provenance note. + if ($line =~ /^ \* This file is part of Catacomb/) { + print $out <; 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"} .= <; 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(); -- 2.11.0