+++ /dev/null
-# Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
-#
-# Licensed under the OpenSSL license (the "License"). You may not use
-# this file except in compliance with the License. You can obtain a copy
-# in the file LICENSE in the source distribution or at
-# https://www.openssl.org/source/license.html
-
-use strict;
-use 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::HelloRetryRequest;
-use TLSProxy::ServerHello;
-use TLSProxy::EncryptedExtensions;
-use TLSProxy::Certificate;
-use TLSProxy::CertificateVerify;
-use TLSProxy::ServerKeyExchange;
-use TLSProxy::NewSessionTicket;
-
-my $have_IPv6 = 0;
-my $IP_factory;
-
-my $is_tls13 = 0;
-my $ciphersuite = undef;
-
-sub new
-{
- 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,
- sessionfile => undef,
-
- #Public read
- execute => $execute,
- cert => $cert,
- debug => $debug,
- cipherc => "",
- ciphers => "AES128-SHA:TLS13-AES-128-GCM-SHA256",
- flight => 0,
- 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
- # 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(@_); };
- $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(@_); };
- }
- }
-
- return bless $self, $class;
-}
-
-sub clearClient
-{
- my $self = shift;
-
- $self->{cipherc} = "";
- $self->{flight} = 0;
- $self->{record_list} = [];
- $self->{message_list} = [];
- $self->{clientflags} = "";
- $self->{sessionfile} = undef;
- $self->{clientpid} = 0;
- $is_tls13 = 0;
- $ciphersuite = undef;
-
- TLSProxy::Message->clear();
- TLSProxy::Record->clear();
-}
-
-sub clear
-{
- my $self = shift;
-
- $self->clearClient;
- $self->{ciphers} = "AES128-SHA:TLS13-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 start
-{
- my ($self) = shift;
- my $pid;
-
- $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 "
- .($self->server_port)
- ." -cert ".$self->cert." -cert2 ".$self->cert
- ." -naccept ".$self->serverconnects;
- if ($self->ciphers ne "") {
- $execcmd .= " -cipher ".$self->ciphers;
- }
- if ($self->serverflags ne "") {
- $execcmd .= " ".$self->serverflags;
- }
- if ($self->debug) {
- print STDERR "Server command: $execcmd\n";
- }
- exec($execcmd);
- }
- $self->serverpid($pid);
-
- return $self->clientstart;
-}
-
-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";
- } else {
- $echostr = "test";
- }
- my $execcmd = "echo ".$echostr." | ".$self->execute
- ." s_client -engine ossltest -connect "
- .($self->proxy_addr).":".($self->proxy_port);
- if ($self->cipherc ne "") {
- $execcmd .= " -cipher ".$self->cipherc;
- }
- if ($self->clientflags ne "") {
- $execcmd .= " ".$self->clientflags;
- }
- if (defined $self->sessionfile) {
- $execcmd .= " -ign_eof";
- }
- if ($self->debug) {
- print STDERR "Client command: $execcmd\n";
- }
- exec($execcmd);
- }
- $self->clientpid($pid);
- }
-
- # Wait for incoming connection from client
- my $client_sock;
- if(!($client_sock = $proxy_sock->accept())) {
- warn "Failed accepting incoming connection: $!\n";
- return 0;
- }
-
- print "Connection opened\n";
-
- # Now connect to the server
- my $retry = 10;
- 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 $indata;
- my @handles = ($server_sock, $client_sock);
-
- #Wait for either the server socket or the client socket to become readable
- my @ready;
- my $ctr = 0;
- while( (!(TLSProxy::Message->end)
- || (defined $self->sessionfile()
- && (-s $self->sessionfile()) == 0))
- && $ctr < 10
- && (@ready = $sel->can_read(1))) {
- foreach my $hand (@ready) {
- if ($hand == $server_sock) {
- $server_sock->sysread($indata, 16384) or goto END;
- $indata = $self->process_packet(1, $indata);
- $client_sock->syswrite($indata);
- $ctr = 0;
- } elsif ($hand == $client_sock) {
- $client_sock->sysread($indata, 16384) or goto END;
- $indata = $self->process_packet(0, $indata);
- $server_sock->syswrite($indata);
- $ctr = 0;
- } else {
- $ctr++
- }
- }
- }
-
- die "No progress made" if $ctr >= 10;
-
- END:
- print "Connection closed\n";
- if($server_sock) {
- $server_sock->close();
- }
- if($client_sock) {
- #Closing this also kills the child process
- $client_sock->close();
- }
- if($proxy_sock) {
- $proxy_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;
- }
- 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;
-}
-
-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";
- }
-
- 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);
- push @{$self->record_list}, @{$ret[0]};
- push @{$self->{message_list}}, @{$ret[1]};
-
- print "\n";
-
- #Finished parsing. Call user provided filter here
- 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($server);
- }
-
- $self->{flight} = $self->{flight} + 1;
-
- 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;
-}
-
-#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};
-}
-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 filter
-{
- my $self = shift;
- if (@_) {
- $self->{filter} = shift;
- }
- return $self->{filter};
-}
-sub cipherc
-{
- my $self = shift;
- if (@_) {
- $self->{cipherc} = shift;
- }
- return $self->{cipherc};
-}
-sub ciphers
-{
- my $self = shift;
- if (@_) {
- $self->{ciphers} = shift;
- }
- return $self->{ciphers};
-}
-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 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
-{
- 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;
projects / openssl.git / blobdiff