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