Use Configure's @disablables and %disabled through configdata.pm

Enhances the routines in OpenSSL::Test::Utils for checking disabled
stuff to get their information directly from Configure instead of
'openssl list -disabled'.

Reviewed-by: Viktor Dukhovni <viktor@openssl.org>
This commit is contained in:
Richard Levitte 2016-01-26 02:09:33 +01:00
parent 36b82b3464
commit 96d2d7bc71
2 changed files with 104 additions and 36 deletions

View File

@ -1310,6 +1310,21 @@ foreach (sort keys %target) {
print OUT <<"EOF"; print OUT <<"EOF";
); );
EOF
print OUT "our \%available_protocols = (\n";
print OUT " tls => [ ", join(", ", map { quotify("perl", $_) } @tls), " ],\n";
print OUT " dtls => [ ", join(", ", map { quotify("perl", $_) } @dtls), " ],\n";
print OUT <<"EOF";
);
EOF
print OUT "our \%disabled = (\n";
foreach (sort keys %disabled) {
print OUT " ", quotify("perl", $_), " => ", quotify("perl", $disabled{$_}), ",\n";
}
print OUT <<"EOF";
);
EOF EOF
print OUT "our %withargs = (\n"; print OUT "our %withargs = (\n";
foreach (sort keys %withargs) { foreach (sort keys %withargs) {

View File

@ -7,7 +7,7 @@ use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = "0.1"; $VERSION = "0.1";
@ISA = qw(Exporter); @ISA = qw(Exporter);
@EXPORT = qw(disabled config); @EXPORT = qw(alldisabled anydisabled disabled config available_protocols);
=head1 NAME =head1 NAME
@ -17,9 +17,12 @@ OpenSSL::Test::Utils - test utility functions
use OpenSSL::Test::Utils; use OpenSSL::Test::Utils;
disabled("dh"); my @tls = available_protocols("tls");
my @dtls = available_protocols("dtls");
alldisabled("dh", "dsa");
anydisabled("dh", "dsa");
config("no_shared"); config("fips");
=head1 DESCRIPTION =head1 DESCRIPTION
@ -31,13 +34,23 @@ use OpenSSL::Test qw/:DEFAULT top_file/;
=over 4 =over 4
=item B<disabled ARRAY> =item B<available_protocols STRING>
In a scalar context returns 1 if any of the features in ARRAY is disabled. Returns a list of strings for all the available SSL/TLS versions if
STRING is "tls", or for all the available DTLS versions if STRING is
"dtls". Otherwise, it returns the empty list. The strings in the
returned list can be used with B<alldisabled> and B<anydisabled>.
=item B<alldisabled ARRAY>
=item B<anydisabled ARRAY>
In an array context returns an array with each element set to 1 if the In an array context returns an array with each element set to 1 if the
corresponding feature is disabled and 0 otherwise. corresponding feature is disabled and 0 otherwise.
In a scalar context, alldisabled returns 1 if all of the features in
ARRAY are disabled, while anydisabled returns 1 if any of them are
disabled.
=item B<config STRING> =item B<config STRING>
Returns an item from the %config hash in \$TOP/configdata.pm. Returns an item from the %config hash in \$TOP/configdata.pm.
@ -46,45 +59,85 @@ Returns an item from the %config hash in \$TOP/configdata.pm.
=cut =cut
our %available_protocols;
our %disabled; our %disabled;
my $disabled_set = 0; our %config;
my $configdata_loaded = 0;
sub load_configdata {
# We eval it so it doesn't run at compile time of this file.
# The latter would have top_dir() complain that setup() hasn't
# been run yet.
my $configdata = top_file("configdata.pm");
eval { require $configdata;
%available_protocols = %configdata::available_protocols;
%disabled = %configdata::disabled;
%config = %configdata::config;
};
$configdata_loaded = 1;
}
# args
# list of 1s and 0s, coming from check_disabled()
sub anyof {
my $x = 0;
foreach (@_) { $x += $_ }
return $x > 0;
}
# args
# list of 1s and 0s, coming from check_disabled()
sub allof {
my $x = 1;
foreach (@_) { $x *= $_ }
return $x > 0;
}
# args
# list of strings, all of them should be names of features
# that can be disabled.
# returns a list of 1s (if the corresponding feature is disabled)
# and 0s (if it isn't)
sub check_disabled { sub check_disabled {
#print STDERR "Running check_disabled\n"; return map { exists $disabled{lc $_} ? 1 : 0 } @_;
foreach (run(app(["openssl", "list", "-disabled"]), capture => 1)) { }
s/\R//; # chomp;
next if /:/; # skip header # Exported functions #################################################
$disabled{lc $_} = 1;
} # args:
$disabled_set = 1; # list of features to check
sub anydisabled {
load_configdata() unless $configdata_loaded;
my @ret = check_disabled(@_);
return @ret if wantarray;
return anyof(@ret);
} }
# args: # args:
# list of features to check # list of features to check
sub disabled { sub alldisabled {
check_disabled() unless $disabled_set; load_configdata() unless $configdata_loaded;
if (wantarray) { my @ret = check_disabled(@_);
my @ret; return @ret if wantarray;
foreach (@_) { return allof(@ret);
push @ret, exists $disabled{lc $_} ? 1 : 0;
}
return @ret;
}
foreach (@_) {
return 1 if exists $disabled{lc $_};
}
return 0;
} }
our %config; #!!! Kept for backward compatibility
sub config { # args:
if (!%config) { # single string
# We eval it so it doesn't run at compile time of this file. sub disabled {
# The latter would have top_dir() complain that setup() hasn't anydisabled(@_);
# been run yet. }
my $configdata = top_file("configdata.pm");
eval { require $configdata; %config = %configdata::config }; sub available_protocols {
my $protocol_class = shift;
if (exists $available_protocols{lc $protocol_class}) {
return @{$available_protocols{lc $protocol_class}}
} }
return ();
}
sub config {
return $config{$_[0]}; return $config{$_[0]};
} }
@ -94,8 +147,8 @@ L<OpenSSL::Test>
=head1 AUTHORS =head1 AUTHORS
Stephen Henson E<lt>steve@openssl.orgE<gt> with inspiration Stephen Henson E<lt>steve@openssl.orgE<gt> and
from Richard Levitte E<lt>levitte@openssl.orgE<gt> Richard Levitte E<lt>levitte@openssl.orgE<gt>
=cut =cut