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