1 # Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved.
3 # Licensed under the OpenSSL license (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::CertificateVerify;
23 use TLSProxy::ServerKeyExchange;
24 use TLSProxy::NewSessionTicket;
30 my $ciphersuite = undef;
42 proxy_addr => "localhost",
43 server_addr => "localhost",
61 ciphers => "AES128-SHA",
62 ciphersuitess => "TLS_AES_128_GCM_SHA256",
70 # IO::Socket::IP is on the core module list, IO::Socket::INET6 isn't.
71 # However, IO::Socket::INET6 is older and is said to be more widely
72 # deployed for the moment, and may have less bugs, so we try the latter
73 # first, then fall back on the code modules. Worst case scenario, we
74 # fall back to IO::Socket::INET, only supports IPv4.
76 require IO::Socket::INET6;
77 my $s = IO::Socket::INET6->new(
86 $IP_factory = sub { IO::Socket::INET6->new(@_); };
90 require IO::Socket::IP;
91 my $s = IO::Socket::IP->new(
100 $IP_factory = sub { IO::Socket::IP->new(@_); };
103 $IP_factory = sub { IO::Socket::INET->new(@_); };
107 # Create the Proxy socket
108 my $proxaddr = $self->{proxy_addr};
109 $proxaddr =~ s/[\[\]]//g; # Remove [ and ]
111 LocalHost => $proxaddr,
116 $self->{proxy_sock} = $IP_factory->(@proxyargs);
118 if ($self->{proxy_sock}) {
119 $self->{proxy_port} = $self->{proxy_sock}->sockport();
120 print "Proxy started on port ".$self->{proxy_port}."\n";
122 warn "Failed creating proxy socket (".$proxaddr.",0): $!\n";
125 return bless $self, $class;
132 $self->{proxy_sock}->close() if $self->{proxy_sock};
139 $self->{cipherc} = "";
140 $self->{ciphersuitec} = "";
141 $self->{flight} = -1;
142 $self->{direction} = -1;
143 $self->{partial} = ["", ""];
144 $self->{record_list} = [];
145 $self->{message_list} = [];
146 $self->{clientflags} = "";
147 $self->{sessionfile} = undef;
148 $self->{clientpid} = 0;
150 $ciphersuite = undef;
152 TLSProxy::Message->clear();
153 TLSProxy::Record->clear();
161 $self->{ciphers} = "AES128-SHA";
162 $self->{ciphersuitess} = "TLS_AES_128_GCM_SHA256";
163 $self->{serverflags} = "";
164 $self->{serverconnects} = 1;
165 $self->{serverpid} = 0;
185 sub connect_to_server
188 my $servaddr = $self->{server_addr};
190 $servaddr =~ s/[\[\]]//g; # Remove [ and ]
192 my $sock = $IP_factory->(PeerAddr => $servaddr,
193 PeerPort => $self->{server_port},
195 if (!defined($sock)) {
197 kill(3, $self->{real_serverpid});
198 die "unable to connect: $err\n";
201 $self->{server_sock} = $sock;
209 if ($self->{proxy_sock} == 0) {
213 my $execcmd = $self->execute
214 ." s_server -max_protocol TLSv1.3 -no_comp -rev -engine ossltest"
215 ." -accept 0 -cert ".$self->cert." -cert2 ".$self->cert
216 ." -naccept ".$self->serverconnects;
217 unless ($self->supports_IPv6) {
220 if ($self->ciphers ne "") {
221 $execcmd .= " -cipher ".$self->ciphers;
223 if ($self->ciphersuitess ne "") {
224 $execcmd .= " -ciphersuites ".$self->ciphersuitess;
226 if ($self->serverflags ne "") {
227 $execcmd .= " ".$self->serverflags;
230 print STDERR "Server command: $execcmd\n";
233 open(my $savedin, "<&STDIN");
235 # Temporarily replace STDIN so that sink process can inherit it...
236 $pid = open(STDIN, "$execcmd |") or die "Failed to $execcmd: $!\n";
237 $self->{real_serverpid} = $pid;
239 # Process the output from s_server until we find the ACCEPT line, which
240 # tells us what the accepting address and port are.
243 s/\R$//; # Better chomp
244 next unless (/^ACCEPT\s.*:(\d+)$/);
245 $self->{server_port} = $1;
249 if ($self->{server_port} == 0) {
250 # This actually means that s_server exited, because otherwise
251 # we would still searching for ACCEPT...
253 die "no ACCEPT detected in '$execcmd' output: $?\n";
256 # Just make sure everything else is simply printed [as separate lines].
257 # The sub process simply inherits our STD* and will keep consuming
258 # server's output and printing it as long as there is anything there,
262 if (eval { require Win32::Process; 1; }) {
263 if (Win32::Process::Create(my $h, $^X, "perl -ne print", 0, 0, ".")) {
264 $pid = $h->GetProcessID();
265 $self->{proc_handle} = $h; # hold handle till next round [or exit]
267 $error = Win32::FormatMessage(Win32::GetLastError());
270 if (defined($pid = fork)) {
271 $pid or exec("$^X -ne print") or exit($!);
277 # Change back to original stdin
278 open(STDIN, "<&", $savedin);
281 if (!defined($pid)) {
282 kill(3, $self->{real_serverpid});
283 die "Failed to capture s_server's output: $error\n";
286 $self->{serverpid} = $pid;
288 print STDERR "Server responds on ",
289 $self->{server_addr}, ":", $self->{server_port}, "\n";
291 # Connect right away...
292 $self->connect_to_server();
294 return $self->clientstart;
301 if ($self->execute) {
303 my $execcmd = $self->execute
304 ." s_client -max_protocol TLSv1.3 -engine ossltest -connect "
305 .($self->proxy_addr).":".($self->proxy_port);
306 unless ($self->supports_IPv6) {
309 if ($self->cipherc ne "") {
310 $execcmd .= " -cipher ".$self->cipherc;
312 if ($self->ciphersuitesc ne "") {
313 $execcmd .= " -ciphersuites ".$self->ciphersuitesc;
315 if ($self->clientflags ne "") {
316 $execcmd .= " ".$self->clientflags;
318 if (defined $self->sessionfile) {
319 $execcmd .= " -ign_eof";
322 print STDERR "Client command: $execcmd\n";
325 open(my $savedout, ">&STDOUT");
326 # If we open pipe with new descriptor, attempt to close it,
327 # explicitly or implicitly, would incur waitpid and effectively
329 if (!($pid = open(STDOUT, "| $execcmd"))) {
331 kill(3, $self->{real_serverpid});
332 die "Failed to $execcmd: $err\n";
334 $self->{clientpid} = $pid;
336 # queue [magic] input
337 print $self->reneg ? "R" : "test";
339 # this closes client's stdin without waiting for its pid
340 open(STDOUT, ">&", $savedout);
344 # Wait for incoming connection from client
345 my $fdset = IO::Select->new($self->{proxy_sock});
346 if (!$fdset->can_read(1)) {
347 kill(3, $self->{real_serverpid});
348 die "s_client didn't try to connect\n";
352 if(!($client_sock = $self->{proxy_sock}->accept())) {
353 warn "Failed accepting incoming connection: $!\n";
357 print "Connection opened\n";
359 my $server_sock = $self->{server_sock};
362 #Wait for either the server socket or the client socket to become readable
363 $fdset = IO::Select->new($server_sock, $client_sock);
366 local $SIG{PIPE} = "IGNORE";
368 && (!(TLSProxy::Message->end)
369 || (defined $self->sessionfile()
370 && (-s $self->sessionfile()) == 0))
372 if (!(@ready = $fdset->can_read(1))) {
376 foreach my $hand (@ready) {
377 if ($hand == $server_sock) {
378 if ($server_sock->sysread($indata, 16384)) {
379 if ($indata = $self->process_packet(1, $indata)) {
380 $client_sock->syswrite($indata) or goto END;
384 $fdset->remove($server_sock);
385 $client_sock->shutdown(SHUT_WR);
387 } elsif ($hand == $client_sock) {
388 if ($client_sock->sysread($indata, 16384)) {
389 if ($indata = $self->process_packet(0, $indata)) {
390 $server_sock->syswrite($indata) or goto END;
394 $fdset->remove($client_sock);
395 $server_sock->shutdown(SHUT_WR);
398 kill(3, $self->{real_serverpid});
399 die "Unexpected handle";
405 kill(3, $self->{real_serverpid});
406 die "No progress made";
410 print "Connection closed\n";
412 $server_sock->close();
413 $self->{server_sock} = undef;
416 #Closing this also kills the child process
417 $client_sock->close();
421 if (--$self->{serverconnects} == 0) {
422 $pid = $self->{serverpid};
423 print "Waiting for 'perl -ne print' process to close: $pid...\n";
424 $pid = waitpid($pid, 0);
426 die "exit code $? from 'perl -ne print' process\n" if $? != 0;
427 } elsif ($pid == 0) {
428 kill(3, $self->{real_serverpid});
429 die "lost control over $self->{serverpid}?";
431 $pid = $self->{real_serverpid};
432 print "Waiting for s_server process to close: $pid...\n";
433 # it's done already, just collect the exit code [and reap]...
435 die "exit code $? from s_server process\n" if $? != 0;
437 # It's a bit counter-intuitive spot to make next connection to
438 # the s_server. Rationale is that established connection works
439 # as syncronization point, in sense that this way we know that
440 # s_server is actually done with current session...
441 $self->connect_to_server();
443 $pid = $self->{clientpid};
444 print "Waiting for client process to close: $pid...\n";
452 my ($self, $server, $packet) = @_;
459 print "Received server packet\n";
461 print "Received client packet\n";
464 if ($self->{direction} != $server) {
465 $self->{flight} = $self->{flight} + 1;
466 $self->{direction} = $server;
469 print "Packet length = ".length($packet)."\n";
470 print "Processing flight ".$self->flight."\n";
472 #Return contains the list of record found in the packet followed by the
473 #list of messages in those records and any partial message
474 my @ret = TLSProxy::Record->get_records($server, $self->flight,
475 $self->{partial}[$server].$packet);
476 $self->{partial}[$server] = $ret[2];
477 push @{$self->{record_list}}, @{$ret[0]};
478 push @{$self->{message_list}}, @{$ret[1]};
482 if (scalar(@{$ret[0]}) == 0) {
486 #Finished parsing. Call user provided filter here
487 if (defined $self->filter) {
488 $self->filter->($self);
491 #Reconstruct the packet
493 foreach my $record (@{$self->record_list}) {
494 $packet .= $record->reconstruct_record($server);
497 print "Forwarded packet length = ".length($packet)."\n\n";
506 return $self->{execute};
511 return $self->{cert};
516 return $self->{debug};
521 return $self->{flight};
526 return $self->{record_list};
531 return $self->{success};
546 return $self->{proxy_addr};
551 return $self->{proxy_port};
556 return $self->{server_addr};
561 return $self->{server_port};
566 return $self->{serverpid};
571 return $self->{clientpid};
574 #Read/write accessors
579 $self->{filter} = shift;
581 return $self->{filter};
587 $self->{cipherc} = shift;
589 return $self->{cipherc};
595 $self->{ciphersuitesc} = shift;
597 return $self->{ciphersuitesc};
603 $self->{ciphers} = shift;
605 return $self->{ciphers};
611 $self->{ciphersuitess} = shift;
613 return $self->{ciphersuitess};
619 $self->{serverflags} = shift;
621 return $self->{serverflags};
627 $self->{clientflags} = shift;
629 return $self->{clientflags};
635 $self->{serverconnects} = shift;
637 return $self->{serverconnects};
639 # This is a bit ugly because the caller is responsible for keeping the records
640 # in sync with the updated message list; simply updating the message list isn't
641 # sufficient to get the proxy to forward the new message.
642 # But it does the trick for the one test (test_sslsessiontick) that needs it.
647 $self->{message_list} = shift;
649 return $self->{message_list};
656 for (my $i = 0; $i < $length; $i++) {
675 $self->{reneg} = shift;
677 return $self->{reneg};
680 #Setting a sessionfile means that the client will not close until the given
681 #file exists. This is useful in TLSv1.3 where otherwise s_client will close
682 #immediately at the end of the handshake, but before the session has been
683 #received from the server. A side effect of this is that s_client never sends
684 #a close_notify, so instead we consider success to be when it sends application
685 #data over the connection.
690 $self->{sessionfile} = shift;
691 TLSProxy::Message->successondata(1);
693 return $self->{sessionfile};
700 $ciphersuite = shift;