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