Copyright consolidation; .pm and Configure
[openssl.git] / test / testlib / OpenSSL / Test / Utils.pm
1 # Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
2 #
3 # Licensed under the OpenSSL license (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
8 package OpenSSL::Test::Utils;
9
10 use strict;
11 use warnings;
12
13 use Exporter;
14 use 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
22 OpenSSL::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
40 This module provides utility functions for the testing framework.
41
42 =cut
43
44 use OpenSSL::Test qw/:DEFAULT bldtop_file/;
45
46 =over 4
47
48 =item B<available_protocols STRING>
49
50 Returns a list of strings for all the available SSL/TLS versions if
51 STRING is "tls", or for all the available DTLS versions if STRING is
52 "dtls".  Otherwise, it returns the empty list.  The strings in the
53 returned list can be used with B<alldisabled> and B<anydisabled>.
54
55 =item B<alldisabled ARRAY>
56 =item B<anydisabled ARRAY>
57
58 In an array context returns an array with each element set to 1 if the
59 corresponding feature is disabled and 0 otherwise.
60
61 In a scalar context, alldisabled returns 1 if all of the features in
62 ARRAY are disabled, while anydisabled returns 1 if any of them are
63 disabled.
64
65 =item B<config STRING>
66
67 Returns an item from the %config hash in \$TOP/configdata.pm.
68
69 =item B<have_IPv4>
70 =item B<have_IPv6>
71
72 Return true if IPv4 / IPv6 is possible to use on the current system.
73
74 =back
75
76 =cut
77
78 our %available_protocols;
79 our %disabled;
80 our %config;
81 my $configdata_loaded = 0;
82
83 sub load_configdata {
84     # We eval it so it doesn't run at compile time of this file.
85     # The latter would have bldtop_file() complain that setup() hasn't
86     # been run yet.
87     my $configdata = bldtop_file("configdata.pm");
88     eval { require $configdata;
89            %available_protocols = %configdata::available_protocols;
90            %disabled = %configdata::disabled;
91            %config = %configdata::config;
92     };
93     $configdata_loaded = 1;
94 }
95
96 # args
97 #  list of 1s and 0s, coming from check_disabled()
98 sub anyof {
99     my $x = 0;
100     foreach (@_) { $x += $_ }
101     return $x > 0;
102 }
103
104 # args
105 #  list of 1s and 0s, coming from check_disabled()
106 sub allof {
107     my $x = 1;
108     foreach (@_) { $x *= $_ }
109     return $x > 0;
110 }
111
112 # args
113 #  list of strings, all of them should be names of features
114 #  that can be disabled.
115 # returns a list of 1s (if the corresponding feature is disabled)
116 #  and 0s (if it isn't)
117 sub check_disabled {
118     return map { exists $disabled{lc $_} ? 1 : 0 } @_;
119 }
120
121 # Exported functions #################################################
122
123 # args:
124 #  list of features to check
125 sub anydisabled {
126     load_configdata() unless $configdata_loaded;
127     my @ret = check_disabled(@_);
128     return @ret if wantarray;
129     return anyof(@ret);
130 }
131
132 # args:
133 #  list of features to check
134 sub alldisabled {
135     load_configdata() unless $configdata_loaded;
136     my @ret = check_disabled(@_);
137     return @ret if wantarray;
138     return allof(@ret);
139 }
140
141 # !!! Kept for backward compatibility
142 # args:
143 #  single string
144 sub disabled {
145     anydisabled(@_);
146 }
147
148 sub available_protocols {
149     load_configdata() unless $configdata_loaded;
150     my $protocol_class = shift;
151     if (exists $available_protocols{lc $protocol_class}) {
152         return @{$available_protocols{lc $protocol_class}}
153     }
154     return ();
155 }
156
157 sub config {
158     return $config{$_[0]};
159 }
160
161 # IPv4 / IPv6 checker
162 my $have_IPv4 = -1;
163 my $have_IPv6 = -1;
164 my $IP_factory;
165 sub check_IP {
166     my $listenaddress = shift;
167
168     eval {
169         require IO::Socket::IP;
170         my $s = IO::Socket::IP->new(
171             LocalAddr => $listenaddress,
172             LocalPort => 0,
173             Listen=>1,
174             );
175         $s or die "\n";
176         $s->close();
177     };
178     if ($@ eq "") {
179         return 1;
180     }
181
182     eval {
183         require IO::Socket::INET6;
184         my $s = IO::Socket::INET6->new(
185             LocalAddr => $listenaddress,
186             LocalPort => 0,
187             Listen=>1,
188             );
189         $s or die "\n";
190         $s->close();
191     };
192     if ($@ eq "") {
193         return 1;
194     }
195
196     eval {
197         require IO::Socket::INET;
198         my $s = IO::Socket::INET->new(
199             LocalAddr => $listenaddress,
200             LocalPort => 0,
201             Listen=>1,
202             );
203         $s or die "\n";
204         $s->close();
205     };
206     if ($@ eq "") {
207         return 1;
208     }
209
210     return 0;
211 }
212
213 sub have_IPv4 {
214     if ($have_IPv4 < 0) {
215         $have_IPv4 = check_IP("127.0.0.1");
216     }
217     return $have_IPv4;
218 }
219
220 sub have_IPv6 {
221     if ($have_IPv6 < 0) {
222         $have_IPv6 = check_IP("::1");
223     }
224     return $have_IPv6;
225 }
226
227
228 =head1 SEE ALSO
229
230 L<OpenSSL::Test>
231
232 =head1 AUTHORS
233
234 Stephen Henson E<lt>steve@openssl.orgE<gt> and
235 Richard Levitte E<lt>levitte@openssl.orgE<gt>
236
237 =cut
238
239 1;