]>
Commit | Line | Data |
---|---|---|
453dfd8d EK |
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; |