test/testlib/OpenSSL/Test/Utils.pm

   1 package OpenSSL::Test::Utils;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Exporter;
   7 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
   8 $VERSION = "0.1";
   9 @ISA = qw(Exporter);
  10 @EXPORT = qw(alldisabled anydisabled disabled config available_protocols);
  11
  12 =head1 NAME
  13
  14 OpenSSL::Test::Utils - test utility functions
  15
  16 =head1 SYNOPSIS
  17
  18   use OpenSSL::Test::Utils;
  19
  20   my @tls = available_protocols("tls");
  21   my @dtls = available_protocols("dtls");
  22   alldisabled("dh", "dsa");
  23   anydisabled("dh", "dsa");
  24
  25   config("fips");
  26
  27 =head1 DESCRIPTION
  28
  29 This module provides utility functions for the testing framework.
  30
  31 =cut
  32
  33 use OpenSSL::Test qw/:DEFAULT top_file/;
  34
  35 =over 4
  36
  37 =item B<available_protocols STRING>
  38
  39 Returns a list of strings for all the available SSL/TLS versions if
  40 STRING is "tls", or for all the available DTLS versions if STRING is
  41 "dtls".  Otherwise, it returns the empty list.  The strings in the
  42 returned list can be used with B<alldisabled> and B<anydisabled>.
  43
  44 =item B<alldisabled ARRAY>
  45 =item B<anydisabled ARRAY>
  46
  47 In an array context returns an array with each element set to 1 if the
  48 corresponding feature is disabled and 0 otherwise.
  49
  50 In a scalar context, alldisabled returns 1 if all of the features in
  51 ARRAY are disabled, while anydisabled returns 1 if any of them are
  52 disabled.
  53
  54 =item B<config STRING>
  55
  56 Returns an item from the %config hash in \$TOP/configdata.pm.
  57
  58 =back
  59
  60 =cut
  61
  62 our %available_protocols;
  63 our %disabled;
  64 our %config;
  65 my $configdata_loaded = 0;
  66
  67 sub load_configdata {
  68     # We eval it so it doesn't run at compile time of this file.
  69     # The latter would have top_dir() complain that setup() hasn't
  70     # been run yet.
  71     my $configdata = top_file("configdata.pm");
  72     eval { require $configdata;
  73            %available_protocols = %configdata::available_protocols;
  74            %disabled = %configdata::disabled;
  75            %config = %configdata::config;
  76     };
  77     $configdata_loaded = 1;
  78 }
  79
  80 # args
  81 #  list of 1s and 0s, coming from check_disabled()
  82 sub anyof {
  83     my $x = 0;
  84     foreach (@_) { $x += $_ }
  85     return $x > 0;
  86 }
  87
  88 # args
  89 #  list of 1s and 0s, coming from check_disabled()
  90 sub allof {
  91     my $x = 1;
  92     foreach (@_) { $x *= $_ }
  93     return $x > 0;
  94 }
  95
  96 # args
  97 #  list of strings, all of them should be names of features
  98 #  that can be disabled.
  99 # returns a list of 1s (if the corresponding feature is disabled)
 100 #  and 0s (if it isn't)
 101 sub check_disabled {
 102     return map { exists $disabled{lc $_} ? 1 : 0 } @_;
 103 }
 104
 105 # Exported functions #################################################
 106
 107 # args:
 108 #  list of features to check
 109 sub anydisabled {
 110     load_configdata() unless $configdata_loaded;
 111     my @ret = check_disabled(@_);
 112     return @ret if wantarray;
 113     return anyof(@ret);
 114 }
 115
 116 # args:
 117 #  list of features to check
 118 sub alldisabled {
 119     load_configdata() unless $configdata_loaded;
 120     my @ret = check_disabled(@_);
 121     return @ret if wantarray;
 122     return allof(@ret);
 123 }
 124
 125 #!!! Kept for backward compatibility
 126 # args:
 127 #  single string
 128 sub disabled {
 129     anydisabled(@_);
 130 }
 131
 132 sub available_protocols {
 133     load_configdata() unless $configdata_loaded;
 134     my $protocol_class = shift;
 135     if (exists $available_protocols{lc $protocol_class}) {
 136         return @{$available_protocols{lc $protocol_class}}
 137     }
 138     return ();
 139 }
 140
 141 sub config {
 142     return $config{$_[0]};
 143 }
 144
 145 =head1 SEE ALSO
 146
 147 L<OpenSSL::Test>
 148
 149 =head1 AUTHORS
 150
 151 Stephen Henson E<lt>steve@openssl.orgE<gt> and
 152 Richard Levitte E<lt>levitte@openssl.orgE<gt>
 153
 154 =cut
 155
 156 1;