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