util/TLSProxy/Record.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 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 => 773,
  39     VERS_TLS_1_3_DRAFT => 32530,
  40     VERS_TLS_1_3 => 772,
  41     VERS_TLS_1_2 => 771,
  42     VERS_TLS_1_1 => 770,
  43     VERS_TLS_1_0 => 769,
  44     VERS_SSL_3_0 => 768,
  45     VERS_SSL_LT_3_0 => 767
  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 @record_list = ();
  65     my @message_list = ();
  66     my $data;
  67     my $content_type;
  68     my $version;
  69     my $len;
  70     my $len_real;
  71     my $decrypt_len;
  72
  73     my $recnum = 1;
  74     while (length ($packet) > 0) {
  75         print " Record $recnum";
  76         if ($server) {
  77             print " (server -> client)\n";
  78         } else {
  79             print " (client -> server)\n";
  80         }
  81         #Get the record header
  82         if (length($packet) < TLS_RECORD_HEADER_LENGTH) {
  83             print "Partial data : ".length($packet)." bytes\n";
  84             $packet = "";
  85         } else {
  86             ($content_type, $version, $len) = unpack('CnnC*', $packet);
  87             $data = substr($packet, 5, $len);
  88
  89             print "  Content type: ".$record_type{$content_type}."\n";
  90             print "  Version: $tls_version{$version}\n";
  91             print "  Length: $len";
  92             if ($len == length($data)) {
  93                 print "\n";
  94                 $decrypt_len = $len_real = $len;
  95             } else {
  96                 print " (expected), ".length($data)." (actual)\n";
  97                 $decrypt_len = $len_real = length($data);
  98             }
  99
 100             my $record = TLSProxy::Record->new(
 101                 $flight,
 102                 $content_type,
 103                 $version,
 104                 $len,
 105                 0,
 106                 $len_real,
 107                 $decrypt_len,
 108                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real),
 109                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real)
 110             );
 111
 112             if (($server && $server_encrypting)
 113                      || (!$server && $client_encrypting)) {
 114                 if ($version != VERS_TLS_1_3() && $etm) {
 115                     $record->decryptETM();
 116                 } else {
 117                     $record->decrypt();
 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_real);
 128             $recnum++;
 129         }
 130     }
 131
 132     return (\@record_list, \@message_list);
 133 }
 134
 135 sub clear
 136 {
 137     $server_encrypting = 0;
 138     $client_encrypting = 0;
 139 }
 140
 141 #Class level accessors
 142 sub server_encrypting
 143 {
 144     my $class = shift;
 145     if (@_) {
 146       $server_encrypting = shift;
 147     }
 148     return $server_encrypting;
 149 }
 150 sub client_encrypting
 151 {
 152     my $class = shift;
 153     if (@_) {
 154       $client_encrypting= shift;
 155     }
 156     return $client_encrypting;
 157 }
 158 #Enable/Disable Encrypt-then-MAC
 159 sub etm
 160 {
 161     my $class = shift;
 162     if (@_) {
 163       $etm = shift;
 164     }
 165     return $etm;
 166 }
 167
 168 sub new
 169 {
 170     my $class = shift;
 171     my ($flight,
 172         $content_type,
 173         $version,
 174         $len,
 175         $sslv2,
 176         $len_real,
 177         $decrypt_len,
 178         $data,
 179         $decrypt_data) = @_;
 180
 181     my $self = {
 182         flight => $flight,
 183         content_type => $content_type,
 184         version => $version,
 185         len => $len,
 186         sslv2 => $sslv2,
 187         len_real => $len_real,
 188         decrypt_len => $decrypt_len,
 189         data => $data,
 190         decrypt_data => $decrypt_data,
 191         orig_decrypt_data => $decrypt_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 ($self->version >= VERS_TLS_1_3()) {
 233         #8 bytes for a GCM IV
 234         $data = substr($data, 8);
 235         $mactaglen = 16;
 236     } elsif ($self->version >= VERS_TLS_1_1()) {
 237         #16 bytes for a standard IV
 238         $data = substr($data, 16);
 239
 240         #Find out what the padding byte is
 241         my $padval = unpack("C", substr($data, length($data) - 1));
 242
 243         #Throw away the padding
 244         $data = substr($data, 0, length($data) - ($padval + 1));
 245     }
 246
 247     #Throw away the MAC or TAG
 248     $data = substr($data, 0, length($data) - $mactaglen);
 249
 250     $self->decrypt_data($data);
 251     $self->decrypt_len(length($data));
 252
 253     return $data;
 254 }
 255
 256 #Reconstruct the on-the-wire record representation
 257 sub reconstruct_record
 258 {
 259     my $self = shift;
 260     my $data;
 261
 262     if ($self->sslv2) {
 263         $data = pack('n', $self->len | 0x8000);
 264     } else {
 265         $data = pack('Cnn', $self->content_type, $self->version, $self->len);
 266     }
 267     $data .= $self->data;
 268
 269     return $data;
 270 }
 271
 272 #Read only accessors
 273 sub flight
 274 {
 275     my $self = shift;
 276     return $self->{flight};
 277 }
 278 sub content_type
 279 {
 280     my $self = shift;
 281     return $self->{content_type};
 282 }
 283 sub sslv2
 284 {
 285     my $self = shift;
 286     return $self->{sslv2};
 287 }
 288 sub len_real
 289 {
 290     my $self = shift;
 291     return $self->{len_real};
 292 }
 293 sub orig_decrypt_data
 294 {
 295     my $self = shift;
 296     return $self->{orig_decrypt_data};
 297 }
 298
 299 #Read/write accessors
 300 sub decrypt_len
 301 {
 302     my $self = shift;
 303     if (@_) {
 304       $self->{decrypt_len} = shift;
 305     }
 306     return $self->{decrypt_len};
 307 }
 308 sub data
 309 {
 310     my $self = shift;
 311     if (@_) {
 312       $self->{data} = shift;
 313     }
 314     return $self->{data};
 315 }
 316 sub decrypt_data
 317 {
 318     my $self = shift;
 319     if (@_) {
 320       $self->{decrypt_data} = shift;
 321     }
 322     return $self->{decrypt_data};
 323 }
 324 sub len
 325 {
 326     my $self = shift;
 327     if (@_) {
 328       $self->{len} = shift;
 329     }
 330     return $self->{len};
 331 }
 332 sub version
 333 {
 334     my $self = shift;
 335     if (@_) {
 336       $self->{version} = shift;
 337     }
 338     return $self->{version};
 339 }
 340 1;