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