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