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