util/perl/TLSProxy/ClientHello.pm

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