1 # Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved.
3 # Licensed under the Apache License 2.0 (the "License"). You may not use
4 # this file except in compliance with the License. You can obtain a copy
5 # in the file LICENSE in the source distribution or at
6 # https://www.openssl.org/source/license.html
9 use POSIX ":sys_wait_h";
11 package TLSProxy::Proxy;
17 use TLSProxy::Message;
18 use TLSProxy::ClientHello;
19 use TLSProxy::ServerHello;
20 use TLSProxy::EncryptedExtensions;
21 use TLSProxy::Certificate;
22 use TLSProxy::CertificateRequest;
23 use TLSProxy::CertificateVerify;
24 use TLSProxy::ServerKeyExchange;
25 use TLSProxy::NewSessionTicket;
32 # IO::Socket::IP is on the core module list, IO::Socket::INET6 isn't.
33 # However, IO::Socket::INET6 is older and is said to be more widely
34 # deployed for the moment, and may have less bugs, so we try the latter
35 # first, then fall back on the core modules. Worst case scenario, we
36 # fall back to IO::Socket::INET, only supports IPv4.
38 require IO::Socket::INET6;
39 my $s = IO::Socket::INET6->new(
48 $IP_factory = sub { IO::Socket::INET6->new(Domain => AF_INET6, @_); };
52 require IO::Socket::IP;
53 my $s = IO::Socket::IP->new(
62 $IP_factory = sub { IO::Socket::IP->new(@_); };
65 $IP_factory = sub { IO::Socket::INET->new(@_); };
72 my $ciphersuite = undef;
84 proxy_addr => $have_IPv6 ? "[::1]" : "127.0.0.1",
102 ciphers => "AES128-SHA",
103 ciphersuitess => "TLS_AES_128_GCM_SHA256",
111 # Create the Proxy socket
112 my $proxaddr = $self->{proxy_addr};
113 $proxaddr =~ s/[\[\]]//g; # Remove [ and ]
115 LocalHost => $proxaddr,
121 if (my $sock = $IP_factory->(@proxyargs)) {
122 $self->{proxy_sock} = $sock;
123 $self->{proxy_port} = $sock->sockport();
124 $self->{proxy_addr} = $sock->sockhost();
125 $self->{proxy_addr} =~ s/(.*:.*)/[$1]/;
126 print "Proxy started on port ",
127 "$self->{proxy_addr}:$self->{proxy_port}\n";
128 # use same address for s_server
129 $self->{server_addr} = $self->{proxy_addr};
131 warn "Failed creating proxy socket (".$proxaddr.",0): $!\n";
134 return bless $self, $class;
141 $self->{proxy_sock}->close() if $self->{proxy_sock};
148 $self->{cipherc} = "";
149 $self->{ciphersuitec} = "";
150 $self->{flight} = -1;
151 $self->{direction} = -1;
152 $self->{partial} = ["", ""];
153 $self->{record_list} = [];
154 $self->{message_list} = [];
155 $self->{clientflags} = "";
156 $self->{sessionfile} = undef;
157 $self->{clientpid} = 0;
159 $ciphersuite = undef;
161 TLSProxy::Message->clear();
162 TLSProxy::Record->clear();
170 $self->{ciphers} = "AES128-SHA";
171 $self->{ciphersuitess} = "TLS_AES_128_GCM_SHA256";
172 $self->{serverflags} = "";
173 $self->{serverconnects} = 1;
174 $self->{serverpid} = 0;
194 sub connect_to_server
197 my $servaddr = $self->{server_addr};
199 $servaddr =~ s/[\[\]]//g; # Remove [ and ]
201 my $sock = $IP_factory->(PeerAddr => $servaddr,
202 PeerPort => $self->{server_port},
204 if (!defined($sock)) {
206 kill(3, $self->{real_serverpid});
207 die "unable to connect: $err\n";
210 $self->{server_sock} = $sock;
218 if ($self->{proxy_sock} == 0) {
222 my $execcmd = $self->execute
223 ." s_server -max_protocol TLSv1.3 -no_comp -rev -engine ossltest"
224 #In TLSv1.3 we issue two session tickets. The default session id
225 #callback gets confused because the ossltest engine causes the same
226 #session id to be created twice due to the changed random number
227 #generation. Using "-ext_cache" replaces the default callback with a
228 #different one that doesn't get confused.
230 ." -accept $self->{server_addr}:0"
231 ." -cert ".$self->cert." -cert2 ".$self->cert
232 ." -naccept ".$self->serverconnects;
233 if ($self->ciphers ne "") {
234 $execcmd .= " -cipher ".$self->ciphers;
236 if ($self->ciphersuitess ne "") {
237 $execcmd .= " -ciphersuites ".$self->ciphersuitess;
239 if ($self->serverflags ne "") {
240 $execcmd .= " ".$self->serverflags;
243 print STDERR "Server command: $execcmd\n";
246 open(my $savedin, "<&STDIN");
248 # Temporarily replace STDIN so that sink process can inherit it...
249 $pid = open(STDIN, "$execcmd 2>&1 |") or die "Failed to $execcmd: $!\n";
250 $self->{real_serverpid} = $pid;
252 # Process the output from s_server until we find the ACCEPT line, which
253 # tells us what the accepting address and port are.
256 s/\R$//; # Better chomp
257 next unless (/^ACCEPT\s.*:(\d+)$/);
258 $self->{server_port} = $1;
262 if ($self->{server_port} == 0) {
263 # This actually means that s_server exited, because otherwise
264 # we would still searching for ACCEPT...
266 die "no ACCEPT detected in '$execcmd' output: $?\n";
269 # Just make sure everything else is simply printed [as separate lines].
270 # The sub process simply inherits our STD* and will keep consuming
271 # server's output and printing it as long as there is anything there,
275 if (eval { require Win32::Process; 1; }) {
276 if (Win32::Process::Create(my $h, $^X, "perl -ne print", 0, 0, ".")) {
277 $pid = $h->GetProcessID();
278 $self->{proc_handle} = $h; # hold handle till next round [or exit]
280 $error = Win32::FormatMessage(Win32::GetLastError());
283 if (defined($pid = fork)) {
284 $pid or exec("$^X -ne print") or exit($!);
290 # Change back to original stdin
291 open(STDIN, "<&", $savedin);
294 if (!defined($pid)) {
295 kill(3, $self->{real_serverpid});
296 die "Failed to capture s_server's output: $error\n";
299 $self->{serverpid} = $pid;
301 print STDERR "Server responds on ",
302 "$self->{server_addr}:$self->{server_port}\n";
304 # Connect right away...
305 $self->connect_to_server();
307 return $self->clientstart;
314 if ($self->execute) {
316 my $execcmd = $self->execute
317 ." s_client -max_protocol TLSv1.3 -engine ossltest"
318 ." -connect $self->{proxy_addr}:$self->{proxy_port}";
319 if ($self->cipherc ne "") {
320 $execcmd .= " -cipher ".$self->cipherc;
322 if ($self->ciphersuitesc ne "") {
323 $execcmd .= " -ciphersuites ".$self->ciphersuitesc;
325 if ($self->clientflags ne "") {
326 $execcmd .= " ".$self->clientflags;
328 if ($self->clientflags !~ m/-(no)?servername/) {
329 $execcmd .= " -servername localhost";
331 if (defined $self->sessionfile) {
332 $execcmd .= " -ign_eof";
335 print STDERR "Client command: $execcmd\n";
338 open(my $savedout, ">&STDOUT");
339 # If we open pipe with new descriptor, attempt to close it,
340 # explicitly or implicitly, would incur waitpid and effectively
342 if (!($pid = open(STDOUT, "| $execcmd"))) {
344 kill(3, $self->{real_serverpid});
345 die "Failed to $execcmd: $err\n";
347 $self->{clientpid} = $pid;
349 # queue [magic] input
350 print $self->reneg ? "R" : "test";
352 # this closes client's stdin without waiting for its pid
353 open(STDOUT, ">&", $savedout);
357 # Wait for incoming connection from client
358 my $fdset = IO::Select->new($self->{proxy_sock});
359 if (!$fdset->can_read(60)) {
360 kill(3, $self->{real_serverpid});
361 die "s_client didn't try to connect\n";
365 if(!($client_sock = $self->{proxy_sock}->accept())) {
366 warn "Failed accepting incoming connection: $!\n";
370 print "Connection opened\n";
372 my $server_sock = $self->{server_sock};
375 #Wait for either the server socket or the client socket to become readable
376 $fdset = IO::Select->new($server_sock, $client_sock);
379 local $SIG{PIPE} = "IGNORE";
380 $self->{saw_session_ticket} = undef;
381 while($fdset->count && $ctr < 10) {
382 if (defined($self->{sessionfile})) {
383 # s_client got -ign_eof and won't be exiting voluntarily, so we
384 # look for data *and* session ticket...
385 last if TLSProxy::Message->success()
386 && $self->{saw_session_ticket};
388 if (!(@ready = $fdset->can_read(1))) {
392 foreach my $hand (@ready) {
393 if ($hand == $server_sock) {
394 if ($server_sock->sysread($indata, 16384)) {
395 if ($indata = $self->process_packet(1, $indata)) {
396 $client_sock->syswrite($indata) or goto END;
400 $fdset->remove($server_sock);
401 $client_sock->shutdown(SHUT_WR);
403 } elsif ($hand == $client_sock) {
404 if ($client_sock->sysread($indata, 16384)) {
405 if ($indata = $self->process_packet(0, $indata)) {
406 $server_sock->syswrite($indata) or goto END;
410 $fdset->remove($client_sock);
411 $server_sock->shutdown(SHUT_WR);
414 kill(3, $self->{real_serverpid});
415 die "Unexpected handle";
421 kill(3, $self->{real_serverpid});
422 die "No progress made";
426 print "Connection closed\n";
428 $server_sock->close();
429 $self->{server_sock} = undef;
432 #Closing this also kills the child process
433 $client_sock->close();
437 if (--$self->{serverconnects} == 0) {
438 $pid = $self->{serverpid};
439 print "Waiting for 'perl -ne print' process to close: $pid...\n";
440 $pid = waitpid($pid, 0);
442 die "exit code $? from 'perl -ne print' process\n" if $? != 0;
443 } elsif ($pid == 0) {
444 kill(3, $self->{real_serverpid});
445 die "lost control over $self->{serverpid}?";
447 $pid = $self->{real_serverpid};
448 print "Waiting for s_server process to close: $pid...\n";
449 # it's done already, just collect the exit code [and reap]...
451 die "exit code $? from s_server process\n" if $? != 0;
453 # It's a bit counter-intuitive spot to make next connection to
454 # the s_server. Rationale is that established connection works
455 # as syncronization point, in sense that this way we know that
456 # s_server is actually done with current session...
457 $self->connect_to_server();
459 $pid = $self->{clientpid};
460 print "Waiting for s_client process to close: $pid...\n";
468 my ($self, $server, $packet) = @_;
475 print "Received server packet\n";
477 print "Received client packet\n";
480 if ($self->{direction} != $server) {
481 $self->{flight} = $self->{flight} + 1;
482 $self->{direction} = $server;
485 print "Packet length = ".length($packet)."\n";
486 print "Processing flight ".$self->flight."\n";
488 #Return contains the list of record found in the packet followed by the
489 #list of messages in those records and any partial message
490 my @ret = TLSProxy::Record->get_records($server, $self->flight,
491 $self->{partial}[$server].$packet);
492 $self->{partial}[$server] = $ret[2];
493 push @{$self->{record_list}}, @{$ret[0]};
494 push @{$self->{message_list}}, @{$ret[1]};
498 if (scalar(@{$ret[0]}) == 0 or length($ret[2]) != 0) {
502 #Finished parsing. Call user provided filter here
503 if (defined $self->filter) {
504 $self->filter->($self);
507 #Take a note on NewSessionTicket
508 foreach my $message (reverse @{$self->{message_list}}) {
509 if ($message->{mt} == TLSProxy::Message::MT_NEW_SESSION_TICKET) {
510 $self->{saw_session_ticket} = 1;
515 #Reconstruct the packet
517 foreach my $record (@{$self->record_list}) {
518 $packet .= $record->reconstruct_record($server);
521 print "Forwarded packet length = ".length($packet)."\n\n";
530 return $self->{execute};
535 return $self->{cert};
540 return $self->{debug};
545 return $self->{flight};
550 return $self->{record_list};
555 return $self->{success};
570 return $self->{proxy_addr};
575 return $self->{proxy_port};
580 return $self->{server_addr};
585 return $self->{server_port};
590 return $self->{serverpid};
595 return $self->{clientpid};
598 #Read/write accessors
603 $self->{filter} = shift;
605 return $self->{filter};
611 $self->{cipherc} = shift;
613 return $self->{cipherc};
619 $self->{ciphersuitesc} = shift;
621 return $self->{ciphersuitesc};
627 $self->{ciphers} = shift;
629 return $self->{ciphers};
635 $self->{ciphersuitess} = shift;
637 return $self->{ciphersuitess};
643 $self->{serverflags} = shift;
645 return $self->{serverflags};
651 $self->{clientflags} = shift;
653 return $self->{clientflags};
659 $self->{serverconnects} = shift;
661 return $self->{serverconnects};
663 # This is a bit ugly because the caller is responsible for keeping the records
664 # in sync with the updated message list; simply updating the message list isn't
665 # sufficient to get the proxy to forward the new message.
666 # But it does the trick for the one test (test_sslsessiontick) that needs it.
671 $self->{message_list} = shift;
673 return $self->{message_list};
680 for (my $i = 0; $i < $length; $i++) {
699 $self->{reneg} = shift;
701 return $self->{reneg};
704 #Setting a sessionfile means that the client will not close until the given
705 #file exists. This is useful in TLSv1.3 where otherwise s_client will close
706 #immediately at the end of the handshake, but before the session has been
707 #received from the server. A side effect of this is that s_client never sends
708 #a close_notify, so instead we consider success to be when it sends application
709 #data over the connection.
714 $self->{sessionfile} = shift;
715 TLSProxy::Message->successondata(1);
717 return $self->{sessionfile};
724 $ciphersuite = shift;