Commit 6228b1da authored by Andy Polyakov's avatar Andy Polyakov
Browse files

TLSProxy/Proxy.pm: switch to dynamic ports and overhaul. 



By asking for port 0, you get a free port dynamically assigned by OS.
TLSProxy::Proxy now asks for 0 and asks s_server to do the same. The
s_server's port is reported in "ACCEPT" line, which TLSProxy::Proxy
parses and uses.

Because the server port is now a random affair in TLSProxy::Proxy,
it's no longer possible to change it with the method 'server_port',
and it has become an accessor only. For the sake of orthogonality, so
has the method 'server_addr'.

Remove all fork calls on Windows, as fork is not to be trusted there.
This naturally minimized amount of fork calls on POSIX systems, to 1.

Sink s_server's output to 'perl -ne print' which ensures that output
is written strictly in lines. This keeps TAP parser happy.

Improve synchronization in -naccept +n cases by establishing next
connection to s_server *after* s_client finishes instead of before it
starts.

Improve error handling and clean up some methods.

Reviewed-by: default avatarRichard Levitte <levitte@openssl.org>
(Merged from https://github.com/openssl/openssl/pull/5843)
parent 5540eb70

util/perl/TLSProxy/Proxy.pm

+179 −139
Original line number Diff line number Diff line
@@ -22,7 +22,6 @@ use TLSProxy::Certificate; 
use TLSProxy::CertificateVerify;

use TLSProxy::ServerKeyExchange;

use TLSProxy::NewSessionTicket;

use Time::HiRes qw/usleep/;



my $have_IPv6 = 0;

my $IP_factory;
@@ -41,19 +40,19 @@ sub new 
    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

        proxy_port => 0,

        server_port => 0,

        serverpid => 0,

        clientpid => 0,

        execute => $execute,

        cert => $cert,

        debug => $debug,
@@ -110,18 +109,17 @@ sub new 
    $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}) {

        $self->{proxy_port} = $self->{proxy_sock}->sockport();

        print "Proxy started on port ".$self->{proxy_port}."\n";

    } else {

        warn "Failed creating proxy socket (".$proxaddr.",".$self->{proxy_port}."): $!\n";

        warn "Failed creating proxy socket (".$proxaddr.",0): $!\n";

    }



    return bless $self, $class;
@@ -184,6 +182,19 @@ sub clientrestart 
    $self->clientstart;

}



sub connect_to_server

{

    my $self = shift;

    my $servaddr = $self->{server_addr};



    $servaddr =~ s/[\[\]]//g; # Remove [ and ]



    $self->{server_sock} = $IP_factory->(PeerAddr => $servaddr,

                                         PeerPort => $self->{server_port},

                                         Proto => 'tcp')

                           or die "unable to connect: $!\n";

}



sub start

{

    my ($self) = shift;
@@ -193,12 +204,9 @@ sub start 
        return 0;

    }



    $pid = fork();

    if ($pid == 0) {

    my $execcmd = $self->execute

            ." s_server -max_protocol TLSv1.3 -no_comp -rev -engine ossltest -accept "

            .($self->server_port)

            ." -cert ".$self->cert." -cert2 ".$self->cert

        ." s_server -max_protocol TLSv1.3 -no_comp -rev -engine ossltest"

        ." -accept 0 -cert ".$self->cert." -cert2 ".$self->cert

        ." -naccept ".$self->serverconnects;

    unless ($self->supports_IPv6) {

        $execcmd .= " -4";
@@ -215,9 +223,65 @@ sub start 
    if ($self->debug) {

        print STDERR "Server command: $execcmd\n";

    }

        exec($execcmd);



    open(my $savedin, "<&STDIN");



    # Temporarily replace STDIN so that sink process can inherit it...

    $pid = open(STDIN, "$execcmd |") 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...

        die "no ACCEPT detected in '$execcmd' output\n";

    }

    $self->serverpid($pid);



    # 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();

        } 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;

}
@@ -225,18 +289,10 @@ 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

        my $pid;

        my $execcmd = $self->execute

             ." s_client -max_protocol TLSv1.3 -engine ossltest -connect "

             .($self->proxy_addr).":".($self->proxy_port);

        unless ($self->supports_IPv6) {
@@ -257,12 +313,33 @@ sub clientstart 
        if ($self->debug) {

            print STDERR "Client command: $execcmd\n";

        }

            exec($execcmd);



        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(1)) {

        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";
@@ -271,44 +348,11 @@ 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";
@@ -316,7 +360,7 @@ sub clientstart 
                || (defined $self->sessionfile()

                    && (-s $self->sessionfile()) == 0))

            && $ctr < 10) {

        if (!(@ready = $sel->can_read(1))) {

        if (!(@ready = $fdset->can_read(1))) {

            $ctr++;

            next;

        }
@@ -332,39 +376,47 @@ sub clientstart 
                $server_sock->syswrite($indata);

                $ctr = 0;

            } else {

                kill(3, $self->{real_serverpid});

                die "Unexpected handle";

            }

        }

    }



    die "No progress made" if $ctr >= 10;

    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);



    my $pid;

    if (--$self->{serverconnects} == 0) {

        $pid = $self->{serverpid};

        die "serverpid is zero\n" if $pid == 0;

        print "Waiting for server process to close: $pid...\n";

        # recall that we wait on process that buffers server's output

        waitpid($pid, 0);

        die "exit code $? from 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};

    die "clientpid is zero\n" if $pid == 0;

    print "Waiting for client process to close: $pid...\n";

    waitpid($pid, 0);



    return 1;

}
@@ -395,7 +447,7 @@ sub process_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->{record_list}}, @{$ret[0]};

    push @{$self->{message_list}}, @{$ret[1]};



    print "\n";
@@ -471,24 +523,28 @@ 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;
@@ -565,22 +621,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

{