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