Add some SSLv2 ClientHello tests
[openssl.git] / util / TLSProxy / Record.pm
1 # Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
2 #
3 # Licensed under the OpenSSL license (the "License").  You may not use
4 # this file except in compliance with the License.  You can obtain a copy
5 # in the file LICENSE in the source distribution or at
6 # https://www.openssl.org/source/license.html
7
8 use strict;
9
10 use TLSProxy::Proxy;
11
12 package TLSProxy::Record;
13
14 my $server_ccs_seen = 0;
15 my $client_ccs_seen = 0;
16 my $etm = 0;
17
18 use constant TLS_RECORD_HEADER_LENGTH => 5;
19
20 #Record types
21 use constant {
22     RT_APPLICATION_DATA => 23,
23     RT_HANDSHAKE => 22,
24     RT_ALERT => 21,
25     RT_CCS => 20
26 };
27
28 my %record_type = (
29     RT_APPLICATION_DATA, "APPLICATION DATA",
30     RT_HANDSHAKE, "HANDSHAKE",
31     RT_ALERT, "ALERT",
32     RT_CCS, "CCS"
33 );
34
35 use constant {
36     VERS_TLS_1_3 => 772,
37     VERS_TLS_1_2 => 771,
38     VERS_TLS_1_1 => 770,
39     VERS_TLS_1_0 => 769,
40     VERS_SSL_3_0 => 768,
41     VERS_SSL_LT_3_0 => 767
42 };
43
44 my %tls_version = (
45     VERS_TLS_1_3, "TLS1.3",
46     VERS_TLS_1_2, "TLS1.2",
47     VERS_TLS_1_1, "TLS1.1",
48     VERS_TLS_1_0, "TLS1.0",
49     VERS_SSL_3_0, "SSL3",
50     VERS_SSL_LT_3_0, "SSL<3"
51 );
52
53 #Class method to extract records from a packet of data
54 sub get_records
55 {
56     my $class = shift;
57     my $server = shift;
58     my $flight = shift;
59     my $packet = shift;
60     my @record_list = ();
61     my @message_list = ();
62     my $data;
63     my $content_type;
64     my $version;
65     my $len;
66     my $len_real;
67     my $decrypt_len;
68
69     my $recnum = 1;
70     while (length ($packet) > 0) {
71         print " Record $recnum";
72         if ($server) {
73             print " (server -> client)\n";
74         } else {
75             print " (client -> server)\n";
76         }
77         #Get the record header
78         if (length($packet) < TLS_RECORD_HEADER_LENGTH) {
79             print "Partial data : ".length($packet)." bytes\n";
80             $packet = "";
81         } else {
82             ($content_type, $version, $len) = unpack('CnnC*', $packet);
83             $data = substr($packet, 5, $len);
84
85             print "  Content type: ".$record_type{$content_type}."\n";
86             print "  Version: $tls_version{$version}\n";
87             print "  Length: $len";
88             if ($len == length($data)) {
89                 print "\n";
90                 $decrypt_len = $len_real = $len;
91             } else {
92                 print " (expected), ".length($data)." (actual)\n";
93                 $decrypt_len = $len_real = length($data);
94             }
95
96             my $record = TLSProxy::Record->new(
97                 $flight,
98                 $content_type,
99                 $version,
100                 $len,
101                 0,
102                 $len_real,
103                 $decrypt_len,
104                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real),
105                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real)
106             );
107
108             if (($server && $server_ccs_seen)
109                      || (!$server && $client_ccs_seen)) {
110                 if ($etm) {
111                     $record->decryptETM();
112                 } else {
113                     $record->decrypt();
114                 }
115             }
116
117             push @record_list, $record;
118
119             #Now figure out what messages are contained within this record
120             my @messages = TLSProxy::Message->get_messages($server, $record);
121             push @message_list, @messages;
122
123             $packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len_real);
124             $recnum++;
125         }
126     }
127
128     return (\@record_list, \@message_list);
129 }
130
131 sub clear
132 {
133     $server_ccs_seen = 0;
134     $client_ccs_seen = 0;
135 }
136
137 #Class level accessors
138 sub server_ccs_seen
139 {
140     my $class = shift;
141     if (@_) {
142       $server_ccs_seen = shift;
143     }
144     return $server_ccs_seen;
145 }
146 sub client_ccs_seen
147 {
148     my $class = shift;
149     if (@_) {
150       $client_ccs_seen = shift;
151     }
152     return $client_ccs_seen;
153 }
154 #Enable/Disable Encrypt-then-MAC
155 sub etm
156 {
157     my $class = shift;
158     if (@_) {
159       $etm = shift;
160     }
161     return $etm;
162 }
163
164 sub new
165 {
166     my $class = shift;
167     my ($flight,
168         $content_type,
169         $version,
170         $len,
171         $sslv2,
172         $len_real,
173         $decrypt_len,
174         $data,
175         $decrypt_data) = @_;
176     
177     my $self = {
178         flight => $flight,
179         content_type => $content_type,
180         version => $version,
181         len => $len,
182         sslv2 => $sslv2,
183         len_real => $len_real,
184         decrypt_len => $decrypt_len,
185         data => $data,
186         decrypt_data => $decrypt_data,
187         orig_decrypt_data => $decrypt_data
188     };
189
190     return bless $self, $class;
191 }
192
193 #Decrypt using encrypt-then-MAC
194 sub decryptETM
195 {
196     my ($self) = shift;
197
198     my $data = $self->data;
199
200     if($self->version >= VERS_TLS_1_1()) {
201         #TLS1.1+ has an explicit IV. Throw it away
202         $data = substr($data, 16);
203     }
204
205     #Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
206     $data = substr($data, 0, length($data) - 20);
207
208     #Find out what the padding byte is
209     my $padval = unpack("C", substr($data, length($data) - 1));
210
211     #Throw away the padding
212     $data = substr($data, 0, length($data) - ($padval + 1));
213
214     $self->decrypt_data($data);
215     $self->decrypt_len(length($data));
216
217     return $data;
218 }
219
220 #Standard decrypt
221 sub decrypt()
222 {
223     my ($self) = shift;
224
225     my $data = $self->data;
226
227     if($self->version >= VERS_TLS_1_1()) {
228         #TLS1.1+ has an explicit IV. Throw it away
229         $data = substr($data, 16);
230     }
231
232     #Find out what the padding byte is
233     my $padval = unpack("C", substr($data, length($data) - 1));
234
235     #Throw away the padding
236     $data = substr($data, 0, length($data) - ($padval + 1));
237
238     #Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
239     $data = substr($data, 0, length($data) - 20);
240
241     $self->decrypt_data($data);
242     $self->decrypt_len(length($data));
243
244     return $data;
245 }
246
247 #Reconstruct the on-the-wire record representation
248 sub reconstruct_record
249 {
250     my $self = shift;
251     my $data;
252
253     if ($self->sslv2) {
254         $data = pack('n', $self->len | 0x8000);
255     } else {
256         $data = pack('Cnn', $self->content_type, $self->version, $self->len);
257     }
258     $data .= $self->data;
259
260     return $data;
261 }
262
263 #Read only accessors
264 sub flight
265 {
266     my $self = shift;
267     return $self->{flight};
268 }
269 sub content_type
270 {
271     my $self = shift;
272     return $self->{content_type};
273 }
274 sub version
275 {
276     my $self = shift;
277     return $self->{version};
278 }
279 sub sslv2
280 {
281     my $self = shift;
282     return $self->{sslv2};
283 }
284 sub len_real
285 {
286     my $self = shift;
287     return $self->{len_real};
288 }
289 sub orig_decrypt_data
290 {
291     my $self = shift;
292     return $self->{orig_decrypt_data};
293 }
294
295 #Read/write accessors
296 sub decrypt_len
297 {
298     my $self = shift;
299     if (@_) {
300       $self->{decrypt_len} = shift;
301     }
302     return $self->{decrypt_len};
303 }
304 sub data
305 {
306     my $self = shift;
307     if (@_) {
308       $self->{data} = shift;
309     }
310     return $self->{data};
311 }
312 sub decrypt_data
313 {
314     my $self = shift;
315     if (@_) {
316       $self->{decrypt_data} = shift;
317     }
318     return $self->{decrypt_data};
319 }
320 sub len
321 {
322     my $self = shift;
323     if (@_) {
324       $self->{len} = shift;
325     }
326     return $self->{len};
327 }
328 1;