• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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
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=item B<anydisabled ARRAY>
57
58In an array context returns an array with each element set to 1 if the
59corresponding feature is disabled and 0 otherwise.
60
61In a scalar context, alldisabled returns 1 if all of the features in
62ARRAY are disabled, while anydisabled returns 1 if any of them are
63disabled.
64
65=item B<config STRING>
66
67Returns an item from the %config hash in \$TOP/configdata.pm.
68
69=item B<have_IPv4>
70=item B<have_IPv6>
71
72Return true if IPv4 / IPv6 is possible to use on the current system.
73
74=back
75
76=cut
77
78our %available_protocols;
79our %disabled;
80our %config;
81my $configdata_loaded = 0;
82
83sub 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()
98sub 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()
106sub 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)
117sub check_disabled {
118    return map { exists $disabled{lc $_} ? 1 : 0 } @_;
119}
120
121# Exported functions #################################################
122
123# args:
124#  list of features to check
125sub 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
134sub 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
144sub disabled {
145    anydisabled(@_);
146}
147
148sub 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
157sub config {
158    load_configdata() unless $configdata_loaded;
159    return $config{$_[0]};
160}
161
162# IPv4 / IPv6 checker
163my $have_IPv4 = -1;
164my $have_IPv6 = -1;
165my $IP_factory;
166sub check_IP {
167    my $listenaddress = shift;
168
169    eval {
170        require IO::Socket::IP;
171        my $s = IO::Socket::IP->new(
172            LocalAddr => $listenaddress,
173            LocalPort => 0,
174            Listen=>1,
175            );
176        $s or die "\n";
177        $s->close();
178    };
179    if ($@ eq "") {
180        return 1;
181    }
182
183    eval {
184        require IO::Socket::INET6;
185        my $s = IO::Socket::INET6->new(
186            LocalAddr => $listenaddress,
187            LocalPort => 0,
188            Listen=>1,
189            );
190        $s or die "\n";
191        $s->close();
192    };
193    if ($@ eq "") {
194        return 1;
195    }
196
197    eval {
198        require IO::Socket::INET;
199        my $s = IO::Socket::INET->new(
200            LocalAddr => $listenaddress,
201            LocalPort => 0,
202            Listen=>1,
203            );
204        $s or die "\n";
205        $s->close();
206    };
207    if ($@ eq "") {
208        return 1;
209    }
210
211    return 0;
212}
213
214sub have_IPv4 {
215    if ($have_IPv4 < 0) {
216        $have_IPv4 = check_IP("127.0.0.1");
217    }
218    return $have_IPv4;
219}
220
221sub have_IPv6 {
222    if ($have_IPv6 < 0) {
223        $have_IPv6 = check_IP("::1");
224    }
225    return $have_IPv6;
226}
227
228
229=head1 SEE ALSO
230
231L<OpenSSL::Test>
232
233=head1 AUTHORS
234
235Stephen Henson E<lt>steve@openssl.orgE<gt> and
236Richard Levitte E<lt>levitte@openssl.orgE<gt>
237
238=cut
239
2401;
241