Home | History | Annotate | Line # | Download | only in test 
      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;
    142