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