1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
#!/usr/bin/env perl
# Require identical generated input bytes across platforms and Perl versions.
use strict;
use warnings;
use Digest::SHA qw(sha256_hex);
use File::Spec;
use File::Temp ();
use FindBin;
use JSON::PP ();
die "usage: $0 <perl>\n" unless @ARGV == 1;
my ($perl) = @ARGV;
my $dir = File::Spec->catdir($FindBin::Bin, 'ii');
my $vectors_path = File::Spec->catfile($dir, 'generator-vectors.json');
open my $fh, '<:raw', $vectors_path or die "cannot read $vectors_path: $!\n";
my $vectors_text = do { local $/; <$fh> };
close $fh;
my $vectors = JSON::PP->new->decode($vectors_text);
for my $name (sort keys %{$vectors}) {
my $digest = $vectors->{$name};
my $generate = File::Spec->catfile($dir, $name, 'generate.pl');
my @outputs;
for my $seed (('0' x 40, '0' x 40, '1' x 40)) {
my ($exit, $out, $err) = run_capture($perl, $generate, $seed, '100');
die "$name: generator exited with $exit\n" if $exit != 0;
if (length $err) {
die "$name: unexpected stderr " . display($err) . "\n";
}
push @outputs, $out;
}
if ($outputs[0] ne $outputs[1] || $outputs[0] eq $outputs[2]) {
die "$name: seed reproducibility failed\n";
}
if (sha256_hex($outputs[0]) ne $digest) {
die "$name: generated input differs from the portable test vector\n";
}
print "PASS $name: repeatable, seed-sensitive, portable bytes\n";
}
sub run_capture {
my (@command) = @_;
my $out_fh = File::Temp->new(UNLINK => 1);
my $err_fh = File::Temp->new(UNLINK => 1);
my $out_path = $out_fh->filename;
my $err_path = $err_fh->filename;
close $out_fh;
close $err_fh;
my $pid = fork();
die "cannot fork: $!\n" unless defined $pid;
if ($pid == 0) {
open STDOUT, '>', $out_path or exit 127;
open STDERR, '>', $err_path or exit 127;
binmode STDOUT;
binmode STDERR;
exec { $command[0] } @command;
exit 127;
}
my $timed_out = 0;
local $SIG{ALRM} = sub { $timed_out = 1; kill 'KILL', $pid; };
alarm 10;
waitpid($pid, 0);
alarm 0;
if ($timed_out) {
waitpid($pid, 0);
die "generator timed out after 10s: @command\n";
}
my $status = $?;
open my $out_in, '<:raw', $out_path or die "cannot read $out_path: $!\n";
my $out = do { local $/; <$out_in> };
close $out_in;
open my $err_in, '<:raw', $err_path or die "cannot read $err_path: $!\n";
my $err = do { local $/; <$err_in> };
close $err_in;
$out = '' unless defined $out;
$err = '' unless defined $err;
my $exit = ($status >> 8);
return ($exit, $out, $err);
}
sub display {
my ($bytes) = @_;
$bytes =~ s/([^ -~\n])/sprintf('\\x{%02x}', ord($1))/ge;
$bytes =~ s/\n/\\n/g;
return "'$bytes'";
}
|
