Use Configure's @disablables and %disabled through configdata.pm
authorRichard Levitte <levitte@openssl.org>
Tue, 26 Jan 2016 01:09:33 +0000 (02:09 +0100)
committerRichard Levitte <levitte@openssl.org>
Tue, 26 Jan 2016 08:53:36 +0000 (09:53 +0100)
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>
Configure
test/testlib/OpenSSL/Test/Utils.pm

index 0a07174..9dc6343 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -1311,6 +1311,21 @@ 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) {
     if (ref($withargs{$_}) eq "ARRAY") {
index eed4424..c024832 100644 (file)
@@ -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<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
 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>
 
 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<OpenSSL::Test>
 
 =head1 AUTHORS
 
-Stephen Henson E<lt>steve@openssl.orgE<gt> with inspiration
-from Richard Levitte E<lt>levitte@openssl.orgE<gt>
+Stephen Henson E<lt>steve@openssl.orgE<gt> and
+Richard Levitte E<lt>levitte@openssl.orgE<gt>
 
 =cut