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) {
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
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
=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.
=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]};
}
=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