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_ccs_seen = 0;
  15 my $client_ccs_seen = 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 };
  27
  28 my %record_type = (
  29     RT_APPLICATION_DATA, "APPLICATION DATA",
  30     RT_HANDSHAKE, "HANDSHAKE",
  31     RT_ALERT, "ALERT",
  32     RT_CCS, "CCS"
  33 );
  34
  35 use constant {
  36     VERS_TLS_1_3 => 772,
  37     VERS_TLS_1_2 => 771,
  38     VERS_TLS_1_1 => 770,
  39     VERS_TLS_1_0 => 769,
  40     VERS_SSL_3_0 => 768,
  41     VERS_SSL_LT_3_0 => 767
  42 };
  43
  44 my %tls_version = (
  45     VERS_TLS_1_3, "TLS1.3",
  46     VERS_TLS_1_2, "TLS1.2",
  47     VERS_TLS_1_1, "TLS1.1",
  48     VERS_TLS_1_0, "TLS1.0",
  49     VERS_SSL_3_0, "SSL3",
  50     VERS_SSL_LT_3_0, "SSL<3"
  51 );
  52
  53 #Class method to extract records from a packet of data
  54 sub get_records
  55 {
  56     my $class = shift;
  57     my $server = shift;
  58     my $flight = shift;
  59     my $packet = shift;
  60     my @record_list = ();
  61     my @message_list = ();
  62     my $data;
  63     my $content_type;
  64     my $version;
  65     my $len;
  66     my $len_real;
  67     my $decrypt_len;
  68
  69     my $recnum = 1;
  70     while (length ($packet) > 0) {
  71         print " Record $recnum";
  72         if ($server) {
  73             print " (server -> client)\n";
  74         } else {
  75             print " (client -> server)\n";
  76         }
  77         #Get the record header
  78         if (length($packet) < TLS_RECORD_HEADER_LENGTH) {
  79             print "Partial data : ".length($packet)." bytes\n";
  80             $packet = "";
  81         } else {
  82             ($content_type, $version, $len) = unpack('CnnC*', $packet);
  83             $data = substr($packet, 5, $len);
  84
  85             print "  Content type: ".$record_type{$content_type}."\n";
  86             print "  Version: $tls_version{$version}\n";
  87             print "  Length: $len";
  88             if ($len == length($data)) {
  89                 print "\n";
  90                 $decrypt_len = $len_real = $len;
  91             } else {
  92                 print " (expected), ".length($data)." (actual)\n";
  93                 $decrypt_len = $len_real = length($data);
  94             }
  95
  96             my $record = TLSProxy::Record->new(
  97                 $flight,
  98                 $content_type,
  99                 $version,
 100                 $len,
 101                 $len_real,
 102                 $decrypt_len,
 103                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real),
 104                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real)
 105             );
 106
 107             if (($server && $server_ccs_seen)
 108                      || (!$server && $client_ccs_seen)) {
 109                 if ($etm) {
 110                     $record->decryptETM();
 111                 } else {
 112                     $record->decrypt();
 113                 }
 114             }
 115
 116             push @record_list, $record;
 117
 118             #Now figure out what messages are contained within this record
 119             my @messages = TLSProxy::Message->get_messages($server, $record);
 120             push @message_list, @messages;
 121
 122             $packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len_real);
 123             $recnum++;
 124         }
 125     }
 126
 127     return (\@record_list, \@message_list);
 128 }
 129
 130 sub clear
 131 {
 132     $server_ccs_seen = 0;
 133     $client_ccs_seen = 0;
 134 }
 135
 136 #Class level accessors
 137 sub server_ccs_seen
 138 {
 139     my $class = shift;
 140     if (@_) {
 141       $server_ccs_seen = shift;
 142     }
 143     return $server_ccs_seen;
 144 }
 145 sub client_ccs_seen
 146 {
 147     my $class = shift;
 148     if (@_) {
 149       $client_ccs_seen = shift;
 150     }
 151     return $client_ccs_seen;
 152 }
 153 #Enable/Disable Encrypt-then-MAC
 154 sub etm
 155 {
 156     my $class = shift;
 157     if (@_) {
 158       $etm = shift;
 159     }
 160     return $etm;
 161 }
 162
 163 sub new
 164 {
 165     my $class = shift;
 166     my ($flight,
 167         $content_type,
 168         $version,
 169         $len,
 170         $len_real,
 171         $decrypt_len,
 172         $data,
 173         $decrypt_data) = @_;
 174
 175     my $self = {
 176         flight => $flight,
 177         content_type => $content_type,
 178         version => $version,
 179         len => $len,
 180         len_real => $len_real,
 181         decrypt_len => $decrypt_len,
 182         data => $data,
 183         decrypt_data => $decrypt_data,
 184         orig_decrypt_data => $decrypt_data
 185     };
 186
 187     return bless $self, $class;
 188 }
 189
 190 #Decrypt using encrypt-then-MAC
 191 sub decryptETM
 192 {
 193     my ($self) = shift;
 194
 195     my $data = $self->data;
 196
 197     if($self->version >= VERS_TLS_1_1()) {
 198         #TLS1.1+ has an explicit IV. Throw it away
 199         $data = substr($data, 16);
 200     }
 201
 202     #Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
 203     $data = substr($data, 0, length($data) - 20);
 204
 205     #Find out what the padding byte is
 206     my $padval = unpack("C", substr($data, length($data) - 1));
 207
 208     #Throw away the padding
 209     $data = substr($data, 0, length($data) - ($padval + 1));
 210
 211     $self->decrypt_data($data);
 212     $self->decrypt_len(length($data));
 213
 214     return $data;
 215 }
 216
 217 #Standard decrypt
 218 sub decrypt()
 219 {
 220     my ($self) = shift;
 221
 222     my $data = $self->data;
 223
 224     if($self->version >= VERS_TLS_1_1()) {
 225         #TLS1.1+ has an explicit IV. Throw it away
 226         $data = substr($data, 16);
 227     }
 228
 229     #Find out what the padding byte is
 230     my $padval = unpack("C", substr($data, length($data) - 1));
 231
 232     #Throw away the padding
 233     $data = substr($data, 0, length($data) - ($padval + 1));
 234
 235     #Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
 236     $data = substr($data, 0, length($data) - 20);
 237
 238     $self->decrypt_data($data);
 239     $self->decrypt_len(length($data));
 240
 241     return $data;
 242 }
 243
 244 #Reconstruct the on-the-wire record representation
 245 sub reconstruct_record
 246 {
 247     my $self = shift;
 248     my $data;
 249
 250     $data = pack('Cnn', $self->content_type, $self->version, $self->len);
 251     $data .= $self->data;
 252
 253     return $data;
 254 }
 255
 256 #Read only accessors
 257 sub flight
 258 {
 259     my $self = shift;
 260     return $self->{flight};
 261 }
 262 sub content_type
 263 {
 264     my $self = shift;
 265     return $self->{content_type};
 266 }
 267 sub version
 268 {
 269     my $self = shift;
 270     return $self->{version};
 271 }
 272 sub len_real
 273 {
 274     my $self = shift;
 275     return $self->{len_real};
 276 }
 277 sub orig_decrypt_data
 278 {
 279     my $self = shift;
 280     return $self->{orig_decrypt_data};
 281 }
 282
 283 #Read/write accessors
 284 sub decrypt_len
 285 {
 286     my $self = shift;
 287     if (@_) {
 288       $self->{decrypt_len} = shift;
 289     }
 290     return $self->{decrypt_len};
 291 }
 292 sub data
 293 {
 294     my $self = shift;
 295     if (@_) {
 296       $self->{data} = shift;
 297     }
 298     return $self->{data};
 299 }
 300 sub decrypt_data
 301 {
 302     my $self = shift;
 303     if (@_) {
 304       $self->{decrypt_data} = shift;
 305     }
 306     return $self->{decrypt_data};
 307 }
 308 sub len
 309 {
 310     my $self = shift;
 311     if (@_) {
 312       $self->{len} = shift;
 313     }
 314     return $self->{len};
 315 }
 316 1;