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