util/perl/TLSProxy/Message.pm

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