util/perl/TLSProxy/Record.pm

   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
   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 DTLS_RECORD_HEADER_LENGTH => 13;
  19 use constant TLS_RECORD_HEADER_LENGTH => 5;
  20
  21 #Record types
  22 use constant {
  23     RT_APPLICATION_DATA => 23,
  24     RT_HANDSHAKE => 22,
  25     RT_ALERT => 21,
  26     RT_CCS => 20,
  27     RT_UNKNOWN => 100
  28 };
  29
  30 my %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
  38 use 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
  50 our %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
  62 sub 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
 176 sub clear
 177 {
 178     $server_encrypting = 0;
 179     $client_encrypting = 0;
 180 }
 181
 182 #Class level accessors
 183 sub server_encrypting
 184 {
 185     my $class = shift;
 186     if (@_) {
 187       $server_encrypting = shift;
 188     }
 189     return $server_encrypting;
 190 }
 191 sub 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
 200 sub etm
 201 {
 202     my $class = shift;
 203     if (@_) {
 204       $etm = shift;
 205     }
 206     return $etm;
 207 }
 208
 209 sub 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
 237 sub 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
 264 sub 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
 303 sub 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
 330 sub 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
 379 sub 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
 418 sub flight
 419 {
 420     my $self = shift;
 421     return $self->{flight};
 422 }
 423 sub sslv2
 424 {
 425     my $self = shift;
 426     return $self->{sslv2};
 427 }
 428 sub len_real
 429 {
 430     my $self = shift;
 431     return $self->{len_real};
 432 }
 433 sub orig_decrypt_data
 434 {
 435     my $self = shift;
 436     return $self->{orig_decrypt_data};
 437 }
 438
 439 #Read/write accessors
 440 sub decrypt_len
 441 {
 442     my $self = shift;
 443     if (@_) {
 444       $self->{decrypt_len} = shift;
 445     }
 446     return $self->{decrypt_len};
 447 }
 448 sub data
 449 {
 450     my $self = shift;
 451     if (@_) {
 452       $self->{data} = shift;
 453     }
 454     return $self->{data};
 455 }
 456 sub decrypt_data
 457 {
 458     my $self = shift;
 459     if (@_) {
 460       $self->{decrypt_data} = shift;
 461     }
 462     return $self->{decrypt_data};
 463 }
 464 sub len
 465 {
 466     my $self = shift;
 467     if (@_) {
 468       $self->{len} = shift;
 469     }
 470     return $self->{len};
 471 }
 472 sub version
 473 {
 474     my $self = shift;
 475     if (@_) {
 476       $self->{version} = shift;
 477     }
 478     return $self->{version};
 479 }
 480 sub content_type
 481 {
 482     my $self = shift;
 483     if (@_) {
 484       $self->{content_type} = shift;
 485     }
 486     return $self->{content_type};
 487 }
 488 sub epoch
 489 {
 490     my $self = shift;
 491     if (@_) {
 492         $self->{epoch} = shift;
 493     }
 494     return $self->{epoch};
 495 }
 496 sub seq
 497 {
 498     my $self = shift;
 499     if (@_) {
 500         $self->{seq} = shift;
 501     }
 502     return $self->{seq};
 503 }
 504 sub encrypted
 505 {
 506     my $self = shift;
 507     if (@_) {
 508       $self->{encrypted} = shift;
 509     }
 510     return $self->{encrypted};
 511 }
 512 sub outer_content_type
 513 {
 514     my $self = shift;
 515     if (@_) {
 516       $self->{outer_content_type} = shift;
 517     }
 518     return $self->{outer_content_type};
 519 }
 520 sub 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 }
 531 1;