ag/cpython-source-deps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import OpenSSL 1.1.0h

Browse Source
This commit is contained in:
Steve Dower
2018-04-13 17:45:41 +00:00
parent f39d324ed3
commit 807cee26df
513 changed files with 11248 additions and 3603 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
util/copy.pl
View File

@@ -26,7 +26,8 @@ foreach $arg (@ARGV) {
next;
}
$arg =~ s|\\|/|g; # compensate for bug/feature in cygwin glob...
foreach (glob qq("$arg"))
$arg = qq("$arg") if ($arg =~ /\s/); # compensate for bug in 5.10...
foreach (glob $arg)
{
push @filelist, $_;
}

14
util/dofile.pl
View File

@@ -1,5 +1,5 @@
#! /usr/bin/env perl
# 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
@@ -14,6 +14,7 @@
use strict;
use warnings;
use FindBin;
use Getopt::Std;
# We actually expect to get the following hash tables from configdata:
@@ -38,7 +39,7 @@ package OpenSSL::Template;
# a fallback in case it's not installed on the system
use File::Basename;
use File::Spec::Functions;
use lib catdir(dirname(__FILE__));
use lib "$FindBin::Bin/perl";
use with_fallback qw(Text::Template);
#use parent qw/Text::Template/;
@@ -98,9 +99,9 @@ package main;
# This adds quotes (") around the given string, and escapes any $, @, \,
# " and ' by prepending a \ to them.
sub quotify1 {
my $s = shift @_;
my $s = my $orig = shift @_;
$s =~ s/([\$\@\\"'])/\\$1/g;
'"'.$s.'"';
$s ne $orig || $s =~ /\s/ ? '"'.$s.'"' : $s;
}
# quotify_l LIST
@@ -175,7 +176,10 @@ my $text =
# Load the full template (combination of files) into Text::Template
# and fill it up with our data. Output goes directly to STDOUT
my $template = OpenSSL::Template->new(TYPE => 'STRING', SOURCE => $text );
my $template =
OpenSSL::Template->new(TYPE => 'STRING',
SOURCE => $text,
PREPEND => qq{use lib "$FindBin::Bin/perl";});
sub output_reset_on {
$template->output_reset_on();

549
util/find-doc-nits Normal file
View File

@@ -0,0 +1,549 @@
#! /usr/bin/env perl
# Copyright 2002-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
require 5.10.0;
use warnings;
use strict;
use Pod::Checker;
use File::Find;
use File::Basename;
use File::Spec::Functions;
use Getopt::Std;
use lib catdir(dirname($0), "perl");
use OpenSSL::Util::Pod;
# Options.
our($opt_d);
our($opt_h);
our($opt_l);
our($opt_n);
our($opt_p);
our($opt_s);
our($opt_u);
our($opt_c);
sub help()
{
print <<EOF;
Find small errors (nits) in documentation. Options:
-d Detailed list of undocumented (implies -u)
-l Print bogus links
-n Print nits in POD pages
-s Also print missing sections in POD pages (implies -n)
-p Warn if non-public name documented (implies -n)
-u List undocumented functions
-h Print this help message
-c List undocumented commands and options
EOF
exit;
}
my $temp = '/tmp/docnits.txt';
my $OUT;
my %public;
my %mandatory_sections =
( '*' => [ 'NAME', 'DESCRIPTION', 'COPYRIGHT' ],
1 => [ 'SYNOPSIS', 'OPTIONS' ],
3 => [ 'SYNOPSIS', 'RETURN VALUES' ],
5 => [ ],
7 => [ ] );
# Cross-check functions in the NAME and SYNOPSIS section.
sub name_synopsis()
{
my $id = shift;
my $filename = shift;
my $contents = shift;
# Get NAME section and all words in it.
return unless $contents =~ /=head1 NAME(.*)=head1 SYNOPSIS/ms;
my $tmp = $1;
$tmp =~ tr/\n/ /;
print "$id trailing comma before - in NAME\n" if $tmp =~ /, *-/;
$tmp =~ s/ -.*//g;
$tmp =~ s/ */ /g;
print "$id missing comma in NAME\n" if $tmp =~ /[^,] /;
$tmp =~ s/,//g;
my $dirname = dirname($filename);
my $simplename = basename($filename);
$simplename =~ s/.pod$//;
my $foundfilename = 0;
my %foundfilenames = ();
my %names;
foreach my $n ( split ' ', $tmp ) {
$names{$n} = 1;
$foundfilename++ if $n eq $simplename;
$foundfilenames{$n} = 1
if -f "$dirname/$n.pod" && $n ne $simplename;
}
print "$id the following exist as other .pod files:\n",
join(" ", sort keys %foundfilenames), "\n"
if %foundfilenames;
print "$id $simplename (filename) missing from NAME section\n"
unless $foundfilename;
foreach my $n ( keys %names ) {
print "$id $n is not public\n"
if $opt_p and !defined $public{$n};
}
# Find all functions in SYNOPSIS
return unless $contents =~ /=head1 SYNOPSIS(.*)=head1 DESCRIPTION/ms;
my $syn = $1;
foreach my $line ( split /\n+/, $syn ) {
my $sym;
$line =~ s/STACK_OF\([^)]+\)/int/g;
$line =~ s/__declspec\([^)]+\)//;
if ( $line =~ /env (\S*)=/ ) {
# environment variable env NAME=...
$sym = $1;
} elsif ( $line =~ /typedef.*\(\*(\S+)\)\(.*/ ) {
# a callback function pointer: typedef ... (*NAME)(...
$sym = $1;
} elsif ( $line =~ /typedef.* (\S+)\(.*/ ) {
# a callback function signature: typedef ... NAME(...
$sym = $1;
} elsif ( $line =~ /typedef.* (\S+);/ ) {
# a simple typedef: typedef ... NAME;
$sym = $1;
} elsif ( $line =~ /enum (\S*) \{/ ) {
# an enumeration: enum ... {
$sym = $1;
} elsif ( $line =~ /#define ([A-Za-z0-9_]+)/ ) {
$sym = $1;
} elsif ( $line =~ /([A-Za-z0-9_]+)\(/ ) {
$sym = $1;
}
else {
next;
}
print "$id $sym missing from NAME section\n"
unless defined $names{$sym};
$names{$sym} = 2;
# Do some sanity checks on the prototype.
print "$id prototype missing spaces around commas: $line\n"
if ( $line =~ /[a-z0-9],[^ ]/ );
}
foreach my $n ( keys %names ) {
next if $names{$n} == 2;
print "$id $n missing from SYNOPSIS\n";
}
}
sub check()
{
my $filename = shift;
my $dirname = basename(dirname($filename));
my $contents = '';
{
local $/ = undef;
open POD, $filename or die "Couldn't open $filename, $!";
$contents = <POD>;
close POD;
}
my $id = "${filename}:1:";
# Find what section this page is in; assume 3.
my $section = 3;
$section = 1 if $dirname eq 'apps';
$section = $1 if ( $contents =~ /=for comment openssl_manual_section:(\d)/);
&name_synopsis($id, $filename, $contents)
unless $contents =~ /=for comment generic/
or $section != 3;
print "$id doesn't start with =pod\n"
if $contents !~ /^=pod/;
print "$id doesn't end with =cut\n"
if $contents !~ /=cut\n$/;
print "$id more than one cut line.\n"
if $contents =~ /=cut.*=cut/ms;
print "$id missing copyright\n"
if $contents !~ /Copyright .* The OpenSSL Project Authors/;
print "$id copyright not last\n"
if $contents =~ /head1 COPYRIGHT.*=head/ms;
print "$id head2 in All uppercase\n"
if $contents =~ /head2\s+[A-Z ]+\n/;
print "$id extra space after head\n"
if $contents =~ /=head\d\s\s+/;
print "$id period in NAME section\n"
if $contents =~ /=head1 NAME.*\.\n.*=head1 SYNOPSIS/ms;
print "$id POD markup in NAME section\n"
if $contents =~ /=head1 NAME.*[<>].*=head1 SYNOPSIS/ms;
print "$id Duplicate $1 in L<>\n"
if $contents =~ /L<([^>]*)\|([^>]*)>/ && $1 eq $2;
print "$id Bad =over $1\n"
if $contents =~ /=over([^ ][^24])/;
print "$id Possible version style issue\n"
if $contents =~ /OpenSSL version [019]/;
if ( $contents !~ /=for comment multiple includes/ ) {
# Look for multiple consecutive openssl #include lines
# (non-consecutive lines are okay; see crypto/MD5.pod).
if ( $contents =~ /=head1 SYNOPSIS(.*)=head1 DESCRIPTION/ms ) {
my $count = 0;
foreach my $line ( split /\n+/, $1 ) {
if ( $line =~ m@include <openssl/@ ) {
print "$id has multiple includes\n" if ++$count == 2;
} else {
$count = 0;
}
}
}
}
open my $OUT, '>', $temp
or die "Can't open $temp, $!";
podchecker($filename, $OUT);
close $OUT;
open $OUT, '<', $temp
or die "Can't read $temp, $!";
while ( <$OUT> ) {
next if /\(section\) in.*deprecated/;
print;
}
close $OUT;
unlink $temp || warn "Can't remove $temp, $!";
foreach ((@{$mandatory_sections{'*'}}, @{$mandatory_sections{$section}})) {
# Skip "return values" if not -s
next if $_ eq 'RETURN VALUES' and not $opt_s;
print "$id: missing $_ head1 section\n"
if $contents !~ /^=head1\s+${_}\s*$/m;
}
}
my %dups;
sub parsenum()
{
my $file = shift;
my @apis;
open my $IN, '<', $file
or die "Can't open $file, $!, stopped";
while ( <$IN> ) {
next if /^#/;
next if /\bNOEXIST\b/;
next if /\bEXPORT_VAR_AS_FUNC\b/;
my @fields = split();
die "Malformed line $_"
if scalar @fields != 2 && scalar @fields != 4;
push @apis, $fields[0];
}
close $IN;
print "# Found ", scalar(@apis), " in $file\n" unless $opt_p;
return sort @apis;
}
sub getdocced()
{
my $dir = shift;
my %return;
foreach my $pod ( glob("$dir/*.pod") ) {
my %podinfo = extract_pod_info($pod);
foreach my $n ( @{$podinfo{names}} ) {
$return{$n} = $pod;
print "# Duplicate $n in $pod and $dups{$n}\n"
if defined $dups{$n} && $dups{$n} ne $pod;
$dups{$n} = $pod;
}
}
return %return;
}
my %docced;
sub checkmacros()
{
my $count = 0;
print "# Checking macros (approximate)\n";
foreach my $f ( glob('include/openssl/*.h') ) {
# Skip some internals we don't want to document yet.
next if $f eq 'include/openssl/asn1.h';
next if $f eq 'include/openssl/asn1t.h';
next if $f eq 'include/openssl/err.h';
open(IN, $f) || die "Can't open $f, $!";
while ( <IN> ) {
next unless /^#\s*define\s*(\S+)\(/;
my $macro = $1;
next if $docced{$macro};
next if $macro =~ /i2d_/
|| $macro =~ /d2i_/
|| $macro =~ /DEPRECATEDIN/
|| $macro =~ /IMPLEMENT_/
|| $macro =~ /DECLARE_/;
print "$f:$macro\n" if $opt_d;
$count++;
}
close(IN);
}
print "# Found $count macros missing (not all should be documented)\n"
}
sub printem()
{
my $libname = shift;
my $numfile = shift;
my $count = 0;
foreach my $func ( &parsenum($numfile) ) {
next if $docced{$func};
# Skip ASN1 utilities
next if $func =~ /^ASN1_/;
print "$libname:$func\n" if $opt_d;
$count++;
}
print "# Found $count missing from $numfile\n\n";
}
# Collection of links in each POD file.
# filename => [ "foo(1)", "bar(3)", ... ]
my %link_collection = ();
# Collection of names in each POD file.
# "name(s)" => filename
my %name_collection = ();
sub collectnames {
my $filename = shift;
$filename =~ m|man(\d)/|;
my $section = $1;
my $simplename = basename($filename, ".pod");
my $id = "${filename}:1:";
my $contents = '';
{
local $/ = undef;
open POD, $filename or die "Couldn't open $filename, $!";
$contents = <POD>;
close POD;
}
$contents =~ /=head1 NAME([^=]*)=head1 /ms;
my $tmp = $1;
unless (defined $tmp) {
print "$id weird name section\n";
return;
}
$tmp =~ tr/\n/ /;
$tmp =~ s/-.*//g;
my @names = map { s/\s+//g; $_ } split(/,/, $tmp);
unless (grep { $simplename eq $_ } @names) {
print "$id missing $simplename\n";
push @names, $simplename;
}
foreach my $name (@names) {
next if $name eq "";
my $name_sec = "$name($section)";
if (! exists $name_collection{$name_sec}) {
$name_collection{$name_sec} = $filename;
} else { #elsif ($filename ne $name_collection{$name_sec}) {
print "$id $name_sec also in $name_collection{$name_sec}\n";
}
}
my @foreign_names =
map { map { s/\s+//g; $_ } split(/,/, $_) }
$contents =~ /=for\s+comment\s+foreign\s+manuals:\s*(.*)\n\n/;
foreach (@foreign_names) {
$name_collection{$_} = undef; # It still exists!
}
my @links = $contents =~ /L<
# if the link is of the form L<something|name(s)>,
# then remove 'something'. Note that 'something'
# may contain POD codes as well...
(?:(?:[^\|]|<[^>]*>)*\|)?
# we're only interested in referenses that have
# a one digit section number
([^\/>\(]+\(\d\))
/gx;
$link_collection{$filename} = [ @links ];
}
sub checklinks {
foreach my $filename (sort keys %link_collection) {
foreach my $link (@{$link_collection{$filename}}) {
print "${filename}:1: reference to non-existing $link\n"
unless exists $name_collection{$link};
}
}
}
sub publicize() {
foreach my $name ( &parsenum('util/libcrypto.num') ) {
$public{$name} = 1;
}
foreach my $name ( &parsenum('util/libssl.num') ) {
$public{$name} = 1;
}
foreach my $name ( &parsenum('util/private.num') ) {
$public{$name} = 1;
}
}
my %skips = (
'aes128' => 1,
'aes192' => 1,
'aes256' => 1,
'aria128' => 1,
'aria192' => 1,
'aria256' => 1,
'camellia128' => 1,
'camellia192' => 1,
'camellia256' => 1,
'des' => 1,
'des3' => 1,
'idea' => 1,
'[cipher]' => 1,
'[digest]' => 1,
);
sub checkflags() {
my $cmd = shift;
my %cmdopts;
my %docopts;
my $ok = 1;
# Get the list of options in the command.
open CFH, "./apps/openssl list --options $cmd|"
|| die "Can list options for $cmd, $!";
while ( <CFH> ) {
chop;
s/ .$//;
$cmdopts{$_} = 1;
}
close CFH;
# Get the list of flags from the synopsis
open CFH, "<doc/apps/$cmd.pod"
|| die "Can't open $cmd.pod, $!";
while ( <CFH> ) {
chop;
last if /DESCRIPTION/;
next unless /\[B<-([^ >]+)/;
$docopts{$1} = 1;
}
close CFH;
# See what's in the command not the manpage.
my @undocced = ();
foreach my $k ( keys %cmdopts ) {
push @undocced, $k unless $docopts{$k};
}
if ( scalar @undocced > 0 ) {
$ok = 0;
foreach ( @undocced ) {
print "doc/apps/$cmd.pod: Missing -$_\n";
}
}
# See what's in the command not the manpage.
my @unimpl = ();
foreach my $k ( keys %docopts ) {
push @unimpl, $k unless $cmdopts{$k};
}
if ( scalar @unimpl > 0 ) {
$ok = 0;
foreach ( @unimpl ) {
next if defined $skips{$_};
print "doc/apps/$cmd.pod: Not implemented -$_\n";
}
}
return $ok;
}
getopts('cdlnsphu');
&help() if $opt_h;
$opt_n = 1 if $opt_s or $opt_p;
$opt_u = 1 if $opt_d;
die "Need one of -[cdlnspu] flags.\n"
unless $opt_c or $opt_l or $opt_n or $opt_u;
if ( $opt_c ) {
my $ok = 1;
my @commands = ();
# Get list of commands.
open FH, "./apps/openssl list -1 -commands|"
|| die "Can't list commands, $!";
while ( <FH> ) {
chop;
push @commands, $_;
}
close FH;
# See if each has a manpage.
foreach ( @commands ) {
next if $_ eq 'help' || $_ eq 'exit';
if ( ! -f "doc/apps/$_.pod" ) {
print "doc/apps/$_.pod does not exist\n";
$ok = 0;
} else {
$ok = 0 if not &checkflags($_);
}
}
# See what help is missing.
open FH, "./apps/openssl list --missing-help |"
|| die "Can't list missing help, $!";
while ( <FH> ) {
chop;
my ($cmd, $flag) = split;
print "$cmd has no help for -$flag\n";
$ok = 0;
}
close FH;
exit 1 if not $ok;
}
if ( $opt_l ) {
foreach (@ARGV ? @ARGV : glob('doc/*/*.pod')) {
collectnames($_);
}
checklinks();
}
if ( $opt_n ) {
&publicize() if $opt_p;
foreach (@ARGV ? @ARGV : glob('doc/*/*.pod')) {
&check($_);
}
}
if ( $opt_u ) {
my %temp = &getdocced('doc/crypto');
foreach ( keys %temp ) {
$docced{$_} = $temp{$_};
}
&printem('crypto', 'util/libcrypto.num');
&printem('ssl', 'util/libssl.num');
&checkmacros();
}
exit;

3
util/indent.pro
View File

@@ -512,7 +512,8 @@
-T asn1_ps_func
-T bio_dgram_data
-T bio_info_cb
-T BIO_callack_fn
-T BIO_info_cb
-T BIO_callback_fn
-T char_io
-T conf_finish_func
-T conf_init_func

4
util/libcrypto.num
View File

@@ -4230,3 +4230,7 @@ UINT32_it 4214 1_1_0f EXIST:!EXPORT_VAR_AS_FUNCTIO
UINT32_it 4214 1_1_0f EXIST:EXPORT_VAR_AS_FUNCTION:FUNCTION:
ZINT64_it 4215 1_1_0f EXIST:!EXPORT_VAR_AS_FUNCTION:VARIABLE:
ZINT64_it 4215 1_1_0f EXIST:EXPORT_VAR_AS_FUNCTION:FUNCTION:
CRYPTO_secure_clear_free 4315 1_1_0g EXIST::FUNCTION:
EVP_PKEY_set1_engine 4347 1_1_0g EXIST::FUNCTION:ENGINE
OCSP_resp_get0_signer 4374 1_1_0h EXIST::FUNCTION:OCSP
X509_get0_authority_key_id 4448 1_1_0h EXIST::FUNCTION:

186
util/mkdef.pl
View File

@@ -1,5 +1,5 @@
#! /usr/bin/env perl
# Copyright 1995-2016 The OpenSSL Project Authors. All Rights Reserved.
# Copyright 1995-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
@@ -48,8 +48,66 @@
use lib ".";
use configdata;
use File::Spec::Functions;
use File::Basename;
use FindBin;
use lib "$FindBin::Bin/perl";
use OpenSSL::Glob;
# When building a "variant" shared library, with a custom SONAME, also customize
# all the symbol versions. This produces a shared object that can coexist
# without conflict in the same address space as a default build, or an object
# with a different variant tag.
#
# For example, with a target definition that includes:
#
# shlib_variant => "-opt",
#
# we build the following objects:
#
# $ perl -le '
# for (@ARGV) {
# if ($l = readlink) {
# printf "%s -> %s\n", $_, $l
# } else {
# print
# }
# }' *.so*
# libcrypto-opt.so.1.1
# libcrypto.so -> libcrypto-opt.so.1.1
# libssl-opt.so.1.1
# libssl.so -> libssl-opt.so.1.1
#
# whose SONAMEs and dependencies are:
#
# $ for l in *.so; do
# echo $l
# readelf -d $l | egrep 'SONAME|NEEDED.*(ssl|crypto)'
# done
# libcrypto.so
# 0x000000000000000e (SONAME) Library soname: [libcrypto-opt.so.1.1]
# libssl.so
# 0x0000000000000001 (NEEDED) Shared library: [libcrypto-opt.so.1.1]
# 0x000000000000000e (SONAME) Library soname: [libssl-opt.so.1.1]
#
# We case-fold the variant tag to upper case and replace all non-alnum
# characters with "_". This yields the following symbol versions:
#
# $ nm libcrypto.so | grep -w A
# 0000000000000000 A OPENSSL_OPT_1_1_0
# 0000000000000000 A OPENSSL_OPT_1_1_0a
# 0000000000000000 A OPENSSL_OPT_1_1_0c
# 0000000000000000 A OPENSSL_OPT_1_1_0d
# 0000000000000000 A OPENSSL_OPT_1_1_0f
# 0000000000000000 A OPENSSL_OPT_1_1_0g
# $ nm libssl.so | grep -w A
# 0000000000000000 A OPENSSL_OPT_1_1_0
# 0000000000000000 A OPENSSL_OPT_1_1_0d
#
(my $SO_VARIANT = qq{\U$target{"shlib_variant"}}) =~ s/\W/_/g;
my $debug=0;
my $trace=0;
my $verbose=0;
my $crypto_num= catfile($config{sourcedir},"util","libcrypto.num");
my $ssl_num= catfile($config{sourcedir},"util","libssl.num");
@@ -66,6 +124,7 @@ my $do_checkexist = 0;
my $VMS=0;
my $W32=0;
my $NT=0;
my $UNIX=0;
my $linux=0;
# Set this to make typesafe STACK definitions appear in DEF
my $safe_stack_def = 0;
@@ -73,78 +132,31 @@ my $safe_stack_def = 0;
my @known_platforms = ( "__FreeBSD__", "PERL5",
"EXPORT_VAR_AS_FUNCTION", "ZLIB", "_WIN32"
);
my @known_ossl_platforms = ( "VMS", "WIN32", "WINNT", "OS2" );
my @known_algorithms = ( "RC2", "RC4", "RC5", "IDEA", "DES", "BF",
"CAST", "MD2", "MD4", "MD5", "SHA", "SHA0", "SHA1",
"SHA256", "SHA512", "RMD160",
"MDC2", "WHIRLPOOL", "RSA", "DSA", "DH", "EC", "EC2M",
"HMAC", "AES", "CAMELLIA", "SEED", "GOST",
"SCRYPT", "CHACHA", "POLY1305", "BLAKE2",
# EC_NISTP_64_GCC_128
"EC_NISTP_64_GCC_128",
# Envelope "algorithms"
"EVP", "X509", "ASN1_TYPEDEFS",
# Helper "algorithms"
"BIO", "COMP", "BUFFER", "LHASH", "STACK", "ERR",
"LOCKING",
# External "algorithms"
"FP_API", "STDIO", "SOCK", "DGRAM",
"CRYPTO_MDEBUG",
# Engines
"STATIC_ENGINE", "ENGINE", "HW", "GMP",
# Entropy Gathering
"EGD",
# Certificate Transparency
"CT",
# RFC3779
"RFC3779",
# TLS
"PSK", "SRP", "HEARTBEATS",
# CMS
"CMS",
"OCSP",
# CryptoAPI Engine
"CAPIENG",
# SSL methods
"SSL3_METHOD", "TLS1_METHOD", "TLS1_1_METHOD", "TLS1_2_METHOD", "DTLS1_METHOD", "DTLS1_2_METHOD",
# NEXTPROTONEG
"NEXTPROTONEG",
# Deprecated functions
my @known_ossl_platforms = ( "UNIX", "VMS", "WIN32", "WINNT", "OS2" );
my @known_algorithms = ( # These are algorithms we know are guarded in relevant
# header files, but aren't actually disablable.
# Without these, this script will warn a lot.
"RSA", "MD5",
# @disablables comes from configdata.pm
map { (my $x = uc $_) =~ s|-|_|g; $x; } @disablables,
# Deprecated functions. Not really algorithmss, but
# treated as such here for the sake of simplicity
"DEPRECATEDIN_0_9_8",
"DEPRECATEDIN_1_0_0",
"DEPRECATEDIN_1_1_0",
# SCTP
"SCTP",
# SRTP
"SRTP",
# SSL TRACE
"SSL_TRACE",
# Unit testing
"UNIT_TEST",
# User Interface
"UI",
#
"TS",
# OCB mode
"OCB",
"CMAC",
# APPLINK (win build feature?)
"APPLINK"
);
my %disabled_algorithms;
foreach (@known_algorithms) {
$disabled_algorithms{$_} = 0;
}
# disabled by default
$disabled_algorithms{"STATIC_ENGINE"} = 1;
# %disabled comes from configdata.pm
my %disabled_algorithms =
map { (my $x = uc $_) =~ s|-|_|g; $x => 1; } keys %disabled;
my $zlib;
foreach (@ARGV, split(/ /, $config{options}))
{
$debug=1 if $_ eq "debug";
$trace=1 if $_ eq "trace";
$verbose=1 if $_ eq "verbose";
$W32=1 if $_ eq "32";
die "win16 not supported" if $_ eq "16";
if($_ eq "NT") {
@@ -153,6 +165,7 @@ foreach (@ARGV, split(/ /, $config{options}))
}
if ($_ eq "linux") {
$linux=1;
$UNIX=1;
}
$VMS=1 if $_ eq "VMS";
if ($_ eq "zlib" || $_ eq "enable-zlib" || $_ eq "zlib-dynamic"
@@ -177,7 +190,7 @@ foreach (@ARGV, split(/ /, $config{options}))
$do_checkexist=1 if $_ eq "exist";
if (/^--api=(\d+)\.(\d+)\.(\d+)$/) {
my $apiv = sprintf "%x%02x%02x", $1, $2, $3;
foreach (keys %disabled_algorithms) {
foreach (@known_algorithms) {
if (/^DEPRECATEDIN_(\d+)_(\d+)_(\d+)$/) {
my $depv = sprintf "%x%02x%02x", $1, $2, $3;
$disabled_algorithms{$_} = 1 if $apiv ge $depv;
@@ -185,7 +198,7 @@ foreach (@ARGV, split(/ /, $config{options}))
}
}
if (/^no-deprecated$/) {
foreach (keys %disabled_algorithms) {
foreach (@known_algorithms) {
if (/^DEPRECATEDIN_/) {
$disabled_algorithms{$_} = 1;
}
@@ -386,7 +399,7 @@ sub do_defs
foreach $file (split(/\s+/,$symhacksfile." ".$files))
{
my $fn = catfile($config{sourcedir},$file);
print STDERR "DEBUG: starting on $fn:\n" if $debug;
print STDERR "TRACE: start reading $fn\n" if $trace;
open(IN,"<$fn") || die "unable to open $fn:$!\n";
my $line = "", my $def= "";
my %tag = (
@@ -456,10 +469,10 @@ sub do_defs
print STDERR "DEBUG: parsing ----------\n" if $debug;
while(<IN>) {
s|\R$||; # Better chomp
if($parens > 0) {
#Inside a DEPRECATEDIN
$stored_multiline .= $_;
$stored_multiline =~ s|\R$||; # Better chomp
print STDERR "DEBUG: Continuing multiline DEPRECATEDIN: $stored_multiline\n" if $debug;
$parens = count_parens($stored_multiline);
if ($parens == 0) {
@@ -511,19 +524,19 @@ sub do_defs
push(@tag,$1);
$tag{$1}=-1;
print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
} elsif (/^\#\s*if\s+!defined\(([^\)]+)\)/) {
} elsif (/^\#\s*if\s+!defined\s*\(([^\)]+)\)/) {
push(@tag,"-");
if (/^\#\s*if\s+(!defined\(([^\)]+)\)(\s+\&\&\s+!defined\(([^\)]+)\))*)$/) {
if (/^\#\s*if\s+(!defined\s*\(([^\)]+)\)(\s+\&\&\s+!defined\s*\(([^\)]+)\))*)$/) {
my $tmp_1 = $1;
my $tmp_;
foreach $tmp_ (split '\&\&',$tmp_1) {
$tmp_ =~ /!defined\(([^\)]+)\)/;
$tmp_ =~ /!defined\s*\(([^\)]+)\)/;
print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
push(@tag,$1);
$tag{$1}=-1;
}
} else {
print STDERR "Warning: $file: complicated expression: $_" if $debug; # because it is O...
print STDERR "Warning: $file: taking only '!defined($1)' of complicated expression: $_" if $verbose; # because it is O...
print STDERR "DEBUG: $file: found tag $1 = -1\n" if $debug;
push(@tag,$1);
$tag{$1}=-1;
@@ -533,19 +546,19 @@ sub do_defs
push(@tag,$1);
$tag{$1}=1;
print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
} elsif (/^\#\s*if\s+defined\(([^\)]+)\)/) {
} elsif (/^\#\s*if\s+defined\s*\(([^\)]+)\)/) {
push(@tag,"-");
if (/^\#\s*if\s+(defined\(([^\)]+)\)(\s+\|\|\s+defined\(([^\)]+)\))*)$/) {
if (/^\#\s*if\s+(defined\s*\(([^\)]+)\)(\s+\|\|\s+defined\s*\(([^\)]+)\))*)$/) {
my $tmp_1 = $1;
my $tmp_;
foreach $tmp_ (split '\|\|',$tmp_1) {
$tmp_ =~ /defined\(([^\)]+)\)/;
$tmp_ =~ /defined\s*\(([^\)]+)\)/;
print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
push(@tag,$1);
$tag{$1}=1;
}
} else {
print STDERR "Warning: $file: complicated expression: $_\n" if $debug; # because it is O...
print STDERR "Warning: $file: taking only 'defined($1)' of complicated expression: $_\n" if $verbose; # because it is O...
print STDERR "DEBUG: $file: found tag $1 = 1\n" if $debug;
push(@tag,$1);
$tag{$1}=1;
@@ -610,6 +623,7 @@ sub do_defs
} elsif (/^\#\s*if\s+/) {
#Some other unrecognized "if" style
push(@tag,"-");
print STDERR "Warning: $file: ignoring unrecognized expression: $_\n" if $verbose; # because it is O...
} elsif (/^\#\s*define\s+(\w+)\s+(\w+)/
&& $symhacking && $tag{'TRUE'} != -1) {
# This is for aliasing. When we find an alias,
@@ -873,7 +887,6 @@ sub do_defs
\@current_algorithms);
} else {
$stored_multiline = $_;
$stored_multiline =~ s|\R$||;
print STDERR "DEBUG: Found multiline DEPRECATEDIN starting with: $stored_multiline\n" if $debug;
next;
}
@@ -901,11 +914,13 @@ sub do_defs
next if(/typedef\W/);
next if(/\#define/);
print STDERR "TRACE: processing $_\n" if $trace && !/^\#INFO:/;
# Reduce argument lists to empty ()
# fold round brackets recursively: (t(*v)(t),t) -> (t{}{},t) -> {}
while(/\(.*\)/s) {
s/\([^\(\)]+\)/\{\}/gs;
s/\(\s*\*\s*(\w+)\s*\{\}\s*\)/$1/gs; #(*f{}) -> f
my $nsubst = 1; # prevent infinite loop, e.g., on int fn()
while($nsubst && /\(.*\)/s) {
$nsubst = s/\([^\(\)]+\)/\{\}/gs;
$nsubst+= s/\(\s*\*\s*(\w+)\s*\{\}\s*\)/$1/gs; #(*f{}) -> f
}
# pretend as we didn't use curly braces: {} -> ()
s/\{\}/\(\)/gs;
@@ -1095,6 +1110,7 @@ sub is_valid
if ($platforms) {
# platforms
if ($keyword eq "UNIX" && $UNIX) { return 1; }
if ($keyword eq "VMS" && $VMS) { return 1; }
if ($keyword eq "WIN32" && $W32) { return 1; }
if ($keyword eq "_WIN32" && $W32) { return 1; }
@@ -1241,7 +1257,6 @@ EOF
if(!$do_update);
} else {
(my $n, my $symversion, my $dummy) = split /\\/, $nums{$s};
next if $symversion ne $thisversion;
my %pf = ();
my $p = ($i =~ /^[^:]*:([^:]*):/,$1);
my $a = ($i =~ /^[^:]*:[^:]*:[^:]*:([^:]*)/,$1);
@@ -1254,16 +1269,17 @@ EOF
}
$prev = $s2; # To warn about duplicates...
if($linux) {
next if $symversion ne $thisversion;
if ($symversion ne $prevsymversion) {
if ($prevsymversion ne "") {
if ($prevprevsymversion ne "") {
print OUT "} OPENSSL_"
print OUT "} OPENSSL${SO_VARIANT}_"
."$prevprevsymversion;\n\n";
} else {
print OUT "};\n\n";
}
}
print OUT "OPENSSL_$symversion {\n global:\n";
print OUT "OPENSSL${SO_VARIANT}_$symversion {\n global:\n";
$prevprevsymversion = $prevsymversion;
$prevsymversion = $symversion;
}
@@ -1309,10 +1325,10 @@ EOF
}
}
}
} while ($thisversion ne $currversion);
} while ($linux && $thisversion ne $currversion);
if ($linux) {
if ($prevprevsymversion ne "") {
print OUT " local: *;\n} OPENSSL_$prevprevsymversion;\n\n";
print OUT " local: *;\n} OPENSSL${SO_VARIANT}_$prevprevsymversion;\n\n";
} else {
print OUT " local: *;\n};\n\n";
}
@@ -1381,9 +1397,9 @@ sub load_numbers
$prev=$a[0];
}
if ($num_noinfo) {
print STDERR "Warning: $num_noinfo symbols were without info.";
print STDERR "Warning: $num_noinfo symbols were without info." if $verbose || !$do_rewrite;
if ($do_rewrite) {
printf STDERR " The rewrite will fix this.\n";
printf STDERR " The rewrite will fix this.\n" if $verbose;
} else {
printf STDERR " You should do a rewrite to fix this.\n";
}

21
util/perl/OpenSSL/Glob.pm Normal file
View File

@@ -0,0 +1,21 @@
package OpenSSL::Glob;
use strict;
use warnings;
use File::Glob;
use Exporter;
use vars qw($VERSION @ISA @EXPORT);
$VERSION = '0.1';
@ISA = qw(Exporter);
@EXPORT = qw(glob);
sub glob {
goto &File::Glob::bsd_glob if $^O ne "VMS";
goto &CORE::glob;
}
1;
__END__

1051
util/perl/OpenSSL/Test.pm Normal file
View File

File diff suppressed because it is too large Load Diff

91
util/perl/OpenSSL/Test/Simple.pm Normal file
View File

@@ -0,0 +1,91 @@
# 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
package OpenSSL::Test::Simple;
use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = "0.2";
@ISA = qw(Exporter);
@EXPORT = qw(simple_test);
=head1 NAME
OpenSSL::Test::Simple - a few very simple test functions
=head1 SYNOPSIS
use OpenSSL::Test::Simple;
simple_test("my_test_name", "destest", "des");
=head1 DESCRIPTION
Sometimes, the functions in L<OpenSSL::Test> are quite tedious for some
repetitive tasks. This module provides functions to make life easier.
You could call them hacks if you wish.
=cut
use OpenSSL::Test;
use OpenSSL::Test::Utils;
=over 4
=item B<simple_test NAME, PROGRAM, ALGORITHM>
Runs a test named NAME, running the program PROGRAM with no arguments,
to test the algorithm ALGORITHM.
A complete recipe looks like this:
use OpenSSL::Test::Simple;
simple_test("test_bf", "bftest", "bf");
=back
=cut
# args:
# name (used with setup())
# algorithm (used to check if it's at all supported)
# name of binary (the program that does the actual test)
sub simple_test {
my ($name, $prgr, @algos) = @_;
setup($name);
if (scalar(disabled(@algos))) {
if (scalar(@algos) == 1) {
plan skip_all => $algos[0]." is not supported by this OpenSSL build";
} else {
my $last = pop @algos;
plan skip_all => join(", ", @algos)." and $last are not supported by this OpenSSL build";
}
}
plan tests => 1;
ok(run(test([$prgr])), "running $prgr");
}
=head1 SEE ALSO
L<OpenSSL::Test>
=head1 AUTHORS
Richard Levitte E<lt>levitte@openssl.orgE<gt> with inspiration
from Rich Salz E<lt>rsalz@openssl.orgE<gt>.
=cut
1;

240
util/perl/OpenSSL/Test/Utils.pm Normal file
View File

@@ -0,0 +1,240 @@
# 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
package OpenSSL::Test::Utils;
use strict;
use warnings;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = "0.1";
@ISA = qw(Exporter);
@EXPORT = qw(alldisabled anydisabled disabled config available_protocols
have_IPv4 have_IPv6);
=head1 NAME
OpenSSL::Test::Utils - test utility functions
=head1 SYNOPSIS
use OpenSSL::Test::Utils;
my @tls = available_protocols("tls");
my @dtls = available_protocols("dtls");
alldisabled("dh", "dsa");
anydisabled("dh", "dsa");
config("fips");
have_IPv4();
have_IPv6();
=head1 DESCRIPTION
This module provides utility functions for the testing framework.
=cut
use OpenSSL::Test qw/:DEFAULT bldtop_file/;
=over 4
=item B<available_protocols STRING>
Returns a list of strings for all the available SSL/TLS versions if
STRING is "tls", or for all the available DTLS versions if STRING is
"dtls". Otherwise, it returns the empty list. The strings in the
returned list can be used with B<alldisabled> and B<anydisabled>.
=item B<alldisabled ARRAY>
=item B<anydisabled ARRAY>
In an array context returns an array with each element set to 1 if the
corresponding feature is disabled and 0 otherwise.
In a scalar context, alldisabled returns 1 if all of the features in
ARRAY are disabled, while anydisabled returns 1 if any of them are
disabled.
=item B<config STRING>
Returns an item from the %config hash in \$TOP/configdata.pm.
=item B<have_IPv4>
=item B<have_IPv6>
Return true if IPv4 / IPv6 is possible to use on the current system.
=back
=cut
our %available_protocols;
our %disabled;
our %config;
my $configdata_loaded = 0;
sub load_configdata {
# We eval it so it doesn't run at compile time of this file.
# The latter would have bldtop_file() complain that setup() hasn't
# been run yet.
my $configdata = bldtop_file("configdata.pm");
eval { require $configdata;
%available_protocols = %configdata::available_protocols;
%disabled = %configdata::disabled;
%config = %configdata::config;
};
$configdata_loaded = 1;
}
# args
# list of 1s and 0s, coming from check_disabled()
sub anyof {
my $x = 0;
foreach (@_) { $x += $_ }
return $x > 0;
}
# args
# list of 1s and 0s, coming from check_disabled()
sub allof {
my $x = 1;
foreach (@_) { $x *= $_ }
return $x > 0;
}
# args
# list of strings, all of them should be names of features
# that can be disabled.
# returns a list of 1s (if the corresponding feature is disabled)
# and 0s (if it isn't)
sub check_disabled {
return map { exists $disabled{lc $_} ? 1 : 0 } @_;
}
# Exported functions #################################################
# args:
# list of features to check
sub anydisabled {
load_configdata() unless $configdata_loaded;
my @ret = check_disabled(@_);
return @ret if wantarray;
return anyof(@ret);
}
# args:
# list of features to check
sub alldisabled {
load_configdata() unless $configdata_loaded;
my @ret = check_disabled(@_);
return @ret if wantarray;
return allof(@ret);
}
# !!! Kept for backward compatibility
# args:
# single string
sub disabled {
anydisabled(@_);
}
sub available_protocols {
load_configdata() unless $configdata_loaded;
my $protocol_class = shift;
if (exists $available_protocols{lc $protocol_class}) {
return @{$available_protocols{lc $protocol_class}}
}
return ();
}
sub config {
load_configdata() unless $configdata_loaded;
return $config{$_[0]};
}
# IPv4 / IPv6 checker
my $have_IPv4 = -1;
my $have_IPv6 = -1;
my $IP_factory;
sub check_IP {
my $listenaddress = shift;
eval {
require IO::Socket::IP;
my $s = IO::Socket::IP->new(
LocalAddr => $listenaddress,
LocalPort => 0,
Listen=>1,
);
$s or die "\n";
$s->close();
};
if ($@ eq "") {
return 1;
}
eval {
require IO::Socket::INET6;
my $s = IO::Socket::INET6->new(
LocalAddr => $listenaddress,
LocalPort => 0,
Listen=>1,
);
$s or die "\n";
$s->close();
};
if ($@ eq "") {
return 1;
}
eval {
require IO::Socket::INET;
my $s = IO::Socket::INET->new(
LocalAddr => $listenaddress,
LocalPort => 0,
Listen=>1,
);
$s or die "\n";
$s->close();
};
if ($@ eq "") {
return 1;
}
return 0;
}
sub have_IPv4 {
if ($have_IPv4 < 0) {
$have_IPv4 = check_IP("127.0.0.1");
}
return $have_IPv4;
}
sub have_IPv6 {
if ($have_IPv6 < 0) {
$have_IPv6 = check_IP("::1");
}
return $have_IPv6;
}
=head1 SEE ALSO
L<OpenSSL::Test>
=head1 AUTHORS
Stephen Henson E<lt>steve@openssl.orgE<gt> and
Richard Levitte E<lt>levitte@openssl.orgE<gt>
=cut
1;

0
util/TLSProxy/ClientHello.pm → util/perl/TLSProxy/ClientHello.pm
View File

0
util/TLSProxy/Message.pm → util/perl/TLSProxy/Message.pm
View File

0
util/TLSProxy/NewSessionTicket.pm → util/perl/TLSProxy/NewSessionTicket.pm
View File

142
util/TLSProxy/Proxy.pm → util/perl/TLSProxy/Proxy.pm
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
@@ -19,6 +19,7 @@ use TLSProxy::ClientHello;
use TLSProxy::ServerHello;
use TLSProxy::ServerKeyExchange;
use TLSProxy::NewSessionTicket;
use Time::HiRes qw/usleep/;
my $have_IPv6 = 0;
my $IP_factory;
@@ -42,6 +43,7 @@ sub new
clientflags => "",
serverconnects => 1,
serverpid => 0,
clientpid => 0,
reneg => 0,
#Public read
@@ -50,7 +52,9 @@ sub new
debug => $debug,
cipherc => "",
ciphers => "AES128-SHA",
flight => 0,
flight => -1,
direction => -1,
partial => ["", ""],
record_list => [],
message_list => [],
};
@@ -92,18 +96,47 @@ sub new
}
}
# Create the Proxy socket
my $proxaddr = $self->{proxy_addr};
$proxaddr =~ s/[\[\]]//g; # Remove [ and ]
my @proxyargs = (
LocalHost => $proxaddr,
LocalPort => $self->{proxy_port},
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";
} else {
warn "Failed creating proxy socket (".$proxaddr.",".$self->{proxy_port}."): $!\n";
}
return bless $self, $class;
}
sub DESTROY
{
my $self = shift;
$self->{proxy_sock}->close() if $self->{proxy_sock};
}
sub clearClient
{
my $self = shift;
$self->{cipherc} = "";
$self->{flight} = 0;
$self->{flight} = -1;
$self->{direction} = -1;
$self->{partial} = ["", ""];
$self->{record_list} = [];
$self->{message_list} = [];
$self->{clientflags} = "";
$self->{clientpid} = 0;
TLSProxy::Message->clear();
TLSProxy::Record->clear();
@@ -142,17 +175,19 @@ sub start
my ($self) = shift;
my $pid;
if ($self->{proxy_sock} == 0) {
return 0;
}
$pid = fork();
if ($pid == 0) {
if (!$self->debug) {
open(STDOUT, ">", File::Spec->devnull())
or die "Failed to redirect stdout: $!";
open(STDERR, ">&STDOUT");
}
my $execcmd = $self->execute
." s_server -no_comp -rev -engine ossltest -accept "
." 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;
}
@@ -174,37 +209,9 @@ sub clientstart
my ($self) = shift;
my $oldstdout;
if(!$self->debug) {
open DEVNULL, ">", File::Spec->devnull();
$oldstdout = select(DEVNULL);
}
# Create the Proxy socket
my $proxaddr = $self->proxy_addr;
$proxaddr =~ s/[\[\]]//g; # Remove [ and ]
my $proxy_sock = $IP_factory->(
LocalHost => $proxaddr,
LocalPort => $self->proxy_port,
Proto => "tcp",
Listen => SOMAXCONN,
ReuseAddr => 1
);
if ($proxy_sock) {
print "Proxy started on port ".$self->proxy_port."\n";
} else {
warn "Failed creating proxy socket (".$proxaddr.",".$self->proxy_port."): $!\n";
return 0;
}
if ($self->execute) {
my $pid = fork();
if ($pid == 0) {
if (!$self->debug) {
open(STDOUT, ">", File::Spec->devnull())
or die "Failed to redirect stdout: $!";
open(STDERR, ">&STDOUT");
}
my $echostr;
if ($self->reneg()) {
$echostr = "R";
@@ -212,8 +219,11 @@ sub clientstart
$echostr = "test";
}
my $execcmd = "echo ".$echostr." | ".$self->execute
." s_client -engine ossltest -connect "
." 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;
}
@@ -225,11 +235,12 @@ sub clientstart
}
exec($execcmd);
}
$self->clientpid($pid);
}
# Wait for incoming connection from client
my $client_sock;
if(!($client_sock = $proxy_sock->accept())) {
if(!($client_sock = $self->{proxy_sock}->accept())) {
warn "Failed accepting incoming connection: $!\n";
return 0;
}
@@ -237,7 +248,7 @@ sub clientstart
print "Connection opened\n";
# Now connect to the server
my $retry = 3;
my $retry = 50;
my $server_sock;
#We loop over this a few times because sometimes s_server can take a while
#to start up
@@ -275,6 +286,7 @@ sub clientstart
#Wait for either the server socket or the client socket to become readable
my @ready;
local $SIG{PIPE} = "IGNORE";
while(!(TLSProxy::Message->end) && (@ready = $sel->can_read)) {
foreach my $hand (@ready) {
if ($hand == $server_sock) {
@@ -301,9 +313,6 @@ sub clientstart
#Closing this also kills the child process
$client_sock->close();
}
if($proxy_sock) {
$proxy_sock->close();
}
if(!$self->debug) {
select($oldstdout);
}
@@ -314,7 +323,14 @@ sub clientstart
.$self->serverpid."\n";
waitpid( $self->serverpid, 0);
die "exit code $? from server process\n" if $? != 0;
} else {
# Give s_server sufficient time to finish what it was doing
usleep(250000);
}
die "clientpid is zero\n" if $self->clientpid == 0;
print "Waiting for client process to close: ".$self->clientpid."\n";
waitpid($self->clientpid, 0);
return 1;
}
@@ -332,34 +348,38 @@ 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
my @ret = TLSProxy::Record->get_records($server, $self->flight, $packet);
#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];
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}) {
#We only replay the records for the current flight
if ($record->flight != $self->flight) {
next;
}
$packet .= $record->reconstruct_record();
}
$self->{flight} = $self->{flight} + 1;
print "Forwarded packet length = ".length($packet)."\n\n";
return $packet;
@@ -406,24 +426,18 @@ sub supports_IPv6
my $self = shift;
return $have_IPv6;
}
#Read/write accessors
sub proxy_addr
{
my $self = shift;
if (@_) {
$self->{proxy_addr} = shift;
}
return $self->{proxy_addr};
}
sub proxy_port
{
my $self = shift;
if (@_) {
$self->{proxy_port} = shift;
}
return $self->{proxy_port};
}
#Read/write accessors
sub server_addr
{
my $self = shift;
@@ -508,6 +522,14 @@ sub serverpid
}
return $self->{serverpid};
}
sub clientpid
{
my $self = shift;
if (@_) {
$self->{clientpid} = shift;
}
return $self->{clientpid};
}
sub fill_known_data
{

17
util/TLSProxy/Record.pm → util/perl/TLSProxy/Record.pm
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
@@ -59,6 +59,7 @@ sub get_records
my $server = shift;
my $flight = shift;
my $packet = shift;
my $partial = "";
my @record_list = ();
my @message_list = ();
my $data;
@@ -77,8 +78,10 @@ sub get_records
print " (client -> server)\n";
}
#Get the record header
if (length($packet) < TLS_RECORD_HEADER_LENGTH) {
if (length($packet) < TLS_RECORD_HEADER_LENGTH
|| length($packet) < 5 + unpack("n", substr($packet, 3, 2))) {
print "Partial data : ".length($packet)." bytes\n";
$partial = $packet;
$packet = "";
} else {
($content_type, $version, $len) = unpack('CnnC*', $packet);
@@ -127,7 +130,7 @@ sub get_records
}
}
return (\@record_list, \@message_list);
return (\@record_list, \@message_list, $partial);
}
sub clear
@@ -186,7 +189,8 @@ sub new
decrypt_len => $decrypt_len,
data => $data,
decrypt_data => $decrypt_data,
orig_decrypt_data => $decrypt_data
orig_decrypt_data => $decrypt_data,
sent => 0
};
return bless $self, $class;
@@ -252,6 +256,11 @@ sub reconstruct_record
my $self = shift;
my $data;
if ($self->{sent}) {
return "";
}
$self->{sent} = 1;
if ($self->sslv2) {
$data = pack('n', $self->len | 0x8000);
} else {

0
util/TLSProxy/ServerHello.pm → util/perl/TLSProxy/ServerHello.pm
View File

0
util/TLSProxy/ServerKeyExchange.pm → util/perl/TLSProxy/ServerKeyExchange.pm
View File

3
util/with_fallback.pm → util/perl/with_fallback.pm
View File

@@ -13,7 +13,8 @@ sub import {
foreach (@_) {
eval "require $_";
if ($@) {
unshift @INC, catdir(dirname(__FILE__), "..", "external", "perl");
unshift @INC, catdir(dirname(__FILE__),
"..", "..", "external", "perl");
my $transfer = "transfer::$_";
eval "require $transfer";
shift @INC;

4
util/process_docs.pl
View File

@@ -13,7 +13,9 @@ use File::Spec::Functions;
use File::Basename;
use File::Copy;
use File::Path;
use if $^O ne "VMS", 'File::Glob' => qw/glob/;
use FindBin;
use lib "$FindBin::Bin/perl";
use OpenSSL::Glob;
use Getopt::Long;
use Pod::Usage;

20
util/shlib_wrap.sh.in
View File

@@ -1,5 +1,25 @@
#!/bin/sh
# To test this OpenSSL version's applications against another version's
# shared libraries, simply set
#
# OPENSSL_REGRESSION=/path/to/other/OpenSSL/build/tree
if [ -n "$OPENSSL_REGRESSION" ]; then
shlibwrap="$OPENSSL_REGRESSION/util/shlib_wrap.sh"
if [ -x "$shlibwrap" ]; then
# We clear OPENSSL_REGRESSION to avoid a loop, should the shlib_wrap.sh
# we exec also support that mechanism...
OPENSSL_REGRESSION= exec "$shlibwrap" "$@"
else
if [ -f "$shlibwrap" ]; then
echo "Not permitted to run $shlibwrap" >&2
else
echo "No $shlibwrap, perhaps OPENSSL_REGRESSION isn't properly set?" >&2
fi
exit 1
fi
fi
[ $# -ne 0 ] || set -x # debug mode without arguments:-)
THERE="`echo $0 | sed -e 's|[^/]*$||' 2>/dev/null`.."