mirror of https://github.com/openssl/openssl.git
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:
parent
36b82b3464
commit
96d2d7bc71
15
Configure
15
Configure
|
|
@ -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) {
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue