1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
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;
|
