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