test/generate_ssl_tests.pl

   1 #! /usr/bin/env perl
   2 # Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
   3 #
   4 # Licensed under the Apache License 2.0 (the "License").  You may not use
   5 # this file except in compliance with the License.  You can obtain a copy
   6 # in the file LICENSE in the source distribution or at
   7 # https://www.openssl.org/source/license.html
   8
   9 ## SSL testcase generator
  10
  11 use strict;
  12 use warnings;
  13
  14 use File::Basename;
  15 use File::Spec::Functions;
  16
  17 use OpenSSL::Test qw/srctop_dir srctop_file/;
  18 use OpenSSL::Test::Utils;
  19
  20 # This block needs to run before 'use lib srctop_dir' directives.
  21 BEGIN {
  22     OpenSSL::Test::setup("no_test_here", quiet => 1);
  23 }
  24
  25 use FindBin;
  26 use lib "$FindBin::Bin/../util/perl";
  27 use OpenSSL::fallback "$FindBin::Bin/../external/perl/MODULES.txt";
  28 use Text::Template 1.46;
  29
  30 use lib "$FindBin::Bin/ssl-tests";
  31
  32 use vars qw/@ISA/;
  33 push (@ISA, qw/Text::Template/);
  34
  35 use ssltests_base;
  36
  37 sub print_templates {
  38     my $source = srctop_file("test", "ssl_test.tmpl");
  39     my $template = Text::Template->new(TYPE => 'FILE', SOURCE => $source);
  40
  41     print "# Generated with generate_ssl_tests.pl\n\n";
  42
  43     my $num = scalar @ssltests::tests;
  44
  45     # Add the implicit base configuration.
  46     foreach my $test (@ssltests::tests) {
  47         $test->{"server"} = { (%ssltests::base_server, %{$test->{"server"}}) };
  48         if (defined $test->{"server2"}) {
  49             $test->{"server2"} = { (%ssltests::base_server, %{$test->{"server2"}}) };
  50         } else {
  51             if ($test->{"server"}->{"extra"} &&
  52                 defined $test->{"server"}->{"extra"}->{"ServerNameCallback"}) {
  53                 # Default is the same as server.
  54                 $test->{"reuse_server2"} = 1;
  55             }
  56             # Do not emit an empty/duplicate "server2" section.
  57             $test->{"server2"} = { };
  58         }
  59         if (defined $test->{"resume_server"}) {
  60             $test->{"resume_server"} = { (%ssltests::base_server, %{$test->{"resume_server"}}) };
  61         } else {
  62             if (defined $test->{"test"}->{"HandshakeMode"} &&
  63                  $test->{"test"}->{"HandshakeMode"} eq "Resume") {
  64                 # Default is the same as server.
  65                 $test->{"reuse_resume_server"} = 1;
  66             }
  67             # Do not emit an empty/duplicate "resume-server" section.
  68             $test->{"resume_server"} = { };
  69         }
  70         $test->{"client"} = { (%ssltests::base_client, %{$test->{"client"}}) };
  71         if (defined $test->{"resume_client"}) {
  72             $test->{"resume_client"} = { (%ssltests::base_client, %{$test->{"resume_client"}}) };
  73         } else {
  74             if (defined $test->{"test"}->{"HandshakeMode"} &&
  75                  $test->{"test"}->{"HandshakeMode"} eq "Resume") {
  76                 # Default is the same as client.
  77                 $test->{"reuse_resume_client"} = 1;
  78             }
  79             # Do not emit an empty/duplicate "resume-client" section.
  80             $test->{"resume_client"} = { };
  81         }
  82     }
  83
  84     # ssl_test expects to find a
  85     #
  86     # num_tests = n
  87     #
  88     # directive in the file. It'll then look for configuration directives
  89     # for n tests, that each look like this:
  90     #
  91     # test-n = test-section
  92     #
  93     # [test-section]
  94     # (SSL modules for client and server configuration go here.)
  95     #
  96     # [test-n]
  97     # (Test configuration goes here.)
  98     print "num_tests = $num\n\n";
  99
 100     # The conf module locations must come before everything else, because
 101     # they look like
 102     #
 103     # test-n = test-section
 104     #
 105     # and you can't mix and match them with sections.
 106     my $idx = 0;
 107
 108     foreach my $test (@ssltests::tests) {
 109         my $testname = "${idx}-" . $test->{'name'};
 110         print "test-$idx = $testname\n";
 111         $idx++;
 112     }
 113
 114     $idx = 0;
 115
 116     foreach my $test (@ssltests::tests) {
 117         my $testname = "${idx}-" . $test->{'name'};
 118         my $text = $template->fill_in(
 119             HASH => [{ idx => $idx, testname => $testname } , $test],
 120             DELIMITERS => [ "{-", "-}" ]);
 121         print "# ===========================================================\n\n";
 122         print "$text\n";
 123         $idx++;
 124     }
 125 }
 126
 127 # Shamelessly copied from Configure.
 128 sub read_config {
 129     my $fname = shift;
 130     my $provider = shift;
 131     my $fips_mode = "0";
 132     my $no_deflt_libctx = "0";
 133
 134     $fips_mode = "1" if $provider eq "fips";
 135     $no_deflt_libctx = "1" if $provider eq "default" || $provider eq "fips";
 136
 137     open(INPUT, "< $fname") or die "Can't open input file '$fname'!\n";
 138     local $/ = undef;
 139     my $content = <INPUT>;
 140     $content =~ s/FIPS_MODE/$fips_mode/g;
 141     $content =~ s/NO_DEFLT_LIBCTX/$no_deflt_libctx/g;
 142
 143     close(INPUT);
 144     eval $content;
 145     warn $@ if $@;
 146 }
 147
 148 my $input_file = shift;
 149 my $provider = shift;
 150 # Reads the tests into ssltests::tests.
 151 read_config($input_file, $provider);
 152 print_templates();
 153
 154 1;