Add a test to check the EC point formats extension appears when we expect
[openssl.git] / util / TLSProxy / Proxy.pm
1 # Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
2 #
3 # Licensed under the OpenSSL license (the "License").  You may not use
4 # this file except in compliance with the License.  You can obtain a copy
5 # in the file LICENSE in the source distribution or at
6 # https://www.openssl.org/source/license.html
7
8 use strict;
9 use POSIX ":sys_wait_h";
10
11 package TLSProxy::Proxy;
12
13 use File::Spec;
14 use IO::Socket;
15 use IO::Select;
16 use TLSProxy::Record;
17 use TLSProxy::Message;
18 use TLSProxy::ClientHello;
19 use TLSProxy::ServerHello;
20 use TLSProxy::EncryptedExtensions;
21 use TLSProxy::ServerKeyExchange;
22 use TLSProxy::NewSessionTicket;
23
24 my $have_IPv6 = 0;
25 my $IP_factory;
26
27 my $is_tls13 = 0;
28 my $ciphersuite = undef;
29
30 sub new
31 {
32     my $class = shift;
33     my ($filter,
34         $execute,
35         $cert,
36         $debug) = @_;
37
38     my $self = {
39         #Public read/write
40         proxy_addr => "localhost",
41         proxy_port => 4453,
42         server_addr => "localhost",
43         server_port => 4443,
44         filter => $filter,
45         serverflags => "",
46         clientflags => "",
47         serverconnects => 1,
48         serverpid => 0,
49         reneg => 0,
50
51         #Public read
52         execute => $execute,
53         cert => $cert,
54         debug => $debug,
55         cipherc => "",
56         ciphers => "AES128-SHA:TLS13-AES-128-GCM-SHA256",
57         flight => 0,
58         record_list => [],
59         message_list => [],
60     };
61
62     # IO::Socket::IP is on the core module list, IO::Socket::INET6 isn't.
63     # However, IO::Socket::INET6 is older and is said to be more widely
64     # deployed for the moment, and may have less bugs, so we try the latter
65     # first, then fall back on the code modules.  Worst case scenario, we
66     # fall back to IO::Socket::INET, only supports IPv4.
67     eval {
68         require IO::Socket::INET6;
69         my $s = IO::Socket::INET6->new(
70             LocalAddr => "::1",
71             LocalPort => 0,
72             Listen=>1,
73             );
74         $s or die "\n";
75         $s->close();
76     };
77     if ($@ eq "") {
78         $IP_factory = sub { IO::Socket::INET6->new(@_); };
79         $have_IPv6 = 1;
80     } else {
81         eval {
82             require IO::Socket::IP;
83             my $s = IO::Socket::IP->new(
84                 LocalAddr => "::1",
85                 LocalPort => 0,
86                 Listen=>1,
87                 );
88             $s or die "\n";
89             $s->close();
90         };
91         if ($@ eq "") {
92             $IP_factory = sub { IO::Socket::IP->new(@_); };
93             $have_IPv6 = 1;
94         } else {
95             $IP_factory = sub { IO::Socket::INET->new(@_); };
96         }
97     }
98
99     return bless $self, $class;
100 }
101
102 sub clearClient
103 {
104     my $self = shift;
105
106     $self->{cipherc} = "";
107     $self->{flight} = 0;
108     $self->{record_list} = [];
109     $self->{message_list} = [];
110     $self->{clientflags} = "";
111     $is_tls13 = 0;
112     $ciphersuite = undef;
113
114     TLSProxy::Message->clear();
115     TLSProxy::Record->clear();
116 }
117
118 sub clear
119 {
120     my $self = shift;
121
122     $self->clearClient;
123     $self->{ciphers} = "AES128-SHA:TLS13-AES-128-GCM-SHA256";
124     $self->{serverflags} = "";
125     $self->{serverconnects} = 1;
126     $self->{serverpid} = 0;
127     $self->{reneg} = 0;
128 }
129
130 sub restart
131 {
132     my $self = shift;
133
134     $self->clear;
135     $self->start;
136 }
137
138 sub clientrestart
139 {
140     my $self = shift;
141
142     $self->clear;
143     $self->clientstart;
144 }
145
146 sub start
147 {
148     my ($self) = shift;
149     my $pid;
150
151     $pid = fork();
152     if ($pid == 0) {
153         if (!$self->debug) {
154             open(STDOUT, ">", File::Spec->devnull())
155                 or die "Failed to redirect stdout: $!";
156             open(STDERR, ">&STDOUT");
157         }
158         my $execcmd = $self->execute
159             ." s_server -no_comp -rev -engine ossltest -accept "
160             .($self->server_port)
161             ." -cert ".$self->cert." -cert2 ".$self->cert
162             ." -naccept ".$self->serverconnects;
163         if ($self->ciphers ne "") {
164             $execcmd .= " -cipher ".$self->ciphers;
165         }
166         if ($self->serverflags ne "") {
167             $execcmd .= " ".$self->serverflags;
168         }
169         exec($execcmd);
170     }
171     $self->serverpid($pid);
172
173     return $self->clientstart;
174 }
175
176 sub clientstart
177 {
178     my ($self) = shift;
179     my $oldstdout;
180
181     if(!$self->debug) {
182         open DEVNULL, ">", File::Spec->devnull();
183         $oldstdout = select(DEVNULL);
184     }
185
186     # Create the Proxy socket
187     my $proxaddr = $self->proxy_addr;
188     $proxaddr =~ s/[\[\]]//g; # Remove [ and ]
189     my $proxy_sock = $IP_factory->(
190         LocalHost   => $proxaddr,
191         LocalPort   => $self->proxy_port,
192         Proto       => "tcp",
193         Listen      => SOMAXCONN,
194         ReuseAddr   => 1
195     );
196
197     if ($proxy_sock) {
198         print "Proxy started on port ".$self->proxy_port."\n";
199     } else {
200         warn "Failed creating proxy socket (".$proxaddr.",".$self->proxy_port."): $!\n";
201         return 0;
202     }
203
204     if ($self->execute) {
205         my $pid = fork();
206         if ($pid == 0) {
207             if (!$self->debug) {
208                 open(STDOUT, ">", File::Spec->devnull())
209                     or die "Failed to redirect stdout: $!";
210                 open(STDERR, ">&STDOUT");
211             }
212             my $echostr;
213             if ($self->reneg()) {
214                 $echostr = "R";
215             } else {
216                 $echostr = "test";
217             }
218             my $execcmd = "echo ".$echostr." | ".$self->execute
219                  ." s_client -engine ossltest -connect "
220                  .($self->proxy_addr).":".($self->proxy_port);
221             if ($self->cipherc ne "") {
222                 $execcmd .= " -cipher ".$self->cipherc;
223             }
224             if ($self->clientflags ne "") {
225                 $execcmd .= " ".$self->clientflags;
226             }
227             exec($execcmd);
228         }
229     }
230
231     # Wait for incoming connection from client
232     my $client_sock;
233     if(!($client_sock = $proxy_sock->accept())) {
234         warn "Failed accepting incoming connection: $!\n";
235         return 0;
236     }
237
238     print "Connection opened\n";
239
240     # Now connect to the server
241     my $retry = 3;
242     my $server_sock;
243     #We loop over this a few times because sometimes s_server can take a while
244     #to start up
245     do {
246         my $servaddr = $self->server_addr;
247         $servaddr =~ s/[\[\]]//g; # Remove [ and ]
248         eval {
249             $server_sock = $IP_factory->(
250                 PeerAddr => $servaddr,
251                 PeerPort => $self->server_port,
252                 MultiHomed => 1,
253                 Proto => 'tcp'
254             );
255         };
256
257         $retry--;
258         #Some buggy IP factories can return a defined server_sock that hasn't
259         #actually connected, so we check peerport too
260         if ($@ || !defined($server_sock) || !defined($server_sock->peerport)) {
261             $server_sock->close() if defined($server_sock);
262             undef $server_sock;
263             if ($retry) {
264                 #Sleep for a short while
265                 select(undef, undef, undef, 0.1);
266             } else {
267                 warn "Failed to start up server (".$servaddr.",".$self->server_port."): $!\n";
268                 return 0;
269             }
270         }
271     } while (!$server_sock);
272
273     my $sel = IO::Select->new($server_sock, $client_sock);
274     my $indata;
275     my @handles = ($server_sock, $client_sock);
276
277     #Wait for either the server socket or the client socket to become readable
278     my @ready;
279     while(!(TLSProxy::Message->end) && (@ready = $sel->can_read)) {
280         foreach my $hand (@ready) {
281             if ($hand == $server_sock) {
282                 $server_sock->sysread($indata, 16384) or goto END;
283                 $indata = $self->process_packet(1, $indata);
284                 $client_sock->syswrite($indata);
285             } elsif ($hand == $client_sock) {
286                 $client_sock->sysread($indata, 16384) or goto END;
287                 $indata = $self->process_packet(0, $indata);
288                 $server_sock->syswrite($indata);
289             } else {
290                 print "Err\n";
291                 goto END;
292             }
293         }
294     }
295
296     END:
297     print "Connection closed\n";
298     if($server_sock) {
299         $server_sock->close();
300     }
301     if($client_sock) {
302         #Closing this also kills the child process
303         $client_sock->close();
304     }
305     if($proxy_sock) {
306         $proxy_sock->close();
307     }
308     if(!$self->debug) {
309         select($oldstdout);
310     }
311     $self->serverconnects($self->serverconnects - 1);
312     if ($self->serverconnects == 0) {
313         die "serverpid is zero\n" if $self->serverpid == 0;
314         print "Waiting for server process to close: "
315               .$self->serverpid."\n";
316         waitpid( $self->serverpid, 0);
317     }
318     return 1;
319 }
320
321 sub process_packet
322 {
323     my ($self, $server, $packet) = @_;
324     my $len_real;
325     my $decrypt_len;
326     my $data;
327     my $recnum;
328
329     if ($server) {
330         print "Received server packet\n";
331     } else {
332         print "Received client packet\n";
333     }
334
335     print "Packet length = ".length($packet)."\n";
336     print "Processing flight ".$self->flight."\n";
337
338     #Return contains the list of record found in the packet followed by the
339     #list of messages in those records
340     my @ret = TLSProxy::Record->get_records($server, $self->flight, $packet);
341     push @{$self->record_list}, @{$ret[0]};
342     push @{$self->{message_list}}, @{$ret[1]};
343
344     print "\n";
345
346     #Finished parsing. Call user provided filter here
347     if(defined $self->filter) {
348         $self->filter->($self);
349     }
350
351     #Reconstruct the packet
352     $packet = "";
353     foreach my $record (@{$self->record_list}) {
354         #We only replay the records for the current flight
355         if ($record->flight != $self->flight) {
356             next;
357         }
358         $packet .= $record->reconstruct_record($server);
359     }
360
361     $self->{flight} = $self->{flight} + 1;
362
363     print "Forwarded packet length = ".length($packet)."\n\n";
364
365     return $packet;
366 }
367
368 #Read accessors
369 sub execute
370 {
371     my $self = shift;
372     return $self->{execute};
373 }
374 sub cert
375 {
376     my $self = shift;
377     return $self->{cert};
378 }
379 sub debug
380 {
381     my $self = shift;
382     return $self->{debug};
383 }
384 sub flight
385 {
386     my $self = shift;
387     return $self->{flight};
388 }
389 sub record_list
390 {
391     my $self = shift;
392     return $self->{record_list};
393 }
394 sub success
395 {
396     my $self = shift;
397     return $self->{success};
398 }
399 sub end
400 {
401     my $self = shift;
402     return $self->{end};
403 }
404 sub supports_IPv6
405 {
406     my $self = shift;
407     return $have_IPv6;
408 }
409
410 #Read/write accessors
411 sub proxy_addr
412 {
413     my $self = shift;
414     if (@_) {
415         $self->{proxy_addr} = shift;
416     }
417     return $self->{proxy_addr};
418 }
419 sub proxy_port
420 {
421     my $self = shift;
422     if (@_) {
423         $self->{proxy_port} = shift;
424     }
425     return $self->{proxy_port};
426 }
427 sub server_addr
428 {
429     my $self = shift;
430     if (@_) {
431         $self->{server_addr} = shift;
432     }
433     return $self->{server_addr};
434 }
435 sub server_port
436 {
437     my $self = shift;
438     if (@_) {
439         $self->{server_port} = shift;
440     }
441     return $self->{server_port};
442 }
443 sub filter
444 {
445     my $self = shift;
446     if (@_) {
447         $self->{filter} = shift;
448     }
449     return $self->{filter};
450 }
451 sub cipherc
452 {
453     my $self = shift;
454     if (@_) {
455         $self->{cipherc} = shift;
456     }
457     return $self->{cipherc};
458 }
459 sub ciphers
460 {
461     my $self = shift;
462     if (@_) {
463         $self->{ciphers} = shift;
464     }
465     return $self->{ciphers};
466 }
467 sub serverflags
468 {
469     my $self = shift;
470     if (@_) {
471         $self->{serverflags} = shift;
472     }
473     return $self->{serverflags};
474 }
475 sub clientflags
476 {
477     my $self = shift;
478     if (@_) {
479         $self->{clientflags} = shift;
480     }
481     return $self->{clientflags};
482 }
483 sub serverconnects
484 {
485     my $self = shift;
486     if (@_) {
487         $self->{serverconnects} = shift;
488     }
489     return $self->{serverconnects};
490 }
491 # This is a bit ugly because the caller is responsible for keeping the records
492 # in sync with the updated message list; simply updating the message list isn't
493 # sufficient to get the proxy to forward the new message.
494 # But it does the trick for the one test (test_sslsessiontick) that needs it.
495 sub message_list
496 {
497     my $self = shift;
498     if (@_) {
499         $self->{message_list} = shift;
500     }
501     return $self->{message_list};
502 }
503 sub serverpid
504 {
505     my $self = shift;
506     if (@_) {
507         $self->{serverpid} = shift;
508     }
509     return $self->{serverpid};
510 }
511
512 sub fill_known_data
513 {
514     my $length = shift;
515     my $ret = "";
516     for (my $i = 0; $i < $length; $i++) {
517         $ret .= chr($i);
518     }
519     return $ret;
520 }
521
522 sub is_tls13
523 {
524     my $class = shift;
525     if (@_) {
526         $is_tls13 = shift;
527     }
528     return $is_tls13;
529 }
530
531 sub reneg
532 {
533     my $self = shift;
534     if (@_) {
535         $self->{reneg} = shift;
536     }
537     return $self->{reneg};
538 }
539
540 sub ciphersuite
541 {
542     my $class = shift;
543     if (@_) {
544         $ciphersuite = shift;
545     }
546     return $ciphersuite;
547 }
548
549 1;