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