Hakase/openssl-custom
1
0 Fork 0
Code Issues Pull Requests Releases Wiki Activity

OpenSSL 1.1.1-pre2

Browse Source
This commit is contained in:
Hakase
2018-04-07 17:29:40 +09:00
parent 82a44d2483
commit bbac8ca55d
17755 changed files with 221242 additions and 98415 deletions
Download Patch File Download Diff File Expand all files Collapse all files
util/perl/OpenSSL/Test.pm
+260 -145
View File
@@ -16,8 +16,8 @@ use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = "0.8";
@ISA = qw(Exporter);
@EXPORT = (@Test::More::EXPORT, qw(setup indir app fuzz perlapp test perltest
run));
@EXPORT = (@Test::More::EXPORT, qw(setup run indir cmd app fuzz test
perlapp perltest subtest));
@EXPORT_OK = (@Test::More::EXPORT_OK, qw(bldtop_dir bldtop_file
srctop_dir srctop_file
data_file
@@ -65,6 +65,7 @@ use File::Spec::Functions qw/file_name_is_absolute curdir canonpath splitdir
use File::Path 2.00 qw/rmtree mkpath/;
use File::Basename;
my $level = 0;
# The name of the test. This is set by setup() and is used in the other
# functions to verify that setup() has been used.
@@ -91,9 +92,9 @@ my %hooks = (
# exit_checker is used by run() directly after completion of a command.
# it receives the exit code from that command and is expected to return
# 1 (for success) or 0 (for failure). This is the value that will be
# returned by run().
# NOTE: When run() gets the option 'capture => 1', this hook is ignored.
# 1 (for success) or 0 (for failure). This is the status value that run()
# will give back (through the |statusvar| reference and as returned value
# when capture => 1 doesn't apply).
exit_checker => sub { return shift == 0 ? 1 : 0 },
);
@@ -101,21 +102,6 @@ my %hooks = (
# Debug flag, to be set manually when needed
my $debug = 0;
# Declare some utility functions that are defined at the end
sub bldtop_file;
sub bldtop_dir;
sub srctop_file;
sub srctop_dir;
sub quotify;
# Declare some private functions that are defined at the end
sub __env;
sub __cwd;
sub __apps_file;
sub __results_file;
sub __fixup_cmd;
sub __build_cmd;
=head2 Main functions
The following functions are exported by default when using C<OpenSSL::Test>.
@@ -225,25 +211,18 @@ sub indir {
=over 4
=item B<app ARRAYREF, OPTS>
=item B<cmd ARRAYREF, OPTS>
=item B<test ARRAYREF, OPTS>
This functions build up a platform dependent command based on the
input. It takes a reference to a list that is the executable or
script and its arguments, and some additional options (described
further on). Where necessary, the command will be wrapped in a
suitable environment to make sure the correct shared libraries are
used (currently only on Unix).
Both of these functions take a reference to a list that is a command and
its arguments, and some additional options (described further on).
It returns a CODEREF to be used by C<run>, C<pipe> or C<cmdstr>.
C<app> expects to find the given command (the first item in the given list
reference) as an executable in C<$BIN_D> (if defined, otherwise C<$TOP/apps>
or C<$BLDTOP/apps>).
C<test> expects to find the given command (the first item in the given list
reference) as an executable in C<$TEST_D> (if defined, otherwise C<$TOP/test>
or C<$BLDTOP/test>).
Both return a CODEREF to be used by C<run>, C<pipe> or C<cmdstr>.
The options that both C<app> and C<test> can take are in the form of hash
values:
The options that C<cmd> can take are in the form of hash values:
=over 4
@@ -259,21 +238,42 @@ string PATH, I<or>, if the value is C<undef>, C</dev/null> or similar.
=back
=item B<app ARRAYREF, OPTS>
=item B<test ARRAYREF, OPTS>
Both of these are specific applications of C<cmd>, with just a couple
of small difference:
C<app> expects to find the given command (the first item in the given list
reference) as an executable in C<$BIN_D> (if defined, otherwise C<$TOP/apps>
or C<$BLDTOP/apps>).
C<test> expects to find the given command (the first item in the given list
reference) as an executable in C<$TEST_D> (if defined, otherwise C<$TOP/test>
or C<$BLDTOP/test>).
Also, for both C<app> and C<test>, the command may be prefixed with
the content of the environment variable C<$EXE_SHELL>, which is useful
in case OpenSSL has been cross compiled.
=item B<perlapp ARRAYREF, OPTS>
=item B<perltest ARRAYREF, OPTS>
Both these functions function the same way as B<app> and B<test>, except
that they expect the command to be a perl script. Also, they support one
more option:
These are also specific applications of C<cmd>, where the interpreter
is predefined to be C<perl>, and they expect the script to be
interpreted to reside in the same location as C<app> and C<test>.
C<perlapp> and C<perltest> will also take the following option:
=over 4
=item B<interpreter_args =E<gt> ARRAYref>
The array reference is a set of arguments for perl rather than the script.
Take care so that none of them can be seen as a script! Flags and their
eventual arguments only!
The array reference is a set of arguments for the interpreter rather
than the script. Take care so that none of them can be seen as a
script! Flags and their eventual arguments only!
=back
@@ -284,54 +284,114 @@ An example:
=back
=begin comment
One might wonder over the complexity of C<apps>, C<fuzz>, C<test>, ...
with all the lazy evaluations and all that. The reason for this is that
we want to make sure the directory in which those programs are found are
correct at the time these commands are used. Consider the following code
snippet:
my $cmd = app(["openssl", ...]);
indir "foo", sub {
ok(run($cmd), "Testing foo")
};
If there wasn't this lazy evaluation, the directory where C<openssl> is
found would be incorrect at the time C<run> is called, because it was
calculated before we moved into the directory "foo".
=end comment
=cut
sub cmd {
my $cmd = shift;
my %opts = @_;
return sub {
my $num = shift;
# Make a copy to not destroy the caller's array
my @cmdargs = ( @$cmd );
my @prog = __wrap_cmd(shift @cmdargs, $opts{exe_shell} // ());
return __decorate_cmd($num, [ @prog, quotify(@cmdargs) ],
%opts);
}
}
sub app {
my $cmd = shift;
my %opts = @_;
return sub { my $num = shift;
return __build_cmd($num, \&__apps_file, $cmd, %opts); }
return sub {
my @cmdargs = ( @{$cmd} );
my @prog = __fixup_prg(__apps_file(shift @cmdargs, __exeext()));
return cmd([ @prog, @cmdargs ],
exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift);
}
}
sub fuzz {
my $cmd = shift;
my %opts = @_;
return sub { my $num = shift;
return __build_cmd($num, \&__fuzz_file, $cmd, %opts); }
return sub {
my @cmdargs = ( @{$cmd} );
my @prog = __fixup_prg(__fuzz_file(shift @cmdargs, __exeext()));
return cmd([ @prog, @cmdargs ],
exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift);
}
}
sub test {
my $cmd = shift;
my %opts = @_;
return sub { my $num = shift;
return __build_cmd($num, \&__test_file, $cmd, %opts); }
return sub {
my @cmdargs = ( @{$cmd} );
my @prog = __fixup_prg(__test_file(shift @cmdargs, __exeext()));
return cmd([ @prog, @cmdargs ],
exe_shell => $ENV{EXE_SHELL}, %opts) -> (shift);
}
}
sub perlapp {
my $cmd = shift;
my %opts = @_;
return sub { my $num = shift;
return __build_cmd($num, \&__perlapps_file, $cmd, %opts); }
return sub {
my @interpreter_args = defined $opts{interpreter_args} ?
@{$opts{interpreter_args}} : ();
my @interpreter = __fixup_prg($^X);
my @cmdargs = ( @{$cmd} );
my @prog = __apps_file(shift @cmdargs, undef);
return cmd([ @interpreter, @interpreter_args,
@prog, @cmdargs ], %opts) -> (shift);
}
}
sub perltest {
my $cmd = shift;
my %opts = @_;
return sub { my $num = shift;
return __build_cmd($num, \&__perltest_file, $cmd, %opts); }
return sub {
my @interpreter_args = defined $opts{interpreter_args} ?
@{$opts{interpreter_args}} : ();
my @interpreter = __fixup_prg($^X);
my @cmdargs = ( @{$cmd} );
my @prog = __test_file(shift @cmdargs, undef);
return cmd([ @interpreter, @interpreter_args,
@prog, @cmdargs ], %opts) -> (shift);
}
}
=over 4
=item B<run CODEREF, OPTS>
This CODEREF is expected to be the value return by C<app> or C<test>,
anything else will most likely cause an error unless you know what you're
doing.
CODEREF is expected to be the value return by C<cmd> or any of its
derivatives, anything else will most likely cause an error unless you
know what you're doing.
C<run> executes the command returned by CODEREF and return either the
resulting output (if the option C<capture> is set true) or a boolean indicating
if the command succeeded or not.
resulting output (if the option C<capture> is set true) or a boolean
indicating if the command succeeded or not.
The options that C<run> can take are in the form of hash values:
@@ -344,6 +404,18 @@ return the resulting output as an array of lines. If false or not given,
the command will be executed with C<system()>, and C<run> will return 1 if
the command was successful or 0 if it wasn't.
=item B<prefix =E<gt> EXPR>
If specified, EXPR will be used as a string to prefix the output from the
command. This is useful if the output contains lines starting with C<ok >
or C<not ok > that can disturb Test::Harness.
=item B<statusvar =E<gt> VARREF>
If used, B<VARREF> must be a reference to a scalar variable. It will be
assigned a boolean indicating if the command succeeded or not. This is
particularly useful together with B<capture>.
=back
For further discussion on what is considered a successful command or not, see
@@ -368,6 +440,9 @@ sub run {
my $r = 0;
my $e = 0;
die "OpenSSL::Test::run(): statusvar value not a scalar reference"
if $opts{statusvar} && ref($opts{statusvar}) ne "SCALAR";
# In non-verbose, we want to shut up the command interpreter, in case
# it has something to complain about. On VMS, it might complain both
# on stdout and stderr
@@ -380,17 +455,35 @@ sub run {
open STDERR, ">", devnull();
}
$ENV{HARNESS_OSSL_LEVEL} = $level + 1;
# The dance we do with $? is the same dance the Unix shells appear to
# do. For example, a program that gets aborted (and therefore signals
# SIGABRT = 6) will appear to exit with the code 134. We mimic this
# to make it easier to compare with a manual run of the command.
if ($opts{capture}) {
@r = `$prefix$cmd`;
$e = ($? & 0x7f) ? ($? & 0x7f)|0x80 : ($? >> 8);
if ($opts{capture} || defined($opts{prefix})) {
my $pipe;
local $_;
open($pipe, '-|', "$prefix$cmd") or die "Can't start command: $!";
while(<$pipe>) {
my $l = ($opts{prefix} // "") . $_;
if ($opts{capture}) {
push @r, $l;
} else {
print STDOUT $l;
}
}
close $pipe;
} else {
$ENV{HARNESS_OSSL_PREFIX} = "# ";
system("$prefix$cmd");
$e = ($? & 0x7f) ? ($? & 0x7f)|0x80 : ($? >> 8);
$r = $hooks{exit_checker}->($e);
delete $ENV{HARNESS_OSSL_PREFIX};
}
$e = ($? & 0x7f) ? ($? & 0x7f)|0x80 : ($? >> 8);
$r = $hooks{exit_checker}->($e);
if ($opts{statusvar}) {
${$opts{statusvar}} = $r;
}
if ($ENV{HARNESS_ACTIVE} && !$ENV{HARNESS_VERBOSE}) {
@@ -570,7 +663,7 @@ sub pipe {
=item B<with HASHREF, CODEREF>
C<with> will temporarly install hooks given by the HASHREF and then execute
C<with> will temporarily install hooks given by the HASHREF and then execute
the given CODEREF. Hooks are usually expected to have a coderef as value.
The currently available hoosk are:
@@ -616,7 +709,7 @@ sub with {
C<cmdstr> takes a CODEREF from C<app> or C<test> and simply returns the
command as a string.
C<cmdstr> takes some additiona options OPTS that affect the string returned:
C<cmdstr> takes some additional options OPTS that affect the string returned:
=over 4
@@ -754,6 +847,14 @@ sub __env {
$end_with_bailout = $ENV{STOPTEST} ? 1 : 0;
};
# __srctop_file and __srctop_dir are helpers to build file and directory
# names on top of the source directory. They depend on $SRCTOP, and
# therefore on the proper use of setup() and when needed, indir().
# __bldtop_file and __bldtop_dir do the same thing but relative to $BLDTOP.
# __srctop_file and __bldtop_file take the same kind of argument as
# File::Spec::Functions::catfile.
# Similarly, __srctop_dir and __bldtop_dir take the same kind of argument
# as File::Spec::Functions::catdir
sub __srctop_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
@@ -780,6 +881,9 @@ sub __bldtop_dir {
return catdir($directories{BLDTOP},@_);
}
# __exeext is a function that returns the platform dependent file extension
# for executable binaries, or the value of the environment variable $EXE_EXT
# if that one is defined.
sub __exeext {
my $ext = "";
if ($^O eq "VMS" ) { # VMS
@@ -790,51 +894,45 @@ sub __exeext {
return $ENV{"EXE_EXT"} || $ext;
}
# __test_file, __apps_file and __fuzz_file return the full path to a file
# relative to the test/, apps/ or fuzz/ directory in the build tree or the
# source tree, depending on where the file is found. Note that when looking
# in the build tree, the file name with an added extension is looked for, if
# an extension is given. The intent is to look for executable binaries (in
# the build tree) or possibly scripts (in the source tree).
# These functions all take the same arguments as File::Spec::Functions::catfile,
# *plus* a mandatory extension argument. This extension argument can be undef,
# and is ignored in such a case.
sub __test_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $e = pop || "";
my $f = pop;
my $out = catfile($directories{BLDTEST},@_,$f . __exeext());
$out = catfile($directories{SRCTEST},@_,$f) unless -x $out;
return $out;
}
sub __perltest_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $f = pop;
my $out = catfile($directories{BLDTEST},@_,$f);
my $out = catfile($directories{BLDTEST},@_,$f . $e);
$out = catfile($directories{SRCTEST},@_,$f) unless -f $out;
return ($^X, $out);
return $out;
}
sub __apps_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $e = pop || "";
my $f = pop;
my $out = catfile($directories{BLDAPPS},@_,$f . __exeext());
$out = catfile($directories{SRCAPPS},@_,$f) unless -x $out;
my $out = catfile($directories{BLDAPPS},@_,$f . $e);
$out = catfile($directories{SRCAPPS},@_,$f) unless -f $out;
return $out;
}
sub __fuzz_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $e = pop || "";
my $f = pop;
my $out = catfile($directories{BLDFUZZ},@_,$f . __exeext());
$out = catfile($directories{SRCFUZZ},@_,$f) unless -x $out;
my $out = catfile($directories{BLDFUZZ},@_,$f . $e);
$out = catfile($directories{SRCFUZZ},@_,$f) unless -f $out;
return $out;
}
sub __perlapps_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $f = pop;
my $out = catfile($directories{BLDAPPS},@_,$f);
$out = catfile($directories{SRCAPPS},@_,$f) unless -f $out;
return ($^X, $out);
}
sub __data_file {
BAIL_OUT("Must run setup() first") if (! $test_name);
@@ -849,6 +947,16 @@ sub __results_file {
return catfile($directories{RESULTS},@_,$f);
}
# __cwd DIR
# __cwd DIR, OPTS
#
# __cwd changes directory to DIR (string) and changes all the relative
# entries in %directories accordingly. OPTS is an optional series of
# hash style arguments to alter __cwd's behavior:
#
# create = 0|1 The directory we move to is created if 1, not if 0.
# cleanup = 0|1 The directory we move from is removed if 1, not if 0.
sub __cwd {
my $dir = catdir(shift);
my %opts = @_;
@@ -910,7 +1018,7 @@ sub __cwd {
}
# We put back new values carefully. Doing the obvious
# %directories = ( %tmp_irectories )
# %directories = ( %tmp_directories )
# will clear out any value that happens to be an absolute path
foreach (keys %tmp_directories) {
$directories{$_} = $tmp_directories{$_};
@@ -937,28 +1045,46 @@ sub __cwd {
return $reverse;
}
sub __fixup_cmd {
my $prog = shift;
# __wrap_cmd CMD
# __wrap_cmd CMD, EXE_SHELL
#
# __wrap_cmd "wraps" CMD (string) with a beginning command that makes sure
# the command gets executed with an appropriate environment. If EXE_SHELL
# is given, it is used as the beginning command.
#
# __wrap_cmd returns a list that should be used to build up a larger list
# of command tokens, or be joined together like this:
#
# join(" ", __wrap_cmd($cmd))
sub __wrap_cmd {
my $cmd = shift;
my $exe_shell = shift;
my $prefix = __bldtop_file("util", "shlib_wrap.sh")." ";
my @prefix = ( __bldtop_file("util", "shlib_wrap.sh") );
if (defined($exe_shell)) {
$prefix = "$exe_shell ";
} elsif ($^O eq "VMS" ) { # VMS
$prefix = ($prog =~ /^(?:[\$a-z0-9_]+:)?[<\[]/i ? "mcr " : "mcr []");
} elsif ($^O eq "MSWin32") { # Windows
$prefix = "";
if(defined($exe_shell)) {
@prefix = ( $exe_shell );
} elsif ($^O eq "VMS" || $^O eq "MSWin32") {
# VMS and Windows don't use any wrapper script for the moment
@prefix = ();
}
# We test both with and without extension. The reason
# is that we might be passed a complete file spec, with
# extension.
if ( ! -x $prog ) {
my $prog = "$prog";
if ( ! -x $prog ) {
$prog = undef;
}
return (@prefix, $cmd);
}
# __fixup_prg PROG
#
# __fixup_prg does whatever fixup is needed to execute an executable binary
# given by PROG (string).
#
# __fixup_prg returns a string with the possibly prefixed program path spec.
sub __fixup_prg {
my $prog = shift;
my $prefix = "";
if ($^O eq "VMS" ) {
$prefix = ($prog =~ /^(?:[\$a-z0-9_]+:)?[<\[]/i ? "mcr " : "mcr []");
}
if (defined($prog)) {
@@ -974,45 +1100,25 @@ sub __fixup_cmd {
return undef;
}
sub __build_cmd {
# __decorate_cmd NUM, CMDARRAYREF
#
# __decorate_cmd takes a command number NUM and a command token array
# CMDARRAYREF, builds up a command string from them and decorates it
# with necessary redirections.
# __decorate_cmd returns a list of two strings, one with the command
# string to actually be used, the other to be displayed for the user.
# The reason these strings might differ is that we redirect stderr to
# the null device unless we're verbose and unless the user has
# explicitly specified a stderr redirection.
sub __decorate_cmd {
BAIL_OUT("Must run setup() first") if (! $test_name);
my $num = shift;
my $path_builder = shift;
# Make a copy to not destroy the caller's array
my @cmdarray = ( @{$_[0]} ); shift;
my $cmd = shift;
my %opts = @_;
# We do a little dance, as $path_builder might return a list of
# more than one. If so, only the first is to be considered a
# program to fix up, the rest is part of the arguments. This
# happens for perl scripts, where $path_builder will return
# a list of two, $^X and the script name.
# Also, if $path_builder returned more than one, we don't apply
# the EXE_SHELL environment variable.
my @prog = ($path_builder->(shift @cmdarray));
my $first = shift @prog;
my $exe_shell = @prog ? undef : $ENV{EXE_SHELL};
my $cmd = __fixup_cmd($first, $exe_shell);
if (@prog) {
if ( ! -f $prog[0] ) {
print STDERR "$prog[0] not found\n";
$cmd = undef;
}
}
my @args = (@prog, @cmdarray);
if (defined($opts{interpreter_args})) {
unshift @args, @{$opts{interpreter_args}};
}
return () if !$cmd;
my $arg_str = "";
my $cmdstr = join(" ", @$cmd);
my $null = devnull();
$arg_str = " ".join(" ", quotify @args) if @args;
my $fileornull = sub { $_[0] ? $_[0] : $null; };
my $stdin = "";
my $stdout = "";
@@ -1022,19 +1128,19 @@ sub __build_cmd {
$stdout= " > ".$fileornull->($opts{stdout}) if exists($opts{stdout});
$stderr=" 2> ".$fileornull->($opts{stderr}) if exists($opts{stderr});
my $display_cmd = "$cmd$arg_str$stdin$stdout$stderr";
my $display_cmd = "$cmdstr$stdin$stdout$stderr";
$stderr=" 2> ".$null
unless $stderr || !$ENV{HARNESS_ACTIVE} || $ENV{HARNESS_VERBOSE};
$cmd .= "$arg_str$stdin$stdout$stderr";
$cmdstr .= "$stdin$stdout$stderr";
if ($debug) {
print STDERR "DEBUG[__build_cmd]: \$cmd = \"$cmd\"\n";
print STDERR "DEBUG[__build_cmd]: \$display_cmd = \"$display_cmd\"\n";
print STDERR "DEBUG[__decorate_cmd]: \$cmdstr = \"$cmdstr\"\n";
print STDERR "DEBUG[__decorate_cmd]: \$display_cmd = \"$display_cmd\"\n";
}
return ($cmd, $display_cmd);
return ($cmdstr, $display_cmd);
}
=head1 SEE ALSO
@@ -1043,9 +1149,18 @@ L<Test::More>, L<Test::Harness>
=head1 AUTHORS
Richard Levitte E<lt>levitte@openssl.orgE<gt> with assitance and
Richard Levitte E<lt>levitte@openssl.orgE<gt> with assistance and
inspiration from Andy Polyakov E<lt>appro@openssl.org<gt>.
=cut
no warnings 'redefine';
sub subtest {
$level++;
Test::More::subtest @_;
$level--;
};
1;
util/perl/OpenSSL/Util/Pod.pm
+2 -11
View File
@@ -53,11 +53,8 @@ The additional hash is for extra parameters:
=item B<section =E<gt> N>
The value MUST be a number, and will be the default man section number
to be used with the given .pod file. This number can be altered if
the .pod file has a line like this:
=for comment openssl_manual_section: 4
The value MUST be a number, and will be the man section number
to be used with the given .pod file.
=item B<debug =E<gt> 0|1>
@@ -109,12 +106,6 @@ sub extract_pod_info {
my %podinfo = ( section => $defaults{section});
while(<$input>) {
s|\R$||;
if (m|^=for\s+comment\s+openssl_manual_section:\s*([0-9])\s*$|) {
print STDERR "DEBUG: Found man section number $1\n"
if $defaults{debug};
$podinfo{section} = $1;
}
# Stop reading when we have reached past the NAME section.
last if (m|^=head1|
&& defined $podinfo{lastsect}
util/perl/TLSProxy/Certificate.pm
+219
View File
@@ -0,0 +1,219 @@
# 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;
package TLSProxy::Certificate;
use vars '@ISA';
push @ISA, 'TLSProxy::Message';
sub new
{
my $class = shift;
my ($server,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$server,
TLSProxy::Message::MT_CERTIFICATE,
$data,
$records,
$startoffset,
$message_frag_lens);
$self->{first_certificate} = "";
$self->{extension_data} = "";
$self->{remaining_certdata} = "";
return $self;
}
sub parse
{
my $self = shift;
if (TLSProxy::Proxy->is_tls13()) {
my $context_len = unpack('C', $self->data);
my $context = substr($self->data, 1, $context_len);
my $remdata = substr($self->data, 1 + $context_len);
my ($hicertlistlen, $certlistlen) = unpack('Cn', $remdata);
$certlistlen += ($hicertlistlen << 16);
$remdata = substr($remdata, 3);
die "Invalid Certificate List length"
if length($remdata) != $certlistlen;
my ($hicertlen, $certlen) = unpack('Cn', $remdata);
$certlen += ($hicertlen << 16);
die "Certificate too long" if ($certlen + 3) > $certlistlen;
$remdata = substr($remdata, 3);
my $certdata = substr($remdata, 0, $certlen);
$remdata = substr($remdata, $certlen);
my $extensions_len = unpack('n', $remdata);
$remdata = substr($remdata, 2);
die "Extensions too long"
if ($certlen + 3 + $extensions_len + 2) > $certlistlen;
my $extension_data = "";
if ($extensions_len != 0) {
$extension_data = substr($remdata, 0, $extensions_len);
if (length($extension_data) != $extensions_len) {
die "Invalid extension length\n";
}
}
my %extensions = ();
while (length($extension_data) >= 4) {
my ($type, $size) = unpack("nn", $extension_data);
my $extdata = substr($extension_data, 4, $size);
$extension_data = substr($extension_data, 4 + $size);
$extensions{$type} = $extdata;
}
$remdata = substr($remdata, $extensions_len);
$self->context($context);
$self->first_certificate($certdata);
$self->extension_data(\%extensions);
$self->remaining_certdata($remdata);
print " Context:".$context."\n";
print " Certificate List Len:".$certlistlen."\n";
print " Certificate Len:".$certlen."\n";
print " Extensions Len:".$extensions_len."\n";
} else {
my ($hicertlistlen, $certlistlen) = unpack('Cn', $self->data);
$certlistlen += ($hicertlistlen << 16);
my $remdata = substr($self->data, 3);
die "Invalid Certificate List length"
if length($remdata) != $certlistlen;
my ($hicertlen, $certlen) = unpack('Cn', $remdata);
$certlen += ($hicertlen << 16);
die "Certificate too long" if ($certlen + 3) > $certlistlen;
$remdata = substr($remdata, 3);
my $certdata = substr($remdata, 0, $certlen);
$remdata = substr($remdata, $certlen);
$self->first_certificate($certdata);
$self->remaining_certdata($remdata);
print " Certificate List Len:".$certlistlen."\n";
print " Certificate Len:".$certlen."\n";
}
}
#Reconstruct the on-the-wire message data following changes
sub set_message_contents
{
my $self = shift;
my $data;
my $extensions = "";
if (TLSProxy::Proxy->is_tls13()) {
foreach my $key (keys %{$self->extension_data}) {
my $extdata = ${$self->extension_data}{$key};
$extensions .= pack("n", $key);
$extensions .= pack("n", length($extdata));
$extensions .= $extdata;
if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) {
$extensions .= pack("n", $key);
$extensions .= pack("n", length($extdata));
$extensions .= $extdata;
}
}
$data = pack('C', length($self->context()));
$data .= $self->context;
my $certlen = length($self->first_certificate);
my $certlistlen = $certlen + length($extensions)
+ length($self->remaining_certdata);
my $hi = $certlistlen >> 16;
$certlistlen = $certlistlen & 0xffff;
$data .= pack('Cn', $hi, $certlistlen);
$hi = $certlen >> 16;
$certlen = $certlen & 0xffff;
$data .= pack('Cn', $hi, $certlen);
$data .= pack('n', length($extensions));
$data .= $extensions;
$data .= $self->remaining_certdata();
$self->data($data);
} else {
my $certlen = length($self->first_certificate);
my $certlistlen = $certlen + length($self->remaining_certdata);
my $hi = $certlistlen >> 16;
$certlistlen = $certlistlen & 0xffff;
$data .= pack('Cn', $hi, $certlistlen);
$hi = $certlen >> 16;
$certlen = $certlen & 0xffff;
$data .= pack('Cn', $hi, $certlen);
$data .= $self->remaining_certdata();
$self->data($data);
}
}
#Read/write accessors
sub context
{
my $self = shift;
if (@_) {
$self->{context} = shift;
}
return $self->{context};
}
sub first_certificate
{
my $self = shift;
if (@_) {
$self->{first_certificate} = shift;
}
return $self->{first_certificate};
}
sub remaining_certdata
{
my $self = shift;
if (@_) {
$self->{remaining_certdata} = shift;
}
return $self->{remaining_certdata};
}
sub extension_data
{
my $self = shift;
if (@_) {
$self->{extension_data} = shift;
}
return $self->{extension_data};
}
sub set_extension
{
my ($self, $ext_type, $ext_data) = @_;
$self->{extension_data}{$ext_type} = $ext_data;
}
sub delete_extension
{
my ($self, $ext_type) = @_;
delete $self->{extension_data}{$ext_type};
}
1;
util/perl/TLSProxy/CertificateVerify.pm
+96
View File
@@ -0,0 +1,96 @@
# 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;
package TLSProxy::CertificateVerify;
use vars '@ISA';
push @ISA, 'TLSProxy::Message';
sub new
{
my $class = shift;
my ($server,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$server,
TLSProxy::Message::MT_CERTIFICATE_VERIFY,
$data,
$records,
$startoffset,
$message_frag_lens);
$self->{sigalg} = -1;
$self->{signature} = "";
return $self;
}
sub parse
{
my $self = shift;
my $sigalg = -1;
my $remdata = $self->data;
my $record = ${$self->records}[0];
if (TLSProxy::Proxy->is_tls13()
|| $record->version() == TLSProxy::Record::VERS_TLS_1_2) {
$sigalg = unpack('n', $remdata);
$remdata = substr($remdata, 2);
}
my $siglen = unpack('n', substr($remdata, 0, 2));
my $sig = substr($remdata, 2);
die "Invalid CertificateVerify signature length" if length($sig) != $siglen;
print " SigAlg:".$sigalg."\n";
print " Signature Len:".$siglen."\n";
$self->sigalg($sigalg);
$self->signature($sig);
}
#Reconstruct the on-the-wire message data following changes
sub set_message_contents
{
my $self = shift;
my $data = "";
my $sig = $self->signature();
my $olddata = $self->data();
$data .= pack("n", $self->sigalg()) if ($self->sigalg() != -1);
$data .= pack("n", length($sig));
$data .= $sig;
$self->data($data);
}
#Read/write accessors
sub sigalg
{
my $self = shift;
if (@_) {
$self->{sigalg} = shift;
}
return $self->{sigalg};
}
sub signature
{
my $self = shift;
if (@_) {
$self->{signature} = shift;
}
return $self->{signature};
}
1;
util/perl/TLSProxy/ClientHello.pm
+28 -9
View File
@@ -114,6 +114,24 @@ sub process_extensions
}
}
sub extension_contents
{
my $self = shift;
my $key = shift;
my $extension = "";
my $extdata = ${$self->extension_data}{$key};
$extension .= pack("n", $key);
$extension .= pack("n", length($extdata));
$extension .= $extdata;
if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) {
$extension .= pack("n", $key);
$extension .= pack("n", length($extdata));
$extension .= $extdata;
}
return $extension;
}
#Reconstruct the on-the-wire message data following changes
sub set_message_contents
{
@@ -131,15 +149,16 @@ sub set_message_contents
$data .= pack("C*", @{$self->comp_meths});
foreach my $key (keys %{$self->extension_data}) {
my $extdata = ${$self->extension_data}{$key};
$extensions .= pack("n", $key);
$extensions .= pack("n", length($extdata));
$extensions .= $extdata;
if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) {
$extensions .= pack("n", $key);
$extensions .= pack("n", length($extdata));
$extensions .= $extdata;
}
next if ($key == TLSProxy::Message::EXT_PSK);
$extensions .= $self->extension_contents($key);
}
#PSK extension always goes last...
if (defined ${$self->extension_data}{TLSProxy::Message::EXT_PSK}) {
$extensions .= $self->extension_contents(TLSProxy::Message::EXT_PSK);
}
#unless we have EXT_FORCE_LAST
if (defined ${$self->extension_data}{TLSProxy::Message::EXT_FORCE_LAST}) {
$extensions .= $self->extension_contents(TLSProxy::Message::EXT_FORCE_LAST);
}
$data .= pack('n', length($extensions));
util/perl/TLSProxy/EncryptedExtensions.pm
+115
View File
@@ -0,0 +1,115 @@
# 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;
package TLSProxy::EncryptedExtensions;
use vars '@ISA';
push @ISA, 'TLSProxy::Message';
sub new
{
my $class = shift;
my ($server,
$data,
$records,
$startoffset,
$message_frag_lens) = @_;
my $self = $class->SUPER::new(
$server,
TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS,
$data,
$records,
$startoffset,
$message_frag_lens);
$self->{extension_data} = "";
return $self;
}
sub parse
{
my $self = shift;
my $extensions_len = unpack('n', $self->data);
if (!defined $extensions_len) {
$extensions_len = 0;
}
my $extension_data;
if ($extensions_len != 0) {
$extension_data = substr($self->data, 2);
if (length($extension_data) != $extensions_len) {
die "Invalid extension length\n";
}
} else {
if (length($self->data) != 2) {
die "Invalid extension length\n";
}
$extension_data = "";
}
my %extensions = ();
while (length($extension_data) >= 4) {
my ($type, $size) = unpack("nn", $extension_data);
my $extdata = substr($extension_data, 4, $size);
$extension_data = substr($extension_data, 4 + $size);
$extensions{$type} = $extdata;
}
$self->extension_data(\%extensions);
print " Extensions Len:".$extensions_len."\n";
}
#Reconstruct the on-the-wire message data following changes
sub set_message_contents
{
my $self = shift;
my $data;
my $extensions = "";
foreach my $key (keys %{$self->extension_data}) {
my $extdata = ${$self->extension_data}{$key};
$extensions .= pack("n", $key);
$extensions .= pack("n", length($extdata));
$extensions .= $extdata;
if ($key == TLSProxy::Message::EXT_DUPLICATE_EXTENSION) {
$extensions .= pack("n", $key);
$extensions .= pack("n", length($extdata));
$extensions .= $extdata;
}
}
$data = pack('n', length($extensions));
$data .= $extensions;
$self->data($data);
}
#Read/write accessors
sub extension_data
{
my $self = shift;
if (@_) {
$self->{extension_data} = shift;
}
return $self->{extension_data};
}
sub set_extension
{
my ($self, $ext_type, $ext_data) = @_;
$self->{extension_data}{$ext_type} = $ext_data;
}
sub delete_extension
{
my ($self, $ext_type) = @_;
delete $self->{extension_data}{$ext_type};
}
1;
util/perl/TLSProxy/Message.pm
+120 -12
View File
@@ -1,4 +1,4 @@
# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
# Copyright 2016-2018 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
@@ -17,6 +17,7 @@ use constant {
MT_CLIENT_HELLO => 1,
MT_SERVER_HELLO => 2,
MT_NEW_SESSION_TICKET => 4,
MT_ENCRYPTED_EXTENSIONS => 8,
MT_CERTIFICATE => 11,
MT_SERVER_KEY_EXCHANGE => 12,
MT_CERTIFICATE_REQUEST => 13,
@@ -46,6 +47,7 @@ my %message_type = (
MT_CLIENT_HELLO, "ClientHello",
MT_SERVER_HELLO, "ServerHello",
MT_NEW_SESSION_TICKET, "NewSessionTicket",
MT_ENCRYPTED_EXTENSIONS, "EncryptedExtensions",
MT_CERTIFICATE, "Certificate",
MT_SERVER_KEY_EXCHANGE, "ServerKeyExchange",
MT_CERTIFICATE_REQUEST, "CertificateRequest",
@@ -58,13 +60,70 @@ my %message_type = (
);
use constant {
EXT_SERVER_NAME => 0,
EXT_MAX_FRAGMENT_LENGTH => 1,
EXT_STATUS_REQUEST => 5,
EXT_SUPPORTED_GROUPS => 10,
EXT_EC_POINT_FORMATS => 11,
EXT_SRP => 12,
EXT_SIG_ALGS => 13,
EXT_USE_SRTP => 14,
EXT_ALPN => 16,
EXT_SCT => 18,
EXT_PADDING => 21,
EXT_ENCRYPT_THEN_MAC => 22,
EXT_EXTENDED_MASTER_SECRET => 23,
EXT_SESSION_TICKET => 35,
# This extension does not exist and isn't recognised by OpenSSL.
# We use it to test handling of duplicate extensions.
EXT_DUPLICATE_EXTENSION => 1234
EXT_KEY_SHARE => 51,
EXT_PSK => 41,
EXT_SUPPORTED_VERSIONS => 43,
EXT_COOKIE => 44,
EXT_PSK_KEX_MODES => 45,
EXT_POST_HANDSHAKE_AUTH => 49,
EXT_SIG_ALGS_CERT => 50,
EXT_RENEGOTIATE => 65281,
EXT_NPN => 13172,
# This extension is an unofficial extension only ever written by OpenSSL
# (i.e. not read), and even then only when enabled. We use it to test
# handling of duplicate extensions.
EXT_DUPLICATE_EXTENSION => 0xfde8,
EXT_UNKNOWN => 0xfffe,
#Unknown extension that should appear last
EXT_FORCE_LAST => 0xffff
};
# SignatureScheme of TLS 1.3, from
# https://tools.ietf.org/html/draft-ietf-tls-tls13-20#appendix-B.3.1.3
# TODO(TLS1.3) update link to IANA registry after publication
# We have to manually grab the SHA224 equivalents from the old registry
use constant {
SIG_ALG_RSA_PKCS1_SHA256 => 0x0401,
SIG_ALG_RSA_PKCS1_SHA384 => 0x0501,
SIG_ALG_RSA_PKCS1_SHA512 => 0x0601,
SIG_ALG_ECDSA_SECP256R1_SHA256 => 0x0403,
SIG_ALG_ECDSA_SECP384R1_SHA384 => 0x0503,
SIG_ALG_ECDSA_SECP521R1_SHA512 => 0x0603,
SIG_ALG_RSA_PSS_SHA256 => 0x0804,
SIG_ALG_RSA_PSS_SHA384 => 0x0805,
SIG_ALG_RSA_PSS_SHA512 => 0x0806,
SIG_ALG_ED25519 => 0x0807,
SIG_ALG_ED448 => 0x0808,
SIG_ALG_RSA_PKCS1_SHA1 => 0x0201,
SIG_ALG_ECDSA_SHA1 => 0x0203,
SIG_ALG_DSA_SHA1 => 0x0202,
SIG_ALG_DSA_SHA256 => 0x0402,
SIG_ALG_DSA_SHA384 => 0x0502,
SIG_ALG_DSA_SHA512 => 0x0602,
OSSL_SIG_ALG_RSA_PKCS1_SHA224 => 0x0301,
OSSL_SIG_ALG_DSA_SHA224 => 0x0302,
OSSL_SIG_ALG_ECDSA_SHA224 => 0x0303
};
use constant {
CIPHER_DHE_RSA_AES_128_SHA => 0x0033,
CIPHER_ADH_AES_128_SHA => 0x0034,
CIPHER_TLS13_AES_128_GCM_SHA256 => 0x1301,
CIPHER_TLS13_AES_256_GCM_SHA384 => 0x1302
};
my $payload = "";
@@ -77,6 +136,7 @@ my $end = 0;
my @message_rec_list = ();
my @message_frag_lens = ();
my $ciphersuite = 0;
my $successondata = 0;
sub clear
{
@@ -86,6 +146,7 @@ sub clear
$server = 0;
$success = 0;
$end = 0;
$successondata = 0;
@message_rec_list = ();
@message_frag_lens = ();
}
@@ -111,10 +172,12 @@ sub get_messages
#We can't handle this yet
die "CCS received before message data complete\n";
}
if ($server) {
TLSProxy::Record->server_ccs_seen(1);
} else {
TLSProxy::Record->client_ccs_seen(1);
if (!TLSProxy::Proxy->is_tls13()) {
if ($server) {
TLSProxy::Record->server_encrypting(1);
} else {
TLSProxy::Record->client_encrypting(1);
}
}
} elsif ($record->content_type == TLSProxy::Record::RT_HANDSHAKE) {
if ($record->len == 0 || $record->len_real == 0) {
@@ -197,6 +260,11 @@ sub get_messages
} elsif ($record->content_type == TLSProxy::Record::RT_APPLICATION_DATA) {
print " [ENCRYPTED APPLICATION DATA]\n";
print " [".$record->decrypt_data."]\n";
if ($successondata) {
$success = 1;
$end = 1;
}
} elsif ($record->content_type == TLSProxy::Record::RT_ALERT) {
my ($alertlev, $alertdesc) = unpack('CC', $record->decrypt_data);
#A CloseNotify from the client indicates we have finished successfully
@@ -239,6 +307,33 @@ sub create_message
[@message_frag_lens]
);
$message->parse();
} elsif ($mt == MT_ENCRYPTED_EXTENSIONS) {
$message = TLSProxy::EncryptedExtensions->new(
$server,
$data,
[@message_rec_list],
$startoffset,
[@message_frag_lens]
);
$message->parse();
} elsif ($mt == MT_CERTIFICATE) {
$message = TLSProxy::Certificate->new(
$server,
$data,
[@message_rec_list],
$startoffset,
[@message_frag_lens]
);
$message->parse();
} elsif ($mt == MT_CERTIFICATE_VERIFY) {
$message = TLSProxy::CertificateVerify->new(
$server,
$data,
[@message_rec_list],
$startoffset,
[@message_frag_lens]
);
$message->parse();
} elsif ($mt == MT_SERVER_KEY_EXCHANGE) {
$message = TLSProxy::ServerKeyExchange->new(
$server,
@@ -319,7 +414,7 @@ sub ciphersuite
}
#Update all the underlying records with the modified data from this message
#Note: Does not currently support re-encrypting
#Note: Only supports re-encrypting for TLSv1.3
sub repack
{
my $self = shift;
@@ -362,8 +457,14 @@ sub repack
# use an explicit override field instead.)
$rec->decrypt_len(length($rec->decrypt_data));
$rec->len($rec->len + length($msgdata) - $old_length);
# Don't support re-encryption.
$rec->data($rec->decrypt_data);
# Only support re-encryption for TLSv1.3.
if (TLSProxy::Proxy->is_tls13() && $rec->encrypted()) {
#Add content type (1 byte) and 16 tag bytes
$rec->data($rec->decrypt_data
.pack("C", TLSProxy::Record::RT_HANDSHAKE).("\0"x16));
} else {
$rec->data($rec->decrypt_data);
}
#Update the fragment len in case we changed it above
${$self->message_frag_lens}[0] = length($msgdata)
@@ -452,5 +553,12 @@ sub encoded_length
my $self = shift;
return TLS_MESSAGE_HEADER_LENGTH + length($self->data);
}
sub successondata
{
my $class = shift;
if (@_) {
$successondata = shift;
}
return $successondata;
}
1;
util/perl/TLSProxy/Proxy.pm
+89 -38
View File
@@ -17,6 +17,9 @@ use TLSProxy::Record;
use TLSProxy::Message;
use TLSProxy::ClientHello;
use TLSProxy::ServerHello;
use TLSProxy::EncryptedExtensions;
use TLSProxy::Certificate;
use TLSProxy::CertificateVerify;
use TLSProxy::ServerKeyExchange;
use TLSProxy::NewSessionTicket;
use Time::HiRes qw/usleep/;
@@ -24,6 +27,9 @@ use Time::HiRes qw/usleep/;
my $have_IPv6 = 0;
my $IP_factory;
my $is_tls13 = 0;
my $ciphersuite = undef;
sub new
{
my $class = shift;
@@ -45,16 +51,15 @@ sub new
serverpid => 0,
clientpid => 0,
reneg => 0,
sessionfile => undef,
#Public read
execute => $execute,
cert => $cert,
debug => $debug,
cipherc => "",
ciphers => "AES128-SHA",
flight => -1,
direction => -1,
partial => ["", ""],
ciphers => "AES128-SHA:TLS13-AES-128-GCM-SHA256",
flight => 0,
record_list => [],
message_list => [],
};
@@ -130,13 +135,14 @@ sub clearClient
my $self = shift;
$self->{cipherc} = "";
$self->{flight} = -1;
$self->{direction} = -1;
$self->{partial} = ["", ""];
$self->{flight} = 0;
$self->{record_list} = [];
$self->{message_list} = [];
$self->{clientflags} = "";
$self->{sessionfile} = undef;
$self->{clientpid} = 0;
$is_tls13 = 0;
$ciphersuite = undef;
TLSProxy::Message->clear();
TLSProxy::Record->clear();
@@ -147,7 +153,7 @@ sub clear
my $self = shift;
$self->clearClient;
$self->{ciphers} = "AES128-SHA";
$self->{ciphers} = "AES128-SHA:TLS13-AES-128-GCM-SHA256";
$self->{serverflags} = "";
$self->{serverconnects} = 1;
$self->{serverpid} = 0;
@@ -182,9 +188,10 @@ sub start
$pid = fork();
if ($pid == 0) {
my $execcmd = $self->execute
." s_server -max_protocol TLSv1.2 -no_comp -rev -engine ossltest -accept "
." s_server -no_comp -rev -engine ossltest -accept "
.($self->server_port)
." -cert ".$self->cert." -naccept ".$self->serverconnects;
." -cert ".$self->cert." -cert2 ".$self->cert
." -naccept ".$self->serverconnects;
unless ($self->supports_IPv6) {
$execcmd .= " -4";
}
@@ -219,7 +226,7 @@ sub clientstart
$echostr = "test";
}
my $execcmd = "echo ".$echostr." | ".$self->execute
." s_client -max_protocol TLSv1.2 -engine ossltest -connect "
." s_client -engine ossltest -connect "
.($self->proxy_addr).":".($self->proxy_port);
unless ($self->supports_IPv6) {
$execcmd .= " -4";
@@ -230,6 +237,9 @@ sub clientstart
if ($self->clientflags ne "") {
$execcmd .= " ".$self->clientflags;
}
if (defined $self->sessionfile) {
$execcmd .= " -ign_eof";
}
if ($self->debug) {
print STDERR "Client command: $execcmd\n";
}
@@ -286,24 +296,35 @@ sub clientstart
#Wait for either the server socket or the client socket to become readable
my @ready;
my $ctr = 0;
local $SIG{PIPE} = "IGNORE";
while(!(TLSProxy::Message->end) && (@ready = $sel->can_read)) {
while( (!(TLSProxy::Message->end)
|| (defined $self->sessionfile()
&& (-s $self->sessionfile()) == 0))
&& $ctr < 10) {
if (!(@ready = $sel->can_read(1))) {
$ctr++;
next;
}
foreach my $hand (@ready) {
if ($hand == $server_sock) {
$server_sock->sysread($indata, 16384) or goto END;
$indata = $self->process_packet(1, $indata);
$client_sock->syswrite($indata);
$ctr = 0;
} elsif ($hand == $client_sock) {
$client_sock->sysread($indata, 16384) or goto END;
$indata = $self->process_packet(0, $indata);
$server_sock->syswrite($indata);
$ctr = 0;
} else {
print "Err\n";
goto END;
die "Unexpected handle";
}
}
}
die "No progress made" if $ctr >= 10;
END:
print "Connection closed\n";
if($server_sock) {
@@ -348,38 +369,34 @@ sub process_packet
print "Received client packet\n";
}
if ($self->{direction} != $server) {
$self->{flight} = $self->{flight} + 1;
$self->{direction} = $server;
}
print "Packet length = ".length($packet)."\n";
print "Processing flight ".$self->flight."\n";
#Return contains the list of record found in the packet followed by the
#list of messages in those records and any partial message
my @ret = TLSProxy::Record->get_records($server, $self->flight, $self->{partial}[$server].$packet);
$self->{partial}[$server] = $ret[2];
#list of messages in those records
my @ret = TLSProxy::Record->get_records($server, $self->flight, $packet);
push @{$self->record_list}, @{$ret[0]};
push @{$self->{message_list}}, @{$ret[1]};
print "\n";
if (scalar(@{$ret[0]}) == 0 or length($ret[2]) != 0) {
return "";
}
#Finished parsing. Call user provided filter here
if (defined $self->filter) {
if(defined $self->filter) {
$self->filter->($self);
}
#Reconstruct the packet
$packet = "";
foreach my $record (@{$self->record_list}) {
$packet .= $record->reconstruct_record();
#We only replay the records for the current flight
if ($record->flight != $self->flight) {
next;
}
$packet .= $record->reconstruct_record($server);
}
$self->{flight} = $self->{flight} + 1;
print "Forwarded packet length = ".length($packet)."\n\n";
return $packet;
@@ -442,7 +459,7 @@ sub server_addr
{
my $self = shift;
if (@_) {
$self->{server_addr} = shift;
$self->{server_addr} = shift;
}
return $self->{server_addr};
}
@@ -450,7 +467,7 @@ sub server_port
{
my $self = shift;
if (@_) {
$self->{server_port} = shift;
$self->{server_port} = shift;
}
return $self->{server_port};
}
@@ -458,7 +475,7 @@ sub filter
{
my $self = shift;
if (@_) {
$self->{filter} = shift;
$self->{filter} = shift;
}
return $self->{filter};
}
@@ -466,7 +483,7 @@ sub cipherc
{
my $self = shift;
if (@_) {
$self->{cipherc} = shift;
$self->{cipherc} = shift;
}
return $self->{cipherc};
}
@@ -474,7 +491,7 @@ sub ciphers
{
my $self = shift;
if (@_) {
$self->{ciphers} = shift;
$self->{ciphers} = shift;
}
return $self->{ciphers};
}
@@ -482,7 +499,7 @@ sub serverflags
{
my $self = shift;
if (@_) {
$self->{serverflags} = shift;
$self->{serverflags} = shift;
}
return $self->{serverflags};
}
@@ -490,7 +507,7 @@ sub clientflags
{
my $self = shift;
if (@_) {
$self->{clientflags} = shift;
$self->{clientflags} = shift;
}
return $self->{clientflags};
}
@@ -498,7 +515,7 @@ sub serverconnects
{
my $self = shift;
if (@_) {
$self->{serverconnects} = shift;
$self->{serverconnects} = shift;
}
return $self->{serverconnects};
}
@@ -518,7 +535,7 @@ sub serverpid
{
my $self = shift;
if (@_) {
$self->{serverpid} = shift;
$self->{serverpid} = shift;
}
return $self->{serverpid};
}
@@ -541,13 +558,47 @@ sub fill_known_data
return $ret;
}
sub is_tls13
{
my $class = shift;
if (@_) {
$is_tls13 = shift;
}
return $is_tls13;
}
sub reneg
{
my $self = shift;
if (@_) {
$self->{reneg} = shift;
$self->{reneg} = shift;
}
return $self->{reneg};
}
#Setting a sessionfile means that the client will not close until the given
#file exists. This is useful in TLSv1.3 where otherwise s_client will close
#immediately at the end of the handshake, but before the session has been
#received from the server. A side effect of this is that s_client never sends
#a close_notify, so instead we consider success to be when it sends application
#data over the connection.
sub sessionfile
{
my $self = shift;
if (@_) {
$self->{sessionfile} = shift;
TLSProxy::Message->successondata(1);
}
return $self->{sessionfile};
}
sub ciphersuite
{
my $class = shift;
if (@_) {
$ciphersuite = shift;
}
return $ciphersuite;
}
1;
util/perl/TLSProxy/Record.pm
+109 -54
View File
@@ -11,8 +11,8 @@ use TLSProxy::Proxy;
package TLSProxy::Record;
my $server_ccs_seen = 0;
my $client_ccs_seen = 0;
my $server_encrypting = 0;
my $client_encrypting = 0;
my $etm = 0;
use constant TLS_RECORD_HEADER_LENGTH => 5;
@@ -35,12 +35,14 @@ my %record_type = (
);
use constant {
VERS_TLS_1_3 => 772,
VERS_TLS_1_2 => 771,
VERS_TLS_1_1 => 770,
VERS_TLS_1_0 => 769,
VERS_SSL_3_0 => 768,
VERS_SSL_LT_3_0 => 767
VERS_TLS_1_4 => 0x0305,
VERS_TLS_1_3_DRAFT => 0x7f17,
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 = (
@@ -59,7 +61,6 @@ sub get_records
my $server = shift;
my $flight = shift;
my $packet = shift;
my $partial = "";
my @record_list = ();
my @message_list = ();
my $data;
@@ -78,10 +79,8 @@ sub get_records
print " (client -> server)\n";
}
#Get the record header
if (length($packet) < TLS_RECORD_HEADER_LENGTH
|| length($packet) < 5 + unpack("n", substr($packet, 3, 2))) {
if (length($packet) < TLS_RECORD_HEADER_LENGTH) {
print "Partial data : ".length($packet)." bytes\n";
$partial = $packet;
$packet = "";
} else {
($content_type, $version, $len) = unpack('CnnC*', $packet);
@@ -110,12 +109,20 @@ sub get_records
substr($packet, TLS_RECORD_HEADER_LENGTH, $len_real)
);
if (($server && $server_ccs_seen)
|| (!$server && $client_ccs_seen)) {
if ($etm) {
$record->decryptETM();
} else {
$record->decrypt();
if ($content_type != RT_CCS) {
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";
}
}
}
@@ -130,31 +137,31 @@ sub get_records
}
}
return (\@record_list, \@message_list, $partial);
return (\@record_list, \@message_list);
}
sub clear
{
$server_ccs_seen = 0;
$client_ccs_seen = 0;
$server_encrypting = 0;
$client_encrypting = 0;
}
#Class level accessors
sub server_ccs_seen
sub server_encrypting
{
my $class = shift;
if (@_) {
$server_ccs_seen = shift;
$server_encrypting = shift;
}
return $server_ccs_seen;
return $server_encrypting;
}
sub client_ccs_seen
sub client_encrypting
{
my $class = shift;
if (@_) {
$client_ccs_seen = shift;
$client_encrypting= shift;
}
return $client_ccs_seen;
return $client_encrypting;
}
#Enable/Disable Encrypt-then-MAC
sub etm
@@ -190,7 +197,8 @@ sub new
data => $data,
decrypt_data => $decrypt_data,
orig_decrypt_data => $decrypt_data,
sent => 0
encrypted => 0,
outer_content_type => RT_APPLICATION_DATA
};
return bless $self, $class;
@@ -227,22 +235,44 @@ sub decryptETM
sub decrypt()
{
my ($self) = shift;
my $mactaglen = 20;
my $data = $self->data;
if($self->version >= VERS_TLS_1_1()) {
#TLS1.1+ has an explicit IV. Throw it away
#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));
}
#Find out what the padding byte is
my $padval = unpack("C", substr($data, length($data) - 1));
#Throw away the MAC or TAG
$data = substr($data, 0, length($data) - $mactaglen);
#Throw away the padding
$data = substr($data, 0, length($data) - ($padval + 1));
#Throw away the MAC (assumes MAC is 20 bytes for now. FIXME)
$data = substr($data, 0, length($data) - 20);
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));
@@ -254,17 +284,20 @@ sub decrypt()
sub reconstruct_record
{
my $self = shift;
my $server = shift;
my $data;
if ($self->{sent}) {
return "";
}
$self->{sent} = 1;
if ($self->sslv2) {
$data = pack('n', $self->len | 0x8000);
} else {
$data = pack('Cnn', $self->content_type, $self->version, $self->len);
if (TLSProxy::Proxy->is_tls13() && $self->encrypted) {
$data = pack('Cnn', $self->outer_content_type, $self->version,
$self->len);
} else {
$data = pack('Cnn', $self->content_type, $self->version,
$self->len);
}
}
$data .= $self->data;
@@ -277,16 +310,6 @@ sub flight
my $self = shift;
return $self->{flight};
}
sub content_type
{
my $self = shift;
return $self->{content_type};
}
sub version
{
my $self = shift;
return $self->{version};
}
sub sslv2
{
my $self = shift;
@@ -336,4 +359,36 @@ sub len
}
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;
util/perl/TLSProxy/ServerHello.pm
+33 -5
View File
@@ -12,6 +12,11 @@ package TLSProxy::ServerHello;
use vars '@ISA';
push @ISA, 'TLSProxy::Message';
my $hrrrandom = pack("C*", 0xCF, 0x21, 0xAD, 0x74, 0xE5, 0x9A, 0x61, 0x11, 0xBE,
0x1D, 0x8C, 0x02, 0x1E, 0x65, 0xB8, 0x91, 0xC2, 0xA2,
0x11, 0x16, 0x7A, 0xBB, 0x8C, 0x5E, 0x07, 0x9E, 0x09,
0xE2, 0xC8, 0xA8, 0x33, 0x9C);
sub new
{
my $class = shift;
@@ -45,16 +50,23 @@ sub parse
my $self = shift;
my $ptr = 2;
my ($server_version) = unpack('n', $self->data);
my $neg_version = $server_version;
my $random = substr($self->data, $ptr, 32);
$ptr += 32;
my $session_id_len = unpack('C', substr($self->data, $ptr));
my $session_id_len = 0;
my $session = "";
$session_id_len = unpack('C', substr($self->data, $ptr));
$ptr++;
my $session = substr($self->data, $ptr, $session_id_len);
$session = substr($self->data, $ptr, $session_id_len);
$ptr += $session_id_len;
my $ciphersuite = unpack('n', substr($self->data, $ptr));
$ptr += 2;
my $comp_meth = unpack('C', substr($self->data, $ptr));
my $comp_meth = 0;
$comp_meth = unpack('C', substr($self->data, $ptr));
$ptr++;
my $extensions_len = unpack('n', substr($self->data, $ptr));
if (!defined $extensions_len) {
$extensions_len = 0;
@@ -82,6 +94,20 @@ sub parse
my $extdata = substr($extension_data, 4, $size);
$extension_data = substr($extension_data, 4 + $size);
$extensions{$type} = $extdata;
if ($type == TLSProxy::Message::EXT_SUPPORTED_VERSIONS) {
$neg_version = unpack('n', $extdata);
}
}
if ($random eq $hrrrandom) {
TLSProxy::Proxy->is_tls13(1);
# TODO(TLS1.3): Replace this reference to draft version before release
} elsif ($neg_version == TLSProxy::Record::VERS_TLS_1_3_DRAFT) {
$neg_version = TLSProxy::Record::VERS_TLS_1_3;
TLSProxy::Proxy->is_tls13(1);
TLSProxy::Record->server_encrypting(1);
TLSProxy::Record->client_encrypting(1);
}
$self->server_version($server_version);
@@ -89,11 +115,13 @@ sub parse
$self->session_id_len($session_id_len);
$self->session($session);
$self->ciphersuite($ciphersuite);
TLSProxy::Proxy->ciphersuite($ciphersuite);
$self->comp_meth($comp_meth);
$self->extension_data(\%extensions);
$self->process_data();
print " Server Version:".$server_version."\n";
print " Session ID Len:".$session_id_len."\n";
print " Ciphersuite:".$ciphersuite."\n";
@@ -145,9 +173,9 @@ sub server_version
{
my $self = shift;
if (@_) {
$self->{client_version} = shift;
$self->{server_version} = shift;
}
return $self->{client_version};
return $self->{server_version};
}
sub random
{
util/perl/TLSProxy/ServerKeyExchange.pm
+36 -13
View File
@@ -33,6 +33,7 @@ sub new
$self->{p} = "";
$self->{g} = "";
$self->{pub_key} = "";
$self->{sigalg} = -1;
$self->{sig} = "";
return $self;
@@ -41,10 +42,13 @@ sub new
sub parse
{
my $self = shift;
my $sigalg = -1;
#Minimal SKE parsing. Only supports DHE at the moment (if its not DHE
#the parsing data will be trash...which is ok as long as we don't try to
#use it)
#Minimal SKE parsing. Only supports one known DHE ciphersuite at the moment
return if TLSProxy::Proxy->ciphersuite()
!= TLSProxy::Message::CIPHER_ADH_AES_128_SHA
&& TLSProxy::Proxy->ciphersuite()
!= TLSProxy::Message::CIPHER_DHE_RSA_AES_128_SHA;
my $p_len = unpack('n', $self->data);
my $ptr = 2;
@@ -62,18 +66,28 @@ sub parse
$ptr += $pub_key_len;
#We assume its signed
my $sig_len = unpack('n', substr($self->data, $ptr));
my $record = ${$self->records}[0];
if (TLSProxy::Proxy->is_tls13()
|| $record->version() == TLSProxy::Record::VERS_TLS_1_2) {
$sigalg = unpack('n', substr($self->data, $ptr));
$ptr += 2;
}
my $sig = "";
if (defined $sig_len) {
$ptr += 2;
$sig = substr($self->data, $ptr, $sig_len);
$ptr += $sig_len;
if (defined $sigalg) {
my $sig_len = unpack('n', substr($self->data, $ptr));
if (defined $sig_len) {
$ptr += 2;
$sig = substr($self->data, $ptr, $sig_len);
$ptr += $sig_len;
}
}
$self->p($p);
$self->g($g);
$self->pub_key($pub_key);
$self->sig($sig);
$self->sigalg($sigalg) if defined $sigalg;
$self->signature($sig);
}
@@ -89,9 +103,10 @@ sub set_message_contents
$data .= $self->g;
$data .= pack('n', length($self->pub_key));
$data .= $self->pub_key;
if (length($self->sig) > 0) {
$data .= pack('n', length($self->sig));
$data .= $self->sig;
$data .= pack('n', $self->sigalg) if ($self->sigalg != -1);
if (length($self->signature) > 0) {
$data .= pack('n', length($self->signature));
$data .= $self->signature;
}
$self->data($data);
@@ -123,7 +138,15 @@ sub pub_key
}
return $self->{pub_key};
}
sub sig
sub sigalg
{
my $self = shift;
if (@_) {
$self->{sigalg} = shift;
}
return $self->{sigalg};
}
sub signature
{
my $self = shift;
if (@_) {
util/perl/checkhandshake.pm
+228
View File
@@ -0,0 +1,228 @@
#! /usr/bin/env perl
# Copyright 2015-2018 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
package checkhandshake;
use OpenSSL::Test qw/:DEFAULT cmdstr srctop_file srctop_dir bldtop_dir/;
use OpenSSL::Test::Utils;
use TLSProxy::Proxy;
use Exporter;
our @ISA = 'Exporter';
our @EXPORT = qw(@handmessages @extensions checkhandshake);
use constant {
DEFAULT_HANDSHAKE => 1,
OCSP_HANDSHAKE => 2,
RESUME_HANDSHAKE => 4,
CLIENT_AUTH_HANDSHAKE => 8,
RENEG_HANDSHAKE => 16,
NPN_HANDSHAKE => 32,
EC_HANDSHAKE => 64,
HRR_HANDSHAKE => 128,
HRR_RESUME_HANDSHAKE => 256,
ALL_HANDSHAKES => 511
};
use constant {
#DEFAULT also includes SESSION_TICKET_SRV_EXTENSION and SERVER_NAME_CLI
DEFAULT_EXTENSIONS => 0x00000007,
SESSION_TICKET_SRV_EXTENSION => 0x00000002,
SERVER_NAME_CLI_EXTENSION => 0x00000004,
SERVER_NAME_SRV_EXTENSION => 0x00000008,
STATUS_REQUEST_CLI_EXTENSION => 0x00000010,
STATUS_REQUEST_SRV_EXTENSION => 0x00000020,
ALPN_CLI_EXTENSION => 0x00000040,
ALPN_SRV_EXTENSION => 0x00000080,
SCT_CLI_EXTENSION => 0x00000100,
SCT_SRV_EXTENSION => 0x00000200,
RENEGOTIATE_CLI_EXTENSION => 0x00000400,
NPN_CLI_EXTENSION => 0x00000800,
NPN_SRV_EXTENSION => 0x00001000,
SRP_CLI_EXTENSION => 0x00002000,
#Client side for ec point formats is a default extension
EC_POINT_FORMAT_SRV_EXTENSION => 0x00004000,
PSK_CLI_EXTENSION => 0x00008000,
PSK_SRV_EXTENSION => 0x00010000,
KEY_SHARE_SRV_EXTENSION => 0x00020000,
PSK_KEX_MODES_EXTENSION => 0x00040000,
KEY_SHARE_HRR_EXTENSION => 0x00080000,
SUPPORTED_GROUPS_SRV_EXTENSION => 0x00100000,
POST_HANDSHAKE_AUTH_CLI_EXTENSION => 0x00200000
};
our @handmessages = ();
our @extensions = ();
sub checkhandshake($$$$)
{
my ($proxy, $handtype, $exttype, $testname) = @_;
subtest $testname => sub {
my $loop = 0;
my $numtests;
my $extcount;
my $clienthelloseen = 0;
my $lastmt = 0;
my $numsh = 0;
if (TLSProxy::Proxy::is_tls13()) {
#How many ServerHellos are we expecting?
for ($numtests = 0; $handmessages[$loop][1] != 0; $loop++) {
next if (($handmessages[$loop][1] & $handtype) == 0);
$numsh++ if ($lastmt != TLSProxy::Message::MT_SERVER_HELLO
&& $handmessages[$loop][0] == TLSProxy::Message::MT_SERVER_HELLO);
$lastmt = $handmessages[$loop][0];
}
}
#First count the number of tests
my $nextmess = 0;
my $message = undef;
my $chnum = 0;
my $shnum = 0;
if (!TLSProxy::Proxy::is_tls13()) {
# In non-TLSv1.3 we always treat reneg CH and SH like the first CH
# and SH
$chnum = 1;
$shnum = 1;
}
#If we're only expecting one ServerHello out of two then we skip the
#first ServerHello in the list completely
$shnum++ if ($numsh == 1 && TLSProxy::Proxy::is_tls13());
$loop = 0;
for ($numtests = 0; $handmessages[$loop][1] != 0; $loop++) {
next if (($handmessages[$loop][1] & $handtype) == 0);
if (scalar @{$proxy->message_list} > $nextmess) {
$message = ${$proxy->message_list}[$nextmess];
$nextmess++;
} else {
$message = undef;
}
$numtests++;
next if (!defined $message);
if (TLSProxy::Proxy::is_tls13()) {
$chnum++ if $message->mt() == TLSProxy::Message::MT_CLIENT_HELLO;
$shnum++ if $message->mt() == TLSProxy::Message::MT_SERVER_HELLO;
}
next if ($message->mt() != TLSProxy::Message::MT_CLIENT_HELLO
&& $message->mt() != TLSProxy::Message::MT_SERVER_HELLO
&& $message->mt() !=
TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS
&& $message->mt() != TLSProxy::Message::MT_CERTIFICATE);
next if $message->mt() == TLSProxy::Message::MT_CERTIFICATE
&& !TLSProxy::Proxy::is_tls13();
my $extchnum = 1;
my $extshnum = 1;
for (my $extloop = 0;
$extensions[$extloop][2] != 0;
$extloop++) {
$extchnum = 2 if $extensions[$extloop][0] != TLSProxy::Message::MT_CLIENT_HELLO
&& TLSProxy::Proxy::is_tls13();
$extshnum = 2 if $extensions[$extloop][0] != TLSProxy::Message::MT_SERVER_HELLO
&& $extchnum == 2;
next if $extensions[$extloop][0] == TLSProxy::Message::MT_CLIENT_HELLO
&& $extchnum != $chnum;
next if $extensions[$extloop][0] == TLSProxy::Message::MT_SERVER_HELLO
&& $extshnum != $shnum;
next if ($message->mt() != $extensions[$extloop][0]);
$numtests++;
}
$numtests++;
}
plan tests => $numtests;
$nextmess = 0;
$message = undef;
if (TLSProxy::Proxy::is_tls13()) {
$chnum = 0;
$shnum = 0;
} else {
# In non-TLSv1.3 we always treat reneg CH and SH like the first CH
# and SH
$chnum = 1;
$shnum = 1;
}
#If we're only expecting one ServerHello out of two then we skip the
#first ServerHello in the list completely
$shnum++ if ($numsh == 1 && TLSProxy::Proxy::is_tls13());
for ($loop = 0; $handmessages[$loop][1] != 0; $loop++) {
next if (($handmessages[$loop][1] & $handtype) == 0);
if (scalar @{$proxy->message_list} > $nextmess) {
$message = ${$proxy->message_list}[$nextmess];
$nextmess++;
} else {
$message = undef;
}
if (!defined $message) {
fail("Message type check. Got nothing, expected "
.$handmessages[$loop][0]);
next;
} else {
ok($message->mt == $handmessages[$loop][0],
"Message type check. Got ".$message->mt
.", expected ".$handmessages[$loop][0]);
}
if (TLSProxy::Proxy::is_tls13()) {
$chnum++ if $message->mt() == TLSProxy::Message::MT_CLIENT_HELLO;
$shnum++ if $message->mt() == TLSProxy::Message::MT_SERVER_HELLO;
}
next if ($message->mt() != TLSProxy::Message::MT_CLIENT_HELLO
&& $message->mt() != TLSProxy::Message::MT_SERVER_HELLO
&& $message->mt() !=
TLSProxy::Message::MT_ENCRYPTED_EXTENSIONS
&& $message->mt() != TLSProxy::Message::MT_CERTIFICATE);
next if $message->mt() == TLSProxy::Message::MT_CERTIFICATE
&& !TLSProxy::Proxy::is_tls13();
if ($message->mt() == TLSProxy::Message::MT_CLIENT_HELLO) {
#Add renegotiate extension we will expect if renegotiating
$exttype |= RENEGOTIATE_CLI_EXTENSION
if ($clienthelloseen && !TLSProxy::Proxy::is_tls13());
$clienthelloseen = 1;
}
#Now check that we saw the extensions we expected
my $msgexts = $message->extension_data();
my $extchnum = 1;
my $extshnum = 1;
for (my $extloop = 0, $extcount = 0; $extensions[$extloop][2] != 0;
$extloop++) {
#In TLSv1.3 we can have two ClientHellos if there has been a
#HelloRetryRequest, and they may have different extensions. Skip
#if these are extensions for a different ClientHello
$extchnum = 2 if $extensions[$extloop][0] != TLSProxy::Message::MT_CLIENT_HELLO
&& TLSProxy::Proxy::is_tls13();
$extshnum = 2 if $extensions[$extloop][0] != TLSProxy::Message::MT_SERVER_HELLO
&& $extchnum == 2;
next if $extensions[$extloop][0] == TLSProxy::Message::MT_CLIENT_HELLO
&& $extchnum != $chnum;
next if $extensions[$extloop][0] == TLSProxy::Message::MT_SERVER_HELLO
&& $extshnum != $shnum;
next if ($message->mt() != $extensions[$extloop][0]);
ok (($extensions[$extloop][2] & $exttype) == 0
|| defined ($msgexts->{$extensions[$extloop][1]}),
"Extension presence check (Message: ".$message->mt()
." Extension: ".($extensions[$extloop][2] & $exttype).", "
.$extloop.")");
$extcount++ if (($extensions[$extloop][2] & $exttype) != 0);
}
ok($extcount == keys %$msgexts, "Extensions count mismatch ("
.$extcount.", ".(keys %$msgexts)
.")");
}
}
}
1;