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