zte's code,first commit
Change-Id: I9a04da59e459a9bc0d67f101f700d9d7dc8d681b
diff --git a/ap/lib/libssl/openssl-1.1.1o/util/perl/TLSProxy/Proxy.pm b/ap/lib/libssl/openssl-1.1.1o/util/perl/TLSProxy/Proxy.pm
new file mode 100644
index 0000000..6f983b3
--- /dev/null
+++ b/ap/lib/libssl/openssl-1.1.1o/util/perl/TLSProxy/Proxy.pm
@@ -0,0 +1,729 @@
+# Copyright 2016-2019 The OpenSSL Project Authors. All Rights Reserved.
+#
+# Licensed under the OpenSSL license (the "License"). You may not use
+# this file except in compliance with the License. You can obtain a copy
+# in the file LICENSE in the source distribution or at
+# https://www.openssl.org/source/license.html
+
+use strict;
+use POSIX ":sys_wait_h";
+
+package TLSProxy::Proxy;
+
+use File::Spec;
+use IO::Socket;
+use IO::Select;
+use TLSProxy::Record;
+use TLSProxy::Message;
+use TLSProxy::ClientHello;
+use TLSProxy::ServerHello;
+use TLSProxy::EncryptedExtensions;
+use TLSProxy::Certificate;
+use TLSProxy::CertificateRequest;
+use TLSProxy::CertificateVerify;
+use TLSProxy::ServerKeyExchange;
+use TLSProxy::NewSessionTicket;
+
+my $have_IPv6;
+my $IP_factory;
+
+BEGIN
+{
+ # 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 core modules. Worst case scenario, we
+ # fall back to IO::Socket::INET, only supports IPv4.
+ eval {
+ require IO::Socket::INET6;
+ my $s = IO::Socket::INET6->new(
+ LocalAddr => "::1",
+ LocalPort => 0,
+ Listen=>1,
+ );
+ $s or die "\n";
+ $s->close();
+ };
+ if ($@ eq "") {
+ $IP_factory = sub { IO::Socket::INET6->new(Domain => AF_INET6, @_); };
+ $have_IPv6 = 1;
+ } else {
+ eval {
+ require IO::Socket::IP;
+ my $s = IO::Socket::IP->new(
+ LocalAddr => "::1",
+ LocalPort => 0,
+ Listen=>1,
+ );
+ $s or die "\n";
+ $s->close();
+ };
+ if ($@ eq "") {
+ $IP_factory = sub { IO::Socket::IP->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 => 0,
+ Proto => "tcp",
+ Listen => SOMAXCONN,
+ );
+
+ 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.",0): $!\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->{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();
+}
+
+sub clear
+{
+ my $self = shift;
+
+ $self->clearClient;
+ $self->{ciphers} = "AES128-SHA";
+ $self->{ciphersuitess} = "TLS_AES_128_GCM_SHA256";
+ $self->{serverflags} = "";
+ $self->{serverconnects} = 1;
+ $self->{serverpid} = 0;
+ $self->{reneg} = 0;
+}
+
+sub restart
+{
+ my $self = shift;
+
+ $self->clear;
+ $self->start;
+}
+
+sub clientrestart
+{
+ my $self = shift;
+
+ $self->clear;
+ $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;
+ my $pid;
+
+ if ($self->{proxy_sock} == 0) {
+ return 0;
+ }
+
+ 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());
+ }
+ } else {
+ if (defined($pid = fork)) {
+ $pid or exec("$^X -ne print") or exit($!);
+ } else {
+ $error = $!;
+ }
+ }
+
+ # 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;
+}
+
+sub clientstart
+{
+ my ($self) = shift;
+
+ if ($self->execute) {
+ 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;
+
+ # 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";
+ return 0;
+ }
+
+ print "Connection opened\n";
+
+ my $server_sock = $self->{server_sock};
+ my $indata;
+
+ #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";
+ $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) {
+ 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) {
+ 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 {
+ 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();
+ }
+
+ 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 {
+ # It's a bit counter-intuitive spot to make next connection to
+ # the s_server. Rationale is that established connection works
+ # as synchronization point, in sense that this way we know that
+ # s_server is actually done with current session...
+ $self->connect_to_server();
+ }
+ $pid = $self->{clientpid};
+ print "Waiting for s_client process to close: $pid...\n";
+ waitpid($pid, 0);
+
+ return 1;
+}
+
+sub process_packet
+{
+ my ($self, $server, $packet) = @_;
+ my $len_real;
+ my $decrypt_len;
+ my $data;
+ my $recnum;
+
+ if ($server) {
+ print "Received server packet\n";
+ } else {
+ print "Received client packet\n";
+ }
+
+ if ($self->{direction} != $server) {
+ $self->{flight} = $self->{flight} + 1;
+ $self->{direction} = $server;
+ }
+
+ print "Packet length = ".length($packet)."\n";
+ print "Processing flight ".$self->flight."\n";
+
+ #Return contains the list of record found in the packet followed by the
+ #list of messages in those records and any partial message
+ my @ret = TLSProxy::Record->get_records($server, $self->flight,
+ $self->{partial}[$server].$packet);
+ $self->{partial}[$server] = $ret[2];
+ 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) {
+ $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($server);
+ }
+
+ print "Forwarded packet length = ".length($packet)."\n\n";
+
+ return $packet;
+}
+
+#Read accessors
+sub execute
+{
+ my $self = shift;
+ return $self->{execute};
+}
+sub cert
+{
+ my $self = shift;
+ return $self->{cert};
+}
+sub debug
+{
+ my $self = shift;
+ return $self->{debug};
+}
+sub flight
+{
+ my $self = shift;
+ return $self->{flight};
+}
+sub record_list
+{
+ my $self = shift;
+ return $self->{record_list};
+}
+sub success
+{
+ my $self = shift;
+ return $self->{success};
+}
+sub end
+{
+ my $self = shift;
+ return $self->{end};
+}
+sub supports_IPv6
+{
+ my $self = shift;
+ return $have_IPv6;
+}
+sub proxy_addr
+{
+ my $self = shift;
+ return $self->{proxy_addr};
+}
+sub proxy_port
+{
+ my $self = shift;
+ return $self->{proxy_port};
+}
+sub server_addr
+{
+ my $self = shift;
+ return $self->{server_addr};
+}
+sub server_port
+{
+ my $self = 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;
+ }
+ return $self->{filter};
+}
+sub cipherc
+{
+ my $self = shift;
+ if (@_) {
+ $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;
+ }
+ return $self->{ciphers};
+}
+sub ciphersuitess
+{
+ my $self = shift;
+ if (@_) {
+ $self->{ciphersuitess} = shift;
+ }
+ return $self->{ciphersuitess};
+}
+sub serverflags
+{
+ my $self = shift;
+ if (@_) {
+ $self->{serverflags} = shift;
+ }
+ return $self->{serverflags};
+}
+sub clientflags
+{
+ my $self = shift;
+ if (@_) {
+ $self->{clientflags} = shift;
+ }
+ return $self->{clientflags};
+}
+sub serverconnects
+{
+ my $self = shift;
+ if (@_) {
+ $self->{serverconnects} = shift;
+ }
+ return $self->{serverconnects};
+}
+# This is a bit ugly because the caller is responsible for keeping the records
+# in sync with the updated message list; simply updating the message list isn't
+# sufficient to get the proxy to forward the new message.
+# But it does the trick for the one test (test_sslsessiontick) that needs it.
+sub message_list
+{
+ my $self = shift;
+ if (@_) {
+ $self->{message_list} = shift;
+ }
+ return $self->{message_list};
+}
+
+sub fill_known_data
+{
+ my $length = shift;
+ my $ret = "";
+ for (my $i = 0; $i < $length; $i++) {
+ $ret .= chr($i);
+ }
+ return $ret;
+}
+
+sub is_tls13
+{
+ my $class = shift;
+ if (@_) {
+ $is_tls13 = shift;
+ }
+ return $is_tls13;
+}
+
+sub reneg
+{
+ my $self = shift;
+ if (@_) {
+ $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;