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                 0,
 102                 $len_real,
 103                 $decrypt_len,
 104                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real),
 105                 substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real)
 106             );
 107
 108             if (($server && $server_ccs_seen)
 109                      || (!$server && $client_ccs_seen)) {
 110                 if ($version != VERS_TLS_1_3() && $etm) {
 111                     $record->decryptETM();
 112                 } else {
 113                     $record->decrypt();
 114                 }
 115             }
 116
 117             push @record_list, $record;
 118
 119             #Now figure out what messages are contained within this record
 120             my @messages = TLSProxy::Message->get_messages($server, $record);
 121             push @message_list, @messages;
 122
 123             $packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len_real);
 124             $recnum++;
 125         }
 126     }
 127
 128     return (\@record_list, \@message_list);
 129 }
 130
 131 sub clear
 132 {
 133     $server_ccs_seen = 0;
 134     $client_ccs_seen = 0;
 135 }
 136
 137 #Class level accessors
 138 sub server_ccs_seen
 139 {
 140     my $class = shift;
 141     if (@_) {
 142       $server_ccs_seen = shift;
 143     }
 144     return $server_ccs_seen;
 145 }
 146 sub client_ccs_seen
 147 {
 148     my $class = shift;
 149     if (@_) {
 150       $client_ccs_seen = shift;
 151     }
 152     return $client_ccs_seen;
 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     };
 189
 190     return bless $self, $class;
 191 }
 192
 193 #Decrypt using encrypt-then-MAC
 194 sub decryptETM
 195 {
 196     my ($self) = shift;
 197
 198     my $data = $self->data;
 199
 200     if($self->version >= VERS_TLS_1_1()) {
 201         #TLS1.1+ has an explicit IV. Throw it away
 202         $data = substr($data, 16);
 203     }
 204
 205     #Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
 206     $data = substr($data, 0, length($data) - 20);
 207
 208     #Find out what the padding byte is
 209     my $padval = unpack("C", substr($data, length($data) - 1));
 210
 211     #Throw away the padding
 212     $data = substr($data, 0, length($data) - ($padval + 1));
 213
 214     $self->decrypt_data($data);
 215     $self->decrypt_len(length($data));
 216
 217     return $data;
 218 }
 219
 220 #Standard decrypt
 221 sub decrypt()
 222 {
 223     my ($self) = shift;
 224     my $mactaglen = 20;
 225     my $data = $self->data;
 226
 227     #Throw away any IVs
 228     if ($self->version >= VERS_TLS_1_3()) {
 229         #8 bytes for a GCM IV
 230         $data = substr($data, 8);
 231         $mactaglen = 16;
 232     } elsif ($self->version >= VERS_TLS_1_1()) {
 233         #16 bytes for a standard IV
 234         $data = substr($data, 16);
 235
 236         #Find out what the padding byte is
 237         my $padval = unpack("C", substr($data, length($data) - 1));
 238
 239         #Throw away the padding
 240         $data = substr($data, 0, length($data) - ($padval + 1));
 241     }
 242
 243     #Throw away the MAC or TAG
 244     $data = substr($data, 0, length($data) - $mactaglen);
 245
 246     $self->decrypt_data($data);
 247     $self->decrypt_len(length($data));
 248
 249     return $data;
 250 }
 251
 252 #Reconstruct the on-the-wire record representation
 253 sub reconstruct_record
 254 {
 255     my $self = shift;
 256     my $data;
 257
 258     if ($self->sslv2) {
 259         $data = pack('n', $self->len | 0x8000);
 260     } else {
 261         $data = pack('Cnn', $self->content_type, $self->version, $self->len);
 262     }
 263     $data .= $self->data;
 264
 265     return $data;
 266 }
 267
 268 #Read only accessors
 269 sub flight
 270 {
 271     my $self = shift;
 272     return $self->{flight};
 273 }
 274 sub content_type
 275 {
 276     my $self = shift;
 277     return $self->{content_type};
 278 }
 279 sub version
 280 {
 281     my $self = shift;
 282     return $self->{version};
 283 }
 284 sub sslv2
 285 {
 286     my $self = shift;
 287     return $self->{sslv2};
 288 }
 289 sub len_real
 290 {
 291     my $self = shift;
 292     return $self->{len_real};
 293 }
 294 sub orig_decrypt_data
 295 {
 296     my $self = shift;
 297     return $self->{orig_decrypt_data};
 298 }
 299
 300 #Read/write accessors
 301 sub decrypt_len
 302 {
 303     my $self = shift;
 304     if (@_) {
 305       $self->{decrypt_len} = shift;
 306     }
 307     return $self->{decrypt_len};
 308 }
 309 sub data
 310 {
 311     my $self = shift;
 312     if (@_) {
 313       $self->{data} = shift;
 314     }
 315     return $self->{data};
 316 }
 317 sub decrypt_data
 318 {
 319     my $self = shift;
 320     if (@_) {
 321       $self->{decrypt_data} = shift;
 322     }
 323     return $self->{decrypt_data};
 324 }
 325 sub len
 326 {
 327     my $self = shift;
 328     if (@_) {
 329       $self->{len} = shift;
 330     }
 331     return $self->{len};
 332 }
 333 1;