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