Commit | Line | Data |
---|---|---|
d1d3b5e8 MW |
1 | #! /usr/bin/perl -w |
2 | ### | |
3 | ### Import/update crypto implementations from Catacomb. | |
4 | ||
5 | ### This file is part of secnet. | |
6 | ### See README for full list of copyright holders. | |
7 | ### | |
8 | ### secnet is free software; you can redistribute it and/or modify it | |
9 | ### under the terms of the GNU General Public License as published by | |
10 | ### the Free Software Foundation; either version d of the License, or | |
11 | ### (at your option) any later version. | |
12 | ### | |
13 | ### secnet is distributed in the hope that it will be useful, but | |
14 | ### WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | ### General Public License for more details. | |
17 | ### | |
18 | ### You should have received a copy of the GNU General Public License | |
19 | ### version 3 along with secnet; if not, see | |
20 | ### https://www.gnu.org/licenses/gpl.html. | |
21 | ||
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 -------------------------------------------------- |