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