a4e7adcf8248698472a8b7d17f955145b532d8fa
[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     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_3 => 772,
39     VERS_TLS_1_2 => 771,
40     VERS_TLS_1_1 => 770,
41     VERS_TLS_1_0 => 769,
42     VERS_SSL_3_0 => 768,
43     VERS_SSL_LT_3_0 => 767
44 };
45
46 my %tls_version = (
47     VERS_TLS_1_3, "TLS1.3",
48     VERS_TLS_1_2, "TLS1.2",
49     VERS_TLS_1_1, "TLS1.1",
50     VERS_TLS_1_0, "TLS1.0",
51     VERS_SSL_3_0, "SSL3",
52     VERS_SSL_LT_3_0, "SSL<3"
53 );
54
55 #Class method to extract records from a packet of data
56 sub get_records
57 {
58     my $class = shift;
59     my $server = shift;
60     my $flight = shift;
61     my $packet = shift;
62     my @record_list = ();
63     my @message_list = ();
64     my $data;
65     my $content_type;
66     my $version;
67     my $len;
68     my $len_real;
69     my $decrypt_len;
70
71     my $recnum = 1;
72     while (length ($packet) > 0) {
73         print " Record $recnum";
74         if ($server) {
75             print " (server -> client)\n";
76         } else {
77             print " (client -> server)\n";
78         }
79         #Get the record header
80         if (length($packet) < TLS_RECORD_HEADER_LENGTH) {
81             print "Partial data : ".length($packet)." bytes\n";
82             $packet = "";
83         } else {
84             ($content_type, $version, $len) = unpack('CnnC*', $packet);
85             $data = substr($packet, 5, $len);
86
87             print "  Content type: ".$record_type{$content_type}."\n";
88             print "  Version: $tls_version{$version}\n";
89             print "  Length: $len";
90             if ($len == length($data)) {
91                 print "\n";
92                 $decrypt_len = $len_real = $len;
93             } else {
94                 print " (expected), ".length($data)." (actual)\n";
95                 $decrypt_len = $len_real = length($data);
96             }
97
98             my $record = TLSProxy::Record->new(
99                 $flight,
100                 $content_type,
101                 $version,
102                 $len,
103                 0,
104                 $len_real,
105                 $decrypt_len,
106                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real),
107                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real)
108             );
109
110             if (($server && $server_ccs_seen)
111                      || (!$server && $client_ccs_seen)) {
112                 if ($version != VERS_TLS_1_3() && $etm) {
113                     $record->decryptETM();
114                 } else {
115                     $record->decrypt();
116                 }
117             }
118
119             push @record_list, $record;
120
121             #Now figure out what messages are contained within this record
122             my @messages = TLSProxy::Message->get_messages($server, $record);
123             push @message_list, @messages;
124
125             $packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len_real);
126             $recnum++;
127         }
128     }
129
130     return (\@record_list, \@message_list);
131 }
132
133 sub clear
134 {
135     $server_ccs_seen = 0;
136     $client_ccs_seen = 0;
137 }
138
139 #Class level accessors
140 sub server_ccs_seen
141 {
142     my $class = shift;
143     if (@_) {
144       $server_ccs_seen = shift;
145     }
146     return $server_ccs_seen;
147 }
148 sub client_ccs_seen
149 {
150     my $class = shift;
151     if (@_) {
152       $client_ccs_seen = shift;
153     }
154     return $client_ccs_seen;
155 }
156 #Enable/Disable Encrypt-then-MAC
157 sub etm
158 {
159     my $class = shift;
160     if (@_) {
161       $etm = shift;
162     }
163     return $etm;
164 }
165
166 sub new
167 {
168     my $class = shift;
169     my ($flight,
170         $content_type,
171         $version,
172         $len,
173         $sslv2,
174         $len_real,
175         $decrypt_len,
176         $data,
177         $decrypt_data) = @_;
178     
179     my $self = {
180         flight => $flight,
181         content_type => $content_type,
182         version => $version,
183         len => $len,
184         sslv2 => $sslv2,
185         len_real => $len_real,
186         decrypt_len => $decrypt_len,
187         data => $data,
188         decrypt_data => $decrypt_data,
189         orig_decrypt_data => $decrypt_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 ($self->version >= VERS_TLS_1_3()) {
231         #8 bytes for a GCM IV
232         $data = substr($data, 8);
233         $mactaglen = 16;
234     } elsif ($self->version >= VERS_TLS_1_1()) {
235         #16 bytes for a standard IV
236         $data = substr($data, 16);
237
238         #Find out what the padding byte is
239         my $padval = unpack("C", substr($data, length($data) - 1));
240
241         #Throw away the padding
242         $data = substr($data, 0, length($data) - ($padval + 1));
243     }
244
245     #Throw away the MAC or TAG
246     $data = substr($data, 0, length($data) - $mactaglen);
247
248     $self->decrypt_data($data);
249     $self->decrypt_len(length($data));
250
251     return $data;
252 }
253
254 #Reconstruct the on-the-wire record representation
255 sub reconstruct_record
256 {
257     my $self = shift;
258     my $data;
259
260     if ($self->sslv2) {
261         $data = pack('n', $self->len | 0x8000);
262     } else {
263         $data = pack('Cnn', $self->content_type, $self->version, $self->len);
264     }
265     $data .= $self->data;
266
267     return $data;
268 }
269
270 #Read only accessors
271 sub flight
272 {
273     my $self = shift;
274     return $self->{flight};
275 }
276 sub content_type
277 {
278     my $self = shift;
279     return $self->{content_type};
280 }
281 sub sslv2
282 {
283     my $self = shift;
284     return $self->{sslv2};
285 }
286 sub len_real
287 {
288     my $self = shift;
289     return $self->{len_real};
290 }
291 sub orig_decrypt_data
292 {
293     my $self = shift;
294     return $self->{orig_decrypt_data};
295 }
296
297 #Read/write accessors
298 sub decrypt_len
299 {
300     my $self = shift;
301     if (@_) {
302       $self->{decrypt_len} = shift;
303     }
304     return $self->{decrypt_len};
305 }
306 sub data
307 {
308     my $self = shift;
309     if (@_) {
310       $self->{data} = shift;
311     }
312     return $self->{data};
313 }
314 sub decrypt_data
315 {
316     my $self = shift;
317     if (@_) {
318       $self->{decrypt_data} = shift;
319     }
320     return $self->{decrypt_data};
321 }
322 sub len
323 {
324     my $self = shift;
325     if (@_) {
326       $self->{len} = shift;
327     }
328     return $self->{len};
329 }
330 sub version
331 {
332     my $self = shift;
333     if (@_) {
334       $self->{version} = shift;
335     }
336     return $self->{version};
337 }
338 1;