aboutsummaryrefslogtreecommitdiff
path: root/openssl-1.1.0h/util/perl/OpenSSL/Test
diff options
context:
space:
mode:
Diffstat (limited to 'openssl-1.1.0h/util/perl/OpenSSL/Test')
-rw-r--r--openssl-1.1.0h/util/perl/OpenSSL/Test/Simple.pm91
-rw-r--r--openssl-1.1.0h/util/perl/OpenSSL/Test/Utils.pm240
2 files changed, 331 insertions, 0 deletions
diff --git a/openssl-1.1.0h/util/perl/OpenSSL/Test/Simple.pm b/openssl-1.1.0h/util/perl/OpenSSL/Test/Simple.pm
new file mode 100644
index 0000000..c5a84d5
--- /dev/null
+++ b/openssl-1.1.0h/util/perl/OpenSSL/Test/Simple.pm
@@ -0,0 +1,91 @@
+# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
+#
+# Licensed under the OpenSSL license (the "License"). You may not use
+# this file except in compliance with the License. You can obtain a copy
+# in the file LICENSE in the source distribution or at
+# https://www.openssl.org/source/license.html
+
+package OpenSSL::Test::Simple;
+
+use strict;
+use warnings;
+
+use Exporter;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+$VERSION = "0.2";
+@ISA = qw(Exporter);
+@EXPORT = qw(simple_test);
+
+=head1 NAME
+
+OpenSSL::Test::Simple - a few very simple test functions
+
+=head1 SYNOPSIS
+
+ use OpenSSL::Test::Simple;
+
+ simple_test("my_test_name", "destest", "des");
+
+=head1 DESCRIPTION
+
+Sometimes, the functions in L<OpenSSL::Test> are quite tedious for some
+repetitive tasks. This module provides functions to make life easier.
+You could call them hacks if you wish.
+
+=cut
+
+use OpenSSL::Test;
+use OpenSSL::Test::Utils;
+
+=over 4
+
+=item B<simple_test NAME, PROGRAM, ALGORITHM>
+
+Runs a test named NAME, running the program PROGRAM with no arguments,
+to test the algorithm ALGORITHM.
+
+A complete recipe looks like this:
+
+ use OpenSSL::Test::Simple;
+
+ simple_test("test_bf", "bftest", "bf");
+
+=back
+
+=cut
+
+# args:
+# name (used with setup())
+# algorithm (used to check if it's at all supported)
+# name of binary (the program that does the actual test)
+sub simple_test {
+ my ($name, $prgr, @algos) = @_;
+
+ setup($name);
+
+ if (scalar(disabled(@algos))) {
+ if (scalar(@algos) == 1) {
+ plan skip_all => $algos[0]." is not supported by this OpenSSL build";
+ } else {
+ my $last = pop @algos;
+ plan skip_all => join(", ", @algos)." and $last are not supported by this OpenSSL build";
+ }
+ }
+
+ plan tests => 1;
+
+ ok(run(test([$prgr])), "running $prgr");
+}
+
+=head1 SEE ALSO
+
+L<OpenSSL::Test>
+
+=head1 AUTHORS
+
+Richard Levitte E<lt>levitte@openssl.orgE<gt> with inspiration
+from Rich Salz E<lt>rsalz@openssl.orgE<gt>.
+
+=cut
+
+1;
diff --git a/openssl-1.1.0h/util/perl/OpenSSL/Test/Utils.pm b/openssl-1.1.0h/util/perl/OpenSSL/Test/Utils.pm
new file mode 100644
index 0000000..7b0a705
--- /dev/null
+++ b/openssl-1.1.0h/util/perl/OpenSSL/Test/Utils.pm
@@ -0,0 +1,240 @@
+# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
+#
+# Licensed under the OpenSSL license (the "License"). You may not use
+# this file except in compliance with the License. You can obtain a copy
+# in the file LICENSE in the source distribution or at
+# https://www.openssl.org/source/license.html
+
+package OpenSSL::Test::Utils;
+
+use strict;
+use warnings;
+
+use Exporter;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+$VERSION = "0.1";
+@ISA = qw(Exporter);
+@EXPORT = qw(alldisabled anydisabled disabled config available_protocols
+ have_IPv4 have_IPv6);
+
+=head1 NAME
+
+OpenSSL::Test::Utils - test utility functions
+
+=head1 SYNOPSIS
+
+ use OpenSSL::Test::Utils;
+
+ my @tls = available_protocols("tls");
+ my @dtls = available_protocols("dtls");
+ alldisabled("dh", "dsa");
+ anydisabled("dh", "dsa");
+
+ config("fips");
+
+ have_IPv4();
+ have_IPv6();
+
+=head1 DESCRIPTION
+
+This module provides utility functions for the testing framework.
+
+=cut
+
+use OpenSSL::Test qw/:DEFAULT bldtop_file/;
+
+=over 4
+
+=item B<available_protocols STRING>
+
+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.
+
+=item B<have_IPv4>
+=item B<have_IPv6>
+
+Return true if IPv4 / IPv6 is possible to use on the current system.
+
+=back
+
+=cut
+
+our %available_protocols;
+our %disabled;
+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 bldtop_file() complain that setup() hasn't
+ # been run yet.
+ my $configdata = bldtop_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 {
+ 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 {
+ anydisabled(@_);
+}
+
+sub available_protocols {
+ load_configdata() unless $configdata_loaded;
+ my $protocol_class = shift;
+ if (exists $available_protocols{lc $protocol_class}) {
+ return @{$available_protocols{lc $protocol_class}}
+ }
+ return ();
+}
+
+sub config {
+ load_configdata() unless $configdata_loaded;
+ return $config{$_[0]};
+}
+
+# IPv4 / IPv6 checker
+my $have_IPv4 = -1;
+my $have_IPv6 = -1;
+my $IP_factory;
+sub check_IP {
+ my $listenaddress = shift;
+
+ eval {
+ require IO::Socket::IP;
+ my $s = IO::Socket::IP->new(
+ LocalAddr => $listenaddress,
+ LocalPort => 0,
+ Listen=>1,
+ );
+ $s or die "\n";
+ $s->close();
+ };
+ if ($@ eq "") {
+ return 1;
+ }
+
+ eval {
+ require IO::Socket::INET6;
+ my $s = IO::Socket::INET6->new(
+ LocalAddr => $listenaddress,
+ LocalPort => 0,
+ Listen=>1,
+ );
+ $s or die "\n";
+ $s->close();
+ };
+ if ($@ eq "") {
+ return 1;
+ }
+
+ eval {
+ require IO::Socket::INET;
+ my $s = IO::Socket::INET->new(
+ LocalAddr => $listenaddress,
+ LocalPort => 0,
+ Listen=>1,
+ );
+ $s or die "\n";
+ $s->close();
+ };
+ if ($@ eq "") {
+ return 1;
+ }
+
+ return 0;
+}
+
+sub have_IPv4 {
+ if ($have_IPv4 < 0) {
+ $have_IPv4 = check_IP("127.0.0.1");
+ }
+ return $have_IPv4;
+}
+
+sub have_IPv6 {
+ if ($have_IPv6 < 0) {
+ $have_IPv6 = check_IP("::1");
+ }
+ return $have_IPv6;
+}
+
+
+=head1 SEE ALSO
+
+L<OpenSSL::Test>
+
+=head1 AUTHORS
+
+Stephen Henson E<lt>steve@openssl.orgE<gt> and
+Richard Levitte E<lt>levitte@openssl.orgE<gt>
+
+=cut
+
+1;
generated by cgit