diff options
Diffstat (limited to 'deps/openssl/openssl/util/perl')
| -rw-r--r-- | deps/openssl/openssl/util/perl/OpenSSL/Test.pm | 426 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/OpenSSL/Util/Pod.pm | 13 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/TLSProxy/Alert.pm | 51 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/TLSProxy/Certificate.pm | 219 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/TLSProxy/CertificateVerify.pm | 96 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/TLSProxy/ClientHello.pm | 37 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/TLSProxy/EncryptedExtensions.pm | 115 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/TLSProxy/Message.pm | 158 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/TLSProxy/Proxy.pm | 537 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/TLSProxy/Record.pm | 244 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/TLSProxy/ServerHello.pm | 38 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/TLSProxy/ServerKeyExchange.pm | 49 | ||||
| -rw-r--r-- | deps/openssl/openssl/util/perl/checkhandshake.pm | 228 |
13 files changed, 1742 insertions, 469 deletions
diff --git a/deps/openssl/openssl/util/perl/OpenSSL/Test.pm b/deps/openssl/openssl/util/perl/OpenSSL/Test.pm index a77909c606..9564b26046 100644 --- a/deps/openssl/openssl/util/perl/OpenSSL/Test.pm +++ b/deps/openssl/openssl/util/perl/OpenSSL/Test.pm @@ -16,11 +16,11 @@ 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 + data_file data_dir pipe with cmdstr quotify openssl_versions)); @@ -66,6 +66,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. @@ -92,9 +93,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 }, ); @@ -102,21 +103,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>. @@ -226,25 +212,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 @@ -260,21 +239,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 @@ -285,54 +285,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: @@ -345,6 +405,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 @@ -369,6 +441,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 @@ -381,17 +456,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}) { @@ -514,6 +607,23 @@ sub srctop_file { =over 4 +=item B<data_dir LIST> + +LIST is a list of directories that make up a path from the data directory +associated with the test (see L</DESCRIPTION> above). +C<data_dir> returns the resulting directory as a string, adapted to the local +operating system. + +=back + +=cut + +sub data_dir { + return __data_dir(@_); +} + +=over 4 + =item B<data_file LIST, FILENAME> LIST is a list of directories that make up a path from the data directory @@ -571,7 +681,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: @@ -617,7 +727,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 @@ -781,6 +891,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); @@ -807,6 +925,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 @@ -817,56 +938,56 @@ 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 { +sub __data_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); + return catfile($directories{SRCDATA},@_,$f); } -sub __data_file { +sub __data_dir { BAIL_OUT("Must run setup() first") if (! $test_name); - my $f = pop; - return catfile($directories{SRCDATA},@_,$f); + return catdir($directories{SRCDATA},@_); } sub __results_file { @@ -876,6 +997,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 = @_; @@ -937,7 +1068,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{$_}; @@ -964,28 +1095,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)) { @@ -1001,45 +1150,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 = ""; @@ -1049,19 +1178,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 @@ -1070,9 +1199,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; diff --git a/deps/openssl/openssl/util/perl/OpenSSL/Util/Pod.pm b/deps/openssl/openssl/util/perl/OpenSSL/Util/Pod.pm index 5c0af95918..9f76fbf1a6 100644 --- a/deps/openssl/openssl/util/perl/OpenSSL/Util/Pod.pm +++ b/deps/openssl/openssl/util/perl/OpenSSL/Util/Pod.pm @@ -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} diff --git a/deps/openssl/openssl/util/perl/TLSProxy/Alert.pm b/deps/openssl/openssl/util/perl/TLSProxy/Alert.pm new file mode 100644 index 0000000000..e66883d459 --- /dev/null +++ b/deps/openssl/openssl/util/perl/TLSProxy/Alert.pm @@ -0,0 +1,51 @@ +# Copyright 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 + +use strict; + +package TLSProxy::Alert; + +sub new +{ + my $class = shift; + my ($server, + $encrypted, + $level, + $description) = @_; + + my $self = { + server => $server, + encrypted => $encrypted, + level => $level, + description => $description + }; + + return bless $self, $class; +} + +#Read only accessors +sub server +{ + my $self = shift; + return $self->{server}; +} +sub encrypted +{ + my $self = shift; + return $self->{encrypted}; +} +sub level +{ + my $self = shift; + return $self->{level}; +} +sub description +{ + my $self = shift; + return $self->{description}; +} +1; diff --git a/deps/openssl/openssl/util/perl/TLSProxy/Certificate.pm b/deps/openssl/openssl/util/perl/TLSProxy/Certificate.pm new file mode 100644 index 0000000000..d3bf7f2180 --- /dev/null +++ b/deps/openssl/openssl/util/perl/TLSProxy/Certificate.pm @@ -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; diff --git a/deps/openssl/openssl/util/perl/TLSProxy/CertificateVerify.pm b/deps/openssl/openssl/util/perl/TLSProxy/CertificateVerify.pm new file mode 100644 index 0000000000..8bf969fba1 --- /dev/null +++ b/deps/openssl/openssl/util/perl/TLSProxy/CertificateVerify.pm @@ -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; diff --git a/deps/openssl/openssl/util/perl/TLSProxy/ClientHello.pm b/deps/openssl/openssl/util/perl/TLSProxy/ClientHello.pm index ec739d2970..2ae9d6f55d 100644 --- a/deps/openssl/openssl/util/perl/TLSProxy/ClientHello.pm +++ b/deps/openssl/openssl/util/perl/TLSProxy/ClientHello.pm @@ -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)); diff --git a/deps/openssl/openssl/util/perl/TLSProxy/EncryptedExtensions.pm b/deps/openssl/openssl/util/perl/TLSProxy/EncryptedExtensions.pm new file mode 100644 index 0000000000..81242e29ff --- /dev/null +++ b/deps/openssl/openssl/util/perl/TLSProxy/EncryptedExtensions.pm @@ -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; diff --git a/deps/openssl/openssl/util/perl/TLSProxy/Message.pm b/deps/openssl/openssl/util/perl/TLSProxy/Message.pm index 0821bdedd3..16ed012066 100644 --- a/deps/openssl/openssl/util/perl/TLSProxy/Message.pm +++ b/deps/openssl/openssl/util/perl/TLSProxy/Message.pm @@ -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 @@ -9,6 +9,8 @@ use strict; package TLSProxy::Message; +use TLSProxy::Alert; + use constant TLS_MESSAGE_HEADER_LENGTH => 4; #Message types @@ -17,6 +19,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, @@ -38,6 +41,7 @@ use constant { use constant { AL_DESC_CLOSE_NOTIFY => 0, AL_DESC_UNEXPECTED_MESSAGE => 10, + AL_DESC_ILLEGAL_PARAMETER => 47, AL_DESC_NO_RENEGOTIATION => 100 }; @@ -46,6 +50,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 +63,73 @@ 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://www.iana.org/assignments/tls-parameters/tls-parameters.xhtml#tls-signaturescheme +# 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_RSAE_SHA256 => 0x0804, + SIG_ALG_RSA_PSS_RSAE_SHA384 => 0x0805, + SIG_ALG_RSA_PSS_RSAE_SHA512 => 0x0806, + SIG_ALG_ED25519 => 0x0807, + SIG_ALG_ED448 => 0x0808, + SIG_ALG_RSA_PSS_PSS_SHA256 => 0x0809, + SIG_ALG_RSA_PSS_PSS_SHA384 => 0x080a, + SIG_ALG_RSA_PSS_PSS_SHA512 => 0x080b, + 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_RSA_WITH_AES_128_CBC_SHA => 0x002f, + 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 +142,8 @@ my $end = 0; my @message_rec_list = (); my @message_frag_lens = (); my $ciphersuite = 0; +my $successondata = 0; +my $alert; sub clear { @@ -86,8 +153,10 @@ sub clear $server = 0; $success = 0; $end = 0; + $successondata = 0; @message_rec_list = (); @message_frag_lens = (); + $alert = undef; } #Class method to extract messages from a record @@ -111,10 +180,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,16 +268,29 @@ 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); + print " [$alertlev, $alertdesc]\n"; #A CloseNotify from the client indicates we have finished successfully #(we assume) if (!$end && !$server && $alertlev == AL_LEVEL_WARN && $alertdesc == AL_DESC_CLOSE_NOTIFY) { $success = 1; } - #All alerts end the test - $end = 1; + #Fatal or close notify alerts end the test + if ($alertlev == AL_LEVEL_FATAL || $alertdesc == AL_DESC_CLOSE_NOTIFY) { + $end = 1; + } + $alert = TLSProxy::Alert->new( + $server, + $record->encrypted, + $alertlev, + $alertdesc); } return @messages; @@ -239,6 +323,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, @@ -287,6 +398,12 @@ sub fail my $class = shift; return !$success && $end; } + +sub alert +{ + return $alert; +} + sub new { my $class = shift; @@ -319,7 +436,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 +479,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 +575,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; diff --git a/deps/openssl/openssl/util/perl/TLSProxy/Proxy.pm b/deps/openssl/openssl/util/perl/TLSProxy/Proxy.pm index de143626d3..8c13520ec6 100644 --- a/deps/openssl/openssl/util/perl/TLSProxy/Proxy.pm +++ b/deps/openssl/openssl/util/perl/TLSProxy/Proxy.pm @@ -17,52 +17,21 @@ 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/; -my $have_IPv6 = 0; +my $have_IPv6; my $IP_factory; -sub new +BEGIN { - my $class = shift; - my ($filter, - $execute, - $cert, - $debug) = @_; - - my $self = { - #Public read/write - proxy_addr => "localhost", - proxy_port => 4453, - server_addr => "localhost", - server_port => 4443, - filter => $filter, - serverflags => "", - clientflags => "", - serverconnects => 1, - serverpid => 0, - clientpid => 0, - reneg => 0, - - #Public read - execute => $execute, - cert => $cert, - debug => $debug, - cipherc => "", - ciphers => "AES128-SHA", - flight => -1, - direction => -1, - partial => ["", ""], - record_list => [], - message_list => [], - }; - # IO::Socket::IP is on the core module list, IO::Socket::INET6 isn't. # However, IO::Socket::INET6 is older and is said to be more widely # deployed for the moment, and may have less bugs, so we try the latter - # first, then fall back on the code modules. Worst case scenario, we + # first, then fall back on the core modules. Worst case scenario, we # fall back to IO::Socket::INET, only supports IPv4. eval { require IO::Socket::INET6; @@ -93,26 +62,72 @@ sub new $have_IPv6 = 1; } else { $IP_factory = sub { IO::Socket::INET->new(@_); }; + $have_IPv6 = 0; } } +} + +my $is_tls13 = 0; +my $ciphersuite = undef; + +sub new +{ + my $class = shift; + my ($filter, + $execute, + $cert, + $debug) = @_; + + my $self = { + #Public read/write + proxy_addr => $have_IPv6 ? "[::1]" : "127.0.0.1", + filter => $filter, + serverflags => "", + clientflags => "", + serverconnects => 1, + reneg => 0, + sessionfile => undef, + + #Public read + proxy_port => 0, + server_port => 0, + serverpid => 0, + clientpid => 0, + execute => $execute, + cert => $cert, + debug => $debug, + cipherc => "", + ciphersuitesc => "", + ciphers => "AES128-SHA", + ciphersuitess => "TLS_AES_128_GCM_SHA256", + flight => -1, + direction => -1, + partial => ["", ""], + record_list => [], + message_list => [], + }; # Create the Proxy socket my $proxaddr = $self->{proxy_addr}; $proxaddr =~ s/[\[\]]//g; # Remove [ and ] my @proxyargs = ( LocalHost => $proxaddr, - LocalPort => $self->{proxy_port}, + LocalPort => 0, Proto => "tcp", Listen => SOMAXCONN, ); - push @proxyargs, ReuseAddr => 1 - unless $^O eq "MSWin32"; - $self->{proxy_sock} = $IP_factory->(@proxyargs); - if ($self->{proxy_sock}) { - print "Proxy started on port ".$self->{proxy_port}."\n"; + if (my $sock = $IP_factory->(@proxyargs)) { + $self->{proxy_sock} = $sock; + $self->{proxy_port} = $sock->sockport(); + $self->{proxy_addr} = $sock->sockhost(); + $self->{proxy_addr} =~ s/(.*:.*)/[$1]/; + print "Proxy started on port ", + "$self->{proxy_addr}:$self->{proxy_port}\n"; + # use same address for s_server + $self->{server_addr} = $self->{proxy_addr}; } else { - warn "Failed creating proxy socket (".$proxaddr.",".$self->{proxy_port}."): $!\n"; + warn "Failed creating proxy socket (".$proxaddr.",0): $!\n"; } return bless $self, $class; @@ -130,13 +145,17 @@ sub clearClient my $self = shift; $self->{cipherc} = ""; + $self->{ciphersuitec} = ""; $self->{flight} = -1; $self->{direction} = -1; $self->{partial} = ["", ""]; $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(); @@ -148,6 +167,7 @@ sub clear $self->clearClient; $self->{ciphers} = "AES128-SHA"; + $self->{ciphersuitess} = "TLS_AES_128_GCM_SHA256"; $self->{serverflags} = ""; $self->{serverconnects} = 1; $self->{serverpid} = 0; @@ -170,6 +190,25 @@ sub clientrestart $self->clientstart; } +sub connect_to_server +{ + my $self = shift; + my $servaddr = $self->{server_addr}; + + $servaddr =~ s/[\[\]]//g; # Remove [ and ] + + my $sock = $IP_factory->(PeerAddr => $servaddr, + PeerPort => $self->{server_port}, + Proto => 'tcp'); + if (!defined($sock)) { + my $err = $!; + kill(3, $self->{real_serverpid}); + die "unable to connect: $err\n"; + } + + $self->{server_sock} = $sock; +} + sub start { my ($self) = shift; @@ -179,27 +218,90 @@ sub start return 0; } - $pid = fork(); - if ($pid == 0) { - my $execcmd = $self->execute - ." s_server -max_protocol TLSv1.2 -no_comp -rev -engine ossltest -accept " - .($self->server_port) - ." -cert ".$self->cert." -naccept ".$self->serverconnects; - unless ($self->supports_IPv6) { - $execcmd .= " -4"; - } - if ($self->ciphers ne "") { - $execcmd .= " -cipher ".$self->ciphers; - } - if ($self->serverflags ne "") { - $execcmd .= " ".$self->serverflags; + my $execcmd = $self->execute + ." s_server -max_protocol TLSv1.3 -no_comp -rev -engine ossltest" + #In TLSv1.3 we issue two session tickets. The default session id + #callback gets confused because the ossltest engine causes the same + #session id to be created twice due to the changed random number + #generation. Using "-ext_cache" replaces the default callback with a + #different one that doesn't get confused. + ." -ext_cache" + ." -accept $self->{server_addr}:0" + ." -cert ".$self->cert." -cert2 ".$self->cert + ." -naccept ".$self->serverconnects; + if ($self->ciphers ne "") { + $execcmd .= " -cipher ".$self->ciphers; + } + if ($self->ciphersuitess ne "") { + $execcmd .= " -ciphersuites ".$self->ciphersuitess; + } + if ($self->serverflags ne "") { + $execcmd .= " ".$self->serverflags; + } + if ($self->debug) { + print STDERR "Server command: $execcmd\n"; + } + + open(my $savedin, "<&STDIN"); + + # Temporarily replace STDIN so that sink process can inherit it... + $pid = open(STDIN, "$execcmd 2>&1 |") or die "Failed to $execcmd: $!\n"; + $self->{real_serverpid} = $pid; + + # Process the output from s_server until we find the ACCEPT line, which + # tells us what the accepting address and port are. + while (<>) { + print; + s/\R$//; # Better chomp + next unless (/^ACCEPT\s.*:(\d+)$/); + $self->{server_port} = $1; + last; + } + + if ($self->{server_port} == 0) { + # This actually means that s_server exited, because otherwise + # we would still searching for ACCEPT... + waitpid($pid, 0); + die "no ACCEPT detected in '$execcmd' output: $?\n"; + } + + # Just make sure everything else is simply printed [as separate lines]. + # The sub process simply inherits our STD* and will keep consuming + # server's output and printing it as long as there is anything there, + # out of our way. + my $error; + $pid = undef; + if (eval { require Win32::Process; 1; }) { + if (Win32::Process::Create(my $h, $^X, "perl -ne print", 0, 0, ".")) { + $pid = $h->GetProcessID(); + $self->{proc_handle} = $h; # hold handle till next round [or exit] + } else { + $error = Win32::FormatMessage(Win32::GetLastError()); } - if ($self->debug) { - print STDERR "Server command: $execcmd\n"; + } else { + if (defined($pid = fork)) { + $pid or exec("$^X -ne print") or exit($!); + } else { + $error = $!; } - exec($execcmd); } - $self->serverpid($pid); + + # Change back to original stdin + open(STDIN, "<&", $savedin); + close($savedin); + + if (!defined($pid)) { + kill(3, $self->{real_serverpid}); + die "Failed to capture s_server's output: $error\n"; + } + + $self->{serverpid} = $pid; + + print STDERR "Server responds on ", + "$self->{server_addr}:$self->{server_port}\n"; + + # Connect right away... + $self->connect_to_server(); return $self->clientstart; } @@ -207,38 +309,57 @@ sub start sub clientstart { my ($self) = shift; - my $oldstdout; if ($self->execute) { - my $pid = fork(); - if ($pid == 0) { - my $echostr; - if ($self->reneg()) { - $echostr = "R"; - } else { - $echostr = "test"; - } - my $execcmd = "echo ".$echostr." | ".$self->execute - ." s_client -max_protocol TLSv1.2 -engine ossltest -connect " - .($self->proxy_addr).":".($self->proxy_port); - unless ($self->supports_IPv6) { - $execcmd .= " -4"; - } - if ($self->cipherc ne "") { - $execcmd .= " -cipher ".$self->cipherc; - } - if ($self->clientflags ne "") { - $execcmd .= " ".$self->clientflags; - } - if ($self->debug) { - print STDERR "Client command: $execcmd\n"; - } - exec($execcmd); + my $pid; + my $execcmd = $self->execute + ." s_client -max_protocol TLSv1.3 -engine ossltest" + ." -connect $self->{proxy_addr}:$self->{proxy_port}"; + if ($self->cipherc ne "") { + $execcmd .= " -cipher ".$self->cipherc; + } + if ($self->ciphersuitesc ne "") { + $execcmd .= " -ciphersuites ".$self->ciphersuitesc; + } + if ($self->clientflags ne "") { + $execcmd .= " ".$self->clientflags; + } + if ($self->clientflags !~ m/-(no)?servername/) { + $execcmd .= " -servername localhost"; + } + if (defined $self->sessionfile) { + $execcmd .= " -ign_eof"; + } + if ($self->debug) { + print STDERR "Client command: $execcmd\n"; + } + + open(my $savedout, ">&STDOUT"); + # If we open pipe with new descriptor, attempt to close it, + # explicitly or implicitly, would incur waitpid and effectively + # dead-lock... + if (!($pid = open(STDOUT, "| $execcmd"))) { + my $err = $!; + kill(3, $self->{real_serverpid}); + die "Failed to $execcmd: $err\n"; } - $self->clientpid($pid); + $self->{clientpid} = $pid; + + # queue [magic] input + print $self->reneg ? "R" : "test"; + + # this closes client's stdin without waiting for its pid + open(STDOUT, ">&", $savedout); + close($savedout); } # Wait for incoming connection from client + my $fdset = IO::Select->new($self->{proxy_sock}); + if (!$fdset->can_read(60)) { + kill(3, $self->{real_serverpid}); + die "s_client didn't try to connect\n"; + } + my $client_sock; if(!($client_sock = $self->{proxy_sock}->accept())) { warn "Failed accepting incoming connection: $!\n"; @@ -247,89 +368,96 @@ sub clientstart print "Connection opened\n"; - # Now connect to the server - my $retry = 50; - my $server_sock; - #We loop over this a few times because sometimes s_server can take a while - #to start up - do { - my $servaddr = $self->server_addr; - $servaddr =~ s/[\[\]]//g; # Remove [ and ] - eval { - $server_sock = $IP_factory->( - PeerAddr => $servaddr, - PeerPort => $self->server_port, - MultiHomed => 1, - Proto => 'tcp' - ); - }; - - $retry--; - #Some buggy IP factories can return a defined server_sock that hasn't - #actually connected, so we check peerport too - if ($@ || !defined($server_sock) || !defined($server_sock->peerport)) { - $server_sock->close() if defined($server_sock); - undef $server_sock; - if ($retry) { - #Sleep for a short while - select(undef, undef, undef, 0.1); - } else { - warn "Failed to start up server (".$servaddr.",".$self->server_port."): $!\n"; - return 0; - } - } - } while (!$server_sock); - - my $sel = IO::Select->new($server_sock, $client_sock); + my $server_sock = $self->{server_sock}; my $indata; - my @handles = ($server_sock, $client_sock); #Wait for either the server socket or the client socket to become readable + $fdset = IO::Select->new($server_sock, $client_sock); my @ready; + my $ctr = 0; local $SIG{PIPE} = "IGNORE"; - while(!(TLSProxy::Message->end) && (@ready = $sel->can_read)) { + $self->{saw_session_ticket} = undef; + while($fdset->count && $ctr < 10) { + if (defined($self->{sessionfile})) { + # s_client got -ign_eof and won't be exiting voluntarily, so we + # look for data *and* session ticket... + last if TLSProxy::Message->success() + && $self->{saw_session_ticket}; + } + if (!(@ready = $fdset->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); + if ($server_sock->sysread($indata, 16384)) { + if ($indata = $self->process_packet(1, $indata)) { + $client_sock->syswrite($indata) or goto END; + } + $ctr = 0; + } else { + $fdset->remove($server_sock); + $client_sock->shutdown(SHUT_WR); + } } elsif ($hand == $client_sock) { - $client_sock->sysread($indata, 16384) or goto END; - $indata = $self->process_packet(0, $indata); - $server_sock->syswrite($indata); + if ($client_sock->sysread($indata, 16384)) { + if ($indata = $self->process_packet(0, $indata)) { + $server_sock->syswrite($indata) or goto END; + } + $ctr = 0; + } else { + $fdset->remove($client_sock); + $server_sock->shutdown(SHUT_WR); + } } else { - print "Err\n"; - goto END; + kill(3, $self->{real_serverpid}); + die "Unexpected handle"; } } } + if ($ctr >= 10) { + kill(3, $self->{real_serverpid}); + die "No progress made"; + } + END: print "Connection closed\n"; if($server_sock) { $server_sock->close(); + $self->{server_sock} = undef; } if($client_sock) { #Closing this also kills the child process $client_sock->close(); } - if(!$self->debug) { - select($oldstdout); - } - $self->serverconnects($self->serverconnects - 1); - if ($self->serverconnects == 0) { - die "serverpid is zero\n" if $self->serverpid == 0; - print "Waiting for server process to close: " - .$self->serverpid."\n"; - waitpid( $self->serverpid, 0); - die "exit code $? from server process\n" if $? != 0; + + my $pid; + if (--$self->{serverconnects} == 0) { + $pid = $self->{serverpid}; + print "Waiting for 'perl -ne print' process to close: $pid...\n"; + $pid = waitpid($pid, 0); + if ($pid > 0) { + die "exit code $? from 'perl -ne print' process\n" if $? != 0; + } elsif ($pid == 0) { + kill(3, $self->{real_serverpid}); + die "lost control over $self->{serverpid}?"; + } + $pid = $self->{real_serverpid}; + print "Waiting for s_server process to close: $pid...\n"; + # it's done already, just collect the exit code [and reap]... + waitpid($pid, 0); + die "exit code $? from s_server process\n" if $? != 0; } else { - # Give s_server sufficient time to finish what it was doing - usleep(250000); + # It's a bit counter-intuitive spot to make next connection to + # the s_server. Rationale is that established connection works + # as syncronization point, in sense that this way we know that + # s_server is actually done with current session... + $self->connect_to_server(); } - die "clientpid is zero\n" if $self->clientpid == 0; - print "Waiting for client process to close: ".$self->clientpid."\n"; - waitpid($self->clientpid, 0); + $pid = $self->{clientpid}; + print "Waiting for s_client process to close: $pid...\n"; + waitpid($pid, 0); return 1; } @@ -358,9 +486,10 @@ sub process_packet #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); + my @ret = TLSProxy::Record->get_records($server, $self->flight, + $self->{partial}[$server].$packet); $self->{partial}[$server] = $ret[2]; - push @{$self->record_list}, @{$ret[0]}; + push @{$self->{record_list}}, @{$ret[0]}; push @{$self->{message_list}}, @{$ret[1]}; print "\n"; @@ -374,10 +503,18 @@ sub process_packet $self->filter->($self); } + #Take a note on NewSessionTicket + foreach my $message (reverse @{$self->{message_list}}) { + if ($message->{mt} == TLSProxy::Message::MT_NEW_SESSION_TICKET) { + $self->{saw_session_ticket} = 1; + last; + } + } + #Reconstruct the packet $packet = ""; foreach my $record (@{$self->record_list}) { - $packet .= $record->reconstruct_record(); + $packet .= $record->reconstruct_record($server); } print "Forwarded packet length = ".length($packet)."\n\n"; @@ -436,29 +573,33 @@ sub proxy_port my $self = shift; return $self->{proxy_port}; } - -#Read/write accessors sub server_addr { my $self = shift; - if (@_) { - $self->{server_addr} = shift; - } return $self->{server_addr}; } sub server_port { my $self = shift; - if (@_) { - $self->{server_port} = shift; - } return $self->{server_port}; } +sub serverpid +{ + my $self = shift; + return $self->{serverpid}; +} +sub clientpid +{ + my $self = shift; + return $self->{clientpid}; +} + +#Read/write accessors sub filter { my $self = shift; if (@_) { - $self->{filter} = shift; + $self->{filter} = shift; } return $self->{filter}; } @@ -466,23 +607,39 @@ sub cipherc { my $self = shift; if (@_) { - $self->{cipherc} = shift; + $self->{cipherc} = shift; } return $self->{cipherc}; } +sub ciphersuitesc +{ + my $self = shift; + if (@_) { + $self->{ciphersuitesc} = shift; + } + return $self->{ciphersuitesc}; +} sub ciphers { my $self = shift; if (@_) { - $self->{ciphers} = shift; + $self->{ciphers} = shift; } return $self->{ciphers}; } +sub ciphersuitess +{ + my $self = shift; + if (@_) { + $self->{ciphersuitess} = shift; + } + return $self->{ciphersuitess}; +} sub serverflags { my $self = shift; if (@_) { - $self->{serverflags} = shift; + $self->{serverflags} = shift; } return $self->{serverflags}; } @@ -490,7 +647,7 @@ sub clientflags { my $self = shift; if (@_) { - $self->{clientflags} = shift; + $self->{clientflags} = shift; } return $self->{clientflags}; } @@ -498,7 +655,7 @@ sub serverconnects { my $self = shift; if (@_) { - $self->{serverconnects} = shift; + $self->{serverconnects} = shift; } return $self->{serverconnects}; } @@ -514,22 +671,6 @@ sub message_list } return $self->{message_list}; } -sub serverpid -{ - my $self = shift; - if (@_) { - $self->{serverpid} = shift; - } - return $self->{serverpid}; -} -sub clientpid -{ - my $self = shift; - if (@_) { - $self->{clientpid} = shift; - } - return $self->{clientpid}; -} sub fill_known_data { @@ -541,13 +682,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; diff --git a/deps/openssl/openssl/util/perl/TLSProxy/Record.pm b/deps/openssl/openssl/util/perl/TLSProxy/Record.pm index 786ba0c72b..0a280cb269 100644 --- a/deps/openssl/openssl/util/perl/TLSProxy/Record.pm +++ b/deps/openssl/openssl/util/perl/TLSProxy/Record.pm @@ -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,13 @@ 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 => 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 = ( @@ -62,72 +63,66 @@ sub get_records my $partial = ""; 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 - || length($packet) < 5 + unpack("n", substr($packet, 3, 2))) { + print " Record $recnum ", $server ? "(server -> client)\n" + : "(client -> server)\n"; + + #Get the record header (unpack can't fail if $packet is too short) + my ($content_type, $version, $len) = unpack('Cnn', $packet); + + if (length($packet) < TLS_RECORD_HEADER_LENGTH + ($len // 0)) { print "Partial data : ".length($packet)." bytes\n"; $partial = $packet; - $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); - } + last; + } - 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_ccs_seen) - || (!$server && $client_ccs_seen)) { - if ($etm) { + my $data = substr($packet, TLS_RECORD_HEADER_LENGTH, $len); + + print " Content type: ".$record_type{$content_type}."\n"; + print " Version: $tls_version{$version}\n"; + print " Length: $len\n"; + + my $record = TLSProxy::Record->new( + $flight, + $content_type, + $version, + $len, + 0, + $len, # len_real + $len, # decrypt_len + $data, # data + $data # decrypt_data + ); + + if ($content_type != RT_CCS + && (!TLSProxy::Proxy->is_tls13() + || $content_type != RT_ALERT)) { + 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; + 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; + #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++; - } + $packet = substr($packet, TLS_RECORD_HEADER_LENGTH + $len); + $recnum++; } return (\@record_list, \@message_list, $partial); @@ -135,26 +130,26 @@ sub get_records 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 +185,9 @@ sub new data => $data, decrypt_data => $decrypt_data, orig_decrypt_data => $decrypt_data, - sent => 0 + sent => 0, + encrypted => 0, + outer_content_type => RT_APPLICATION_DATA }; return bless $self, $class; @@ -227,22 +224,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)); + #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 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); + #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)); @@ -254,9 +273,11 @@ sub decrypt() sub reconstruct_record { my $self = shift; + my $server = shift; my $data; - if ($self->{sent}) { + #We only replay the records in the same direction + if ($self->{sent} || ($self->flight & 1) != $server) { return ""; } $self->{sent} = 1; @@ -264,7 +285,14 @@ sub reconstruct_record 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 +305,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 +354,48 @@ 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}; +} +sub is_fatal_alert +{ + my $self = shift; + my $server = shift; + + if (($self->{flight} & 1) == $server + && $self->{content_type} == TLSProxy::Record::RT_ALERT) { + my ($level, $alert) = unpack('CC', $self->decrypt_data); + return $alert if ($level == 2); + } + return 0; +} 1; diff --git a/deps/openssl/openssl/util/perl/TLSProxy/ServerHello.pm b/deps/openssl/openssl/util/perl/TLSProxy/ServerHello.pm index 79a8be9a89..84f2faab05 100644 --- a/deps/openssl/openssl/util/perl/TLSProxy/ServerHello.pm +++ b/deps/openssl/openssl/util/perl/TLSProxy/ServerHello.pm @@ -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 @@ -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,18 @@ 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); + } elsif ($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 +113,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 +171,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 { diff --git a/deps/openssl/openssl/util/perl/TLSProxy/ServerKeyExchange.pm b/deps/openssl/openssl/util/perl/TLSProxy/ServerKeyExchange.pm index 6e5b4cdcb4..cb4cc7c762 100644 --- a/deps/openssl/openssl/util/perl/TLSProxy/ServerKeyExchange.pm +++ b/deps/openssl/openssl/util/perl/TLSProxy/ServerKeyExchange.pm @@ -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 (@_) { diff --git a/deps/openssl/openssl/util/perl/checkhandshake.pm b/deps/openssl/openssl/util/perl/checkhandshake.pm new file mode 100644 index 0000000000..c53b96d5ee --- /dev/null +++ b/deps/openssl/openssl/util/perl/checkhandshake.pm @@ -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; |