util/perl/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;