test/generate_ssl_tests.pl

   1 #! /usr/bin/perl
   2 # -*- mode: perl; -*-
   3
   4 ## SSL testcase generator
   5
   6 use strict;
   7 use warnings;
   8
   9 use File::Basename;
  10 use File::Spec::Functions;
  11
  12 use OpenSSL::Test qw/srctop_dir srctop_file/;
  13 use OpenSSL::Test::Utils;
  14
  15 # This block needs to run before 'use lib srctop_dir' directives.
  16 BEGIN {
  17     OpenSSL::Test::setup("no_test_here");
  18 }
  19
  20 use lib srctop_dir("util");  # for with_fallback
  21 use lib srctop_dir("test", "ssl-tests");  # for ssltests_base
  22
  23 use with_fallback qw(Text::Template);
  24
  25 use vars qw/@ISA/;
  26 push (@ISA, qw/Text::Template/);
  27
  28 use ssltests_base;
  29
  30 sub print_templates {
  31     my $source = srctop_file("test", "ssl_test.tmpl");
  32     my $template = Text::Template->new(TYPE => 'FILE', SOURCE => $source);
  33
  34     print "# Generated with generate_ssl_tests.pl\n\n";
  35
  36     my $num = scalar @ssltests::tests;
  37
  38     # Add the implicit base configuration.
  39     foreach my $test (@ssltests::tests) {
  40         $test->{"server"} = { (%ssltests::base_server, %{$test->{"server"}}) };
  41         $test->{"client"} = { (%ssltests::base_client, %{$test->{"client"}}) };
  42     }
  43
  44     # ssl_test expects to find a
  45     #
  46     # num_tests = n
  47     #
  48     # directive in the file. It'll then look for configuration directives
  49     # for n tests, that each look like this:
  50     #
  51     # test-n = test-section
  52     #
  53     # [test-section]
  54     # (SSL modules for client and server configuration go here.)
  55     #
  56     # [test-n]
  57     # (Test configuration goes here.)
  58     print "num_tests = $num\n\n";
  59
  60     # The conf module locations must come before everything else, because
  61     # they look like
  62     #
  63     # test-n = test-section
  64     #
  65     # and you can't mix and match them with sections.
  66     my $idx = 0;
  67
  68     foreach my $test (@ssltests::tests) {
  69         my $testname = "${idx}-" . $test->{'name'};
  70         print "test-$idx = $testname\n";
  71         $idx++;
  72     }
  73
  74     $idx = 0;
  75
  76     foreach my $test (@ssltests::tests) {
  77         my $testname = "${idx}-" . $test->{'name'};
  78         my $text = $template->fill_in(
  79             HASH => [{ idx => $idx, testname => $testname } , $test],
  80             DELIMITERS => [ "{-", "-}" ]);
  81         print "# ===========================================================\n\n";
  82         print "$text\n";
  83         $idx++;
  84     }
  85 }
  86
  87 # Shamelessly copied from Configure.
  88 sub read_config {
  89     my $fname = shift;
  90     open(INPUT, "< $fname")
  91         or die "Can't open input file '$fname'!\n";
  92     local $/ = undef;
  93     my $content = <INPUT>;
  94     close(INPUT);
  95     eval $content;
  96     warn $@ if $@;
  97 }
  98
  99 my $input_file = shift;
 100 # Reads the tests into ssltests::tests.
 101 read_config($input_file);
 102 print_templates();
 103
 104 1;