xref: /openssl/util/perl/TLSProxy/Record.pm (revision b6461792) 
1# Copyright 2016-2024 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 DTLS_RECORD_HEADER_LENGTH => 13;
19use constant TLS_RECORD_HEADER_LENGTH => 5;
20
21#Record types
22use constant {
23    RT_APPLICATION_DATA => 23,
24    RT_HANDSHAKE => 22,
25    RT_ALERT => 21,
26    RT_CCS => 20,
27    RT_UNKNOWN => 100
28};
29
30my %record_type = (
31    RT_APPLICATION_DATA, "APPLICATION DATA",
32    RT_HANDSHAKE, "HANDSHAKE",
33    RT_ALERT, "ALERT",
34    RT_CCS, "CCS",
35    RT_UNKNOWN, "UNKNOWN"
36);
37
38use constant {
39    VERS_DTLS_1_2 => 0xfefd,
40    VERS_DTLS_1 => 0xfeff,
41    VERS_TLS_1_4 => 0x0305,
42    VERS_TLS_1_3 => 0x0304,
43    VERS_TLS_1_2 => 0x0303,
44    VERS_TLS_1_1 => 0x0302,
45    VERS_TLS_1_0 => 0x0301,
46    VERS_SSL_3_0 => 0x0300,
47    VERS_SSL_LT_3_0 => 0x02ff
48};
49
50our %tls_version = (
51    VERS_DTLS_1_2, "DTLS1.2",
52    VERS_DTLS_1, "DTLS1",
53    VERS_TLS_1_3, "TLS1.3",
54    VERS_TLS_1_2, "TLS1.2",
55    VERS_TLS_1_1, "TLS1.1",
56    VERS_TLS_1_0, "TLS1.0",
57    VERS_SSL_3_0, "SSL3",
58    VERS_SSL_LT_3_0, "SSL<3"
59);
60
61#Class method to extract records from a packet of data
62sub get_records
63{
64    my $class = shift;
65    my $server = shift;
66    my $flight = shift;
67    my $packet = shift;
68    my $isdtls = shift;
69    my $partial = "";
70    my @record_list = ();
71    my @message_list = ();
72    my $record_hdr_len = $isdtls ? DTLS_RECORD_HEADER_LENGTH
73                                 : TLS_RECORD_HEADER_LENGTH;
74
75    my $recnum = 1;
76    while (length ($packet) > 0) {
77        print " Record $recnum ", $server ? "(server -> client)\n"
78                                          : "(client -> server)\n";
79
80        my $content_type;
81        my $version;
82        my $len;
83        my $epoch;
84        my $seq;
85
86        if ($isdtls) {
87            my $seqhi;
88            my $seqmi;
89            my $seqlo;
90            #Get the record header (unpack can't fail if $packet is too short)
91            ($content_type, $version, $epoch,
92                $seqhi, $seqmi, $seqlo, $len) = unpack('Cnnnnnn', $packet);
93            $seq = ($seqhi << 32) | ($seqmi << 16) | $seqlo
94        } else {
95            #Get the record header (unpack can't fail if $packet is too short)
96            ($content_type, $version, $len) = unpack('Cnn', $packet);
97        }
98
99        if (length($packet) < $record_hdr_len + ($len // 0)) {
100            print "Partial data : ".length($packet)." bytes\n";
101            $partial = $packet;
102            last;
103        }
104
105        my $data = substr($packet, $record_hdr_len, $len);
106
107        print "  Content type: ".$record_type{$content_type}."\n";
108        print "  Version: $tls_version{$version}\n";
109        if($isdtls) {
110            print "  Epoch: $epoch\n";
111            print "  Sequence: $seq\n";
112        }
113        print "  Length: $len\n";
114
115        my $record;
116        if ($isdtls) {
117            $record = TLSProxy::Record->new_dtls(
118                $flight,
119                $content_type,
120                $version,
121                $epoch,
122                $seq,
123                $len,
124                0,
125                $len,       # len_real
126                $len,       # decrypt_len
127                $data,      # data
128                $data       # decrypt_data
129            );
130        } else {
131            $record = TLSProxy::Record->new(
132                $flight,
133                $content_type,
134                $version,
135                $len,
136                0,
137                $len,  # len_real
138                $len,  # decrypt_len
139                $data, # data
140                $data  # decrypt_data
141            );
142        }
143
144        if ($content_type != RT_CCS
145                && (!TLSProxy::Proxy->is_tls13()
146                    || $content_type != RT_ALERT)) {
147            if (($server && $server_encrypting)
148                     || (!$server && $client_encrypting)) {
149                if (!TLSProxy::Proxy->is_tls13() && $etm) {
150                    $record->decryptETM();
151                } else {
152                    $record->decrypt();
153                }
154                $record->encrypted(1);
155
156                if (TLSProxy::Proxy->is_tls13()) {
157                    print "  Inner content type: "
158                          .$record_type{$record->content_type()}."\n";
159                }
160            }
161        }
162
163        push @record_list, $record;
164
165        #Now figure out what messages are contained within this record
166        my @messages = TLSProxy::Message->get_messages($server, $record, $isdtls);
167        push @message_list, @messages;
168
169        $packet = substr($packet, $record_hdr_len + $len);
170        $recnum++;
171    }
172
173    return (\@record_list, \@message_list, $partial);
174}
175
176sub clear
177{
178    $server_encrypting = 0;
179    $client_encrypting = 0;
180}
181
182#Class level accessors
183sub server_encrypting
184{
185    my $class = shift;
186    if (@_) {
187      $server_encrypting = shift;
188    }
189    return $server_encrypting;
190}
191sub client_encrypting
192{
193    my $class = shift;
194    if (@_) {
195      $client_encrypting= shift;
196    }
197    return $client_encrypting;
198}
199#Enable/Disable Encrypt-then-MAC
200sub etm
201{
202    my $class = shift;
203    if (@_) {
204      $etm = shift;
205    }
206    return $etm;
207}
208
209sub new_dtls
210{
211    my $class = shift;
212    my ($flight,
213        $content_type,
214        $version,
215        $epoch,
216        $seq,
217        $len,
218        $sslv2,
219        $len_real,
220        $decrypt_len,
221        $data,
222        $decrypt_data) = @_;
223    return $class->init(1,
224        $flight,
225        $content_type,
226        $version,
227        $epoch,
228        $seq,
229        $len,
230        $sslv2,
231        $len_real,
232        $decrypt_len,
233        $data,
234        $decrypt_data);
235}
236
237sub new
238{
239    my $class = shift;
240    my ($flight,
241        $content_type,
242        $version,
243        $len,
244        $sslv2,
245        $len_real,
246        $decrypt_len,
247        $data,
248        $decrypt_data) = @_;
249    return $class->init(
250        0,
251        $flight,
252        $content_type,
253        $version,
254        0, #epoch
255        0, #seq
256        $len,
257        $sslv2,
258        $len_real,
259        $decrypt_len,
260        $data,
261        $decrypt_data);
262}
263
264sub init
265{
266    my $class = shift;
267    my ($isdtls,
268        $flight,
269        $content_type,
270        $version,
271        $epoch,
272        $seq,
273        $len,
274        $sslv2,
275        $len_real,
276        $decrypt_len,
277        $data,
278        $decrypt_data) = @_;
279
280    my $self = {
281        isdtls => $isdtls,
282        flight => $flight,
283        content_type => $content_type,
284        version => $version,
285        epoch => $epoch,
286        seq => $seq,
287        len => $len,
288        sslv2 => $sslv2,
289        len_real => $len_real,
290        decrypt_len => $decrypt_len,
291        data => $data,
292        decrypt_data => $decrypt_data,
293        orig_decrypt_data => $decrypt_data,
294        sent => 0,
295        encrypted => 0,
296        outer_content_type => RT_APPLICATION_DATA
297    };
298
299    return bless $self, $class;
300}
301
302#Decrypt using encrypt-then-MAC
303sub decryptETM
304{
305    my ($self) = shift;
306
307    my $data = $self->data;
308
309    if($self->version >= VERS_TLS_1_1()) {
310        #TLS1.1+ has an explicit IV. Throw it away
311        $data = substr($data, 16);
312    }
313
314    #Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
315    $data = substr($data, 0, length($data) - 20);
316
317    #Find out what the padding byte is
318    my $padval = unpack("C", substr($data, length($data) - 1));
319
320    #Throw away the padding
321    $data = substr($data, 0, length($data) - ($padval + 1));
322
323    $self->decrypt_data($data);
324    $self->decrypt_len(length($data));
325
326    return $data;
327}
328
329#Standard decrypt
330sub decrypt()
331{
332    my ($self) = shift;
333    my $mactaglen = 20;
334    my $data = $self->data;
335
336    #Throw away any IVs
337    if (TLSProxy::Proxy->is_tls13()) {
338        #A TLS1.3 client, when processing the server's initial flight, could
339        #respond with either an encrypted or an unencrypted alert.
340        if ($self->content_type() == RT_ALERT) {
341            #TODO(TLS1.3): Eventually it is sufficient just to check the record
342            #content type. If an alert is encrypted it will have a record
343            #content type of application data. However we haven't done the
344            #record layer changes yet, so it's a bit more complicated. For now
345            #we will additionally check if the data length is 2 (1 byte for
346            #alert level, 1 byte for alert description). If it is, then this is
347            #an unencrypted alert, so don't try to decrypt
348            return $data if (length($data) == 2);
349        }
350        $mactaglen = 16;
351    } elsif ($self->version >= VERS_TLS_1_1()) {
352        #16 bytes for a standard IV
353        $data = substr($data, 16);
354
355        #Find out what the padding byte is
356        my $padval = unpack("C", substr($data, length($data) - 1));
357
358        #Throw away the padding
359        $data = substr($data, 0, length($data) - ($padval + 1));
360    }
361
362    #Throw away the MAC or TAG
363    $data = substr($data, 0, length($data) - $mactaglen);
364
365    if (TLSProxy::Proxy->is_tls13()) {
366        #Get the content type
367        my $content_type = unpack("C", substr($data, length($data) - 1));
368        $self->content_type($content_type);
369        $data = substr($data, 0, length($data) - 1);
370    }
371
372    $self->decrypt_data($data);
373    $self->decrypt_len(length($data));
374
375    return $data;
376}
377
378#Reconstruct the on-the-wire record representation
379sub reconstruct_record
380{
381    my $self = shift;
382    my $server = shift;
383    my $data;
384
385    #We only replay the records in the same direction
386    if ($self->{sent} || ($self->flight & 1) != $server) {
387        return "";
388    }
389    $self->{sent} = 1;
390
391    if ($self->sslv2) {
392        $data = pack('n', $self->len | 0x8000);
393    } else {
394        if($self->{isdtls}) {
395            my $seqhi = ($self->seq >> 32) & 0xffff;
396            my $seqmi = ($self->seq >> 16) & 0xffff;
397            my $seqlo = ($self->seq >> 0) & 0xffff;
398            $data = pack('Cnnnnnn', $self->content_type, $self->version,
399                         $self->epoch, $seqhi, $seqmi, $seqlo, $self->len);
400        } else {
401            if (TLSProxy::Proxy->is_tls13() && $self->encrypted) {
402                $data = pack('Cnn', $self->outer_content_type, $self->version,
403                             $self->len);
404            }
405            else {
406                $data = pack('Cnn', $self->content_type, $self->version,
407                             $self->len);
408            }
409        }
410
411    }
412    $data .= $self->data;
413
414    return $data;
415}
416
417#Read only accessors
418sub flight
419{
420    my $self = shift;
421    return $self->{flight};
422}
423sub sslv2
424{
425    my $self = shift;
426    return $self->{sslv2};
427}
428sub len_real
429{
430    my $self = shift;
431    return $self->{len_real};
432}
433sub orig_decrypt_data
434{
435    my $self = shift;
436    return $self->{orig_decrypt_data};
437}
438
439#Read/write accessors
440sub decrypt_len
441{
442    my $self = shift;
443    if (@_) {
444      $self->{decrypt_len} = shift;
445    }
446    return $self->{decrypt_len};
447}
448sub data
449{
450    my $self = shift;
451    if (@_) {
452      $self->{data} = shift;
453    }
454    return $self->{data};
455}
456sub decrypt_data
457{
458    my $self = shift;
459    if (@_) {
460      $self->{decrypt_data} = shift;
461    }
462    return $self->{decrypt_data};
463}
464sub len
465{
466    my $self = shift;
467    if (@_) {
468      $self->{len} = shift;
469    }
470    return $self->{len};
471}
472sub version
473{
474    my $self = shift;
475    if (@_) {
476      $self->{version} = shift;
477    }
478    return $self->{version};
479}
480sub content_type
481{
482    my $self = shift;
483    if (@_) {
484      $self->{content_type} = shift;
485    }
486    return $self->{content_type};
487}
488sub epoch
489{
490    my $self = shift;
491    if (@_) {
492        $self->{epoch} = shift;
493    }
494    return $self->{epoch};
495}
496sub seq
497{
498    my $self = shift;
499    if (@_) {
500        $self->{seq} = shift;
501    }
502    return $self->{seq};
503}
504sub encrypted
505{
506    my $self = shift;
507    if (@_) {
508      $self->{encrypted} = shift;
509    }
510    return $self->{encrypted};
511}
512sub outer_content_type
513{
514    my $self = shift;
515    if (@_) {
516      $self->{outer_content_type} = shift;
517    }
518    return $self->{outer_content_type};
519}
520sub is_fatal_alert
521{
522    my $self = shift;
523    my $server = shift;
524
525    if (($self->{flight} & 1) == $server && $self->{content_type} == RT_ALERT) {
526        my ($level, $description) = unpack('CC', $self->decrypt_data);
527        return $description if ($level == 2);
528    }
529    return 0;
530}
5311;
532