generate_ssl_tests.pl 4.4 KB

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