Fail if an unrecognised record type is received
[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 ($version != VERS_TLS_1_3() && $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     my $mactaglen = 20;
225     my $data = $self->data;
226
227     #Throw away any IVs
228     if ($self->version >= VERS_TLS_1_3()) {
229         #8 bytes for a GCM IV
230         $data = substr($data, 8);
231         $mactaglen = 16;
232     } elsif ($self->version >= VERS_TLS_1_1()) {
233         #16 bytes for a standard IV
234         $data = substr($data, 16);
235
236         #Find out what the padding byte is
237         my $padval = unpack("C", substr($data, length($data) - 1));
238
239         #Throw away the padding
240         $data = substr($data, 0, length($data) - ($padval + 1));
241     }
242
243     #Throw away the MAC or TAG
244     $data = substr($data, 0, length($data) - $mactaglen);
245
246     $self->decrypt_data($data);
247     $self->decrypt_len(length($data));
248
249     return $data;
250 }
251
252 #Reconstruct the on-the-wire record representation
253 sub reconstruct_record
254 {
255     my $self = shift;
256     my $data;
257
258     if ($self->sslv2) {
259         $data = pack('n', $self->len | 0x8000);
260     } else {
261         $data = pack('Cnn', $self->content_type, $self->version, $self->len);
262     }
263     $data .= $self->data;
264
265     return $data;
266 }
267
268 #Read only accessors
269 sub flight
270 {
271     my $self = shift;
272     return $self->{flight};
273 }
274 sub content_type
275 {
276     my $self = shift;
277     return $self->{content_type};
278 }
279 sub version
280 {
281     my $self = shift;
282     return $self->{version};
283 }
284 sub sslv2
285 {
286     my $self = shift;
287     return $self->{sslv2};
288 }
289 sub len_real
290 {
291     my $self = shift;
292     return $self->{len_real};
293 }
294 sub orig_decrypt_data
295 {
296     my $self = shift;
297     return $self->{orig_decrypt_data};
298 }
299
300 #Read/write accessors
301 sub decrypt_len
302 {
303     my $self = shift;
304     if (@_) {
305       $self->{decrypt_len} = shift;
306     }
307     return $self->{decrypt_len};
308 }
309 sub data
310 {
311     my $self = shift;
312     if (@_) {
313       $self->{data} = shift;
314     }
315     return $self->{data};
316 }
317 sub decrypt_data
318 {
319     my $self = shift;
320     if (@_) {
321       $self->{decrypt_data} = shift;
322     }
323     return $self->{decrypt_data};
324 }
325 sub len
326 {
327     my $self = shift;
328     if (@_) {
329       $self->{len} = shift;
330     }
331     return $self->{len};
332 }
333 1;