util/perl/TLSProxy/ClientHello.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 package TLSProxy::ClientHello;
  11
  12 use vars '@ISA';
  13 push @ISA, 'TLSProxy::Message';
  14
  15 sub new
  16 {
  17     my $class = shift;
  18     my ($server,
  19         $data,
  20         $records,
  21         $startoffset,
  22         $message_frag_lens) = @_;
  23
  24     my $self = $class->SUPER::new(
  25         $server,
  26         1,
  27         $data,
  28         $records,
  29         $startoffset,
  30         $message_frag_lens);
  31
  32     $self->{client_version} = 0;
  33     $self->{random} = [];
  34     $self->{session_id_len} = 0;
  35     $self->{session} = "";
  36     $self->{ciphersuite_len} = 0;
  37     $self->{ciphersuites} = [];
  38     $self->{comp_meth_len} = 0;
  39     $self->{comp_meths} = [];
  40     $self->{extensions_len} = 0;
  41     $self->{extension_data} = "";
  42
  43     return $self;
  44 }
  45
  46 sub parse
  47 {
  48     my $self = shift;
  49     my $ptr = 2;
  50     my ($client_version) = unpack('n', $self->data);
  51     my $random = substr($self->data, $ptr, 32);
  52     $ptr += 32;
  53     my $session_id_len = unpack('C', substr($self->data, $ptr));
  54     $ptr++;
  55     my $session = substr($self->data, $ptr, $session_id_len);
  56     $ptr += $session_id_len;
  57     my $ciphersuite_len = unpack('n', substr($self->data, $ptr));
  58     $ptr += 2;
  59     my @ciphersuites = unpack('n*', substr($self->data, $ptr,
  60                                            $ciphersuite_len));
  61     $ptr += $ciphersuite_len;
  62     my $comp_meth_len = unpack('C', substr($self->data, $ptr));
  63     $ptr++;
  64     my @comp_meths = unpack('C*', substr($self->data, $ptr, $comp_meth_len));
  65     $ptr += $comp_meth_len;
  66     my $extensions_len = unpack('n', substr($self->data, $ptr));
  67     $ptr += 2;
  68     #For now we just deal with this as a block of data. In the future we will
  69     #want to parse this
  70     my $extension_data = substr($self->data, $ptr);
  71
  72     if (length($extension_data) != $extensions_len) {
  73         die "Invalid extension length\n";
  74     }
  75     my %extensions = ();
  76     while (length($extension_data) >= 4) {
  77         my ($type, $size) = unpack("nn", $extension_data);
  78         my $extdata = substr($extension_data, 4, $size);
  79         $extension_data = substr($extension_data, 4 + $size);
  80         $extensions{$type} = $extdata;
  81     }
  82
  83     $self->client_version($client_version);
  84     $self->random($random);
  85     $self->session_id_len($session_id_len);
  86     $self->session($session);
  87     $self->ciphersuite_len($ciphersuite_len);
  88     $self->ciphersuites(\@ciphersuites);
  89     $self->comp_meth_len($comp_meth_len);
  90     $self->comp_meths(\@comp_meths);
  91     $self->extensions_len($extensions_len);
  92     $self->extension_data(\%extensions);
  93
  94     $self->process_extensions();
  95
  96     print "    Client Version:".$client_version."\n";
  97     print "    Session ID Len:".$session_id_len."\n";
  98     print "    Ciphersuite len:".$ciphersuite_len."\n";
  99     print "    Compression Method Len:".$comp_meth_len."\n";
 100     print "    Extensions Len:".$extensions_len."\n";
 101 }
 102
 103 #Perform any actions necessary based on the extensions we've seen
 104 sub process_extensions
 105 {
 106     my $self = shift;
 107     my %extensions = %{$self->extension_data};
 108
 109     #Clear any state from a previous run
 110     TLSProxy::Record->etm(0);
 111
 112     if (exists $extensions{TLSProxy::Message::EXT_ENCRYPT_THEN_MAC}) {
 113         TLSProxy::Record->etm(1);
 114     }
 115 }
 116
 117 sub extension_contents
 118 {
 119     my $self = shift;
 120     my $key = shift;
 121     my $extension = "";
 122
 123     my $extdata = ${$self->extension_data}{$key};
 124     $extension .= pack("n", $key);
 125     $extension .= pack("n", length($extdata));
 126     $extension .= $extdata;
 127     return $extension;
 128 }
 129
 130 #Reconstruct the on-the-wire message data following changes
 131 sub set_message_contents
 132 {
 133     my $self = shift;
 134     my $data;
 135     my $extensions = "";
 136
 137     $data = pack('n', $self->client_version);
 138     $data .= $self->random;
 139     $data .= pack('C', $self->session_id_len);
 140     $data .= $self->session;
 141     $data .= pack('n', $self->ciphersuite_len);
 142     $data .= pack("n*", @{$self->ciphersuites});
 143     $data .= pack('C', $self->comp_meth_len);
 144     $data .= pack("C*", @{$self->comp_meths});
 145
 146     foreach my $key (keys %{$self->extension_data}) {
 147         next if ($key == TLSProxy::Message::EXT_PSK);
 148         $extensions .= $self->extension_contents($key);
 149         #Add extension twice if we are duplicating that extension
 150         $extensions .= $self->extension_contents($key) if ($key == $self->dupext);
 151     }
 152     #PSK extension always goes last...
 153     if (defined ${$self->extension_data}{TLSProxy::Message::EXT_PSK}) {
 154         $extensions .= $self->extension_contents(TLSProxy::Message::EXT_PSK);
 155     }
 156     #unless we have EXT_FORCE_LAST
 157     if (defined ${$self->extension_data}{TLSProxy::Message::EXT_FORCE_LAST}) {
 158         $extensions .= $self->extension_contents(TLSProxy::Message::EXT_FORCE_LAST);
 159     }
 160
 161     $data .= pack('n', length($extensions));
 162     $data .= $extensions;
 163
 164     $self->data($data);
 165 }
 166
 167 #Read/write accessors
 168 sub client_version
 169 {
 170     my $self = shift;
 171     if (@_) {
 172       $self->{client_version} = shift;
 173     }
 174     return $self->{client_version};
 175 }
 176 sub random
 177 {
 178     my $self = shift;
 179     if (@_) {
 180       $self->{random} = shift;
 181     }
 182     return $self->{random};
 183 }
 184 sub session_id_len
 185 {
 186     my $self = shift;
 187     if (@_) {
 188       $self->{session_id_len} = shift;
 189     }
 190     return $self->{session_id_len};
 191 }
 192 sub session
 193 {
 194     my $self = shift;
 195     if (@_) {
 196       $self->{session} = shift;
 197     }
 198     return $self->{session};
 199 }
 200 sub ciphersuite_len
 201 {
 202     my $self = shift;
 203     if (@_) {
 204       $self->{ciphersuite_len} = shift;
 205     }
 206     return $self->{ciphersuite_len};
 207 }
 208 sub ciphersuites
 209 {
 210     my $self = shift;
 211     if (@_) {
 212       $self->{ciphersuites} = shift;
 213     }
 214     return $self->{ciphersuites};
 215 }
 216 sub comp_meth_len
 217 {
 218     my $self = shift;
 219     if (@_) {
 220       $self->{comp_meth_len} = shift;
 221     }
 222     return $self->{comp_meth_len};
 223 }
 224 sub comp_meths
 225 {
 226     my $self = shift;
 227     if (@_) {
 228       $self->{comp_meths} = shift;
 229     }
 230     return $self->{comp_meths};
 231 }
 232 sub extensions_len
 233 {
 234     my $self = shift;
 235     if (@_) {
 236       $self->{extensions_len} = shift;
 237     }
 238     return $self->{extensions_len};
 239 }
 240 sub extension_data
 241 {
 242     my $self = shift;
 243     if (@_) {
 244       $self->{extension_data} = shift;
 245     }
 246     return $self->{extension_data};
 247 }
 248 sub set_extension
 249 {
 250     my ($self, $ext_type, $ext_data) = @_;
 251     $self->{extension_data}{$ext_type} = $ext_data;
 252 }
 253 sub delete_extension
 254 {
 255     my ($self, $ext_type) = @_;
 256     delete $self->{extension_data}{$ext_type};
 257 }
 258 1;