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