util/perl/TLSProxy/Message.pm

   1 # Copyright 2016-2021 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 package TLSProxy::Message;
  11
  12 use TLSProxy::Alert;
  13
  14 use constant TLS_MESSAGE_HEADER_LENGTH => 4;
  15
  16 #Message types
  17 use constant {
  18     MT_HELLO_REQUEST => 0,
  19     MT_CLIENT_HELLO => 1,
  20     MT_SERVER_HELLO => 2,
  21     MT_NEW_SESSION_TICKET => 4,
  22     MT_ENCRYPTED_EXTENSIONS => 8,
  23     MT_CERTIFICATE => 11,
  24     MT_SERVER_KEY_EXCHANGE => 12,
  25     MT_CERTIFICATE_REQUEST => 13,
  26     MT_SERVER_HELLO_DONE => 14,
  27     MT_CERTIFICATE_VERIFY => 15,
  28     MT_CLIENT_KEY_EXCHANGE => 16,
  29     MT_FINISHED => 20,
  30     MT_CERTIFICATE_STATUS => 22,
  31     MT_COMPRESSED_CERTIFICATE => 25,
  32     MT_NEXT_PROTO => 67
  33 };
  34
  35 #Alert levels
  36 use constant {
  37     AL_LEVEL_WARN => 1,
  38     AL_LEVEL_FATAL => 2
  39 };
  40
  41 #Alert descriptions
  42 use constant {
  43     AL_DESC_CLOSE_NOTIFY => 0,
  44     AL_DESC_UNEXPECTED_MESSAGE => 10,
  45     AL_DESC_ILLEGAL_PARAMETER => 47,
  46     AL_DESC_NO_RENEGOTIATION => 100
  47 };
  48
  49 my %message_type = (
  50     MT_HELLO_REQUEST, "HelloRequest",
  51     MT_CLIENT_HELLO, "ClientHello",
  52     MT_SERVER_HELLO, "ServerHello",
  53     MT_NEW_SESSION_TICKET, "NewSessionTicket",
  54     MT_ENCRYPTED_EXTENSIONS, "EncryptedExtensions",
  55     MT_CERTIFICATE, "Certificate",
  56     MT_SERVER_KEY_EXCHANGE, "ServerKeyExchange",
  57     MT_CERTIFICATE_REQUEST, "CertificateRequest",
  58     MT_SERVER_HELLO_DONE, "ServerHelloDone",
  59     MT_CERTIFICATE_VERIFY, "CertificateVerify",
  60     MT_CLIENT_KEY_EXCHANGE, "ClientKeyExchange",
  61     MT_FINISHED, "Finished",
  62     MT_CERTIFICATE_STATUS, "CertificateStatus",
  63     MT_COMPRESSED_CERTIFICATE, "CompressedCertificate",
  64     MT_NEXT_PROTO, "NextProto"
  65 );
  66
  67 use constant {
  68     EXT_SERVER_NAME => 0,
  69     EXT_MAX_FRAGMENT_LENGTH => 1,
  70     EXT_STATUS_REQUEST => 5,
  71     EXT_SUPPORTED_GROUPS => 10,
  72     EXT_EC_POINT_FORMATS => 11,
  73     EXT_SRP => 12,
  74     EXT_SIG_ALGS => 13,
  75     EXT_USE_SRTP => 14,
  76     EXT_ALPN => 16,
  77     EXT_SCT => 18,
  78     EXT_PADDING => 21,
  79     EXT_ENCRYPT_THEN_MAC => 22,
  80     EXT_EXTENDED_MASTER_SECRET => 23,
  81     EXT_COMPRESS_CERTIFICATE => 27,
  82     EXT_SESSION_TICKET => 35,
  83     EXT_KEY_SHARE => 51,
  84     EXT_PSK => 41,
  85     EXT_SUPPORTED_VERSIONS => 43,
  86     EXT_COOKIE => 44,
  87     EXT_PSK_KEX_MODES => 45,
  88     EXT_POST_HANDSHAKE_AUTH => 49,
  89     EXT_SIG_ALGS_CERT => 50,
  90     EXT_RENEGOTIATE => 65281,
  91     EXT_NPN => 13172,
  92     EXT_CRYPTOPRO_BUG_EXTENSION => 0xfde8,
  93     EXT_UNKNOWN => 0xfffe,
  94     #Unknown extension that should appear last
  95     EXT_FORCE_LAST => 0xffff
  96 };
  97
  98 # SignatureScheme of TLS 1.3 from:
  99 # https://www.iana.org/assignments/tls-parameters/tls-parameters.xhtml#tls-signaturescheme
 100 # We have to manually grab the SHA224 equivalents from the old registry
 101 use constant {
 102     SIG_ALG_RSA_PKCS1_SHA256 => 0x0401,
 103     SIG_ALG_RSA_PKCS1_SHA384 => 0x0501,
 104     SIG_ALG_RSA_PKCS1_SHA512 => 0x0601,
 105     SIG_ALG_ECDSA_SECP256R1_SHA256 => 0x0403,
 106     SIG_ALG_ECDSA_SECP384R1_SHA384 => 0x0503,
 107     SIG_ALG_ECDSA_SECP521R1_SHA512 => 0x0603,
 108     SIG_ALG_RSA_PSS_RSAE_SHA256 => 0x0804,
 109     SIG_ALG_RSA_PSS_RSAE_SHA384 => 0x0805,
 110     SIG_ALG_RSA_PSS_RSAE_SHA512 => 0x0806,
 111     SIG_ALG_ED25519 => 0x0807,
 112     SIG_ALG_ED448 => 0x0808,
 113     SIG_ALG_RSA_PSS_PSS_SHA256 => 0x0809,
 114     SIG_ALG_RSA_PSS_PSS_SHA384 => 0x080a,
 115     SIG_ALG_RSA_PSS_PSS_SHA512 => 0x080b,
 116     SIG_ALG_RSA_PKCS1_SHA1 => 0x0201,
 117     SIG_ALG_ECDSA_SHA1 => 0x0203,
 118     SIG_ALG_DSA_SHA1 => 0x0202,
 119     SIG_ALG_DSA_SHA256 => 0x0402,
 120     SIG_ALG_DSA_SHA384 => 0x0502,
 121     SIG_ALG_DSA_SHA512 => 0x0602,
 122     OSSL_SIG_ALG_RSA_PKCS1_SHA224 => 0x0301,
 123     OSSL_SIG_ALG_DSA_SHA224 => 0x0302,
 124     OSSL_SIG_ALG_ECDSA_SHA224 => 0x0303
 125 };
 126
 127 use constant {
 128     CIPHER_RSA_WITH_AES_128_CBC_SHA => 0x002f,
 129     CIPHER_DHE_RSA_AES_128_SHA => 0x0033,
 130     CIPHER_ADH_AES_128_SHA => 0x0034,
 131     CIPHER_TLS13_AES_128_GCM_SHA256 => 0x1301,
 132     CIPHER_TLS13_AES_256_GCM_SHA384 => 0x1302
 133 };
 134
 135 use constant {
 136     CLIENT => 0,
 137     SERVER => 1
 138 };
 139
 140 my $payload = "";
 141 my $messlen = -1;
 142 my $mt;
 143 my $startoffset = -1;
 144 my $server = 0;
 145 my $success = 0;
 146 my $end = 0;
 147 my @message_rec_list = ();
 148 my @message_frag_lens = ();
 149 my $ciphersuite = 0;
 150 my $successondata = 0;
 151 my $alert;
 152
 153 sub clear
 154 {
 155     $payload = "";
 156     $messlen = -1;
 157     $startoffset = -1;
 158     $server = 0;
 159     $success = 0;
 160     $end = 0;
 161     $successondata = 0;
 162     @message_rec_list = ();
 163     @message_frag_lens = ();
 164     $alert = undef;
 165 }
 166
 167 #Class method to extract messages from a record
 168 sub get_messages
 169 {
 170     my $class = shift;
 171     my $serverin = shift;
 172     my $record = shift;
 173     my @messages = ();
 174     my $message;
 175
 176     @message_frag_lens = ();
 177
 178     if ($serverin != $server && length($payload) != 0) {
 179         die "Changed peer, but we still have fragment data\n";
 180     }
 181     $server = $serverin;
 182
 183     if ($record->content_type == TLSProxy::Record::RT_CCS) {
 184         if ($payload ne "") {
 185             #We can't handle this yet
 186             die "CCS received before message data complete\n";
 187         }
 188         if (!TLSProxy::Proxy->is_tls13()) {
 189             if ($server) {
 190                 TLSProxy::Record->server_encrypting(1);
 191             } else {
 192                 TLSProxy::Record->client_encrypting(1);
 193             }
 194         }
 195     } elsif ($record->content_type == TLSProxy::Record::RT_HANDSHAKE) {
 196         if ($record->len == 0 || $record->len_real == 0) {
 197             print "  Message truncated\n";
 198         } else {
 199             my $recoffset = 0;
 200
 201             if (length $payload > 0) {
 202                 #We are continuing processing a message started in a previous
 203                 #record. Add this record to the list associated with this
 204                 #message
 205                 push @message_rec_list, $record;
 206
 207                 if ($messlen <= length($payload)) {
 208                     #Shouldn't happen
 209                     die "Internal error: invalid messlen: ".$messlen
 210                         ." payload length:".length($payload)."\n";
 211                 }
 212                 if (length($payload) + $record->decrypt_len >= $messlen) {
 213                     #We can complete the message with this record
 214                     $recoffset = $messlen - length($payload);
 215                     $payload .= substr($record->decrypt_data, 0, $recoffset);
 216                     push @message_frag_lens, $recoffset;
 217                     $message = create_message($server, $mt, $payload,
 218                                               $startoffset);
 219                     push @messages, $message;
 220
 221                     $payload = "";
 222                 } else {
 223                     #This is just part of the total message
 224                     $payload .= $record->decrypt_data;
 225                     $recoffset = $record->decrypt_len;
 226                     push @message_frag_lens, $record->decrypt_len;
 227                 }
 228                 print "  Partial message data read: ".$recoffset." bytes\n";
 229             }
 230
 231             while ($record->decrypt_len > $recoffset) {
 232                 #We are at the start of a new message
 233                 if ($record->decrypt_len - $recoffset < 4) {
 234                     #Whilst technically probably valid we can't cope with this
 235                     die "End of record in the middle of a message header\n";
 236                 }
 237                 @message_rec_list = ($record);
 238                 my $lenhi;
 239                 my $lenlo;
 240                 ($mt, $lenhi, $lenlo) = unpack('CnC',
 241                                                substr($record->decrypt_data,
 242                                                       $recoffset));
 243                 $messlen = ($lenhi << 8) | $lenlo;
 244                 print "  Message type: $message_type{$mt}\n";
 245                 print "  Message Length: $messlen\n";
 246                 $startoffset = $recoffset;
 247                 $recoffset += 4;
 248                 $payload = "";
 249
 250                 if ($recoffset <= $record->decrypt_len) {
 251                     #Some payload data is present in this record
 252                     if ($record->decrypt_len - $recoffset >= $messlen) {
 253                         #We can complete the message with this record
 254                         $payload .= substr($record->decrypt_data, $recoffset,
 255                                            $messlen);
 256                         $recoffset += $messlen;
 257                         push @message_frag_lens, $messlen;
 258                         $message = create_message($server, $mt, $payload,
 259                                                   $startoffset);
 260                         push @messages, $message;
 261
 262                         $payload = "";
 263                     } else {
 264                         #This is just part of the total message
 265                         $payload .= substr($record->decrypt_data, $recoffset,
 266                                            $record->decrypt_len - $recoffset);
 267                         $recoffset = $record->decrypt_len;
 268                         push @message_frag_lens, $recoffset;
 269                     }
 270                 }
 271             }
 272         }
 273     } elsif ($record->content_type == TLSProxy::Record::RT_APPLICATION_DATA) {
 274         print "  [ENCRYPTED APPLICATION DATA]\n";
 275         print "  [".$record->decrypt_data."]\n";
 276
 277         if ($successondata) {
 278             $success = 1;
 279             $end = 1;
 280         }
 281     } elsif ($record->content_type == TLSProxy::Record::RT_ALERT) {
 282         my ($alertlev, $alertdesc) = unpack('CC', $record->decrypt_data);
 283         print "  [$alertlev, $alertdesc]\n";
 284         #A CloseNotify from the client indicates we have finished successfully
 285         #(we assume)
 286         if (!$end && !$server && $alertlev == AL_LEVEL_WARN
 287             && $alertdesc == AL_DESC_CLOSE_NOTIFY) {
 288             $success = 1;
 289         }
 290         #Fatal or close notify alerts end the test
 291         if ($alertlev == AL_LEVEL_FATAL || $alertdesc == AL_DESC_CLOSE_NOTIFY) {
 292             $end = 1;
 293         }
 294         $alert = TLSProxy::Alert->new(
 295             $server,
 296             $record->encrypted,
 297             $alertlev,
 298             $alertdesc);
 299     }
 300
 301     return @messages;
 302 }
 303
 304 #Function to work out which sub-class we need to create and then
 305 #construct it
 306 sub create_message
 307 {
 308     my ($server, $mt, $data, $startoffset) = @_;
 309     my $message;
 310
 311     #We only support ClientHello in this version...needs to be extended for
 312     #others
 313     if ($mt == MT_CLIENT_HELLO) {
 314         $message = TLSProxy::ClientHello->new(
 315             $server,
 316             $data,
 317             [@message_rec_list],
 318             $startoffset,
 319             [@message_frag_lens]
 320         );
 321         $message->parse();
 322     } elsif ($mt == MT_SERVER_HELLO) {
 323         $message = TLSProxy::ServerHello->new(
 324             $server,
 325             $data,
 326             [@message_rec_list],
 327             $startoffset,
 328             [@message_frag_lens]
 329         );
 330         $message->parse();
 331     } elsif ($mt == MT_ENCRYPTED_EXTENSIONS) {
 332         $message = TLSProxy::EncryptedExtensions->new(
 333             $server,
 334             $data,
 335             [@message_rec_list],
 336             $startoffset,
 337             [@message_frag_lens]
 338         );
 339         $message->parse();
 340     } elsif ($mt == MT_CERTIFICATE) {
 341         $message = TLSProxy::Certificate->new(
 342             $server,
 343             $data,
 344             [@message_rec_list],
 345             $startoffset,
 346             [@message_frag_lens]
 347         );
 348         $message->parse();
 349     } elsif ($mt == MT_CERTIFICATE_REQUEST) {
 350         $message = TLSProxy::CertificateRequest->new(
 351             $server,
 352             $data,
 353             [@message_rec_list],
 354             $startoffset,
 355             [@message_frag_lens]
 356         );
 357         $message->parse();
 358     } elsif ($mt == MT_CERTIFICATE_VERIFY) {
 359         $message = TLSProxy::CertificateVerify->new(
 360             $server,
 361             $data,
 362             [@message_rec_list],
 363             $startoffset,
 364             [@message_frag_lens]
 365         );
 366         $message->parse();
 367     } elsif ($mt == MT_SERVER_KEY_EXCHANGE) {
 368         $message = TLSProxy::ServerKeyExchange->new(
 369             $server,
 370             $data,
 371             [@message_rec_list],
 372             $startoffset,
 373             [@message_frag_lens]
 374         );
 375         $message->parse();
 376     } elsif ($mt == MT_NEW_SESSION_TICKET) {
 377         $message = TLSProxy::NewSessionTicket->new(
 378             $server,
 379             $data,
 380             [@message_rec_list],
 381             $startoffset,
 382             [@message_frag_lens]
 383         );
 384         $message->parse();
 385     } else {
 386         #Unknown message type
 387         $message = TLSProxy::Message->new(
 388             $server,
 389             $mt,
 390             $data,
 391             [@message_rec_list],
 392             $startoffset,
 393             [@message_frag_lens]
 394         );
 395     }
 396
 397     return $message;
 398 }
 399
 400 sub end
 401 {
 402     my $class = shift;
 403     return $end;
 404 }
 405 sub success
 406 {
 407     my $class = shift;
 408     return $success;
 409 }
 410 sub fail
 411 {
 412     my $class = shift;
 413     return !$success && $end;
 414 }
 415
 416 sub alert
 417 {
 418     return $alert;
 419 }
 420
 421 sub new
 422 {
 423     my $class = shift;
 424     my ($server,
 425         $mt,
 426         $data,
 427         $records,
 428         $startoffset,
 429         $message_frag_lens) = @_;
 430
 431     my $self = {
 432         server => $server,
 433         data => $data,
 434         records => $records,
 435         mt => $mt,
 436         startoffset => $startoffset,
 437         message_frag_lens => $message_frag_lens,
 438         dupext => -1
 439     };
 440
 441     return bless $self, $class;
 442 }
 443
 444 sub ciphersuite
 445 {
 446     my $class = shift;
 447     if (@_) {
 448       $ciphersuite = shift;
 449     }
 450     return $ciphersuite;
 451 }
 452
 453 #Update all the underlying records with the modified data from this message
 454 #Note: Only supports TLSv1.3 and ETM encryption
 455 sub repack
 456 {
 457     my $self = shift;
 458     my $msgdata;
 459
 460     my $numrecs = $#{$self->records};
 461
 462     $self->set_message_contents();
 463
 464     my $lenhi;
 465     my $lenlo;
 466
 467     $lenlo = length($self->data) & 0xff;
 468     $lenhi = length($self->data) >> 8;
 469     $msgdata = pack('CnC', $self->mt, $lenhi, $lenlo).$self->data;
 470
 471     if ($numrecs == 0) {
 472         #The message is fully contained within one record
 473         my ($rec) = @{$self->records};
 474         my $recdata = $rec->decrypt_data;
 475
 476         my $old_length;
 477
 478         # We use empty message_frag_lens to indicates that pre-repacking,
 479         # the message wasn't present. The first fragment length doesn't include
 480         # the TLS header, so we need to check and compute the right length.
 481         if (@{$self->message_frag_lens}) {
 482             $old_length = ${$self->message_frag_lens}[0] +
 483               TLS_MESSAGE_HEADER_LENGTH;
 484         } else {
 485             $old_length = 0;
 486         }
 487
 488         my $prefix = substr($recdata, 0, $self->startoffset);
 489         my $suffix = substr($recdata, $self->startoffset + $old_length);
 490
 491         $rec->decrypt_data($prefix.($msgdata).($suffix));
 492         # TODO(openssl-team): don't keep explicit lengths.
 493         # (If a length override is ever needed to construct invalid packets,
 494         #  use an explicit override field instead.)
 495         $rec->decrypt_len(length($rec->decrypt_data));
 496         # Only support re-encryption for TLSv1.3 and ETM.
 497         if ($rec->encrypted()) {
 498             if (TLSProxy::Proxy->is_tls13()) {
 499                 #Add content type (1 byte) and 16 tag bytes
 500                 $rec->data($rec->decrypt_data
 501                     .pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16));
 502             } elsif ($rec->etm()) {
 503                 my $data = $rec->decrypt_data;
 504                 #Add padding
 505                 my $padval = length($data) % 16;
 506                 $padval = 15 - $padval;
 507                 for (0..$padval) {
 508                     $data .= pack("C", $padval);
 509                 }
 510
 511                 #Add MAC. Assumed to be 20 bytes
 512                 foreach my $macval (0..19) {
 513                     $data .= pack("C", $macval);
 514                 }
 515
 516                 if ($rec->version() >= TLSProxy::Record::VERS_TLS_1_1) {
 517                     #Explicit IV
 518                     $data = ("\0"x16).$data;
 519                 }
 520                 $rec->data($data);
 521             } else {
 522                 die "Unsupported encryption: No ETM";
 523             }
 524         } else {
 525             $rec->data($rec->decrypt_data);
 526         }
 527         $rec->len(length($rec->data));
 528
 529         #Update the fragment len in case we changed it above
 530         ${$self->message_frag_lens}[0] = length($msgdata)
 531                                          - TLS_MESSAGE_HEADER_LENGTH;
 532         return;
 533     }
 534
 535     #Note we don't currently support changing a fragmented message length
 536     my $recctr = 0;
 537     my $datadone = 0;
 538     foreach my $rec (@{$self->records}) {
 539         my $recdata = $rec->decrypt_data;
 540         if ($recctr == 0) {
 541             #This is the first record
 542             my $remainlen = length($recdata) - $self->startoffset;
 543             $rec->data(substr($recdata, 0, $self->startoffset)
 544                        .substr(($msgdata), 0, $remainlen));
 545             $datadone += $remainlen;
 546         } elsif ($recctr + 1 == $numrecs) {
 547             #This is the last record
 548             $rec->data(substr($msgdata, $datadone));
 549         } else {
 550             #This is a middle record
 551             $rec->data(substr($msgdata, $datadone, length($rec->data)));
 552             $datadone += length($rec->data);
 553         }
 554         $recctr++;
 555     }
 556 }
 557
 558 #To be overridden by sub-classes
 559 sub set_message_contents
 560 {
 561 }
 562
 563 #Read only accessors
 564 sub server
 565 {
 566     my $self = shift;
 567     return $self->{server};
 568 }
 569
 570 #Read/write accessors
 571 sub mt
 572 {
 573     my $self = shift;
 574     if (@_) {
 575       $self->{mt} = shift;
 576     }
 577     return $self->{mt};
 578 }
 579 sub data
 580 {
 581     my $self = shift;
 582     if (@_) {
 583       $self->{data} = shift;
 584     }
 585     return $self->{data};
 586 }
 587 sub records
 588 {
 589     my $self = shift;
 590     if (@_) {
 591       $self->{records} = shift;
 592     }
 593     return $self->{records};
 594 }
 595 sub startoffset
 596 {
 597     my $self = shift;
 598     if (@_) {
 599       $self->{startoffset} = shift;
 600     }
 601     return $self->{startoffset};
 602 }
 603 sub message_frag_lens
 604 {
 605     my $self = shift;
 606     if (@_) {
 607       $self->{message_frag_lens} = shift;
 608     }
 609     return $self->{message_frag_lens};
 610 }
 611 sub encoded_length
 612 {
 613     my $self = shift;
 614     return TLS_MESSAGE_HEADER_LENGTH + length($self->data);
 615 }
 616 sub dupext
 617 {
 618     my $self = shift;
 619     if (@_) {
 620         $self->{dupext} = shift;
 621     }
 622     return $self->{dupext};
 623 }
 624 sub successondata
 625 {
 626     my $class = shift;
 627     if (@_) {
 628         $successondata = shift;
 629     }
 630     return $successondata;
 631 }
 632 1;