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 $self->{server_sock} = $IP_factory->(PeerAddr => $servaddr,
193 PeerPort => $self->{server_port},
195 or die "unable to connect: $!\n";
203 if ($self->{proxy_sock} == 0) {
207 my $execcmd = $self->execute
208 ." s_server -max_protocol TLSv1.3 -no_comp -rev -engine ossltest"
209 ." -accept 0 -cert ".$self->cert." -cert2 ".$self->cert
210 ." -naccept ".$self->serverconnects;
211 unless ($self->supports_IPv6) {
214 if ($self->ciphers ne "") {
215 $execcmd .= " -cipher ".$self->ciphers;
217 if ($self->ciphersuitess ne "") {
218 $execcmd .= " -ciphersuites ".$self->ciphersuitess;
220 if ($self->serverflags ne "") {
221 $execcmd .= " ".$self->serverflags;
224 print STDERR "Server command: $execcmd\n";
227 open(my $savedin, "<&STDIN");
229 # Temporarily replace STDIN so that sink process can inherit it...
230 $pid = open(STDIN, "$execcmd |") or die "Failed to $execcmd: $!\n";
231 $self->{real_serverpid} = $pid;
233 # Process the output from s_server until we find the ACCEPT line, which
234 # tells us what the accepting address and port are.
237 s/\R$//; # Better chomp
238 next unless (/^ACCEPT\s.*:(\d+)$/);
239 $self->{server_port} = $1;
243 if ($self->{server_port} == 0) {
244 # This actually means that s_server exited, because otherwise
245 # we would still searching for ACCEPT...
246 die "no ACCEPT detected in '$execcmd' output\n";
249 # Just make sure everything else is simply printed [as separate lines].
250 # The sub process simply inherits our STD* and will keep consuming
251 # server's output and printing it as long as there is anything there,
255 if (eval { require Win32::Process; 1; }) {
256 if (Win32::Process::Create(my $h, $^X, "perl -ne print", 0, 0, ".")) {
257 $pid = $h->GetProcessID();
259 $error = Win32::FormatMessage(Win32::GetLastError());
262 if (defined($pid = fork)) {
263 $pid or exec("$^X -ne print") or exit($!);
269 # Change back to original stdin
270 open(STDIN, "<&", $savedin);
273 if (!defined($pid)) {
274 kill(3, $self->{real_serverpid});
275 die "Failed to capture s_server's output: $error\n";
278 $self->{serverpid} = $pid;
280 print STDERR "Server responds on ",
281 $self->{server_addr}, ":", $self->{server_port}, "\n";
283 # Connect right away...
284 $self->connect_to_server();
286 return $self->clientstart;
293 if ($self->execute) {
295 my $execcmd = $self->execute
296 ." s_client -max_protocol TLSv1.3 -engine ossltest -connect "
297 .($self->proxy_addr).":".($self->proxy_port);
298 unless ($self->supports_IPv6) {
301 if ($self->cipherc ne "") {
302 $execcmd .= " -cipher ".$self->cipherc;
304 if ($self->ciphersuitesc ne "") {
305 $execcmd .= " -ciphersuites ".$self->ciphersuitesc;
307 if ($self->clientflags ne "") {
308 $execcmd .= " ".$self->clientflags;
310 if (defined $self->sessionfile) {
311 $execcmd .= " -ign_eof";
314 print STDERR "Client command: $execcmd\n";
317 open(my $savedout, ">&STDOUT");
318 # If we open pipe with new descriptor, attempt to close it,
319 # explicitly or implicitly, would incur waitpid and effectively
321 if (!($pid = open(STDOUT, "| $execcmd"))) {
323 kill(3, $self->{real_serverpid});
324 die "Failed to $execcmd: $err\n";
326 $self->{clientpid} = $pid;
328 # queue [magic] input
329 print $self->reneg ? "R" : "test";
331 # this closes client's stdin without waiting for its pid
332 open(STDOUT, ">&", $savedout);
336 # Wait for incoming connection from client
337 my $fdset = IO::Select->new($self->{proxy_sock});
338 if (!$fdset->can_read(1)) {
339 kill(3, $self->{real_serverpid});
340 die "s_client didn't try to connect\n";
344 if(!($client_sock = $self->{proxy_sock}->accept())) {
345 warn "Failed accepting incoming connection: $!\n";
349 print "Connection opened\n";
351 my $server_sock = $self->{server_sock};
354 #Wait for either the server socket or the client socket to become readable
355 $fdset = IO::Select->new($server_sock, $client_sock);
358 local $SIG{PIPE} = "IGNORE";
360 && (!(TLSProxy::Message->end)
361 || (defined $self->sessionfile()
362 && (-s $self->sessionfile()) == 0))
364 if (!(@ready = $fdset->can_read(1))) {
368 foreach my $hand (@ready) {
369 if ($hand == $server_sock) {
370 if ($server_sock->sysread($indata, 16384)) {
371 if ($indata = $self->process_packet(1, $indata)) {
372 $client_sock->syswrite($indata) or goto END;
376 $fdset->remove($server_sock);
377 $client_sock->shutdown(SHUT_WR);
379 } elsif ($hand == $client_sock) {
380 if ($client_sock->sysread($indata, 16384)) {
381 if ($indata = $self->process_packet(0, $indata)) {
382 $server_sock->syswrite($indata) or goto END;
386 $fdset->remove($client_sock);
387 $server_sock->shutdown(SHUT_WR);
390 kill(3, $self->{real_serverpid});
391 die "Unexpected handle";
397 kill(3, $self->{real_serverpid});
398 die "No progress made";
402 print "Connection closed\n";
404 $server_sock->close();
405 $self->{server_sock} = undef;
408 #Closing this also kills the child process
409 $client_sock->close();
413 if (--$self->{serverconnects} == 0) {
414 $pid = $self->{serverpid};
415 die "serverpid is zero\n" if $pid == 0;
416 print "Waiting for server process to close: $pid...\n";
417 # recall that we wait on process that buffers server's output
419 die "exit code $? from server process\n" if $? != 0;
421 # It's a bit counter-intuitive spot to make next connection to
422 # the s_server. Rationale is that established connection works
423 # as syncronization point, in sense that this way we know that
424 # s_server is actually done with current session...
425 $self->connect_to_server();
427 $pid = $self->{clientpid};
428 die "clientpid is zero\n" if $pid == 0;
429 print "Waiting for client process to close: $pid...\n";
437 my ($self, $server, $packet) = @_;
444 print "Received server packet\n";
446 print "Received client packet\n";
449 if ($self->{direction} != $server) {
450 $self->{flight} = $self->{flight} + 1;
451 $self->{direction} = $server;
454 print "Packet length = ".length($packet)."\n";
455 print "Processing flight ".$self->flight."\n";
457 #Return contains the list of record found in the packet followed by the
458 #list of messages in those records and any partial message
459 my @ret = TLSProxy::Record->get_records($server, $self->flight,
460 $self->{partial}[$server].$packet);
461 $self->{partial}[$server] = $ret[2];
462 push @{$self->{record_list}}, @{$ret[0]};
463 push @{$self->{message_list}}, @{$ret[1]};
467 if (scalar(@{$ret[0]}) == 0) {
471 #Finished parsing. Call user provided filter here
472 if (defined $self->filter) {
473 $self->filter->($self);
476 #Reconstruct the packet
478 foreach my $record (@{$self->record_list}) {
479 $packet .= $record->reconstruct_record($server);
482 print "Forwarded packet length = ".length($packet)."\n\n";
491 return $self->{execute};
496 return $self->{cert};
501 return $self->{debug};
506 return $self->{flight};
511 return $self->{record_list};
516 return $self->{success};
531 return $self->{proxy_addr};
536 return $self->{proxy_port};
541 return $self->{server_addr};
546 return $self->{server_port};
551 return $self->{serverpid};
556 return $self->{clientpid};
559 #Read/write accessors
564 $self->{filter} = shift;
566 return $self->{filter};
572 $self->{cipherc} = shift;
574 return $self->{cipherc};
580 $self->{ciphersuitesc} = shift;
582 return $self->{ciphersuitesc};
588 $self->{ciphers} = shift;
590 return $self->{ciphers};
596 $self->{ciphersuitess} = shift;
598 return $self->{ciphersuitess};
604 $self->{serverflags} = shift;
606 return $self->{serverflags};
612 $self->{clientflags} = shift;
614 return $self->{clientflags};
620 $self->{serverconnects} = shift;
622 return $self->{serverconnects};
624 # This is a bit ugly because the caller is responsible for keeping the records
625 # in sync with the updated message list; simply updating the message list isn't
626 # sufficient to get the proxy to forward the new message.
627 # But it does the trick for the one test (test_sslsessiontick) that needs it.
632 $self->{message_list} = shift;
634 return $self->{message_list};
641 for (my $i = 0; $i < $length; $i++) {
660 $self->{reneg} = shift;
662 return $self->{reneg};
665 #Setting a sessionfile means that the client will not close until the given
666 #file exists. This is useful in TLSv1.3 where otherwise s_client will close
667 #immediately at the end of the handshake, but before the session has been
668 #received from the server. A side effect of this is that s_client never sends
669 #a close_notify, so instead we consider success to be when it sends application
670 #data over the connection.
675 $self->{sessionfile} = shift;
676 TLSProxy::Message->successondata(1);
678 return $self->{sessionfile};
685 $ciphersuite = shift;