aboutsummaryrefslogtreecommitdiffstats
path: root/util/perl/TLSProxy/Record.pm
diff options
context:
space:
mode:
Diffstat (limited to 'util/perl/TLSProxy/Record.pm')
-rw-r--r--util/perl/TLSProxy/Record.pm398
1 files changed, 398 insertions, 0 deletions
diff --git a/util/perl/TLSProxy/Record.pm b/util/perl/TLSProxy/Record.pm
new file mode 100644
index 0000000000..5017c9094c
--- /dev/null
+++ b/util/perl/TLSProxy/Record.pm
@@ -0,0 +1,398 @@
+# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
+#
+# Licensed under the OpenSSL license (the "License"). You may not use
+# this file except in compliance with the License. You can obtain a copy
+# in the file LICENSE in the source distribution or at
+# https://www.openssl.org/source/license.html
+
+use strict;
+
+use TLSProxy::Proxy;
+
+package TLSProxy::Record;
+
+my $server_encrypting = 0;
+my $client_encrypting = 0;
+my $etm = 0;
+
+use constant TLS_RECORD_HEADER_LENGTH => 5;
+
+#Record types
+use constant {
+ RT_APPLICATION_DATA => 23,
+ RT_HANDSHAKE => 22,
+ RT_ALERT => 21,
+ RT_CCS => 20,
+ RT_UNKNOWN => 100
+};
+
+my %record_type = (
+ RT_APPLICATION_DATA, "APPLICATION DATA",
+ RT_HANDSHAKE, "HANDSHAKE",
+ RT_ALERT, "ALERT",
+ RT_CCS, "CCS",
+ RT_UNKNOWN, "UNKNOWN"
+);
+
+use constant {
+ VERS_TLS_1_4 => 0x0305,
+ VERS_TLS_1_3_DRAFT => 0x7f15,
+ VERS_TLS_1_3 => 0x0304,
+ VERS_TLS_1_2 => 0x0303,
+ VERS_TLS_1_1 => 0x0302,
+ VERS_TLS_1_0 => 0x0301,
+ VERS_SSL_3_0 => 0x0300,
+ VERS_SSL_LT_3_0 => 0x02ff
+};
+
+my %tls_version = (
+ VERS_TLS_1_3, "TLS1.3",
+ VERS_TLS_1_2, "TLS1.2",
+ VERS_TLS_1_1, "TLS1.1",
+ VERS_TLS_1_0, "TLS1.0",
+ VERS_SSL_3_0, "SSL3",
+ VERS_SSL_LT_3_0, "SSL<3"
+);
+
+#Class method to extract records from a packet of data
+sub get_records
+{
+ my $class = shift;
+ my $server = shift;
+ my $flight = shift;
+ my $packet = shift;
+ my @record_list = ();
+ my @message_list = ();
+ my $data;
+ my $content_type;
+ my $version;
+ my $len;
+ my $len_real;
+ my $decrypt_len;
+
+ my $recnum = 1;
+ while (length ($packet) > 0) {
+ print " Record $recnum";
+ if ($server) {
+ print " (server -> client)\n";
+ } else {
+ print " (client -> server)\n";
+ }
+ #Get the record header
+ if (length($packet) < TLS_RECORD_HEADER_LENGTH) {
+ print "Partial data : ".length($packet)." bytes\n";
+ $packet = "";
+ } else {
+ ($content_type, $version, $len) = unpack('CnnC*', $packet);
+ $data = substr($packet, 5, $len);
+
+ print " Content type: ".$record_type{$content_type}."\n";
+ print " Version: $tls_version{$version}\n";
+ print " Length: $len";
+ if ($len == length($data)) {
+ print "\n";
+ $decrypt_len = $len_real = $len;
+ } else {
+ print " (expected), ".length($data)." (actual)\n";
+ $decrypt_len = $len_real = length($data);
+ }
+
+ my $record = TLSProxy::Record->new(
+ $flight,
+ $content_type,
+ $version,
+ $len,
+ 0,
+ $len_real,
+ $decrypt_len,
+ substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real),
+ substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real)
+ );
+
+ if (($server && $server_encrypting)
+ || (!$server && $client_encrypting)) {
+ if (!TLSProxy::Proxy->is_tls13() && $etm) {
+ $record->decryptETM();
+ } else {
+ $record->decrypt();
+ }
+ $record->encrypted(1);
+ }
+
+ if (TLSProxy::Proxy->is_tls13()) {
+ print " Inner content type: "
+ .$record_type{$record->content_type()}."\n";
+ }
+
+ push @record_list, $record;
+
+ #Now figure out what messages are contained within this record
+ my @messages = TLSProxy::Message->get_messages($server, $record);
+ push @message_list, @messages;
+
+ $packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len_real);
+ $recnum++;
+ }
+ }
+
+ return (\@record_list, \@message_list);
+}
+
+sub clear
+{
+ $server_encrypting = 0;
+ $client_encrypting = 0;
+}
+
+#Class level accessors
+sub server_encrypting
+{
+ my $class = shift;
+ if (@_) {
+ $server_encrypting = shift;
+ }
+ return $server_encrypting;
+}
+sub client_encrypting
+{
+ my $class = shift;
+ if (@_) {
+ $client_encrypting= shift;
+ }
+ return $client_encrypting;
+}
+#Enable/Disable Encrypt-then-MAC
+sub etm
+{
+ my $class = shift;
+ if (@_) {
+ $etm = shift;
+ }
+ return $etm;
+}
+
+sub new
+{
+ my $class = shift;
+ my ($flight,
+ $content_type,
+ $version,
+ $len,
+ $sslv2,
+ $len_real,
+ $decrypt_len,
+ $data,
+ $decrypt_data) = @_;
+
+ my $self = {
+ flight => $flight,
+ content_type => $content_type,
+ version => $version,
+ len => $len,
+ sslv2 => $sslv2,
+ len_real => $len_real,
+ decrypt_len => $decrypt_len,
+ data => $data,
+ decrypt_data => $decrypt_data,
+ orig_decrypt_data => $decrypt_data,
+ encrypted => 0,
+ outer_content_type => RT_APPLICATION_DATA
+ };
+
+ return bless $self, $class;
+}
+
+#Decrypt using encrypt-then-MAC
+sub decryptETM
+{
+ my ($self) = shift;
+
+ my $data = $self->data;
+
+ if($self->version >= VERS_TLS_1_1()) {
+ #TLS1.1+ has an explicit IV. Throw it away
+ $data = substr($data, 16);
+ }
+
+ #Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
+ $data = substr($data, 0, length($data) - 20);
+
+ #Find out what the padding byte is
+ my $padval = unpack("C", substr($data, length($data) - 1));
+
+ #Throw away the padding
+ $data = substr($data, 0, length($data) - ($padval + 1));
+
+ $self->decrypt_data($data);
+ $self->decrypt_len(length($data));
+
+ return $data;
+}
+
+#Standard decrypt
+sub decrypt()
+{
+ my ($self) = shift;
+ my $mactaglen = 20;
+ my $data = $self->data;
+
+ #Throw away any IVs
+ if (TLSProxy::Proxy->is_tls13()) {
+ #A TLS1.3 client, when processing the server's initial flight, could
+ #respond with either an encrypted or an unencrypted alert.
+ if ($self->content_type() == RT_ALERT) {
+ #TODO(TLS1.3): Eventually it is sufficient just to check the record
+ #content type. If an alert is encrypted it will have a record
+ #content type of application data. However we haven't done the
+ #record layer changes yet, so it's a bit more complicated. For now
+ #we will additionally check if the data length is 2 (1 byte for
+ #alert level, 1 byte for alert description). If it is, then this is
+ #an unencrypted alert, so don't try to decrypt
+ return $data if (length($data) == 2);
+ }
+ $mactaglen = 16;
+ } elsif ($self->version >= VERS_TLS_1_1()) {
+ #16 bytes for a standard IV
+ $data = substr($data, 16);
+
+ #Find out what the padding byte is
+ my $padval = unpack("C", substr($data, length($data) - 1));
+
+ #Throw away the padding
+ $data = substr($data, 0, length($data) - ($padval + 1));
+ }
+
+ #Throw away the MAC or TAG
+ $data = substr($data, 0, length($data) - $mactaglen);
+
+ if (TLSProxy::Proxy->is_tls13()) {
+ #Get the content type
+ my $content_type = unpack("C", substr($data, length($data) - 1));
+ $self->content_type($content_type);
+ $data = substr($data, 0, length($data) - 1);
+ }
+
+ $self->decrypt_data($data);
+ $self->decrypt_len(length($data));
+
+ return $data;
+}
+
+#Reconstruct the on-the-wire record representation
+sub reconstruct_record
+{
+ my $self = shift;
+ my $server = shift;
+ my $data;
+ my $tls13_enc = 0;
+
+ if ($self->sslv2) {
+ $data = pack('n', $self->len | 0x8000);
+ } else {
+ if (TLSProxy::Proxy->is_tls13() && $self->encrypted) {
+ $data = pack('Cnn', $self->outer_content_type, $self->version,
+ $self->len + 1);
+ $tls13_enc = 1;
+ } else {
+ $data = pack('Cnn', $self->content_type, $self->version,
+ $self->len);
+ }
+
+ }
+ $data .= $self->data;
+
+ if ($tls13_enc) {
+ $data .= pack('C', $self->content_type);
+ }
+
+ return $data;
+}
+
+#Read only accessors
+sub flight
+{
+ my $self = shift;
+ return $self->{flight};
+}
+sub sslv2
+{
+ my $self = shift;
+ return $self->{sslv2};
+}
+sub len_real
+{
+ my $self = shift;
+ return $self->{len_real};
+}
+sub orig_decrypt_data
+{
+ my $self = shift;
+ return $self->{orig_decrypt_data};
+}
+
+#Read/write accessors
+sub decrypt_len
+{
+ my $self = shift;
+ if (@_) {
+ $self->{decrypt_len} = shift;
+ }
+ return $self->{decrypt_len};
+}
+sub data
+{
+ my $self = shift;
+ if (@_) {
+ $self->{data} = shift;
+ }
+ return $self->{data};
+}
+sub decrypt_data
+{
+ my $self = shift;
+ if (@_) {
+ $self->{decrypt_data} = shift;
+ }
+ return $self->{decrypt_data};
+}
+sub len
+{
+ my $self = shift;
+ if (@_) {
+ $self->{len} = shift;
+ }
+ return $self->{len};
+}
+sub version
+{
+ my $self = shift;
+ if (@_) {
+ $self->{version} = shift;
+ }
+ return $self->{version};
+}
+sub content_type
+{
+ my $self = shift;
+ if (@_) {
+ $self->{content_type} = shift;
+ }
+ return $self->{content_type};
+}
+sub encrypted
+{
+ my $self = shift;
+ if (@_) {
+ $self->{encrypted} = shift;
+ }
+ return $self->{encrypted};
+}
+sub outer_content_type
+{
+ my $self = shift;
+ if (@_) {
+ $self->{outer_content_type} = shift;
+ }
+ return $self->{outer_content_type};
+}
+1;
generated by cgit v1.2.3 (git 2.39.1) at 2024-08-18 03:46:45 +0000