dab3d34357f7ebd9c646fe644dcd3797efaf44c2
[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             Proto => 'tcp'
265         );
266
267         $retry--;
268         if (!$server_sock) {
269             if ($retry) {
270                 #Sleep for a short while
271                 select(undef, undef, undef, 0.1);
272             } else {
273                 die "Failed to start up server (".$servaddr.",".$self->server_port."): $!\n";
274             }
275         }
276     } while (!$server_sock);
277
278     my $sel = IO::Select->new($server_sock, $client_sock);
279     my $indata;
280     my @handles = ($server_sock, $client_sock);
281
282     #Wait for either the server socket or the client socket to become readable
283     my @ready;
284     while(!(TLSProxy::Message->end) && (@ready = $sel->can_read)) {
285         foreach my $hand (@ready) {
286             if ($hand == $server_sock) {
287                 $server_sock->sysread($indata, 16384) or goto END;
288                 $indata = $self->process_packet(1, $indata);
289                 $client_sock->syswrite($indata);
290             } elsif ($hand == $client_sock) {
291                 $client_sock->sysread($indata, 16384) or goto END;
292                 $indata = $self->process_packet(0, $indata);
293                 $server_sock->syswrite($indata);
294             } else {
295                 print "Err\n";
296                 goto END;
297             }
298         }
299     }
300
301     END:
302     print "Connection closed\n";
303     if($server_sock) {
304         $server_sock->close();
305     }
306     if($client_sock) {
307         #Closing this also kills the child process
308         $client_sock->close();
309     }
310     if($proxy_sock) {
311         $proxy_sock->close();
312     }
313     if(!$self->debug) {
314         select($oldstdout);
315     }
316 }
317
318 sub process_packet
319 {
320     my ($self, $server, $packet) = @_;
321     my $len_real;
322     my $decrypt_len;
323     my $data;
324     my $recnum;
325
326     if ($server) {
327         print "Received server packet\n";
328     } else {
329         print "Received client packet\n";
330     }
331
332     print "Packet length = ".length($packet)."\n";
333     print "Processing flight ".$self->flight."\n";
334
335     #Return contains the list of record found in the packet followed by the
336     #list of messages in those records
337     my @ret = TLSProxy::Record->get_records($server, $self->flight, $packet);
338     push @{$self->record_list}, @{$ret[0]};
339     push @{$self->{message_list}}, @{$ret[1]};
340
341     print "\n";
342
343     #Finished parsing. Call user provided filter here
344     if(defined $self->filter) {
345         $self->filter->($self);
346     }
347
348     #Reconstruct the packet
349     $packet = "";
350     foreach my $record (@{$self->record_list}) {
351         #We only replay the records for the current flight
352         if ($record->flight != $self->flight) {
353             next;
354         }
355         $packet .= $record->reconstruct_record();
356     }
357
358     $self->{flight} = $self->{flight} + 1;
359
360     print "Forwarded packet length = ".length($packet)."\n\n";
361
362     return $packet;
363 }
364
365 #Read accessors
366 sub execute
367 {
368     my $self = shift;
369     return $self->{execute};
370 }
371 sub cert
372 {
373     my $self = shift;
374     return $self->{cert};
375 }
376 sub debug
377 {
378     my $self = shift;
379     return $self->{debug};
380 }
381 sub flight
382 {
383     my $self = shift;
384     return $self->{flight};
385 }
386 sub record_list
387 {
388     my $self = shift;
389     return $self->{record_list};
390 }
391 sub success
392 {
393     my $self = shift;
394     return $self->{success};
395 }
396 sub end
397 {
398     my $self = shift;
399     return $self->{end};
400 }
401 sub supports_IPv6
402 {
403     my $self = shift;
404     return $have_IPv6;
405 }
406
407 #Read/write accessors
408 sub proxy_addr
409 {
410     my $self = shift;
411     if (@_) {
412       $self->{proxy_addr} = shift;
413     }
414     return $self->{proxy_addr};
415 }
416 sub proxy_port
417 {
418     my $self = shift;
419     if (@_) {
420       $self->{proxy_port} = shift;
421     }
422     return $self->{proxy_port};
423 }
424 sub server_addr
425 {
426     my $self = shift;
427     if (@_) {
428       $self->{server_addr} = shift;
429     }
430     return $self->{server_addr};
431 }
432 sub server_port
433 {
434     my $self = shift;
435     if (@_) {
436       $self->{server_port} = shift;
437     }
438     return $self->{server_port};
439 }
440 sub filter
441 {
442     my $self = shift;
443     if (@_) {
444       $self->{filter} = shift;
445     }
446     return $self->{filter};
447 }
448 sub cipherc
449 {
450     my $self = shift;
451     if (@_) {
452       $self->{cipherc} = shift;
453     }
454     return $self->{cipherc};
455 }
456 sub ciphers
457 {
458     my $self = shift;
459     if (@_) {
460       $self->{ciphers} = shift;
461     }
462     return $self->{ciphers};
463 }
464 sub serverflags
465 {
466     my $self = shift;
467     if (@_) {
468       $self->{serverflags} = shift;
469     }
470     return $self->{serverflags};
471 }
472 sub clientflags
473 {
474     my $self = shift;
475     if (@_) {
476       $self->{clientflags} = shift;
477     }
478     return $self->{clientflags};
479 }
480 sub serverconnects
481 {
482     my $self = shift;
483     if (@_) {
484       $self->{serverconnects} = shift;
485     }
486     return $self->{serverconnects};
487 }
488 # This is a bit ugly because the caller is responsible for keeping the records
489 # in sync with the updated message list; simply updating the message list isn't
490 # sufficient to get the proxy to forward the new message.
491 # But it does the trick for the one test (test_sslsessiontick) that needs it.
492 sub message_list
493 {
494     my $self = shift;
495     if (@_) {
496         $self->{message_list} = shift;
497     }
498     return $self->{message_list};
499 }
500 1;