Enable TLSProxy to talk TLS1.3
[openssl.git] / util / TLSProxy / Proxy.pm
1 # Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
2 #
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
7
8 use strict;
9 use POSIX ":sys_wait_h";
10
11 package TLSProxy::Proxy;
12
13 use File::Spec;
14 use IO::Socket;
15 use IO::Select;
16 use TLSProxy::Record;
17 use TLSProxy::Message;
18 use TLSProxy::ClientHello;
19 use TLSProxy::ServerHello;
20 use TLSProxy::ServerKeyExchange;
21 use TLSProxy::NewSessionTicket;
22
23 my $have_IPv6 = 0;
24 my $IP_factory;
25
26 sub new
27 {
28     my $class = shift;
29     my ($filter,
30         $execute,
31         $cert,
32         $debug) = @_;
33
34     my $self = {
35         #Public read/write
36         proxy_addr => "localhost",
37         proxy_port => 4453,
38         server_addr => "localhost",
39         server_port => 4443,
40         filter => $filter,
41         serverflags => "",
42         clientflags => "",
43         serverconnects => 1,
44         serverpid => 0,
45
46         #Public read
47         execute => $execute,
48         cert => $cert,
49         debug => $debug,
50         cipherc => "",
51         ciphers => "AES128-SHA:TLS13-AES-128-GCM-SHA256",
52         flight => 0,
53         record_list => [],
54         message_list => [],
55     };
56
57     # IO::Socket::IP is on the core module list, IO::Socket::INET6 isn't.
58     # However, IO::Socket::INET6 is older and is said to be more widely
59     # deployed for the moment, and may have less bugs, so we try the latter
60     # first, then fall back on the code modules.  Worst case scenario, we
61     # fall back to IO::Socket::INET, only supports IPv4.
62     eval {
63         require IO::Socket::INET6;
64         my $s = IO::Socket::INET6->new(
65             LocalAddr => "::1",
66             LocalPort => 0,
67             Listen=>1,
68             );
69         $s or die "\n";
70         $s->close();
71     };
72     if ($@ eq "") {
73         $IP_factory = sub { IO::Socket::INET6->new(@_); };
74         $have_IPv6 = 1;
75     } else {
76         eval {
77             require IO::Socket::IP;
78             my $s = IO::Socket::IP->new(
79                 LocalAddr => "::1",
80                 LocalPort => 0,
81                 Listen=>1,
82                 );
83             $s or die "\n";
84             $s->close();
85         };
86         if ($@ eq "") {
87             $IP_factory = sub { IO::Socket::IP->new(@_); };
88             $have_IPv6 = 1;
89         } else {
90             $IP_factory = sub { IO::Socket::INET->new(@_); };
91         }
92     }
93
94     return bless $self, $class;
95 }
96
97 sub clearClient
98 {
99     my $self = shift;
100
101     $self->{cipherc} = "";
102     $self->{flight} = 0;
103     $self->{record_list} = [];
104     $self->{message_list} = [];
105     $self->{clientflags} = "";
106
107     TLSProxy::Message->clear();
108     TLSProxy::Record->clear();
109 }
110
111 sub clear
112 {
113     my $self = shift;
114
115     $self->clearClient;
116     $self->{ciphers} = "AES128-SHA:TLS13-AES-128-GCM-SHA256";
117     $self->{serverflags} = "";
118     $self->{serverconnects} = 1;
119     $self->{serverpid} = 0;
120 }
121
122 sub restart
123 {
124     my $self = shift;
125
126     $self->clear;
127     $self->start;
128 }
129
130 sub clientrestart
131 {
132     my $self = shift;
133
134     $self->clear;
135     $self->clientstart;
136 }
137
138 sub start
139 {
140     my ($self) = shift;
141     my $pid;
142
143     $pid = fork();
144     if ($pid == 0) {
145         if (!$self->debug) {
146             open(STDOUT, ">", File::Spec->devnull())
147                 or die "Failed to redirect stdout: $!";
148             open(STDERR, ">&STDOUT");
149         }
150         my $execcmd = $self->execute
151             ." s_server -no_comp -rev -engine ossltest -accept "
152             .($self->server_port)
153             ." -cert ".$self->cert." -naccept ".$self->serverconnects;
154         if ($self->ciphers ne "") {
155             $execcmd .= " -cipher ".$self->ciphers;
156         }
157         if ($self->serverflags ne "") {
158             $execcmd .= " ".$self->serverflags;
159         }
160         exec($execcmd);
161     }
162     $self->serverpid($pid);
163
164     return $self->clientstart;
165 }
166
167 sub clientstart
168 {
169     my ($self) = shift;
170     my $oldstdout;
171
172     if(!$self->debug) {
173         open DEVNULL, ">", File::Spec->devnull();
174         $oldstdout = select(DEVNULL);
175     }
176
177     # Create the Proxy socket
178     my $proxaddr = $self->proxy_addr;
179     $proxaddr =~ s/[\[\]]//g; # Remove [ and ]
180     my $proxy_sock = $IP_factory->(
181         LocalHost   => $proxaddr,
182         LocalPort   => $self->proxy_port,
183         Proto       => "tcp",
184         Listen      => SOMAXCONN,
185         ReuseAddr   => 1
186     );
187
188     if ($proxy_sock) {
189         print "Proxy started on port ".$self->proxy_port."\n";
190     } else {
191         warn "Failed creating proxy socket (".$proxaddr.",".$self->proxy_port."): $!\n";
192         return 0;
193     }
194
195     if ($self->execute) {
196         my $pid = fork();
197         if ($pid == 0) {
198             if (!$self->debug) {
199                 open(STDOUT, ">", File::Spec->devnull())
200                     or die "Failed to redirect stdout: $!";
201                 open(STDERR, ">&STDOUT");
202             }
203             my $execcmd = "echo test | ".$self->execute
204                  ." s_client -engine ossltest -connect "
205                  .($self->proxy_addr).":".($self->proxy_port);
206             if ($self->cipherc ne "") {
207                 $execcmd .= " -cipher ".$self->cipherc;
208             }
209             if ($self->clientflags ne "") {
210                 $execcmd .= " ".$self->clientflags;
211             }
212             exec($execcmd);
213         }
214     }
215
216     # Wait for incoming connection from client
217     my $client_sock;
218     if(!($client_sock = $proxy_sock->accept())) {
219         warn "Failed accepting incoming connection: $!\n";
220         return 0;
221     }
222
223     print "Connection opened\n";
224
225     # Now connect to the server
226     my $retry = 3;
227     my $server_sock;
228     #We loop over this a few times because sometimes s_server can take a while
229     #to start up
230     do {
231         my $servaddr = $self->server_addr;
232         $servaddr =~ s/[\[\]]//g; # Remove [ and ]
233         eval {
234             $server_sock = $IP_factory->(
235                 PeerAddr => $servaddr,
236                 PeerPort => $self->server_port,
237                 MultiHomed => 1,
238                 Proto => 'tcp'
239             );
240         };
241
242         $retry--;
243         #Some buggy IP factories can return a defined server_sock that hasn't
244         #actually connected, so we check peerport too
245         if ($@ || !defined($server_sock) || !defined($server_sock->peerport)) {
246             $server_sock->close() if defined($server_sock);
247             undef $server_sock;
248             if ($retry) {
249                 #Sleep for a short while
250                 select(undef, undef, undef, 0.1);
251             } else {
252                 warn "Failed to start up server (".$servaddr.",".$self->server_port."): $!\n";
253                 return 0;
254             }
255         }
256     } while (!$server_sock);
257
258     my $sel = IO::Select->new($server_sock, $client_sock);
259     my $indata;
260     my @handles = ($server_sock, $client_sock);
261
262     #Wait for either the server socket or the client socket to become readable
263     my @ready;
264     while(!(TLSProxy::Message->end) && (@ready = $sel->can_read)) {
265         foreach my $hand (@ready) {
266             if ($hand == $server_sock) {
267                 $server_sock->sysread($indata, 16384) or goto END;
268                 $indata = $self->process_packet(1, $indata);
269                 $client_sock->syswrite($indata);
270             } elsif ($hand == $client_sock) {
271                 $client_sock->sysread($indata, 16384) or goto END;
272                 $indata = $self->process_packet(0, $indata);
273                 $server_sock->syswrite($indata);
274             } else {
275                 print "Err\n";
276                 goto END;
277             }
278         }
279     }
280
281     END:
282     print "Connection closed\n";
283     if($server_sock) {
284         $server_sock->close();
285     }
286     if($client_sock) {
287         #Closing this also kills the child process
288         $client_sock->close();
289     }
290     if($proxy_sock) {
291         $proxy_sock->close();
292     }
293     if(!$self->debug) {
294         select($oldstdout);
295     }
296     $self->serverconnects($self->serverconnects - 1);
297     if ($self->serverconnects == 0) {
298         die "serverpid is zero\n" if $self->serverpid == 0;
299         print "Waiting for server process to close: "
300               .$self->serverpid."\n";
301         waitpid( $self->serverpid, 0);
302     }
303     return 1;
304 }
305
306 sub process_packet
307 {
308     my ($self, $server, $packet) = @_;
309     my $len_real;
310     my $decrypt_len;
311     my $data;
312     my $recnum;
313
314     if ($server) {
315         print "Received server packet\n";
316     } else {
317         print "Received client packet\n";
318     }
319
320     print "Packet length = ".length($packet)."\n";
321     print "Processing flight ".$self->flight."\n";
322
323     #Return contains the list of record found in the packet followed by the
324     #list of messages in those records
325     my @ret = TLSProxy::Record->get_records($server, $self->flight, $packet);
326     push @{$self->record_list}, @{$ret[0]};
327     push @{$self->{message_list}}, @{$ret[1]};
328
329     print "\n";
330
331     #Finished parsing. Call user provided filter here
332     if(defined $self->filter) {
333         $self->filter->($self);
334     }
335
336     #Reconstruct the packet
337     $packet = "";
338     foreach my $record (@{$self->record_list}) {
339         #We only replay the records for the current flight
340         if ($record->flight != $self->flight) {
341             next;
342         }
343         $packet .= $record->reconstruct_record();
344     }
345
346     $self->{flight} = $self->{flight} + 1;
347
348     print "Forwarded packet length = ".length($packet)."\n\n";
349
350     return $packet;
351 }
352
353 #Read accessors
354 sub execute
355 {
356     my $self = shift;
357     return $self->{execute};
358 }
359 sub cert
360 {
361     my $self = shift;
362     return $self->{cert};
363 }
364 sub debug
365 {
366     my $self = shift;
367     return $self->{debug};
368 }
369 sub flight
370 {
371     my $self = shift;
372     return $self->{flight};
373 }
374 sub record_list
375 {
376     my $self = shift;
377     return $self->{record_list};
378 }
379 sub success
380 {
381     my $self = shift;
382     return $self->{success};
383 }
384 sub end
385 {
386     my $self = shift;
387     return $self->{end};
388 }
389 sub supports_IPv6
390 {
391     my $self = shift;
392     return $have_IPv6;
393 }
394
395 #Read/write accessors
396 sub proxy_addr
397 {
398     my $self = shift;
399     if (@_) {
400       $self->{proxy_addr} = shift;
401     }
402     return $self->{proxy_addr};
403 }
404 sub proxy_port
405 {
406     my $self = shift;
407     if (@_) {
408       $self->{proxy_port} = shift;
409     }
410     return $self->{proxy_port};
411 }
412 sub server_addr
413 {
414     my $self = shift;
415     if (@_) {
416       $self->{server_addr} = shift;
417     }
418     return $self->{server_addr};
419 }
420 sub server_port
421 {
422     my $self = shift;
423     if (@_) {
424       $self->{server_port} = shift;
425     }
426     return $self->{server_port};
427 }
428 sub filter
429 {
430     my $self = shift;
431     if (@_) {
432       $self->{filter} = shift;
433     }
434     return $self->{filter};
435 }
436 sub cipherc
437 {
438     my $self = shift;
439     if (@_) {
440       $self->{cipherc} = shift;
441     }
442     return $self->{cipherc};
443 }
444 sub ciphers
445 {
446     my $self = shift;
447     if (@_) {
448       $self->{ciphers} = shift;
449     }
450     return $self->{ciphers};
451 }
452 sub serverflags
453 {
454     my $self = shift;
455     if (@_) {
456       $self->{serverflags} = shift;
457     }
458     return $self->{serverflags};
459 }
460 sub clientflags
461 {
462     my $self = shift;
463     if (@_) {
464       $self->{clientflags} = shift;
465     }
466     return $self->{clientflags};
467 }
468 sub serverconnects
469 {
470     my $self = shift;
471     if (@_) {
472       $self->{serverconnects} = shift;
473     }
474     return $self->{serverconnects};
475 }
476 # This is a bit ugly because the caller is responsible for keeping the records
477 # in sync with the updated message list; simply updating the message list isn't
478 # sufficient to get the proxy to forward the new message.
479 # But it does the trick for the one test (test_sslsessiontick) that needs it.
480 sub message_list
481 {
482     my $self = shift;
483     if (@_) {
484         $self->{message_list} = shift;
485     }
486     return $self->{message_list};
487 }
488 sub serverpid
489 {
490     my $self = shift;
491     if (@_) {
492       $self->{serverpid} = shift;
493     }
494     return $self->{serverpid};
495 }
496
497 sub fill_known_data
498 {
499     my $length = shift;
500     my $ret = "";
501     for (my $i = 0; $i < $length; $i++) {
502         $ret .= chr($i);
503     }
504     return $ret;
505 }
506
507 1;