X-Git-Url: https://git.openssl.org/gitweb/?p=openssl.git;a=blobdiff_plain;f=util%2FTLSProxy%2FProxy.pm;h=45871b87488aa7227dc54bac9defa1d5dbd0ecda;hp=af6c8ddaaf545d3d1414173e49b39e980f5b499c;hb=cc5a9ba485b988b036974cf682cda35180788446;hpb=8af538e5c55f43f9ae996d3f2cae04222cda6762 diff --git a/util/TLSProxy/Proxy.pm b/util/TLSProxy/Proxy.pm index af6c8ddaaf..45871b8748 100644 --- a/util/TLSProxy/Proxy.pm +++ b/util/TLSProxy/Proxy.pm @@ -63,6 +63,10 @@ use TLSProxy::Message; use TLSProxy::ClientHello; use TLSProxy::ServerHello; use TLSProxy::ServerKeyExchange; +use TLSProxy::NewSessionTicket; + +my $have_IPv6 = 0; +my $IP_factory; sub new { @@ -79,20 +83,58 @@ sub new server_addr => "localhost", server_port => 4443, filter => $filter, + serverflags => "", + clientflags => "", + serverconnects => 1, #Public read execute => $execute, cert => $cert, debug => $debug, - cipherc => "AES128-SHA", - ciphers => "", + cipherc => "", + ciphers => "AES128-SHA", flight => 0, record_list => [], message_list => [], + }; - #Private - message_rec_list => [] + 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 "") { + # IO::Socket::IP supports IPv6 and is in the core modules list + $IP_factory = sub { IO::Socket::IP->new(@_); }; + $have_IPv6 = 1; + } else { + 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 "") { + # IO::Socket::INET6 supports IPv6 but isn't on the core modules list + # However, it's a bit older and said to be more widely deployed + # at the time of writing this comment. + $IP_factory = sub { IO::Socket::INET6->new(@_); }; + $have_IPv6 = 1; + } else { + # IO::Socket::INET doesn't support IPv6 but is a fallback in case + # we have no other. + $IP_factory = sub { IO::Socket::INET->new(@_); }; + } + } return bless $self, $class; } @@ -101,12 +143,14 @@ sub clear { my $self = shift; - $self->{cipherc} = "AES128-SHA"; - $self->{ciphers} = ""; + $self->{cipherc} = ""; + $self->{ciphers} = "AES128-SHA"; $self->{flight} = 0; $self->{record_list} = []; $self->{message_list} = []; - $self->{message_rec_list} = []; + $self->{serverflags} = ""; + $self->{clientflags} = ""; + $self->{serverconnects} = 1; TLSProxy::Message->clear(); TLSProxy::Record->clear(); @@ -120,6 +164,14 @@ sub restart $self->start; } +sub clientrestart +{ + my $self = shift; + + $self->clear; + $self->clientstart; +} + sub start { my ($self) = shift; @@ -128,17 +180,27 @@ sub start $pid = fork(); if ($pid == 0) { open(STDOUT, ">", File::Spec->devnull()) - or die "Failed to redirect stdout"; + or die "Failed to redirect stdout: $!"; open(STDERR, ">&STDOUT"); - my $execcmd = $self->execute." s_server -rev -engine ossltest -accept " + my $execcmd = $self->execute + ." s_server -no_comp -rev -engine ossltest -accept " .($self->server_port) - ." -cert ".$self->cert." -naccept 1"; + ." -cert ".$self->cert." -naccept ".$self->serverconnects; if ($self->ciphers ne "") { $execcmd .= " -cipher ".$self->ciphers; } + if ($self->serverflags ne "") { + $execcmd .= " ".$self->serverflags; + } exec($execcmd); } + $self->clientstart; +} + +sub clientstart +{ + my ($self) = shift; my $oldstdout; if(!$self->debug) { @@ -147,25 +209,27 @@ sub start } # Create the Proxy socket - my $proxy_sock = new IO::Socket::INET( - LocalHost => $self->proxy_addr, + 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, - Reuse => 1 + ReuseAddr => 1 ); if ($proxy_sock) { print "Proxy started on port ".$self->proxy_port."\n"; } else { - die "Failed creating proxy socket\n"; + die "Failed creating proxy socket (".$proxaddr.",".$self->proxy_port."): $!\n"; } if ($self->execute) { my $pid = fork(); if ($pid == 0) { open(STDOUT, ">", File::Spec->devnull()) - or die "Failed to redirect stdout"; + or die "Failed to redirect stdout: $!"; open(STDERR, ">&STDOUT"); my $execcmd = "echo test | ".$self->execute ." s_client -engine ossltest -connect " @@ -173,13 +237,16 @@ sub start if ($self->cipherc ne "") { $execcmd .= " -cipher ".$self->cipherc; } + if ($self->clientflags ne "") { + $execcmd .= " ".$self->clientflags; + } exec($execcmd); } } # Wait for incoming connection from client - my $client_sock = $proxy_sock->accept() - or die "Failed accepting incoming connection\n"; + my $client_sock = $proxy_sock->accept() + or die "Failed accepting incoming connection: $!\n"; print "Connection opened\n"; @@ -189,11 +256,14 @@ sub start #We loop over this a few times because sometimes s_server can take a while #to start up do { - $server_sock = new IO::Socket::INET( - PeerAddr => $self->server_addr, + my $servaddr = $self->server_addr; + $servaddr =~ s/[\[\]]//g; # Remove [ and ] + $server_sock = $IP_factory->( + PeerAddr => $servaddr, PeerPort => $self->server_port, + MultiHomed => 1, Proto => 'tcp' - ); + ); $retry--; if (!$server_sock) { @@ -201,7 +271,7 @@ sub start #Sleep for a short while select(undef, undef, undef, 0.1); } else { - die "Failed to start up server\n"; + die "Failed to start up server (".$servaddr.",".$self->server_port."): $!\n"; } } } while (!$server_sock); @@ -246,7 +316,6 @@ sub start } } - sub process_packet { my ($self, $server, $packet) = @_; @@ -268,13 +337,14 @@ sub process_packet #list of messages in those records my @ret = TLSProxy::Record->get_records($server, $self->flight, $packet); push @{$self->record_list}, @{$ret[0]}; - $self->{message_rec_list} = $ret[0]; push @{$self->{message_list}}, @{$ret[1]}; print "\n"; #Finished parsing. Call user provided filter here - $self->filter->($self); + if(defined $self->filter) { + $self->filter->($self); + } #Reconstruct the packet $packet = ""; @@ -319,11 +389,6 @@ sub record_list my $self = shift; return $self->{record_list}; } -sub message_list -{ - my $self = shift; - return $self->{message_list}; -} sub success { my $self = shift; @@ -334,6 +399,11 @@ sub end my $self = shift; return $self->{end}; } +sub supports_IPv6 +{ + my $self = shift; + return $have_IPv6; +} #Read/write accessors sub proxy_addr @@ -392,4 +462,40 @@ sub ciphers } 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}; +} 1;