Hakase/openssl-custom
1
0 Fork 0
Code Issues Pull Requests Releases Wiki Activity

OpenSSL 1.1.1-pre2

Browse Source
This commit is contained in:
Hakase
2018-04-07 17:29:40 +09:00
parent 82a44d2483
commit bbac8ca55d
17755 changed files with 221242 additions and 98415 deletions
Download Patch File Download Diff File Expand all files Collapse all files
util/perl/OpenSSL/Test.pm
+260 -145
View File
@@ -16,8 +16,8 @@ use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = "0.8";
@ISA = qw(Exporter);
@EXPORT = (@Test::More::EXPORT, qw(setup indir app fuzz perlapp test perltest
run));
@EXPORT = (@Test::More::EXPORT, qw(setup run indir cmd app fuzz test
perlapp perltest subtest));
@EXPORT_OK = (@Test::More::EXPORT_OK, qw(bldtop_dir bldtop_file
srctop_dir srctop_file
data_file
@@ -65,6 +65,7 @@ use File::Spec::Functions qw/file_name_is_absolute curdir canonpath splitdir
use File::Path 2.00 qw/rmtree mkpath/;
use File::Basename;
my $level = 0;
# The name of the test. This is set by setup() and is used in the other
# functions to verify that setup() has been used.
@@ -91,9 +92,9 @@ my %hooks = (
# exit_checker is used by run() directly after completion of a command.
# it receives the exit code from that command and is expected to return
# 1 (for success) or 0 (for failure). This is the value that will be
# returned by run().
# NOTE: When run() gets the option 'capture => 1', this hook is ignored.
# 1 (for success) or 0 (for failure). This is the status value that run()
# will give back (through the |statusvar| reference and as returned value
# when capture => 1 doesn't apply).
exit_checker => sub { return shift == 0 ? 1 : 0 },
);
@@ -101,21 +102,6 @@ my %hooks = (
# Debug flag, to be set manually when needed
my $debug = 0;
# Declare some utility functions that are defined at the end
sub bldtop_file;
sub bldtop_dir;
sub srctop_file;
sub srctop_dir;
sub quotify;
# Declare some private functions that are defined at the end
sub __env;
sub __cwd;
sub __apps_file;
sub __results_file;
sub __fixup_cmd;
sub __build_cmd;
=head2 Main functions
The following functions are exported by default when using C<OpenSSL::Test>.
@@ -225,25 +211,18 @@ sub indir {
=over 4
=item B<app ARRAYREF, OPTS>
=item B<cmd ARRAYREF, OPTS>
=item B<test ARRAYREF, OPTS>
This functions build up a platform dependent command based on the
input. It takes a reference to a list that is the executable or
script and its arguments, and some additional options (described
further on). Where necessary, the command will be wrapped in a
suitable environment to make sure the correct shared libraries are
used (currently only on Unix).
Both of these functions take a reference to a list that is a command and
its arguments, and some additional options (described further on).
It returns a CODEREF to be used by C<run>, C<pipe> or C<cmdstr>.
C<app> expects to find the given command (the first item in the given list
reference) as an executable in C<$BIN_D> (if defined, otherwise C<$TOP/apps>
or C<$BLDTOP/apps>).
C<test> expects to find the given command (the first item in the given list
reference) as an executable in C<$TEST_D> (if defined, otherwise C<$TOP/test>
or C<$BLDTOP/test>).
Both return a CODEREF to be used by C<run>, C<pipe> or C<cmdstr>.
The options that both C<app> and C<test> can take are in the form of hash
values:
The options that C<cmd> can take are in the form of hash values:
=over 4
@@ -259,21 +238,42 @@ string PATH, I<or>, if the value is C<undef>, C</dev/null> or similar.
=back
=item B<app ARRAYREF, OPTS>
=item B<test ARRAYREF, OPTS>
Both of these are specific applications of C<cmd>, with just a couple
of small difference:
C<app> expects to find the given command (the first item in the given list
reference) as an executable in C<$BIN_D> (if defined, otherwise C<$TOP/apps>
or C<$BLDTOP/apps>).
C<test> expects to find the given command (the first item in the given list
reference) as an executable in C<$TEST_D> (if defined, otherwise C<$TOP/test>
or C<$BLDTOP/test>).
Also, for both C<app> and C<test>, the command may be prefixed with
the content of the environment variable C<$EXE_SHELL>, which is useful
in case OpenSSL has been cross compiled.
=item B<perlapp ARRAYREF, OPTS>
=item B<perltest ARRAYREF, OPTS>
Both these functions function the same way as B<app> and B<test>, except
that they expect the command to be a perl script. Also, they support one
more option:
These are also specific applications of C<cmd>, where the interpreter
is predefined to be C<perl>, and they expect the script to be
interpreted to reside in the same location as C<app> and C<test>.
C<perlapp> and C<perltest> will also take the following option:
=over 4
=item B<interpreter_args =E<gt> ARRAYref>
The array reference is a set of arguments for perl rather than the script.
Take care so that none of them can be seen as a script! Flags and their
eventual arguments only!
The array reference is a set of arguments for the interpreter rather
than the script. Take care so that none of them can be seen as a
script! Flags and their eventual arguments only!
=back
@@ -284,54 +284,114 @@ An example:
=back
=begin comment
One might wonder over the complexity of C<apps>, C<fuzz>, C<test>, ...
with all the lazy evaluations and all that. The reason for this is that
we want to make sure the directory in which those programs are found are
correct at the time these commands are used. Consider the following code
snippet:
my $cmd = app(["openssl", ...]);
indir "foo", sub {
ok(run($cmd), "Testing foo")
};
If there wasn't this lazy evaluation, the directory where C<openssl> is
found would be incorrect at the time C<run> is called, because it was
calculated before we moved into the directory "foo".
=end comment
=cut
sub cmd {
my $cmd = shift;
my %opts = @_;
return sub {
my $num = shift;
# Make a copy to not destroy the caller's array
my @cmdargs = ( @$cmd );
my @prog = __wrap_cmd(shift @cmdargs, $opts{exe_shell} // ());
return __decorate_cmd($num, [ @prog, quotify(@cmdargs) ],
%opts);
}
}
sub app {
my $cmd = shift;
my %opts = @_;
return sub { my $num = shift;
return __build_cmd($num, \&__apps_file, $cmd, %opts); }
return sub {
my @cmdargs = ( @{$cmd} );
my @prog = __fixup_prg(__apps_file(shift @cmdargs, __exeext()));
return cmd([ @prog, @cmdargs ],
exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift);
}
}
sub fuzz {
my $cmd = shift;
my %opts = @_;
return sub { my $num = shift;
return __build_cmd($num, \&__fuzz_file, $cmd, %opts); }
return sub {
my @cmdargs = ( @{$cmd} );
my @prog = __fixup_prg(__fuzz_file(shift @cmdargs, __exeext()));
return cmd([ @prog, @cmdargs ],
exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift);
}
}
sub test {
my $cmd = shift;
my %opts = @_;
return sub { my $num = shift;
return __build_cmd($num, \&__test_file, $cmd, %opts); }
return sub {
my @cmdargs = ( @{$cmd} );
my @prog = __fixup_prg(__test_file(shift @cmdargs, __exeext()));
return cmd([ @prog, @cmdargs ],
exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift);
}
}
sub perlapp {
my $cmd = shift;
my %opts = @_;
return sub { my $num = shift;
return __build_cmd($num, \&__perlapps_file, $cmd, %opts); }
return sub {
my @interpreter_args = defined $opts{interpreter_args} ?
@{$opts{interpreter_args}} : ();
my @interpreter = __fixup_prg($^X);
my @cmdargs = ( @{$cmd} );
my @prog = __apps_file(shift @cmdargs, undef);
return cmd([ @interpreter, @interpreter_args,
@prog, @cmdargs ], %opts) -> (shift);
}
}
sub perltest {
my $cmd = shift;
my %opts = @_;
return sub { my $num = shift;
return __build_cmd($num, \&__perltest_file, $cmd, %opts); }
return sub {
my @interpreter_args = defined $opts{interpreter_args} ?
@{$opts{interpreter_args}} : ();
my @interpreter = __fixup_prg($^X);
my @cmdargs = ( @{$cmd} );
my @prog = __test_file(shift @cmdargs, undef);
return cmd([ @interpreter, @interpreter_args,
@prog, @cmdargs ], %opts) -> (shift);
}
}
=over 4
=item B<run CODEREF, OPTS>
This CODEREF is expected to be the value return by C<app> or C<test>,
anything else will most likely cause an error unless you know what you're
doing.
CODEREF is expected to be the value return by C<cmd> or any of its
derivatives, anything else will most likely cause an error unless you
know what you're doing.
C<run> executes the command returned by CODEREF and return either the
resulting output (if the option C<capture> is set true) or a boolean indicating
if the command succeeded or not.
resulting output (if the option C<capture> is set true) or a boolean
indicating if the command succeeded or not.
The options that C<run> can take are in the form of hash values:
@@ -344,6 +404,18 @@ return the resulting output as an array of lines. If false or not given,
the command will be executed with C<system()>, and C<run> will return 1 if
the command was successful or 0 if it wasn't.
=item B<prefix =E<gt> EXPR>
If specified, EXPR will be used as a string to prefix the output from the
command. This is useful if the output contains lines starting with C<ok >
or C<not ok > that can disturb Test::Harness.
=item B<statusvar =E<gt> VARREF>
If used, B<VARREF> must be a reference to a scalar variable. It will be
assigned a boolean indicating if the command succeeded or not. This is
particularly useful together with B<capture>.
=back
For further discussion on what is considered a successful command or not, see
@@ -368,6 +440,9 @@ sub run {
my $r = 0;
my $e = 0;
die "OpenSSL::Test::run(): statusvar value not a scalar reference"
if $opts{statusvar} && ref($opts{statusvar}) ne "SCALAR";
# In non-verbose, we want to shut up the command interpreter, in case
# it has something to complain about. On VMS, it might complain both
# on stdout and stderr
@@ -380,17 +455,35 @@ sub run {
open STDERR, ">", devnull();
}
$ENV{HARNESS_OSSL_LEVEL} = $level + 1;
# The dance we do with $? is the same dance the Unix shells appear to
# do. For example, a program that gets aborted (and therefore signals
# SIGABRT = 6) will appear to exit with the code 134. We mimic this
# to make it easier to compare with a manual run of the command.
if ($opts{capture}) {
@r = `$prefix$cmd`;
$e = ($? & 0x7f) ? ($? & 0x7f)|0x80 : ($? >> 8);
if ($opts{capture} || defined($opts{prefix})) {
my $pipe;
local $_;
open($pipe, '-|', "$prefix$cmd") or die "Can't start command: $!";
while(<$pipe>) {
my $l = ($opts{prefix} // "") . $_;
if ($opts{capture}) {
push @r, $l;
} else {
print STDOUT $l;
}
}
close $pipe;
} else {
$ENV{HARNESS_OSSL_PREFIX} = "# ";
system("$prefix$cmd");
$e = ($? & 0x7f) ? ($? & 0x7f)|0x80 : ($? >> 8);
$r = $hooks{exit_checker}->($e);
delete $ENV{HARNESS_OSSL_PREFIX};
}
$e = ($? & 0x7f) ? ($? & 0x7f)|0x80 : ($? >> 8);
$r = $hooks{exit_checker}->($e);
if ($opts{statusvar}) {
${$opts{statusvar}} = $r;
}
if ($ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_VERBOSE}) {
@@ -570,7 +663,7 @@ sub pipe {
=item B<with HASHREF, CODEREF>
C<with> will temporarly install hooks given by the HASHREF and then execute
C<with> will temporarily install hooks given by the HASHREF and then execute
the given CODEREF. Hooks are usually expected to have a coderef as value.
The currently available hoosk are:
@@ -616,7 +709,7 @@ sub with {
C<cmdstr> takes a CODEREF from C<app> or C<test> and simply returns the
command as a string.
C<cmdstr> takes some additiona options OPTS that affect the string returned:
C<cmdstr> takes some additional options OPTS that affect the string returned:
=over 4
@@ -754,6 +847,14 @@ sub __env {
$end_with_bailout = $ENV{STOPTEST} ? 1 : 0;
};
# __srctop_file and __srctop_dir are helpers to build file and directory
# names on top of the source directory. They depend on $SRCTOP, and
# therefore on the proper use of setup() and when needed, indir().
# __bldtop_file and __bldtop_dir do the same thing but relative to $BLDTOP.
# __srctop_file and __bldtop_file take the same kind of argument as
# File::Spec::Functions::catfile.
# Similarly, __srctop_dir and __bldtop_dir take the same kind of argument
# as File::Spec::Functions::catdir
sub __srctop_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
@@ -780,6 +881,9 @@ sub __bldtop_dir {
return catdir($directories{BLDTOP},@_);
}
# __exeext is a function that returns the platform dependent file extension
# for executable binaries, or the value of the environment variable $EXE_EXT
# if that one is defined.
sub __exeext {
my $ext = "";
if ($^O eq "VMS" ) { # VMS
@@ -790,51 +894,45 @@ sub __exeext {
return $ENV{"EXE_EXT"} || $ext;
}
# __test_file, __apps_file and __fuzz_file return the full path to a file
# relative to the test/, apps/ or fuzz/ directory in the build tree or the
# source tree, depending on where the file is found. Note that when looking
# in the build tree, the file name with an added extension is looked for, if
# an extension is given. The intent is to look for executable binaries (in
# the build tree) or possibly scripts (in the source tree).
# These functions all take the same arguments as File::Spec::Functions::catfile,
# *plus* a mandatory extension argument. This extension argument can be undef,
# and is ignored in such a case.
sub __test_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $e = pop || "";
my $f = pop;
my $out = catfile($directories{BLDTEST},@_,$f . __exeext());
$out = catfile($directories{SRCTEST},@_,$f) unless -x $out;
return $out;
}
sub __perltest_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $f = pop;
my $out = catfile($directories{BLDTEST},@_,$f);
my $out = catfile($directories{BLDTEST},@_,$f . $e);
$out = catfile($directories{SRCTEST},@_,$f) unless -f $out;
return ($^X, $out);
return $out;
}
sub __apps_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $e = pop || "";
my $f = pop;
my $out = catfile($directories{BLDAPPS},@_,$f . __exeext());
$out = catfile($directories{SRCAPPS},@_,$f) unless -x $out;
my $out = catfile($directories{BLDAPPS},@_,$f . $e);
$out = catfile($directories{SRCAPPS},@_,$f) unless -f $out;
return $out;
}
sub __fuzz_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $e = pop || "";
my $f = pop;
my $out = catfile($directories{BLDFUZZ},@_,$f . __exeext());
$out = catfile($directories{SRCFUZZ},@_,$f) unless -x $out;
my $out = catfile($directories{BLDFUZZ},@_,$f . $e);
$out = catfile($directories{SRCFUZZ},@_,$f) unless -f $out;
return $out;
}
sub __perlapps_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $f = pop;
my $out = catfile($directories{BLDAPPS},@_,$f);
$out = catfile($directories{SRCAPPS},@_,$f) unless -f $out;
return ($^X, $out);
}
sub __data_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
@@ -849,6 +947,16 @@ sub __results_file {
return catfile($directories{RESULTS},@_,$f);
}
# __cwd DIR
# __cwd DIR, OPTS
#
# __cwd changes directory to DIR (string) and changes all the relative
# entries in %directories accordingly. OPTS is an optional series of
# hash style arguments to alter __cwd's behavior:
#
# create = 0|1 The directory we move to is created if 1, not if 0.
# cleanup = 0|1 The directory we move from is removed if 1, not if 0.
sub __cwd {
my $dir = catdir(shift);
my %opts = @_;
@@ -910,7 +1018,7 @@ sub __cwd {
}
# We put back new values carefully. Doing the obvious
# %directories = ( %tmp_irectories )
# %directories = ( %tmp_directories )
# will clear out any value that happens to be an absolute path
foreach (keys %tmp_directories) {
$directories{$_} = $tmp_directories{$_};
@@ -937,28 +1045,46 @@ sub __cwd {
return $reverse;
}
sub __fixup_cmd {
my $prog = shift;
# __wrap_cmd CMD
# __wrap_cmd CMD, EXE_SHELL
#
# __wrap_cmd "wraps" CMD (string) with a beginning command that makes sure
# the command gets executed with an appropriate environment. If EXE_SHELL
# is given, it is used as the beginning command.
#
# __wrap_cmd returns a list that should be used to build up a larger list
# of command tokens, or be joined together like this:
#
# join(" ", __wrap_cmd($cmd))
sub __wrap_cmd {
my $cmd = shift;
my $exe_shell = shift;
my $prefix = __bldtop_file("util", "shlib_wrap.sh")." ";
my @prefix = ( __bldtop_file("util", "shlib_wrap.sh") );
if (defined($exe_shell)) {
$prefix = "$exe_shell ";
} elsif ($^O eq "VMS" ) { # VMS
$prefix = ($prog =~ /^(?:[\$a-z0-9_]+:)?[<\[]/i ? "mcr " : "mcr []");
} elsif ($^O eq "MSWin32") { # Windows
$prefix = "";
if(defined($exe_shell)) {
@prefix = ( $exe_shell );
} elsif ($^O eq "VMS" || $^O eq "MSWin32") {
# VMS and Windows don't use any wrapper script for the moment
@prefix = ();
}
# We test both with and without extension. The reason
# is that we might be passed a complete file spec, with
# extension.
if ( ! -x $prog ) {
my $prog = "$prog";
if ( ! -x $prog ) {
$prog = undef;
}
return (@prefix, $cmd);
}
# __fixup_prg PROG
#
# __fixup_prg does whatever fixup is needed to execute an executable binary
# given by PROG (string).
#
# __fixup_prg returns a string with the possibly prefixed program path spec.
sub __fixup_prg {
my $prog = shift;
my $prefix = "";
if ($^O eq "VMS" ) {
$prefix = ($prog =~ /^(?:[\$a-z0-9_]+:)?[<\[]/i ? "mcr " : "mcr []");
}
if (defined($prog)) {
@@ -974,45 +1100,25 @@ sub __fixup_cmd {
return undef;
}
sub __build_cmd {
# __decorate_cmd NUM, CMDARRAYREF
#
# __decorate_cmd takes a command number NUM and a command token array
# CMDARRAYREF, builds up a command string from them and decorates it
# with necessary redirections.
# __decorate_cmd returns a list of two strings, one with the command
# string to actually be used, the other to be displayed for the user.
# The reason these strings might differ is that we redirect stderr to
# the null device unless we're verbose and unless the user has
# explicitly specified a stderr redirection.
sub __decorate_cmd {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $num = shift;
my $path_builder = shift;
# Make a copy to not destroy the caller's array
my @cmdarray = ( @{$_[0]} ); shift;
my $cmd = shift;
my %opts = @_;
# We do a little dance, as $path_builder might return a list of
# more than one. If so, only the first is to be considered a
# program to fix up, the rest is part of the arguments. This
# happens for perl scripts, where $path_builder will return
# a list of two, $^X and the script name.
# Also, if $path_builder returned more than one, we don't apply
# the EXE_SHELL environment variable.
my @prog = ($path_builder->(shift @cmdarray));
my $first = shift @prog;
my $exe_shell = @prog ? undef : $ENV{EXE_SHELL};
my $cmd = __fixup_cmd($first, $exe_shell);
if (@prog) {
if ( ! -f $prog[0] ) {
print STDERR "$prog[0] not found\n";
$cmd = undef;
}
}
my @args = (@prog, @cmdarray);
if (defined($opts{interpreter_args})) {
unshift @args, @{$opts{interpreter_args}};
}
return () if !$cmd;
my $arg_str = "";
my $cmdstr = join(" ", @$cmd);
my $null = devnull();
$arg_str = " ".join(" ", quotify @args) if @args;
my $fileornull = sub { $_[0] ? $_[0] : $null; };
my $stdin = "";
my $stdout = "";
@@ -1022,19 +1128,19 @@ sub __build_cmd {
$stdout= " > ".$fileornull->($opts{stdout}) if exists($opts{stdout});
$stderr=" 2> ".$fileornull->($opts{stderr}) if exists($opts{stderr});
my $display_cmd = "$cmd$arg_str$stdin$stdout$stderr";
my $display_cmd = "$cmdstr$stdin$stdout$stderr";
$stderr=" 2> ".$null
unless $stderr || !$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE};
$cmd .= "$arg_str$stdin$stdout$stderr";
$cmdstr .= "$stdin$stdout$stderr";
if ($debug) {
print STDERR "DEBUG[__build_cmd]: \$cmd = \"$cmd\"\n";
print STDERR "DEBUG[__build_cmd]: \$display_cmd = \"$display_cmd\"\n";
print STDERR "DEBUG[__decorate_cmd]: \$cmdstr = \"$cmdstr\"\n";
print STDERR "DEBUG[__decorate_cmd]: \$display_cmd = \"$display_cmd\"\n";
}
return ($cmd, $display_cmd);
return ($cmdstr, $display_cmd);
}
=head1 SEE ALSO
@@ -1043,9 +1149,18 @@ L<Test::More>, L<Test::Harness>
=head1 AUTHORS
Richard Levitte E<lt>levitte@openssl.orgE<gt> with assitance and
Richard Levitte E<lt>levitte@openssl.orgE<gt> with assistance and
inspiration from Andy Polyakov E<lt>appro@openssl.org<gt>.
=cut
no warnings 'redefine';
sub subtest {
$level++;
Test::More::subtest @_;
$level--;
};
1;
util/perl/OpenSSL/Util/Pod.pm
+2 -11
View File
@@ -53,11 +53,8 @@ The additional hash is for extra parameters:
=item B<section =E<gt> N>
The value MUST be a number, and will be the default man section number
to be used with the given .pod file. This number can be altered if
the .pod file has a line like this:
=for comment openssl_manual_section: 4
The value MUST be a number, and will be the man section number
to be used with the given .pod file.
=item B<debug =E<gt> 0|1>
@@ -109,12 +106,6 @@ sub extract_pod_info {
my %podinfo = ( section => $defaults{section});
while(<$input>) {
s|\R$||;
if (m|^=for\s+comment\s+openssl_manual_section:\s*([0-9])\s*$|) {
print STDERR "DEBUG: Found man section number $1\n"
if $defaults{debug};
$podinfo{section} = $1;
}
# Stop reading when we have reached past the NAME section.
last if (m|^=head1|
&& defined $podinfo{lastsect}