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