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