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