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	   no warnings 'once';
95	   %available_protocols = %configdata::available_protocols;
96	   %disabled = %configdata::disabled;
97	   %config = %configdata::config;
98	   %target = %configdata::target;
99    };
100    $configdata_loaded = 1;
101}
102
103# args
104#  list of 1s and 0s, coming from check_disabled()
105sub anyof {
106    my $x = 0;
107    foreach (@_) { $x += $_ }
108    return $x > 0;
109}
110
111# args
112#  list of 1s and 0s, coming from check_disabled()
113sub allof {
114    my $x = 1;
115    foreach (@_) { $x *= $_ }
116    return $x > 0;
117}
118
119# args
120#  list of strings, all of them should be names of features
121#  that can be disabled.
122# returns a list of 1s (if the corresponding feature is disabled)
123#  and 0s (if it isn't)
124sub check_disabled {
125    return map { exists $disabled{lc $_} ? 1 : 0 } @_;
126}
127
128# Exported functions #################################################
129
130# args:
131#  list of features to check
132sub anydisabled {
133    load_configdata() unless $configdata_loaded;
134    my @ret = check_disabled(@_);
135    return @ret if wantarray;
136    return anyof(@ret);
137}
138
139# args:
140#  list of features to check
141sub alldisabled {
142    load_configdata() unless $configdata_loaded;
143    my @ret = check_disabled(@_);
144    return @ret if wantarray;
145    return allof(@ret);
146}
147
148# !!! Kept for backward compatibility
149# args:
150#  single string
151sub disabled {
152    anydisabled(@_);
153}
154
155sub available_protocols {
156    load_configdata() unless $configdata_loaded;
157    my $protocol_class = shift;
158    if (exists $available_protocols{lc $protocol_class}) {
159	return @{$available_protocols{lc $protocol_class}}
160    }
161    return ();
162}
163
164sub config {
165    load_configdata() unless $configdata_loaded;
166    return $config{$_[0]};
167}
168
169# IPv4 / IPv6 checker
170my $have_IPv4 = -1;
171my $have_IPv6 = -1;
172my $IP_factory;
173sub check_IP {
174    my $listenaddress = shift;
175
176    eval {
177        require IO::Socket::IP;
178        my $s = IO::Socket::IP->new(
179            LocalAddr => $listenaddress,
180            LocalPort => 0,
181            Listen=>1,
182            );
183        $s or die "\n";
184        $s->close();
185    };
186    if ($@ eq "") {
187        return 1;
188    }
189
190    eval {
191        require IO::Socket::INET6;
192        my $s = IO::Socket::INET6->new(
193            LocalAddr => $listenaddress,
194            LocalPort => 0,
195            Listen=>1,
196            );
197        $s or die "\n";
198        $s->close();
199    };
200    if ($@ eq "") {
201        return 1;
202    }
203
204    eval {
205        require IO::Socket::INET;
206        my $s = IO::Socket::INET->new(
207            LocalAddr => $listenaddress,
208            LocalPort => 0,
209            Listen=>1,
210            );
211        $s or die "\n";
212        $s->close();
213    };
214    if ($@ eq "") {
215        return 1;
216    }
217
218    return 0;
219}
220
221sub have_IPv4 {
222    if ($have_IPv4 < 0) {
223        $have_IPv4 = check_IP("127.0.0.1");
224    }
225    return $have_IPv4;
226}
227
228sub have_IPv6 {
229    if ($have_IPv6 < 0) {
230        load_configdata() unless $configdata_loaded;
231        # If OpenSSL is configured with IPv6 explicitly disabled, no IPv6
232        # related tests should be performed.  In other words, pretend IPv6
233        # isn't present.
234        $have_IPv6 = 0
235            if grep { $_ eq 'OPENSSL_USE_IPV6=0' } @{$config{CPPDEFINES}};
236        # Similarly, if a config target has explicitly disabled IPv6, no
237        # IPv6 related tests should be performed.
238        $have_IPv6 = 0
239            if grep { $_ eq 'OPENSSL_USE_IPV6=0' } @{$target{defines}};
240    }
241    if ($have_IPv6 < 0) {
242        $have_IPv6 = check_IP("::1");
243    }
244    return $have_IPv6;
245}
246
247=head1 SEE ALSO
248
249L<OpenSSL::Test>
250
251=head1 AUTHORS
252
253Stephen Henson E<lt>steve@openssl.orgE<gt> and
254Richard Levitte E<lt>levitte@openssl.orgE<gt>
255
256=cut
257
2581;
259