xref: /freebsd/crypto/openssl/util/perl/TLSProxy/Record.pm (revision e0c4386e7e71d93b0edc0c8fa156263fc4a8b0b6) 
1# Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved.
2#
3# Licensed under the Apache License 2.0 (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
8use strict;
9
10use TLSProxy::Proxy;
11
12package TLSProxy::Record;
13
14my $server_encrypting = 0;
15my $client_encrypting = 0;
16my $etm = 0;
17
18use constant TLS_RECORD_HEADER_LENGTH => 5;
19
20#Record types
21use constant {
22    RT_APPLICATION_DATA => 23,
23    RT_HANDSHAKE => 22,
24    RT_ALERT => 21,
25    RT_CCS => 20,
26    RT_UNKNOWN => 100
27};
28
29my %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
37use constant {
38    VERS_TLS_1_4 => 0x0305,
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
45};
46
47my %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",
52    VERS_SSL_3_0, "SSL3",
53    VERS_SSL_LT_3_0, "SSL<3"
54);
55
56#Class method to extract records from a packet of data
57sub get_records
58{
59    my $class = shift;
60    my $server = shift;
61    my $flight = shift;
62    my $packet = shift;
63    my $partial = "";
64    my @record_list = ();
65    my @message_list = ();
66
67    my $recnum = 1;
68    while (length ($packet) > 0) {
69        print " Record $recnum ", $server ? "(server -> client)\n"
70                                          : "(client -> server)\n";
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
75        if (length($packet) < TLS_RECORD_HEADER_LENGTH + ($len // 0)) {
76            print "Partial data : ".length($packet)." bytes\n";
77            $partial = $packet;
78            last;
79        }
80
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
99        if ($content_type != RT_CCS
100                && (!TLSProxy::Proxy->is_tls13()
101                    || $content_type != RT_ALERT)) {
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";
114                }
115            }
116        }
117
118        push @record_list, $record;
119
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;
123
124        $packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len);
125        $recnum++;
126    }
127
128    return (\@record_list, \@message_list, $partial);
129}
130
131sub clear
132{
133    $server_encrypting = 0;
134    $client_encrypting = 0;
135}
136
137#Class level accessors
138sub server_encrypting
139{
140    my $class = shift;
141    if (@_) {
142      $server_encrypting = shift;
143    }
144    return $server_encrypting;
145}
146sub client_encrypting
147{
148    my $class = shift;
149    if (@_) {
150      $client_encrypting= shift;
151    }
152    return $client_encrypting;
153}
154#Enable/Disable Encrypt-then-MAC
155sub etm
156{
157    my $class = shift;
158    if (@_) {
159      $etm = shift;
160    }
161    return $etm;
162}
163
164sub 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        sent => 0,
189        encrypted => 0,
190        outer_content_type => RT_APPLICATION_DATA
191    };
192
193    return bless $self, $class;
194}
195
196#Decrypt using encrypt-then-MAC
197sub 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
224sub decrypt()
225{
226    my ($self) = shift;
227    my $mactaglen = 20;
228    my $data = $self->data;
229
230    #Throw away any IVs
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
241            #an unencrypted alert, so don't try to decrypt
242            return $data if (length($data) == 2);
243        }
244        $mactaglen = 16;
245    } elsif ($self->version >= VERS_TLS_1_1()) {
246        #16 bytes for a standard IV
247        $data = substr($data, 16);
248
249        #Find out what the padding byte is
250        my $padval = unpack("C", substr($data, length($data) - 1));
251
252        #Throw away the padding
253        $data = substr($data, 0, length($data) - ($padval + 1));
254    }
255
256    #Throw away the MAC or TAG
257    $data = substr($data, 0, length($data) - $mactaglen);
258
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
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
273sub reconstruct_record
274{
275    my $self = shift;
276    my $server = shift;
277    my $data;
278
279    #We only replay the records in the same direction
280    if ($self->{sent} || ($self->flight & 1) != $server) {
281        return "";
282    }
283    $self->{sent} = 1;
284
285    if ($self->sslv2) {
286        $data = pack('n', $self->len | 0x8000);
287    } else {
288        if (TLSProxy::Proxy->is_tls13() && $self->encrypted) {
289            $data = pack('Cnn', $self->outer_content_type, $self->version,
290                         $self->len);
291        } else {
292            $data = pack('Cnn', $self->content_type, $self->version,
293                         $self->len);
294        }
295
296    }
297    $data .= $self->data;
298
299    return $data;
300}
301
302#Read only accessors
303sub flight
304{
305    my $self = shift;
306    return $self->{flight};
307}
308sub sslv2
309{
310    my $self = shift;
311    return $self->{sslv2};
312}
313sub len_real
314{
315    my $self = shift;
316    return $self->{len_real};
317}
318sub orig_decrypt_data
319{
320    my $self = shift;
321    return $self->{orig_decrypt_data};
322}
323
324#Read/write accessors
325sub decrypt_len
326{
327    my $self = shift;
328    if (@_) {
329      $self->{decrypt_len} = shift;
330    }
331    return $self->{decrypt_len};
332}
333sub data
334{
335    my $self = shift;
336    if (@_) {
337      $self->{data} = shift;
338    }
339    return $self->{data};
340}
341sub decrypt_data
342{
343    my $self = shift;
344    if (@_) {
345      $self->{decrypt_data} = shift;
346    }
347    return $self->{decrypt_data};
348}
349sub len
350{
351    my $self = shift;
352    if (@_) {
353      $self->{len} = shift;
354    }
355    return $self->{len};
356}
357sub version
358{
359    my $self = shift;
360    if (@_) {
361      $self->{version} = shift;
362    }
363    return $self->{version};
364}
365sub content_type
366{
367    my $self = shift;
368    if (@_) {
369      $self->{content_type} = shift;
370    }
371    return $self->{content_type};
372}
373sub encrypted
374{
375    my $self = shift;
376    if (@_) {
377      $self->{encrypted} = shift;
378    }
379    return $self->{encrypted};
380}
381sub outer_content_type
382{
383    my $self = shift;
384    if (@_) {
385      $self->{outer_content_type} = shift;
386    }
387    return $self->{outer_content_type};
388}
389sub 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}
4011;
402