util/perl/TLSProxy/Message.pm

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