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