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 OpenSSL license (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");
  23 }
  24
  25 use lib srctop_dir("util", "perl");  # for with_fallback
  26 use lib srctop_dir("test", "ssl-tests");  # for ssltests_base
  27
  28 use with_fallback qw(Text::Template);
  29
  30 use vars qw/@ISA/;
  31 push (@ISA, qw/Text::Template/);
  32
  33 use ssltests_base;
  34
  35 sub print_templates {
  36     my $source = srctop_file("test", "ssl_test.tmpl");
  37     my $template = Text::Template->new(TYPE => 'FILE', SOURCE => $source);
  38
  39     print "# Generated with generate_ssl_tests.pl\n\n";
  40
  41     my $num = scalar @ssltests::tests;
  42
  43     # Add the implicit base configuration.
  44     foreach my $test (@ssltests::tests) {
  45         $test->{"server"} = { (%ssltests::base_server, %{$test->{"server"}}) };
  46         if (defined $test->{"server2"}) {
  47             $test->{"server2"} = { (%ssltests::base_server, %{$test->{"server2"}}) };
  48         } else {
  49             if ($test->{"server"}->{"extra"} &&
  50                 defined $test->{"server"}->{"extra"}->{"ServerNameCallback"}) {
  51                 # Default is the same as server.
  52                 $test->{"reuse_server2"} = 1;
  53             }
  54             # Do not emit an empty/duplicate "server2" section.
  55             $test->{"server2"} = { };
  56         }
  57         if (defined $test->{"resume_server"}) {
  58             $test->{"resume_server"} = { (%ssltests::base_server, %{$test->{"resume_server"}}) };
  59         } else {
  60             if (defined $test->{"test"}->{"HandshakeMode"} &&
  61                  $test->{"test"}->{"HandshakeMode"} eq "Resume") {
  62                 # Default is the same as server.
  63                 $test->{"reuse_resume_server"} = 1;
  64             }
  65             # Do not emit an empty/duplicate "resume-server" section.
  66             $test->{"resume_server"} = { };
  67         }
  68         $test->{"client"} = { (%ssltests::base_client, %{$test->{"client"}}) };
  69         if (defined $test->{"resume_client"}) {
  70             $test->{"resume_client"} = { (%ssltests::base_client, %{$test->{"resume_client"}}) };
  71         } else {
  72             if (defined $test->{"test"}->{"HandshakeMode"} &&
  73                  $test->{"test"}->{"HandshakeMode"} eq "Resume") {
  74                 # Default is the same as client.
  75                 $test->{"reuse_resume_client"} = 1;
  76             }
  77             # Do not emit an empty/duplicate "resume-client" section.
  78             $test->{"resume_client"} = { };
  79         }
  80     }
  81
  82     # ssl_test expects to find a
  83     #
  84     # num_tests = n
  85     #
  86     # directive in the file. It'll then look for configuration directives
  87     # for n tests, that each look like this:
  88     #
  89     # test-n = test-section
  90     #
  91     # [test-section]
  92     # (SSL modules for client and server configuration go here.)
  93     #
  94     # [test-n]
  95     # (Test configuration goes here.)
  96     print "num_tests = $num\n\n";
  97
  98     # The conf module locations must come before everything else, because
  99     # they look like
 100     #
 101     # test-n = test-section
 102     #
 103     # and you can't mix and match them with sections.
 104     my $idx = 0;
 105
 106     foreach my $test (@ssltests::tests) {
 107         my $testname = "${idx}-" . $test->{'name'};
 108         print "test-$idx = $testname\n";
 109         $idx++;
 110     }
 111
 112     $idx = 0;
 113
 114     foreach my $test (@ssltests::tests) {
 115         my $testname = "${idx}-" . $test->{'name'};
 116         my $text = $template->fill_in(
 117             HASH => [{ idx => $idx, testname => $testname } , $test],
 118             DELIMITERS => [ "{-", "-}" ]);
 119         print "# ===========================================================\n\n";
 120         print "$text\n";
 121         $idx++;
 122     }
 123 }
 124
 125 # Shamelessly copied from Configure.
 126 sub read_config {
 127     my $fname = shift;
 128     open(INPUT, "< $fname") or die "Can't open input file '$fname'!\n";
 129     local $/ = undef;
 130     my $content = <INPUT>;
 131     close(INPUT);
 132     eval $content;
 133     warn $@ if $@;
 134 }
 135
 136 my $input_file = shift;
 137 # Reads the tests into ssltests::tests.
 138 read_config($input_file);
 139 print_templates();
 140
 141 1;