]>
Commit | Line | Data |
---|---|---|
6738bf14 | 1 | # Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved. |
631c1206 | 2 | # |
9059ab42 | 3 | # Licensed under the Apache License 2.0 (the "License"). You may not use |
ac3d0e13 RS |
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 | |
631c1206 MC |
7 | |
8 | use strict; | |
9 | ||
10 | use TLSProxy::Proxy; | |
11 | ||
12 | package TLSProxy::Record; | |
13 | ||
9970290e MC |
14 | my $server_encrypting = 0; |
15 | my $client_encrypting = 0; | |
631c1206 MC |
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, | |
1f3e70a4 MC |
25 | RT_CCS => 20, |
26 | RT_UNKNOWN => 100 | |
631c1206 MC |
27 | }; |
28 | ||
29 | my %record_type = ( | |
30 | RT_APPLICATION_DATA, "APPLICATION DATA", | |
31 | RT_HANDSHAKE, "HANDSHAKE", | |
32 | RT_ALERT, "ALERT", | |
1f3e70a4 MC |
33 | RT_CCS, "CCS", |
34 | RT_UNKNOWN, "UNKNOWN" | |
631c1206 MC |
35 | ); |
36 | ||
37 | use constant { | |
e984b535 | 38 | VERS_TLS_1_4 => 0x0305, |
e984b535 MC |
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 | |
631c1206 MC |
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", | |
00bf5001 RL |
52 | VERS_SSL_3_0, "SSL3", |
53 | VERS_SSL_LT_3_0, "SSL<3" | |
631c1206 MC |
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; | |
12636c14 | 63 | my $partial = ""; |
631c1206 MC |
64 | my @record_list = (); |
65 | my @message_list = (); | |
631c1206 MC |
66 | |
67 | my $recnum = 1; | |
68 | while (length ($packet) > 0) { | |
3f1f62b9 AP |
69 | print " Record $recnum ", $server ? "(server -> client)\n" |
70 | : "(client -> server)\n"; | |
ceaa3894 AP |
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 | ||
3f1f62b9 | 75 | if (length($packet) < TLS_RECORD_HEADER_LENGTH + ($len // 0)) { |
631c1206 | 76 | print "Partial data : ".length($packet)." bytes\n"; |
12636c14 | 77 | $partial = $packet; |
ceaa3894 AP |
78 | last; |
79 | } | |
631c1206 | 80 | |
ceaa3894 AP |
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 | ||
f460e839 MC |
99 | if ($content_type != RT_CCS |
100 | && (!TLSProxy::Proxy->is_tls13() | |
101 | || $content_type != RT_ALERT)) { | |
ceaa3894 AP |
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"; | |
4d02f870 | 114 | } |
631c1206 | 115 | } |
ceaa3894 | 116 | } |
631c1206 | 117 | |
ceaa3894 | 118 | push @record_list, $record; |
631c1206 | 119 | |
ceaa3894 AP |
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; | |
631c1206 | 123 | |
ceaa3894 AP |
124 | $packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len); |
125 | $recnum++; | |
631c1206 MC |
126 | } |
127 | ||
12636c14 | 128 | return (\@record_list, \@message_list, $partial); |
631c1206 MC |
129 | } |
130 | ||
131 | sub clear | |
132 | { | |
9970290e MC |
133 | $server_encrypting = 0; |
134 | $client_encrypting = 0; | |
631c1206 MC |
135 | } |
136 | ||
137 | #Class level accessors | |
9970290e | 138 | sub server_encrypting |
631c1206 MC |
139 | { |
140 | my $class = shift; | |
141 | if (@_) { | |
9970290e | 142 | $server_encrypting = shift; |
631c1206 | 143 | } |
9970290e | 144 | return $server_encrypting; |
631c1206 | 145 | } |
9970290e | 146 | sub client_encrypting |
631c1206 MC |
147 | { |
148 | my $class = shift; | |
149 | if (@_) { | |
9970290e | 150 | $client_encrypting= shift; |
631c1206 | 151 | } |
9970290e | 152 | return $client_encrypting; |
631c1206 MC |
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, | |
a2a0c86b | 171 | $sslv2, |
631c1206 MC |
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, | |
a2a0c86b | 182 | sslv2 => $sslv2, |
631c1206 MC |
183 | len_real => $len_real, |
184 | decrypt_len => $decrypt_len, | |
185 | data => $data, | |
186 | decrypt_data => $decrypt_data, | |
e60ce9c4 | 187 | orig_decrypt_data => $decrypt_data, |
12636c14 | 188 | sent => 0, |
b4c6e37e MC |
189 | encrypted => 0, |
190 | outer_content_type => RT_APPLICATION_DATA | |
631c1206 MC |
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; | |
837e591d | 227 | my $mactaglen = 20; |
631c1206 MC |
228 | my $data = $self->data; |
229 | ||
837e591d | 230 | #Throw away any IVs |
20b65c7b MC |
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 | |
69687aa8 | 241 | #an unencrypted alert, so don't try to decrypt |
20b65c7b MC |
242 | return $data if (length($data) == 2); |
243 | } | |
837e591d MC |
244 | $mactaglen = 16; |
245 | } elsif ($self->version >= VERS_TLS_1_1()) { | |
246 | #16 bytes for a standard IV | |
631c1206 | 247 | $data = substr($data, 16); |
631c1206 | 248 | |
837e591d MC |
249 | #Find out what the padding byte is |
250 | my $padval = unpack("C", substr($data, length($data) - 1)); | |
631c1206 | 251 | |
837e591d MC |
252 | #Throw away the padding |
253 | $data = substr($data, 0, length($data) - ($padval + 1)); | |
254 | } | |
631c1206 | 255 | |
837e591d MC |
256 | #Throw away the MAC or TAG |
257 | $data = substr($data, 0, length($data) - $mactaglen); | |
631c1206 | 258 | |
e60ce9c4 MC |
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 | ||
631c1206 MC |
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; | |
e60ce9c4 | 276 | my $server = shift; |
631c1206 MC |
277 | my $data; |
278 | ||
0e3ecaec BE |
279 | #We only replay the records in the same direction |
280 | if ($self->{sent} || ($self->flight & 1) != $server) { | |
12636c14 BE |
281 | return ""; |
282 | } | |
283 | $self->{sent} = 1; | |
284 | ||
a2a0c86b MC |
285 | if ($self->sslv2) { |
286 | $data = pack('n', $self->len | 0x8000); | |
287 | } else { | |
e60ce9c4 | 288 | if (TLSProxy::Proxy->is_tls13() && $self->encrypted) { |
b4c6e37e | 289 | $data = pack('Cnn', $self->outer_content_type, $self->version, |
6c61b274 | 290 | $self->len); |
e60ce9c4 MC |
291 | } else { |
292 | $data = pack('Cnn', $self->content_type, $self->version, | |
293 | $self->len); | |
294 | } | |
295 | ||
a2a0c86b | 296 | } |
631c1206 MC |
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 | } | |
a2a0c86b MC |
308 | sub sslv2 |
309 | { | |
310 | my $self = shift; | |
311 | return $self->{sslv2}; | |
312 | } | |
631c1206 MC |
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 | } | |
8e47ee18 MC |
357 | sub version |
358 | { | |
359 | my $self = shift; | |
360 | if (@_) { | |
361 | $self->{version} = shift; | |
362 | } | |
363 | return $self->{version}; | |
364 | } | |
e60ce9c4 MC |
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 | } | |
b4c6e37e MC |
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 | } | |
3f1f62b9 AP |
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 | } | |
631c1206 | 401 | 1; |