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