util/perl/TLSProxy/Record.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 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 TLS_RECORD_HEADER_LENGTH => 5;
  19
  20 #Record types
  21 use constant {
  22     RT_APPLICATION_DATA => 23,
  23     RT_HANDSHAKE => 22,
  24     RT_ALERT => 21,
  25     RT_CCS => 20,
  26     RT_UNKNOWN => 100
  27 };
  28
  29 my %record_type = (
  30     RT_APPLICATION_DATA, "APPLICATION DATA",
  31     RT_HANDSHAKE, "HANDSHAKE",
  32     RT_ALERT, "ALERT",
  33     RT_CCS, "CCS",
  34     RT_UNKNOWN, "UNKNOWN"
  35 );
  36
  37 use constant {
  38     VERS_TLS_1_4 => 0x0305,
  39     VERS_TLS_1_3_DRAFT => 0x7f1c,
  40     VERS_TLS_1_3 => 0x0304,
  41     VERS_TLS_1_2 => 0x0303,
  42     VERS_TLS_1_1 => 0x0302,
  43     VERS_TLS_1_0 => 0x0301,
  44     VERS_SSL_3_0 => 0x0300,
  45     VERS_SSL_LT_3_0 => 0x02ff
  46 };
  47
  48 my %tls_version = (
  49     VERS_TLS_1_3, "TLS1.3",
  50     VERS_TLS_1_2, "TLS1.2",
  51     VERS_TLS_1_1, "TLS1.1",
  52     VERS_TLS_1_0, "TLS1.0",
  53     VERS_SSL_3_0, "SSL3",
  54     VERS_SSL_LT_3_0, "SSL<3"
  55 );
  56
  57 #Class method to extract records from a packet of data
  58 sub get_records
  59 {
  60     my $class = shift;
  61     my $server = shift;
  62     my $flight = shift;
  63     my $packet = shift;
  64     my $partial = "";
  65     my @record_list = ();
  66     my @message_list = ();
  67
  68     my $recnum = 1;
  69     while (length ($packet) > 0) {
  70         print " Record $recnum ", $server ? "(server -> client)\n"
  71                                           : "(client -> server)\n";
  72
  73         #Get the record header (unpack can't fail if $packet is too short)
  74         my ($content_type, $version, $len) = unpack('Cnn', $packet);
  75
  76         if (length($packet) < TLS_RECORD_HEADER_LENGTH + ($len // 0)) {
  77             print "Partial data : ".length($packet)." bytes\n";
  78             $partial = $packet;
  79             last;
  80         }
  81
  82         my $data = substr($packet, TLS_RECORD_HEADER_LENGTH, $len);
  83
  84         print "  Content type: ".$record_type{$content_type}."\n";
  85         print "  Version: $tls_version{$version}\n";
  86         print "  Length: $len\n";
  87
  88         my $record = TLSProxy::Record->new(
  89             $flight,
  90             $content_type,
  91             $version,
  92             $len,
  93             0,
  94             $len,       # len_real
  95             $len,       # decrypt_len
  96             $data,      # data
  97             $data       # decrypt_data
  98         );
  99
 100         if ($content_type != RT_CCS
 101                 && (!TLSProxy::Proxy->is_tls13()
 102                     || $content_type != RT_ALERT)) {
 103             if (($server && $server_encrypting)
 104                      || (!$server && $client_encrypting)) {
 105                 if (!TLSProxy::Proxy->is_tls13() && $etm) {
 106                     $record->decryptETM();
 107                 } else {
 108                     $record->decrypt();
 109                 }
 110                 $record->encrypted(1);
 111
 112                 if (TLSProxy::Proxy->is_tls13()) {
 113                     print "  Inner content type: "
 114                           .$record_type{$record->content_type()}."\n";
 115                 }
 116             }
 117         }
 118
 119         push @record_list, $record;
 120
 121         #Now figure out what messages are contained within this record
 122         my @messages = TLSProxy::Message->get_messages($server, $record);
 123         push @message_list, @messages;
 124
 125         $packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len);
 126         $recnum++;
 127     }
 128
 129     return (\@record_list, \@message_list, $partial);
 130 }
 131
 132 sub clear
 133 {
 134     $server_encrypting = 0;
 135     $client_encrypting = 0;
 136 }
 137
 138 #Class level accessors
 139 sub server_encrypting
 140 {
 141     my $class = shift;
 142     if (@_) {
 143       $server_encrypting = shift;
 144     }
 145     return $server_encrypting;
 146 }
 147 sub client_encrypting
 148 {
 149     my $class = shift;
 150     if (@_) {
 151       $client_encrypting= shift;
 152     }
 153     return $client_encrypting;
 154 }
 155 #Enable/Disable Encrypt-then-MAC
 156 sub etm
 157 {
 158     my $class = shift;
 159     if (@_) {
 160       $etm = shift;
 161     }
 162     return $etm;
 163 }
 164
 165 sub new
 166 {
 167     my $class = shift;
 168     my ($flight,
 169         $content_type,
 170         $version,
 171         $len,
 172         $sslv2,
 173         $len_real,
 174         $decrypt_len,
 175         $data,
 176         $decrypt_data) = @_;
 177
 178     my $self = {
 179         flight => $flight,
 180         content_type => $content_type,
 181         version => $version,
 182         len => $len,
 183         sslv2 => $sslv2,
 184         len_real => $len_real,
 185         decrypt_len => $decrypt_len,
 186         data => $data,
 187         decrypt_data => $decrypt_data,
 188         orig_decrypt_data => $decrypt_data,
 189         sent => 0,
 190         encrypted => 0,
 191         outer_content_type => RT_APPLICATION_DATA
 192     };
 193
 194     return bless $self, $class;
 195 }
 196
 197 #Decrypt using encrypt-then-MAC
 198 sub decryptETM
 199 {
 200     my ($self) = shift;
 201
 202     my $data = $self->data;
 203
 204     if($self->version >= VERS_TLS_1_1()) {
 205         #TLS1.1+ has an explicit IV. Throw it away
 206         $data = substr($data, 16);
 207     }
 208
 209     #Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
 210     $data = substr($data, 0, length($data) - 20);
 211
 212     #Find out what the padding byte is
 213     my $padval = unpack("C", substr($data, length($data) - 1));
 214
 215     #Throw away the padding
 216     $data = substr($data, 0, length($data) - ($padval + 1));
 217
 218     $self->decrypt_data($data);
 219     $self->decrypt_len(length($data));
 220
 221     return $data;
 222 }
 223
 224 #Standard decrypt
 225 sub decrypt()
 226 {
 227     my ($self) = shift;
 228     my $mactaglen = 20;
 229     my $data = $self->data;
 230
 231     #Throw away any IVs
 232     if (TLSProxy::Proxy->is_tls13()) {
 233         #A TLS1.3 client, when processing the server's initial flight, could
 234         #respond with either an encrypted or an unencrypted alert.
 235         if ($self->content_type() == RT_ALERT) {
 236             #TODO(TLS1.3): Eventually it is sufficient just to check the record
 237             #content type. If an alert is encrypted it will have a record
 238             #content type of application data. However we haven't done the
 239             #record layer changes yet, so it's a bit more complicated. For now
 240             #we will additionally check if the data length is 2 (1 byte for
 241             #alert level, 1 byte for alert description). If it is, then this is
 242             #an unencrypted alert, so don't try to decrypt
 243             return $data if (length($data) == 2);
 244         }
 245         $mactaglen = 16;
 246     } elsif ($self->version >= VERS_TLS_1_1()) {
 247         #16 bytes for a standard IV
 248         $data = substr($data, 16);
 249
 250         #Find out what the padding byte is
 251         my $padval = unpack("C", substr($data, length($data) - 1));
 252
 253         #Throw away the padding
 254         $data = substr($data, 0, length($data) - ($padval + 1));
 255     }
 256
 257     #Throw away the MAC or TAG
 258     $data = substr($data, 0, length($data) - $mactaglen);
 259
 260     if (TLSProxy::Proxy->is_tls13()) {
 261         #Get the content type
 262         my $content_type = unpack("C", substr($data, length($data) - 1));
 263         $self->content_type($content_type);
 264         $data = substr($data, 0, length($data) - 1);
 265     }
 266
 267     $self->decrypt_data($data);
 268     $self->decrypt_len(length($data));
 269
 270     return $data;
 271 }
 272
 273 #Reconstruct the on-the-wire record representation
 274 sub reconstruct_record
 275 {
 276     my $self = shift;
 277     my $server = shift;
 278     my $data;
 279
 280     #We only replay the records in the same direction
 281     if ($self->{sent} || ($self->flight & 1) != $server) {
 282         return "";
 283     }
 284     $self->{sent} = 1;
 285
 286     if ($self->sslv2) {
 287         $data = pack('n', $self->len | 0x8000);
 288     } else {
 289         if (TLSProxy::Proxy->is_tls13() && $self->encrypted) {
 290             $data = pack('Cnn', $self->outer_content_type, $self->version,
 291                          $self->len);
 292         } else {
 293             $data = pack('Cnn', $self->content_type, $self->version,
 294                          $self->len);
 295         }
 296
 297     }
 298     $data .= $self->data;
 299
 300     return $data;
 301 }
 302
 303 #Read only accessors
 304 sub flight
 305 {
 306     my $self = shift;
 307     return $self->{flight};
 308 }
 309 sub sslv2
 310 {
 311     my $self = shift;
 312     return $self->{sslv2};
 313 }
 314 sub len_real
 315 {
 316     my $self = shift;
 317     return $self->{len_real};
 318 }
 319 sub orig_decrypt_data
 320 {
 321     my $self = shift;
 322     return $self->{orig_decrypt_data};
 323 }
 324
 325 #Read/write accessors
 326 sub decrypt_len
 327 {
 328     my $self = shift;
 329     if (@_) {
 330       $self->{decrypt_len} = shift;
 331     }
 332     return $self->{decrypt_len};
 333 }
 334 sub data
 335 {
 336     my $self = shift;
 337     if (@_) {
 338       $self->{data} = shift;
 339     }
 340     return $self->{data};
 341 }
 342 sub decrypt_data
 343 {
 344     my $self = shift;
 345     if (@_) {
 346       $self->{decrypt_data} = shift;
 347     }
 348     return $self->{decrypt_data};
 349 }
 350 sub len
 351 {
 352     my $self = shift;
 353     if (@_) {
 354       $self->{len} = shift;
 355     }
 356     return $self->{len};
 357 }
 358 sub version
 359 {
 360     my $self = shift;
 361     if (@_) {
 362       $self->{version} = shift;
 363     }
 364     return $self->{version};
 365 }
 366 sub content_type
 367 {
 368     my $self = shift;
 369     if (@_) {
 370       $self->{content_type} = shift;
 371     }
 372     return $self->{content_type};
 373 }
 374 sub encrypted
 375 {
 376     my $self = shift;
 377     if (@_) {
 378       $self->{encrypted} = shift;
 379     }
 380     return $self->{encrypted};
 381 }
 382 sub outer_content_type
 383 {
 384     my $self = shift;
 385     if (@_) {
 386       $self->{outer_content_type} = shift;
 387     }
 388     return $self->{outer_content_type};
 389 }
 390 sub is_fatal_alert
 391 {
 392     my $self = shift;
 393     my $server = shift;
 394
 395     if (($self->{flight} & 1) == $server
 396         && $self->{content_type} == TLSProxy::Record::RT_ALERT) {
 397         my ($level, $alert) = unpack('CC', $self->decrypt_data);
 398         return $alert if ($level == 2);
 399     }
 400     return 0;
 401 }
 402 1;