Update copyright year
[openssl.git] / util / perl / TLSProxy / Record.pm
1 # Copyright 2016-2019 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_encrypting = 0;
15 my $client_encrypting = 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     RT_UNKNOWN => 100
27 };
28
29 my %record_type = (
30     RT_APPLICATION_DATA, "APPLICATION DATA",
31     RT_HANDSHAKE, "HANDSHAKE",
32     RT_ALERT, "ALERT",
33     RT_CCS, "CCS",
34     RT_UNKNOWN, "UNKNOWN"
35 );
36
37 use constant {
38     VERS_TLS_1_4 => 0x0305,
39     VERS_TLS_1_3 => 0x0304,
40     VERS_TLS_1_2 => 0x0303,
41     VERS_TLS_1_1 => 0x0302,
42     VERS_TLS_1_0 => 0x0301,
43     VERS_SSL_3_0 => 0x0300,
44     VERS_SSL_LT_3_0 => 0x02ff
45 };
46
47 my %tls_version = (
48     VERS_TLS_1_3, "TLS1.3",
49     VERS_TLS_1_2, "TLS1.2",
50     VERS_TLS_1_1, "TLS1.1",
51     VERS_TLS_1_0, "TLS1.0",
52     VERS_SSL_3_0, "SSL3",
53     VERS_SSL_LT_3_0, "SSL<3"
54 );
55
56 #Class method to extract records from a packet of data
57 sub get_records
58 {
59     my $class = shift;
60     my $server = shift;
61     my $flight = shift;
62     my $packet = shift;
63     my $partial = "";
64     my @record_list = ();
65     my @message_list = ();
66
67     my $recnum = 1;
68     while (length ($packet) > 0) {
69         print " Record $recnum ", $server ? "(server -> client)\n"
70                                           : "(client -> server)\n";
71
72         #Get the record header (unpack can't fail if $packet is too short)
73         my ($content_type, $version, $len) = unpack('Cnn', $packet);
74
75         if (length($packet) < TLS_RECORD_HEADER_LENGTH + ($len // 0)) {
76             print "Partial data : ".length($packet)." bytes\n";
77             $partial = $packet;
78             last;
79         }
80
81         my $data = substr($packet, TLS_RECORD_HEADER_LENGTH, $len);
82
83         print "  Content type: ".$record_type{$content_type}."\n";
84         print "  Version: $tls_version{$version}\n";
85         print "  Length: $len\n";
86
87         my $record = TLSProxy::Record->new(
88             $flight,
89             $content_type,
90             $version,
91             $len,
92             0,
93             $len,       # len_real
94             $len,       # decrypt_len
95             $data,      # data
96             $data       # decrypt_data
97         );
98
99         if ($content_type != RT_CCS
100                 && (!TLSProxy::Proxy->is_tls13()
101                     || $content_type != RT_ALERT)) {
102             if (($server && $server_encrypting)
103                      || (!$server && $client_encrypting)) {
104                 if (!TLSProxy::Proxy->is_tls13() && $etm) {
105                     $record->decryptETM();
106                 } else {
107                     $record->decrypt();
108                 }
109                 $record->encrypted(1);
110
111                 if (TLSProxy::Proxy->is_tls13()) {
112                     print "  Inner content type: "
113                           .$record_type{$record->content_type()}."\n";
114                 }
115             }
116         }
117
118         push @record_list, $record;
119
120         #Now figure out what messages are contained within this record
121         my @messages = TLSProxy::Message->get_messages($server, $record);
122         push @message_list, @messages;
123
124         $packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len);
125         $recnum++;
126     }
127
128     return (\@record_list, \@message_list, $partial);
129 }
130
131 sub clear
132 {
133     $server_encrypting = 0;
134     $client_encrypting = 0;
135 }
136
137 #Class level accessors
138 sub server_encrypting
139 {
140     my $class = shift;
141     if (@_) {
142       $server_encrypting = shift;
143     }
144     return $server_encrypting;
145 }
146 sub client_encrypting
147 {
148     my $class = shift;
149     if (@_) {
150       $client_encrypting= shift;
151     }
152     return $client_encrypting;
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         sent => 0,
189         encrypted => 0,
190         outer_content_type => RT_APPLICATION_DATA
191     };
192
193     return bless $self, $class;
194 }
195
196 #Decrypt using encrypt-then-MAC
197 sub decryptETM
198 {
199     my ($self) = shift;
200
201     my $data = $self->data;
202
203     if($self->version >= VERS_TLS_1_1()) {
204         #TLS1.1+ has an explicit IV. Throw it away
205         $data = substr($data, 16);
206     }
207
208     #Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
209     $data = substr($data, 0, length($data) - 20);
210
211     #Find out what the padding byte is
212     my $padval = unpack("C", substr($data, length($data) - 1));
213
214     #Throw away the padding
215     $data = substr($data, 0, length($data) - ($padval + 1));
216
217     $self->decrypt_data($data);
218     $self->decrypt_len(length($data));
219
220     return $data;
221 }
222
223 #Standard decrypt
224 sub decrypt()
225 {
226     my ($self) = shift;
227     my $mactaglen = 20;
228     my $data = $self->data;
229
230     #Throw away any IVs
231     if (TLSProxy::Proxy->is_tls13()) {
232         #A TLS1.3 client, when processing the server's initial flight, could
233         #respond with either an encrypted or an unencrypted alert.
234         if ($self->content_type() == RT_ALERT) {
235             #TODO(TLS1.3): Eventually it is sufficient just to check the record
236             #content type. If an alert is encrypted it will have a record
237             #content type of application data. However we haven't done the
238             #record layer changes yet, so it's a bit more complicated. For now
239             #we will additionally check if the data length is 2 (1 byte for
240             #alert level, 1 byte for alert description). If it is, then this is
241             #an unencrypted alert, so don't try to decrypt
242             return $data if (length($data) == 2);
243         }
244         $mactaglen = 16;
245     } elsif ($self->version >= VERS_TLS_1_1()) {
246         #16 bytes for a standard IV
247         $data = substr($data, 16);
248
249         #Find out what the padding byte is
250         my $padval = unpack("C", substr($data, length($data) - 1));
251
252         #Throw away the padding
253         $data = substr($data, 0, length($data) - ($padval + 1));
254     }
255
256     #Throw away the MAC or TAG
257     $data = substr($data, 0, length($data) - $mactaglen);
258
259     if (TLSProxy::Proxy->is_tls13()) {
260         #Get the content type
261         my $content_type = unpack("C", substr($data, length($data) - 1));
262         $self->content_type($content_type);
263         $data = substr($data, 0, length($data) - 1);
264     }
265
266     $self->decrypt_data($data);
267     $self->decrypt_len(length($data));
268
269     return $data;
270 }
271
272 #Reconstruct the on-the-wire record representation
273 sub reconstruct_record
274 {
275     my $self = shift;
276     my $server = shift;
277     my $data;
278
279     #We only replay the records in the same direction
280     if ($self->{sent} || ($self->flight & 1) != $server) {
281         return "";
282     }
283     $self->{sent} = 1;
284
285     if ($self->sslv2) {
286         $data = pack('n', $self->len | 0x8000);
287     } else {
288         if (TLSProxy::Proxy->is_tls13() && $self->encrypted) {
289             $data = pack('Cnn', $self->outer_content_type, $self->version,
290                          $self->len);
291         } else {
292             $data = pack('Cnn', $self->content_type, $self->version,
293                          $self->len);
294         }
295
296     }
297     $data .= $self->data;
298
299     return $data;
300 }
301
302 #Read only accessors
303 sub flight
304 {
305     my $self = shift;
306     return $self->{flight};
307 }
308 sub sslv2
309 {
310     my $self = shift;
311     return $self->{sslv2};
312 }
313 sub len_real
314 {
315     my $self = shift;
316     return $self->{len_real};
317 }
318 sub orig_decrypt_data
319 {
320     my $self = shift;
321     return $self->{orig_decrypt_data};
322 }
323
324 #Read/write accessors
325 sub decrypt_len
326 {
327     my $self = shift;
328     if (@_) {
329       $self->{decrypt_len} = shift;
330     }
331     return $self->{decrypt_len};
332 }
333 sub data
334 {
335     my $self = shift;
336     if (@_) {
337       $self->{data} = shift;
338     }
339     return $self->{data};
340 }
341 sub decrypt_data
342 {
343     my $self = shift;
344     if (@_) {
345       $self->{decrypt_data} = shift;
346     }
347     return $self->{decrypt_data};
348 }
349 sub len
350 {
351     my $self = shift;
352     if (@_) {
353       $self->{len} = shift;
354     }
355     return $self->{len};
356 }
357 sub version
358 {
359     my $self = shift;
360     if (@_) {
361       $self->{version} = shift;
362     }
363     return $self->{version};
364 }
365 sub content_type
366 {
367     my $self = shift;
368     if (@_) {
369       $self->{content_type} = shift;
370     }
371     return $self->{content_type};
372 }
373 sub encrypted
374 {
375     my $self = shift;
376     if (@_) {
377       $self->{encrypted} = shift;
378     }
379     return $self->{encrypted};
380 }
381 sub outer_content_type
382 {
383     my $self = shift;
384     if (@_) {
385       $self->{outer_content_type} = shift;
386     }
387     return $self->{outer_content_type};
388 }
389 sub is_fatal_alert
390 {
391     my $self = shift;
392     my $server = shift;
393
394     if (($self->{flight} & 1) == $server
395         && $self->{content_type} == TLSProxy::Record::RT_ALERT) {
396         my ($level, $alert) = unpack('CC', $self->decrypt_data);
397         return $alert if ($level == 2);
398     }
399     return 0;
400 }
401 1;