xref: /netbsd-src/crypto/external/bsd/openssl/dist/test/ssl-tests/protocol_version.pm (revision bdc22b2e01993381dcefeff2bc9b56ca75a4235c)
1# -*- mode: perl; -*-
2# Copyright 2016-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
10## Test version negotiation
11
12package ssltests;
13
14use strict;
15use warnings;
16
17use List::Util qw/max min/;
18
19use OpenSSL::Test;
20use OpenSSL::Test::Utils qw/anydisabled alldisabled/;
21setup("no_test_here");
22
23my @tls_protocols = ("SSLv3", "TLSv1", "TLSv1.1", "TLSv1.2");
24# undef stands for "no limit".
25my @min_tls_protocols = (undef, "SSLv3", "TLSv1", "TLSv1.1", "TLSv1.2");
26my @max_tls_protocols = ("SSLv3", "TLSv1", "TLSv1.1", "TLSv1.2", undef);
27
28my @is_tls_disabled = anydisabled("ssl3", "tls1", "tls1_1", "tls1_2");
29
30my $min_tls_enabled; my $max_tls_enabled;
31
32# Protocol configuration works in cascades, i.e.,
33# $no_tls1_1 disables TLSv1.1 and below.
34#
35# $min_enabled and $max_enabled will be correct if there is at least one
36# protocol enabled.
37foreach my $i (0..$#tls_protocols) {
38    if (!$is_tls_disabled[$i]) {
39        $min_tls_enabled = $i;
40        last;
41    }
42}
43
44foreach my $i (0..$#tls_protocols) {
45    if (!$is_tls_disabled[$i]) {
46        $max_tls_enabled = $i;
47    }
48}
49
50my @dtls_protocols = ("DTLSv1", "DTLSv1.2");
51# undef stands for "no limit".
52my @min_dtls_protocols = (undef, "DTLSv1", "DTLSv1.2");
53my @max_dtls_protocols = ("DTLSv1", "DTLSv1.2", undef);
54
55my @is_dtls_disabled = anydisabled("dtls1", "dtls1_2");
56
57my $min_dtls_enabled; my $max_dtls_enabled;
58
59# $min_enabled and $max_enabled will be correct if there is at least one
60# protocol enabled.
61foreach my $i (0..$#dtls_protocols) {
62    if (!$is_dtls_disabled[$i]) {
63        $min_dtls_enabled = $i;
64        last;
65    }
66}
67
68foreach my $i (0..$#dtls_protocols) {
69    if (!$is_dtls_disabled[$i]) {
70        $max_dtls_enabled = $i;
71    }
72}
73
74sub no_tests {
75    my ($dtls) = @_;
76    return $dtls ? alldisabled("dtls1", "dtls1_2") :
77      alldisabled("ssl3", "tls1", "tls1_1", "tls1_2");
78}
79
80sub generate_version_tests {
81    my ($method) = @_;
82
83    my $dtls = $method eq "DTLS";
84    # Don't write the redundant "Method = TLS" into the configuration.
85    undef $method if !$dtls;
86
87    my @protocols = $dtls ? @dtls_protocols : @tls_protocols;
88    my @min_protocols = $dtls ? @min_dtls_protocols : @min_tls_protocols;
89    my @max_protocols = $dtls ? @max_dtls_protocols : @max_tls_protocols;
90    my $min_enabled  = $dtls ? $min_dtls_enabled : $min_tls_enabled;
91    my $max_enabled  = $dtls ? $max_dtls_enabled : $max_tls_enabled;
92
93    if (no_tests($dtls)) {
94        return;
95    }
96
97    my @tests = ();
98
99    foreach my $c_min (0..$#min_protocols) {
100        my $c_max_min = $c_min == 0 ? 0 : $c_min - 1;
101        foreach my $c_max ($c_max_min..$#max_protocols) {
102            foreach my $s_min (0..$#min_protocols) {
103                my $s_max_min = $s_min == 0 ? 0 : $s_min - 1;
104                foreach my $s_max ($s_max_min..$#max_protocols) {
105                    my ($result, $protocol) =
106                        expected_result($c_min, $c_max, $s_min, $s_max,
107                                        $min_enabled, $max_enabled, \@protocols);
108                    push @tests, {
109                        "name" => "version-negotiation",
110                        "client" => {
111                            "MinProtocol" => $min_protocols[$c_min],
112                            "MaxProtocol" => $max_protocols[$c_max],
113                        },
114                        "server" => {
115                            "MinProtocol" => $min_protocols[$s_min],
116                            "MaxProtocol" => $max_protocols[$s_max],
117                        },
118                        "test" => {
119                            "ExpectedResult" => $result,
120                            "ExpectedProtocol" => $protocol,
121                            "Method" => $method,
122                        }
123                    };
124                }
125            }
126        }
127    }
128    return @tests;
129}
130
131sub generate_resumption_tests {
132    my ($method) = @_;
133
134    my $dtls = $method eq "DTLS";
135    # Don't write the redundant "Method = TLS" into the configuration.
136    undef $method if !$dtls;
137
138    my @protocols = $dtls ? @dtls_protocols : @tls_protocols;
139    my $min_enabled  = $dtls ? $min_dtls_enabled : $min_tls_enabled;
140
141    if (no_tests($dtls)) {
142        return;
143    }
144
145    my @server_tests = ();
146    my @client_tests = ();
147
148    # Obtain the first session against a fixed-version server/client.
149    foreach my $original_protocol($min_enabled..$#protocols) {
150        # Upgrade or downgrade the server/client max version support and test
151        # that it upgrades, downgrades or resumes the session as well.
152        foreach my $resume_protocol($min_enabled..$#protocols) {
153            my $resumption_expected;
154            # We should only resume on exact version match.
155            if ($original_protocol eq $resume_protocol) {
156                $resumption_expected = "Yes";
157            } else {
158                $resumption_expected = "No";
159            }
160
161            foreach my $ticket ("SessionTicket", "-SessionTicket") {
162                # Client is flexible, server upgrades/downgrades.
163                push @server_tests, {
164                    "name" => "resumption",
165                    "client" => { },
166                    "server" => {
167                        "MinProtocol" => $protocols[$original_protocol],
168                        "MaxProtocol" => $protocols[$original_protocol],
169                        "Options" => $ticket,
170                    },
171                    "resume_server" => {
172                        "MaxProtocol" => $protocols[$resume_protocol],
173                    },
174                    "test" => {
175                        "ExpectedProtocol" => $protocols[$resume_protocol],
176                        "Method" => $method,
177                        "HandshakeMode" => "Resume",
178                        "ResumptionExpected" => $resumption_expected,
179                    }
180                };
181                # Server is flexible, client upgrades/downgrades.
182                push @client_tests, {
183                    "name" => "resumption",
184                    "client" => {
185                        "MinProtocol" => $protocols[$original_protocol],
186                        "MaxProtocol" => $protocols[$original_protocol],
187                    },
188                    "server" => {
189                        "Options" => $ticket,
190                    },
191                    "resume_client" => {
192                        "MaxProtocol" => $protocols[$resume_protocol],
193                    },
194                    "test" => {
195                        "ExpectedProtocol" => $protocols[$resume_protocol],
196                        "Method" => $method,
197                        "HandshakeMode" => "Resume",
198                        "ResumptionExpected" => $resumption_expected,
199                    }
200                };
201            }
202        }
203    }
204
205    return (@server_tests, @client_tests);
206}
207
208sub expected_result {
209    my ($c_min, $c_max, $s_min, $s_max, $min_enabled, $max_enabled,
210        $protocols) = @_;
211
212    # Adjust for "undef" (no limit).
213    $c_min = $c_min == 0 ? 0 : $c_min - 1;
214    $c_max = $c_max == scalar @$protocols ? $c_max - 1 : $c_max;
215    $s_min = $s_min == 0 ? 0 : $s_min - 1;
216    $s_max = $s_max == scalar @$protocols ? $s_max - 1 : $s_max;
217
218    # We now have at least one protocol enabled, so $min_enabled and
219    # $max_enabled are well-defined.
220    $c_min = max $c_min, $min_enabled;
221    $s_min = max $s_min, $min_enabled;
222    $c_max = min $c_max, $max_enabled;
223    $s_max = min $s_max, $max_enabled;
224
225    if ($c_min > $c_max) {
226        # Client should fail to even send a hello.
227        # This results in an internal error since the server will be
228        # waiting for input that never arrives.
229        return ("InternalError", undef);
230    } elsif ($s_min > $s_max) {
231        # Server has no protocols, should always fail.
232        return ("ServerFail", undef);
233    } elsif ($s_min > $c_max) {
234        # Server doesn't support the client range.
235        return ("ServerFail", undef);
236    } elsif ($c_min > $s_max) {
237        # Server will try with a version that is lower than the lowest
238        # supported client version.
239        return ("ClientFail", undef);
240    } else {
241        # Server and client ranges overlap.
242        my $max_common = $s_max < $c_max ? $s_max : $c_max;
243        return ("Success", $protocols->[$max_common]);
244    }
245}
246
2471;
248