lib/openssl/util/TLSProxy/Message.pm

   1 # Copyright 2016 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 constant TLS_MESSAGE_HEADER_LENGTH => 4;
  13
  14 #Message types
  15 use constant {
  16     MT_HELLO_REQUEST => 0,
  17     MT_CLIENT_HELLO => 1,
  18     MT_SERVER_HELLO => 2,
  19     MT_NEW_SESSION_TICKET => 4,
  20     MT_CERTIFICATE => 11,
  21     MT_SERVER_KEY_EXCHANGE => 12,
  22     MT_CERTIFICATE_REQUEST => 13,
  23     MT_SERVER_HELLO_DONE => 14,
  24     MT_CERTIFICATE_VERIFY => 15,
  25     MT_CLIENT_KEY_EXCHANGE => 16,
  26     MT_FINISHED => 20,
  27     MT_CERTIFICATE_STATUS => 22,
  28     MT_NEXT_PROTO => 67
  29 };
  30
  31 #Alert levels
  32 use constant {
  33     AL_LEVEL_WARN => 1,
  34     AL_LEVEL_FATAL => 2
  35 };
  36
  37 #Alert descriptions
  38 use constant {
  39     AL_DESC_CLOSE_NOTIFY => 0,
  40     AL_DESC_UNEXPECTED_MESSAGE => 10,
  41     AL_DESC_NO_RENEGOTIATION => 100
  42 };
  43
  44 my %message_type = (
  45     MT_HELLO_REQUEST, "HelloRequest",
  46     MT_CLIENT_HELLO, "ClientHello",
  47     MT_SERVER_HELLO, "ServerHello",
  48     MT_NEW_SESSION_TICKET, "NewSessionTicket",
  49     MT_CERTIFICATE, "Certificate",
  50     MT_SERVER_KEY_EXCHANGE, "ServerKeyExchange",
  51     MT_CERTIFICATE_REQUEST, "CertificateRequest",
  52     MT_SERVER_HELLO_DONE, "ServerHelloDone",
  53     MT_CERTIFICATE_VERIFY, "CertificateVerify",
  54     MT_CLIENT_KEY_EXCHANGE, "ClientKeyExchange",
  55     MT_FINISHED, "Finished",
  56     MT_CERTIFICATE_STATUS, "CertificateStatus",
  57     MT_NEXT_PROTO, "NextProto"
  58 );
  59
  60 use constant {
  61     EXT_STATUS_REQUEST => 5,
  62     EXT_ENCRYPT_THEN_MAC => 22,
  63     EXT_EXTENDED_MASTER_SECRET => 23,
  64     EXT_SESSION_TICKET => 35,
  65     # This extension does not exist and isn't recognised by OpenSSL.
  66     # We use it to test handling of duplicate extensions.
  67     EXT_DUPLICATE_EXTENSION => 1234
  68 };
  69
  70 my $payload = "";
  71 my $messlen = -1;
  72 my $mt;
  73 my $startoffset = -1;
  74 my $server = 0;
  75 my $success = 0;
  76 my $end = 0;
  77 my @message_rec_list = ();
  78 my @message_frag_lens = ();
  79 my $ciphersuite = 0;
  80
  81 sub clear
  82 {
  83     $payload = "";
  84     $messlen = -1;
  85     $startoffset = -1;
  86     $server = 0;
  87     $success = 0;
  88     $end = 0;
  89     @message_rec_list = ();
  90     @message_frag_lens = ();
  91 }
  92
  93 #Class method to extract messages from a record
  94 sub get_messages
  95 {
  96     my $class = shift;
  97     my $serverin = shift;
  98     my $record = shift;
  99     my @messages = ();
 100     my $message;
 101
 102     @message_frag_lens = ();
 103
 104     if ($serverin != $server && length($payload) != 0) {
 105         die "Changed peer, but we still have fragment data\n";
 106     }
 107     $server = $serverin;
 108
 109     if ($record->content_type == TLSProxy::Record::RT_CCS) {
 110         if ($payload ne "") {
 111             #We can't handle this yet
 112             die "CCS received before message data complete\n";
 113         }
 114         if ($server) {
 115             TLSProxy::Record->server_ccs_seen(1);
 116         } else {
 117             TLSProxy::Record->client_ccs_seen(1);
 118         }
 119     } elsif ($record->content_type == TLSProxy::Record::RT_HANDSHAKE) {
 120         if ($record->len == 0 || $record->len_real == 0) {
 121             print "  Message truncated\n";
 122         } else {
 123             my $recoffset = 0;
 124
 125             if (length $payload > 0) {
 126                 #We are continuing processing a message started in a previous
 127                 #record. Add this record to the list associated with this
 128                 #message
 129                 push @message_rec_list, $record;
 130
 131                 if ($messlen <= length($payload)) {
 132                     #Shouldn't happen
 133                     die "Internal error: invalid messlen: ".$messlen
 134                         ." payload length:".length($payload)."\n";
 135                 }
 136                 if (length($payload) + $record->decrypt_len >= $messlen) {
 137                     #We can complete the message with this record
 138                     $recoffset = $messlen - length($payload);
 139                     $payload .= substr($record->decrypt_data, 0, $recoffset);
 140                     push @message_frag_lens, $recoffset;
 141                     $message = create_message($server, $mt, $payload,
 142                                               $startoffset);
 143                     push @messages, $message;
 144
 145                     $payload = "";
 146                 } else {
 147                     #This is just part of the total message
 148                     $payload .= $record->decrypt_data;
 149                     $recoffset = $record->decrypt_len;
 150                     push @message_frag_lens, $record->decrypt_len;
 151                 }
 152                 print "  Partial message data read: ".$recoffset." bytes\n";
 153             }
 154
 155             while ($record->decrypt_len > $recoffset) {
 156                 #We are at the start of a new message
 157                 if ($record->decrypt_len - $recoffset < 4) {
 158                     #Whilst technically probably valid we can't cope with this
 159                     die "End of record in the middle of a message header\n";
 160                 }
 161                 @message_rec_list = ($record);
 162                 my $lenhi;
 163                 my $lenlo;
 164                 ($mt, $lenhi, $lenlo) = unpack('CnC',
 165                                                substr($record->decrypt_data,
 166                                                       $recoffset));
 167                 $messlen = ($lenhi << 8) | $lenlo;
 168                 print "  Message type: $message_type{$mt}\n";
 169                 print "  Message Length: $messlen\n";
 170                 $startoffset = $recoffset;
 171                 $recoffset += 4;
 172                 $payload = "";
 173
 174                 if ($recoffset < $record->decrypt_len) {
 175                     #Some payload data is present in this record
 176                     if ($record->decrypt_len - $recoffset >= $messlen) {
 177                         #We can complete the message with this record
 178                         $payload .= substr($record->decrypt_data, $recoffset,
 179                                            $messlen);
 180                         $recoffset += $messlen;
 181                         push @message_frag_lens, $messlen;
 182                         $message = create_message($server, $mt, $payload,
 183                                                   $startoffset);
 184                         push @messages, $message;
 185
 186                         $payload = "";
 187                     } else {
 188                         #This is just part of the total message
 189                         $payload .= substr($record->decrypt_data, $recoffset,
 190                                            $record->decrypt_len - $recoffset);
 191                         $recoffset = $record->decrypt_len;
 192                         push @message_frag_lens, $recoffset;
 193                     }
 194                 }
 195             }
 196         }
 197     } elsif ($record->content_type == TLSProxy::Record::RT_APPLICATION_DATA) {
 198         print "  [ENCRYPTED APPLICATION DATA]\n";
 199         print "  [".$record->decrypt_data."]\n";
 200     } elsif ($record->content_type == TLSProxy::Record::RT_ALERT) {
 201         my ($alertlev, $alertdesc) = unpack('CC', $record->decrypt_data);
 202         #A CloseNotify from the client indicates we have finished successfully
 203         #(we assume)
 204         if (!$end && !$server && $alertlev == AL_LEVEL_WARN
 205             && $alertdesc == AL_DESC_CLOSE_NOTIFY) {
 206             $success = 1;
 207         }
 208         #All alerts end the test
 209         $end = 1;
 210     }
 211
 212     return @messages;
 213 }
 214
 215 #Function to work out which sub-class we need to create and then
 216 #construct it
 217 sub create_message
 218 {
 219     my ($server, $mt, $data, $startoffset) = @_;
 220     my $message;
 221
 222     #We only support ClientHello in this version...needs to be extended for
 223     #others
 224     if ($mt == MT_CLIENT_HELLO) {
 225         $message = TLSProxy::ClientHello->new(
 226             $server,
 227             $data,
 228             [@message_rec_list],
 229             $startoffset,
 230             [@message_frag_lens]
 231         );
 232         $message->parse();
 233     } elsif ($mt == MT_SERVER_HELLO) {
 234         $message = TLSProxy::ServerHello->new(
 235             $server,
 236             $data,
 237             [@message_rec_list],
 238             $startoffset,
 239             [@message_frag_lens]
 240         );
 241         $message->parse();
 242     } elsif ($mt == MT_SERVER_KEY_EXCHANGE) {
 243         $message = TLSProxy::ServerKeyExchange->new(
 244             $server,
 245             $data,
 246             [@message_rec_list],
 247             $startoffset,
 248             [@message_frag_lens]
 249         );
 250         $message->parse();
 251     } elsif ($mt == MT_NEW_SESSION_TICKET) {
 252         $message = TLSProxy::NewSessionTicket->new(
 253             $server,
 254             $data,
 255             [@message_rec_list],
 256             $startoffset,
 257             [@message_frag_lens]
 258         );
 259         $message->parse();
 260     } else {
 261         #Unknown message type
 262         $message = TLSProxy::Message->new(
 263             $server,
 264             $mt,
 265             $data,
 266             [@message_rec_list],
 267             $startoffset,
 268             [@message_frag_lens]
 269         );
 270     }
 271
 272     return $message;
 273 }
 274
 275 sub end
 276 {
 277     my $class = shift;
 278     return $end;
 279 }
 280 sub success
 281 {
 282     my $class = shift;
 283     return $success;
 284 }
 285 sub fail
 286 {
 287     my $class = shift;
 288     return !$success && $end;
 289 }
 290 sub new
 291 {
 292     my $class = shift;
 293     my ($server,
 294         $mt,
 295         $data,
 296         $records,
 297         $startoffset,
 298         $message_frag_lens) = @_;
 299
 300     my $self = {
 301         server => $server,
 302         data => $data,
 303         records => $records,
 304         mt => $mt,
 305         startoffset => $startoffset,
 306         message_frag_lens => $message_frag_lens
 307     };
 308
 309     return bless $self, $class;
 310 }
 311
 312 sub ciphersuite
 313 {
 314     my $class = shift;
 315     if (@_) {
 316       $ciphersuite = shift;
 317     }
 318     return $ciphersuite;
 319 }
 320
 321 #Update all the underlying records with the modified data from this message
 322 #Note: Does not currently support re-encrypting
 323 sub repack
 324 {
 325     my $self = shift;
 326     my $msgdata;
 327
 328     my $numrecs = $#{$self->records};
 329
 330     $self->set_message_contents();
 331
 332     my $lenhi;
 333     my $lenlo;
 334
 335     $lenlo = length($self->data) & 0xff;
 336     $lenhi = length($self->data) >> 8;
 337     $msgdata = pack('CnC', $self->mt, $lenhi, $lenlo).$self->data;
 338
 339     if ($numrecs == 0) {
 340         #The message is fully contained within one record
 341         my ($rec) = @{$self->records};
 342         my $recdata = $rec->decrypt_data;
 343
 344         my $old_length;
 345
 346         # We use empty message_frag_lens to indicates that pre-repacking,
 347         # the message wasn't present. The first fragment length doesn't include
 348         # the TLS header, so we need to check and compute the right length.
 349         if (@{$self->message_frag_lens}) {
 350             $old_length = ${$self->message_frag_lens}[0] +
 351               TLS_MESSAGE_HEADER_LENGTH;
 352         } else {
 353             $old_length = 0;
 354         }
 355
 356         my $prefix = substr($recdata, 0, $self->startoffset);
 357         my $suffix = substr($recdata, $self->startoffset + $old_length);
 358
 359         $rec->decrypt_data($prefix.($msgdata).($suffix));
 360         # TODO(openssl-team): don't keep explicit lengths.
 361         # (If a length override is ever needed to construct invalid packets,
 362         #  use an explicit override field instead.)
 363         $rec->decrypt_len(length($rec->decrypt_data));
 364         $rec->len($rec->len + length($msgdata) - $old_length);
 365         # Don't support re-encryption.
 366         $rec->data($rec->decrypt_data);
 367
 368         #Update the fragment len in case we changed it above
 369         ${$self->message_frag_lens}[0] = length($msgdata)
 370                                          - TLS_MESSAGE_HEADER_LENGTH;
 371         return;
 372     }
 373
 374     #Note we don't currently support changing a fragmented message length
 375     my $recctr = 0;
 376     my $datadone = 0;
 377     foreach my $rec (@{$self->records}) {
 378         my $recdata = $rec->decrypt_data;
 379         if ($recctr == 0) {
 380             #This is the first record
 381             my $remainlen = length($recdata) - $self->startoffset;
 382             $rec->data(substr($recdata, 0, $self->startoffset)
 383                        .substr(($msgdata), 0, $remainlen));
 384             $datadone += $remainlen;
 385         } elsif ($recctr + 1 == $numrecs) {
 386             #This is the last record
 387             $rec->data(substr($msgdata, $datadone));
 388         } else {
 389             #This is a middle record
 390             $rec->data(substr($msgdata, $datadone, length($rec->data)));
 391             $datadone += length($rec->data);
 392         }
 393         $recctr++;
 394     }
 395 }
 396
 397 #To be overridden by sub-classes
 398 sub set_message_contents
 399 {
 400 }
 401
 402 #Read only accessors
 403 sub server
 404 {
 405     my $self = shift;
 406     return $self->{server};
 407 }
 408
 409 #Read/write accessors
 410 sub mt
 411 {
 412     my $self = shift;
 413     if (@_) {
 414       $self->{mt} = shift;
 415     }
 416     return $self->{mt};
 417 }
 418 sub data
 419 {
 420     my $self = shift;
 421     if (@_) {
 422       $self->{data} = shift;
 423     }
 424     return $self->{data};
 425 }
 426 sub records
 427 {
 428     my $self = shift;
 429     if (@_) {
 430       $self->{records} = shift;
 431     }
 432     return $self->{records};
 433 }
 434 sub startoffset
 435 {
 436     my $self = shift;
 437     if (@_) {
 438       $self->{startoffset} = shift;
 439     }
 440     return $self->{startoffset};
 441 }
 442 sub message_frag_lens
 443 {
 444     my $self = shift;
 445     if (@_) {
 446       $self->{message_frag_lens} = shift;
 447     }
 448     return $self->{message_frag_lens};
 449 }
 450 sub encoded_length
 451 {
 452     my $self = shift;
 453     return TLS_MESSAGE_HEADER_LENGTH + length($self->data);
 454 }
 455
 456 1;