From 96d2d7bc71a8413f23ff9fc88f600acc4c340a9b Mon Sep 17 00:00:00 2001 From: Richard Levitte Date: Tue, 26 Jan 2016 02:09:33 +0100 Subject: [PATCH] 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 --- Configure | 15 ++++ test/testlib/OpenSSL/Test/Utils.pm | 121 +++++++++++++++++++++-------- 2 files changed, 102 insertions(+), 34 deletions(-) diff --git a/Configure b/Configure index 0a07174257..9dc6343962 100755 --- a/Configure +++ b/Configure @@ -1310,6 +1310,21 @@ foreach (sort keys %target) { 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 print OUT "our %withargs = (\n"; foreach (sort keys %withargs) { diff --git a/test/testlib/OpenSSL/Test/Utils.pm b/test/testlib/OpenSSL/Test/Utils.pm index eed44244b8..c0248322a7 100644 --- a/test/testlib/OpenSSL/Test/Utils.pm +++ b/test/testlib/OpenSSL/Test/Utils.pm @@ -7,7 +7,7 @@ use Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = "0.1"; @ISA = qw(Exporter); -@EXPORT = qw(disabled config); +@EXPORT = qw(alldisabled anydisabled disabled config available_protocols); =head1 NAME @@ -17,9 +17,12 @@ OpenSSL::Test::Utils - test utility functions 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 @@ -31,13 +34,23 @@ use OpenSSL::Test qw/:DEFAULT top_file/; =over 4 -=item B +=item B -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 and B. + +=item B +=item B In an array context returns an array with each element set to 1 if the 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 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 +our %available_protocols; 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 { -#print STDERR "Running check_disabled\n"; - foreach (run(app(["openssl", "list", "-disabled"]), capture => 1)) { - s/\R//; # chomp; - next if /:/; # skip header - $disabled{lc $_} = 1; - } - $disabled_set = 1; + return map { exists $disabled{lc $_} ? 1 : 0 } @_; +} + +# Exported functions ################################################# + +# args: +# list of features to check +sub anydisabled { + load_configdata() unless $configdata_loaded; + my @ret = check_disabled(@_); + return @ret if wantarray; + return anyof(@ret); } # args: # list of features to check +sub alldisabled { + load_configdata() unless $configdata_loaded; + my @ret = check_disabled(@_); + return @ret if wantarray; + return allof(@ret); +} + +#!!! Kept for backward compatibility +# args: +# single string sub disabled { - check_disabled() unless $disabled_set; - if (wantarray) { - my @ret; - foreach (@_) { - push @ret, exists $disabled{lc $_} ? 1 : 0; - } - return @ret; - } - foreach (@_) { - return 1 if exists $disabled{lc $_}; + anydisabled(@_); +} + +sub available_protocols { + my $protocol_class = shift; + if (exists $available_protocols{lc $protocol_class}) { + return @{$available_protocols{lc $protocol_class}} } - return 0; + return (); } -our %config; sub config { - if (!%config) { - # 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; %config = %configdata::config }; - } return $config{$_[0]}; } @@ -94,8 +147,8 @@ L =head1 AUTHORS -Stephen Henson Esteve@openssl.orgE with inspiration -from Richard Levitte Elevitte@openssl.orgE +Stephen Henson Esteve@openssl.orgE and +Richard Levitte Elevitte@openssl.orgE =cut -- 2.34.1