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