fcbe2483c4afb3fcddaf4ee3a21f5a7899eb935d
[openssl.git] / util / TLSProxy / Proxy.pm
1 # Written by Matt Caswell for the OpenSSL project.
2 # ====================================================================
3 # Copyright (c) 1998-2015 The OpenSSL Project.  All rights reserved.
4 #
5 # Redistribution and use in source and binary forms, with or without
6 # modification, are permitted provided that the following conditions
7 # are met:
8 #
9 # 1. Redistributions of source code must retain the above copyright
10 #    notice, this list of conditions and the following disclaimer.
11 #
12 # 2. Redistributions in binary form must reproduce the above copyright
13 #    notice, this list of conditions and the following disclaimer in
14 #    the documentation and/or other materials provided with the
15 #    distribution.
16 #
17 # 3. All advertising materials mentioning features or use of this
18 #    software must display the following acknowledgment:
19 #    "This product includes software developed by the OpenSSL Project
20 #    for use in the OpenSSL Toolkit. (http://www.openssl.org/)"
21 #
22 # 4. The names "OpenSSL Toolkit" and "OpenSSL Project" must not be used to
23 #    endorse or promote products derived from this software without
24 #    prior written permission. For written permission, please contact
25 #    openssl-core@openssl.org.
26 #
27 # 5. Products derived from this software may not be called "OpenSSL"
28 #    nor may "OpenSSL" appear in their names without prior written
29 #    permission of the OpenSSL Project.
30 #
31 # 6. Redistributions of any form whatsoever must retain the following
32 #    acknowledgment:
33 #    "This product includes software developed by the OpenSSL Project
34 #    for use in the OpenSSL Toolkit (http://www.openssl.org/)"
35 #
36 # THIS SOFTWARE IS PROVIDED BY THE OpenSSL PROJECT ``AS IS'' AND ANY
37 # EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
38 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
39 # PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE OpenSSL PROJECT OR
40 # ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
41 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
42 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
43 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
44 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
45 # STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
46 # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
47 # OF THE POSSIBILITY OF SUCH DAMAGE.
48 # ====================================================================
49 #
50 # This product includes cryptographic software written by Eric Young
51 # (eay@cryptsoft.com).  This product includes software written by Tim
52 # Hudson (tjh@cryptsoft.com).
53
54 use strict;
55 use POSIX ":sys_wait_h";
56
57 package TLSProxy::Proxy;
58
59 use File::Spec;
60 use IO::Socket;
61 use IO::Select;
62 use TLSProxy::Record;
63 use TLSProxy::Message;
64 use TLSProxy::ClientHello;
65 use TLSProxy::ServerHello;
66 use TLSProxy::ServerKeyExchange;
67 use TLSProxy::NewSessionTicket;
68
69 my $have_IPv6 = 0;
70 my $IP_factory;
71
72 sub new
73 {
74     my $class = shift;
75     my ($filter,
76         $execute,
77         $cert,
78         $debug) = @_;
79
80     my $self = {
81         #Public read/write
82         proxy_addr => "localhost",
83         proxy_port => 4453,
84         server_addr => "localhost",
85         server_port => 4443,
86         filter => $filter,
87         serverflags => "",
88         clientflags => "",
89         serverconnects => 1,
90         serverpid => 0,
91
92         #Public read
93         execute => $execute,
94         cert => $cert,
95         debug => $debug,
96         cipherc => "",
97         ciphers => "AES128-SHA",
98         flight => 0,
99         record_list => [],
100         message_list => [],
101     };
102
103     # IO::Socket::IP is on the core module list, IO::Socket::INET6 isn't.
104     # However, IO::Socket::INET6 is older and is said to be more widely
105     # deployed for the moment, and may have less bugs, so we try the latter
106     # first, then fall back on the code modules.  Worst case scenario, we
107     # fall back to IO::Socket::INET, only supports IPv4.
108     eval {
109         require IO::Socket::INET6;
110         my $s = IO::Socket::INET6->new(
111             LocalAddr => "::1",
112             LocalPort => 0,
113             Listen=>1,
114             );
115         $s or die "\n";
116         $s->close();
117     };
118     if ($@ eq "") {
119         $IP_factory = sub { IO::Socket::INET6->new(@_); };
120         $have_IPv6 = 1;
121     } else {
122         eval {
123             require IO::Socket::IP;
124             my $s = IO::Socket::IP->new(
125                 LocalAddr => "::1",
126                 LocalPort => 0,
127                 Listen=>1,
128                 );
129             $s or die "\n";
130             $s->close();
131         };
132         if ($@ eq "") {
133             $IP_factory = sub { IO::Socket::IP->new(@_); };
134             $have_IPv6 = 1;
135         } else {
136             $IP_factory = sub { IO::Socket::INET->new(@_); };
137         }
138     }
139
140     return bless $self, $class;
141 }
142
143 sub clearClient
144 {
145     my $self = shift;
146
147     $self->{cipherc} = "";
148     $self->{flight} = 0;
149     $self->{record_list} = [];
150     $self->{message_list} = [];
151     $self->{clientflags} = "";
152
153     TLSProxy::Message->clear();
154     TLSProxy::Record->clear();
155 }
156
157 sub clear
158 {
159     my $self = shift;
160
161     $self->clearClient;
162     $self->{ciphers} = "AES128-SHA";
163     $self->{serverflags} = "";
164     $self->{serverconnects} = 1;
165     $self->{serverpid} = 0;
166 }
167
168 sub restart
169 {
170     my $self = shift;
171
172     $self->clear;
173     $self->start;
174 }
175
176 sub clientrestart
177 {
178     my $self = shift;
179
180     $self->clear;
181     $self->clientstart;
182 }
183
184 sub start
185 {
186     my ($self) = shift;
187     my $pid;
188
189     $pid = fork();
190     if ($pid == 0) {
191         if (!$self->debug) {
192             open(STDOUT, ">", File::Spec->devnull())
193                 or die "Failed to redirect stdout: $!";
194             open(STDERR, ">&STDOUT");
195         }
196         my $execcmd = $self->execute
197             ." s_server -no_comp -rev -engine ossltest -accept "
198             .($self->server_port)
199             ." -cert ".$self->cert." -naccept ".$self->serverconnects;
200         if ($self->ciphers ne "") {
201             $execcmd .= " -cipher ".$self->ciphers;
202         }
203         if ($self->serverflags ne "") {
204             $execcmd .= " ".$self->serverflags;
205         }
206         exec($execcmd);
207     }
208     $self->serverpid($pid);
209
210     $self->clientstart;
211 }
212
213 sub clientstart
214 {
215     my ($self) = shift;
216     my $oldstdout;
217
218     if(!$self->debug) {
219         open DEVNULL, ">", File::Spec->devnull();
220         $oldstdout = select(DEVNULL);
221     }
222
223     # Create the Proxy socket
224     my $proxaddr = $self->proxy_addr;
225     $proxaddr =~ s/[\[\]]//g; # Remove [ and ]
226     my $proxy_sock = $IP_factory->(
227         LocalHost   => $proxaddr,
228         LocalPort   => $self->proxy_port,
229         Proto       => "tcp",
230         Listen      => SOMAXCONN,
231         ReuseAddr   => 1
232     );
233
234     if ($proxy_sock) {
235         print "Proxy started on port ".$self->proxy_port."\n";
236     } else {
237         die "Failed creating proxy socket (".$proxaddr.",".$self->proxy_port."): $!\n";
238     }
239
240     if ($self->execute) {
241         my $pid = fork();
242         if ($pid == 0) {
243             if (!$self->debug) {
244                 open(STDOUT, ">", File::Spec->devnull())
245                     or die "Failed to redirect stdout: $!";
246                 open(STDERR, ">&STDOUT");
247             }
248             my $execcmd = "echo test | ".$self->execute
249                  ." s_client -engine ossltest -connect "
250                  .($self->proxy_addr).":".($self->proxy_port);
251             if ($self->cipherc ne "") {
252                 $execcmd .= " -cipher ".$self->cipherc;
253             }
254             if ($self->clientflags ne "") {
255                 $execcmd .= " ".$self->clientflags;
256             }
257             exec($execcmd);
258         }
259     }
260
261     # Wait for incoming connection from client
262     my $client_sock = $proxy_sock->accept()
263         or die "Failed accepting incoming connection: $!\n";
264
265     print "Connection opened\n";
266
267     # Now connect to the server
268     my $retry = 3;
269     my $server_sock;
270     #We loop over this a few times because sometimes s_server can take a while
271     #to start up
272     do {
273         my $servaddr = $self->server_addr;
274         $servaddr =~ s/[\[\]]//g; # Remove [ and ]
275         $server_sock = $IP_factory->(
276             PeerAddr => $servaddr,
277             PeerPort => $self->server_port,
278             MultiHomed => 1,
279             Proto => 'tcp'
280         );
281
282         $retry--;
283         if ($@ || !defined($server_sock)) {
284             $server_sock->close() if defined($server_sock);
285             undef $server_sock;
286             if ($retry) {
287                 #Sleep for a short while
288                 select(undef, undef, undef, 0.1);
289             } else {
290                 die "Failed to start up server (".$servaddr.",".$self->server_port."): $!\n";
291             }
292         }
293     } while (!$server_sock);
294
295     my $sel = IO::Select->new($server_sock, $client_sock);
296     my $indata;
297     my @handles = ($server_sock, $client_sock);
298
299     #Wait for either the server socket or the client socket to become readable
300     my @ready;
301     while(!(TLSProxy::Message->end) && (@ready = $sel->can_read)) {
302         foreach my $hand (@ready) {
303             if ($hand == $server_sock) {
304                 $server_sock->sysread($indata, 16384) or goto END;
305                 $indata = $self->process_packet(1, $indata);
306                 $client_sock->syswrite($indata);
307             } elsif ($hand == $client_sock) {
308                 $client_sock->sysread($indata, 16384) or goto END;
309                 $indata = $self->process_packet(0, $indata);
310                 $server_sock->syswrite($indata);
311             } else {
312                 print "Err\n";
313                 goto END;
314             }
315         }
316     }
317
318     END:
319     print "Connection closed\n";
320     if($server_sock) {
321         $server_sock->close();
322     }
323     if($client_sock) {
324         #Closing this also kills the child process
325         $client_sock->close();
326     }
327     if($proxy_sock) {
328         $proxy_sock->close();
329     }
330     if(!$self->debug) {
331         select($oldstdout);
332     }
333     $self->serverconnects($self->serverconnects - 1);
334     if ($self->serverconnects == 0) {
335         die "serverpid is zero\n" if $self->serverpid == 0;
336         print "Waiting for server process to close: "
337               .$self->serverpid."\n";
338         waitpid( $self->serverpid, 0);
339     }
340 }
341
342 sub process_packet
343 {
344     my ($self, $server, $packet) = @_;
345     my $len_real;
346     my $decrypt_len;
347     my $data;
348     my $recnum;
349
350     if ($server) {
351         print "Received server packet\n";
352     } else {
353         print "Received client packet\n";
354     }
355
356     print "Packet length = ".length($packet)."\n";
357     print "Processing flight ".$self->flight."\n";
358
359     #Return contains the list of record found in the packet followed by the
360     #list of messages in those records
361     my @ret = TLSProxy::Record->get_records($server, $self->flight, $packet);
362     push @{$self->record_list}, @{$ret[0]};
363     push @{$self->{message_list}}, @{$ret[1]};
364
365     print "\n";
366
367     #Finished parsing. Call user provided filter here
368     if(defined $self->filter) {
369         $self->filter->($self);
370     }
371
372     #Reconstruct the packet
373     $packet = "";
374     foreach my $record (@{$self->record_list}) {
375         #We only replay the records for the current flight
376         if ($record->flight != $self->flight) {
377             next;
378         }
379         $packet .= $record->reconstruct_record();
380     }
381
382     $self->{flight} = $self->{flight} + 1;
383
384     print "Forwarded packet length = ".length($packet)."\n\n";
385
386     return $packet;
387 }
388
389 #Read accessors
390 sub execute
391 {
392     my $self = shift;
393     return $self->{execute};
394 }
395 sub cert
396 {
397     my $self = shift;
398     return $self->{cert};
399 }
400 sub debug
401 {
402     my $self = shift;
403     return $self->{debug};
404 }
405 sub flight
406 {
407     my $self = shift;
408     return $self->{flight};
409 }
410 sub record_list
411 {
412     my $self = shift;
413     return $self->{record_list};
414 }
415 sub success
416 {
417     my $self = shift;
418     return $self->{success};
419 }
420 sub end
421 {
422     my $self = shift;
423     return $self->{end};
424 }
425 sub supports_IPv6
426 {
427     my $self = shift;
428     return $have_IPv6;
429 }
430
431 #Read/write accessors
432 sub proxy_addr
433 {
434     my $self = shift;
435     if (@_) {
436       $self->{proxy_addr} = shift;
437     }
438     return $self->{proxy_addr};
439 }
440 sub proxy_port
441 {
442     my $self = shift;
443     if (@_) {
444       $self->{proxy_port} = shift;
445     }
446     return $self->{proxy_port};
447 }
448 sub server_addr
449 {
450     my $self = shift;
451     if (@_) {
452       $self->{server_addr} = shift;
453     }
454     return $self->{server_addr};
455 }
456 sub server_port
457 {
458     my $self = shift;
459     if (@_) {
460       $self->{server_port} = shift;
461     }
462     return $self->{server_port};
463 }
464 sub filter
465 {
466     my $self = shift;
467     if (@_) {
468       $self->{filter} = shift;
469     }
470     return $self->{filter};
471 }
472 sub cipherc
473 {
474     my $self = shift;
475     if (@_) {
476       $self->{cipherc} = shift;
477     }
478     return $self->{cipherc};
479 }
480 sub ciphers
481 {
482     my $self = shift;
483     if (@_) {
484       $self->{ciphers} = shift;
485     }
486     return $self->{ciphers};
487 }
488 sub serverflags
489 {
490     my $self = shift;
491     if (@_) {
492       $self->{serverflags} = shift;
493     }
494     return $self->{serverflags};
495 }
496 sub clientflags
497 {
498     my $self = shift;
499     if (@_) {
500       $self->{clientflags} = shift;
501     }
502     return $self->{clientflags};
503 }
504 sub serverconnects
505 {
506     my $self = shift;
507     if (@_) {
508       $self->{serverconnects} = shift;
509     }
510     return $self->{serverconnects};
511 }
512 # This is a bit ugly because the caller is responsible for keeping the records
513 # in sync with the updated message list; simply updating the message list isn't
514 # sufficient to get the proxy to forward the new message.
515 # But it does the trick for the one test (test_sslsessiontick) that needs it.
516 sub message_list
517 {
518     my $self = shift;
519     if (@_) {
520         $self->{message_list} = shift;
521     }
522     return $self->{message_list};
523 }
524 sub serverpid
525 {
526     my $self = shift;
527     if (@_) {
528       $self->{serverpid} = shift;
529     }
530     return $self->{serverpid};
531 }
532 1;