1# Copyright 2016-2024 The OpenSSL Project Authors. All Rights Reserved. 2# 3# Licensed under the Apache License 2.0 (the "License"). You may not use 4# this file except in compliance with the License. You can obtain a copy 5# in the file LICENSE in the source distribution or at 6# https://www.openssl.org/source/license.html 7 8package OpenSSL::Test::Utils; 9 10use strict; 11use warnings; 12 13use Exporter; 14use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 15$VERSION = "0.1"; 16@ISA = qw(Exporter); 17@EXPORT = qw(alldisabled anydisabled disabled config available_protocols 18 have_IPv4 have_IPv6); 19 20=head1 NAME 21 22OpenSSL::Test::Utils - test utility functions 23 24=head1 SYNOPSIS 25 26 use OpenSSL::Test::Utils; 27 28 my @tls = available_protocols("tls"); 29 my @dtls = available_protocols("dtls"); 30 alldisabled("dh", "dsa"); 31 anydisabled("dh", "dsa"); 32 33 config("fips"); 34 35 have_IPv4(); 36 have_IPv6(); 37 38=head1 DESCRIPTION 39 40This module provides utility functions for the testing framework. 41 42=cut 43 44use OpenSSL::Test qw/:DEFAULT bldtop_file/; 45 46=over 4 47 48=item B<available_protocols STRING> 49 50Returns a list of strings for all the available SSL/TLS versions if 51STRING is "tls", or for all the available DTLS versions if STRING is 52"dtls". Otherwise, it returns the empty list. The strings in the 53returned list can be used with B<alldisabled> and B<anydisabled>. 54 55=item B<alldisabled ARRAY> 56 57=item B<anydisabled ARRAY> 58 59In an array context returns an array with each element set to 1 if the 60corresponding feature is disabled and 0 otherwise. 61 62In a scalar context, alldisabled returns 1 if all of the features in 63ARRAY are disabled, while anydisabled returns 1 if any of them are 64disabled. 65 66=item B<config STRING> 67 68Returns an item from the %config hash in \$TOP/configdata.pm. 69 70=item B<have_IPv4> 71 72=item B<have_IPv6> 73 74Return true if IPv4 / IPv6 is possible to use on the current system. 75Additionally, B<have_IPv6> also checks how OpenSSL was configured, 76i.e. if IPv6 was explicitly disabled with -DOPENSSL_USE_IPv6=0. 77 78=back 79 80=cut 81 82our %available_protocols; 83our %disabled; 84our %config; 85our %target; 86my $configdata_loaded = 0; 87 88sub load_configdata { 89 # We eval it so it doesn't run at compile time of this file. 90 # The latter would have bldtop_file() complain that setup() hasn't 91 # been run yet. 92 my $configdata = bldtop_file("configdata.pm"); 93 eval { require $configdata; 94 %available_protocols = %configdata::available_protocols; 95 %disabled = %configdata::disabled; 96 %config = %configdata::config; 97 %target = %configdata::target; 98 }; 99 $configdata_loaded = 1; 100} 101 102# args 103# list of 1s and 0s, coming from check_disabled() 104sub anyof { 105 my $x = 0; 106 foreach (@_) { $x += $_ } 107 return $x > 0; 108} 109 110# args 111# list of 1s and 0s, coming from check_disabled() 112sub allof { 113 my $x = 1; 114 foreach (@_) { $x *= $_ } 115 return $x > 0; 116} 117 118# args 119# list of strings, all of them should be names of features 120# that can be disabled. 121# returns a list of 1s (if the corresponding feature is disabled) 122# and 0s (if it isn't) 123sub check_disabled { 124 return map { exists $disabled{lc $_} ? 1 : 0 } @_; 125} 126 127# Exported functions ################################################# 128 129# args: 130# list of features to check 131sub anydisabled { 132 load_configdata() unless $configdata_loaded; 133 my @ret = check_disabled(@_); 134 return @ret if wantarray; 135 return anyof(@ret); 136} 137 138# args: 139# list of features to check 140sub alldisabled { 141 load_configdata() unless $configdata_loaded; 142 my @ret = check_disabled(@_); 143 return @ret if wantarray; 144 return allof(@ret); 145} 146 147# !!! Kept for backward compatibility 148# args: 149# single string 150sub disabled { 151 anydisabled(@_); 152} 153 154sub available_protocols { 155 load_configdata() unless $configdata_loaded; 156 my $protocol_class = shift; 157 if (exists $available_protocols{lc $protocol_class}) { 158 return @{$available_protocols{lc $protocol_class}} 159 } 160 return (); 161} 162 163sub config { 164 load_configdata() unless $configdata_loaded; 165 return $config{$_[0]}; 166} 167 168# IPv4 / IPv6 checker 169my $have_IPv4 = -1; 170my $have_IPv6 = -1; 171my $IP_factory; 172sub check_IP { 173 my $listenaddress = shift; 174 175 eval { 176 require IO::Socket::IP; 177 my $s = IO::Socket::IP->new( 178 LocalAddr => $listenaddress, 179 LocalPort => 0, 180 Listen=>1, 181 ); 182 $s or die "\n"; 183 $s->close(); 184 }; 185 if ($@ eq "") { 186 return 1; 187 } 188 189 eval { 190 require IO::Socket::INET6; 191 my $s = IO::Socket::INET6->new( 192 LocalAddr => $listenaddress, 193 LocalPort => 0, 194 Listen=>1, 195 ); 196 $s or die "\n"; 197 $s->close(); 198 }; 199 if ($@ eq "") { 200 return 1; 201 } 202 203 eval { 204 require IO::Socket::INET; 205 my $s = IO::Socket::INET->new( 206 LocalAddr => $listenaddress, 207 LocalPort => 0, 208 Listen=>1, 209 ); 210 $s or die "\n"; 211 $s->close(); 212 }; 213 if ($@ eq "") { 214 return 1; 215 } 216 217 return 0; 218} 219 220sub have_IPv4 { 221 if ($have_IPv4 < 0) { 222 $have_IPv4 = check_IP("127.0.0.1"); 223 } 224 return $have_IPv4; 225} 226 227sub have_IPv6 { 228 if ($have_IPv6 < 0) { 229 load_configdata() unless $configdata_loaded; 230 # If OpenSSL is configured with IPv6 explicitly disabled, no IPv6 231 # related tests should be performed. In other words, pretend IPv6 232 # isn't present. 233 $have_IPv6 = 0 234 if grep { $_ eq 'OPENSSL_USE_IPV6=0' } @{$config{CPPDEFINES}}; 235 # Similarly, if a config target has explicitly disabled IPv6, no 236 # IPv6 related tests should be performed. 237 $have_IPv6 = 0 238 if grep { $_ eq 'OPENSSL_USE_IPV6=0' } @{$target{defines}}; 239 } 240 if ($have_IPv6 < 0) { 241 $have_IPv6 = check_IP("::1"); 242 } 243 return $have_IPv6; 244} 245 246=head1 SEE ALSO 247 248L<OpenSSL::Test> 249 250=head1 AUTHORS 251 252Stephen Henson E<lt>steve@openssl.orgE<gt> and 253Richard Levitte E<lt>levitte@openssl.orgE<gt> 254 255=cut 256 2571; 258