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 11use strict; 12use warnings; 13 14use File::Basename; 15use File::Spec::Functions; 16 17use OpenSSL::Test qw/srctop_dir srctop_file/; 18use OpenSSL::Test::Utils; 19 20# This block needs to run before 'use lib srctop_dir' directives. 21BEGIN { 22 OpenSSL::Test::setup("no_test_here"); 23} 24 25use lib srctop_dir("util", "perl"); # for with_fallback 26use lib srctop_dir("test", "ssl-tests"); # for ssltests_base 27 28use with_fallback qw(Text::Template); 29 30use vars qw/@ISA/; 31push (@ISA, qw/Text::Template/); 32 33use ssltests_base; 34 35sub 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. 126sub 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 136my $input_file = shift; 137# Reads the tests into ssltests::tests. 138read_config($input_file); 139print_templates(); 140 1411; 142