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