util/TLSProxy/Proxy.pm

   1 # Copyright 2016 The OpenSSL Project Authors. All Rights Reserved.
   2 #
   3 # Licensed under the OpenSSL license (the "License").  You may not use
   4 # this file except in compliance with the License.  You can obtain a copy
   5 # in the file LICENSE in the source distribution or at
   6 # https://www.openssl.org/source/license.html
   7
   8 use strict;
   9 use POSIX ":sys_wait_h";
  10
  11 package TLSProxy::Proxy;
  12
  13 use File::Spec;
  14 use IO::Socket;
  15 use IO::Select;
  16 use TLSProxy::Record;
  17 use TLSProxy::Message;
  18 use TLSProxy::ClientHello;
  19 use TLSProxy::ServerHello;
  20 use TLSProxy::ServerKeyExchange;
  21 use TLSProxy::NewSessionTicket;
  22
  23 my $have_IPv6 = 0;
  24 my $IP_factory;
  25
  26 sub new
  27 {
  28     my $class = shift;
  29     my ($filter,
  30         $execute,
  31         $cert,
  32         $debug) = @_;
  33
  34     my $self = {
  35         #Public read/write
  36         proxy_addr => "localhost",
  37         proxy_port => 4453,
  38         server_addr => "localhost",
  39         server_port => 4443,
  40         filter => $filter,
  41         serverflags => "",
  42         clientflags => "",
  43         serverconnects => 1,
  44         serverpid => 0,
  45         reneg => 0,
  46
  47         #Public read
  48         execute => $execute,
  49         cert => $cert,
  50         debug => $debug,
  51         cipherc => "",
  52         ciphers => "AES128-SHA",
  53         flight => 0,
  54         record_list => [],
  55         message_list => [],
  56     };
  57
  58     # IO::Socket::IP is on the core module list, IO::Socket::INET6 isn't.
  59     # However, IO::Socket::INET6 is older and is said to be more widely
  60     # deployed for the moment, and may have less bugs, so we try the latter
  61     # first, then fall back on the code modules.  Worst case scenario, we
  62     # fall back to IO::Socket::INET, only supports IPv4.
  63     eval {
  64         require IO::Socket::INET6;
  65         my $s = IO::Socket::INET6->new(
  66             LocalAddr => "::1",
  67             LocalPort => 0,
  68             Listen=>1,
  69             );
  70         $s or die "\n";
  71         $s->close();
  72     };
  73     if ($@ eq "") {
  74         $IP_factory = sub { IO::Socket::INET6->new(@_); };
  75         $have_IPv6 = 1;
  76     } else {
  77         eval {
  78             require IO::Socket::IP;
  79             my $s = IO::Socket::IP->new(
  80                 LocalAddr => "::1",
  81                 LocalPort => 0,
  82                 Listen=>1,
  83                 );
  84             $s or die "\n";
  85             $s->close();
  86         };
  87         if ($@ eq "") {
  88             $IP_factory = sub { IO::Socket::IP->new(@_); };
  89             $have_IPv6 = 1;
  90         } else {
  91             $IP_factory = sub { IO::Socket::INET->new(@_); };
  92         }
  93     }
  94
  95     return bless $self, $class;
  96 }
  97
  98 sub clearClient
  99 {
 100     my $self = shift;
 101
 102     $self->{cipherc} = "";
 103     $self->{flight} = 0;
 104     $self->{record_list} = [];
 105     $self->{message_list} = [];
 106     $self->{clientflags} = "";
 107
 108     TLSProxy::Message->clear();
 109     TLSProxy::Record->clear();
 110 }
 111
 112 sub clear
 113 {
 114     my $self = shift;
 115
 116     $self->clearClient;
 117     $self->{ciphers} = "AES128-SHA";
 118     $self->{serverflags} = "";
 119     $self->{serverconnects} = 1;
 120     $self->{serverpid} = 0;
 121     $self->{reneg} = 0;
 122 }
 123
 124 sub restart
 125 {
 126     my $self = shift;
 127
 128     $self->clear;
 129     $self->start;
 130 }
 131
 132 sub clientrestart
 133 {
 134     my $self = shift;
 135
 136     $self->clear;
 137     $self->clientstart;
 138 }
 139
 140 sub start
 141 {
 142     my ($self) = shift;
 143     my $pid;
 144
 145     $pid = fork();
 146     if ($pid == 0) {
 147         if (!$self->debug) {
 148             open(STDOUT, ">", File::Spec->devnull())
 149                 or die "Failed to redirect stdout: $!";
 150             open(STDERR, ">&STDOUT");
 151         }
 152         my $execcmd = $self->execute
 153             ." s_server -no_comp -rev -engine ossltest -accept "
 154             .($self->server_port)
 155             ." -cert ".$self->cert." -naccept ".$self->serverconnects;
 156         if ($self->ciphers ne "") {
 157             $execcmd .= " -cipher ".$self->ciphers;
 158         }
 159         if ($self->serverflags ne "") {
 160             $execcmd .= " ".$self->serverflags;
 161         }
 162         exec($execcmd);
 163     }
 164     $self->serverpid($pid);
 165
 166     return $self->clientstart;
 167 }
 168
 169 sub clientstart
 170 {
 171     my ($self) = shift;
 172     my $oldstdout;
 173
 174     if(!$self->debug) {
 175         open DEVNULL, ">", File::Spec->devnull();
 176         $oldstdout = select(DEVNULL);
 177     }
 178
 179     # Create the Proxy socket
 180     my $proxaddr = $self->proxy_addr;
 181     $proxaddr =~ s/[\[\]]//g; # Remove [ and ]
 182     my $proxy_sock = $IP_factory->(
 183         LocalHost   => $proxaddr,
 184         LocalPort   => $self->proxy_port,
 185         Proto       => "tcp",
 186         Listen      => SOMAXCONN,
 187         ReuseAddr   => 1
 188     );
 189
 190     if ($proxy_sock) {
 191         print "Proxy started on port ".$self->proxy_port."\n";
 192     } else {
 193         warn "Failed creating proxy socket (".$proxaddr.",".$self->proxy_port."): $!\n";
 194         return 0;
 195     }
 196
 197     if ($self->execute) {
 198         my $pid = fork();
 199         if ($pid == 0) {
 200             if (!$self->debug) {
 201                 open(STDOUT, ">", File::Spec->devnull())
 202                     or die "Failed to redirect stdout: $!";
 203                 open(STDERR, ">&STDOUT");
 204             }
 205             my $echostr;
 206             if ($self->reneg()) {
 207                 $echostr = "R";
 208             } else {
 209                 $echostr = "test";
 210             }
 211             my $execcmd = "echo ".$echostr." | ".$self->execute
 212                  ." s_client -engine ossltest -connect "
 213                  .($self->proxy_addr).":".($self->proxy_port);
 214             if ($self->cipherc ne "") {
 215                 $execcmd .= " -cipher ".$self->cipherc;
 216             }
 217             if ($self->clientflags ne "") {
 218                 $execcmd .= " ".$self->clientflags;
 219             }
 220             exec($execcmd);
 221         }
 222     }
 223
 224     # Wait for incoming connection from client
 225     my $client_sock;
 226     if(!($client_sock = $proxy_sock->accept())) {
 227         warn "Failed accepting incoming connection: $!\n";
 228         return 0;
 229     }
 230
 231     print "Connection opened\n";
 232
 233     # Now connect to the server
 234     my $retry = 3;
 235     my $server_sock;
 236     #We loop over this a few times because sometimes s_server can take a while
 237     #to start up
 238     do {
 239         my $servaddr = $self->server_addr;
 240         $servaddr =~ s/[\[\]]//g; # Remove [ and ]
 241         eval {
 242             $server_sock = $IP_factory->(
 243                 PeerAddr => $servaddr,
 244                 PeerPort => $self->server_port,
 245                 MultiHomed => 1,
 246                 Proto => 'tcp'
 247             );
 248         };
 249
 250         $retry--;
 251         #Some buggy IP factories can return a defined server_sock that hasn't
 252         #actually connected, so we check peerport too
 253         if ($@ || !defined($server_sock) || !defined($server_sock->peerport)) {
 254             $server_sock->close() if defined($server_sock);
 255             undef $server_sock;
 256             if ($retry) {
 257                 #Sleep for a short while
 258                 select(undef, undef, undef, 0.1);
 259             } else {
 260                 warn "Failed to start up server (".$servaddr.",".$self->server_port."): $!\n";
 261                 return 0;
 262             }
 263         }
 264     } while (!$server_sock);
 265
 266     my $sel = IO::Select->new($server_sock, $client_sock);
 267     my $indata;
 268     my @handles = ($server_sock, $client_sock);
 269
 270     #Wait for either the server socket or the client socket to become readable
 271     my @ready;
 272     while(!(TLSProxy::Message->end) && (@ready = $sel->can_read)) {
 273         foreach my $hand (@ready) {
 274             if ($hand == $server_sock) {
 275                 $server_sock->sysread($indata, 16384) or goto END;
 276                 $indata = $self->process_packet(1, $indata);
 277                 $client_sock->syswrite($indata);
 278             } elsif ($hand == $client_sock) {
 279                 $client_sock->sysread($indata, 16384) or goto END;
 280                 $indata = $self->process_packet(0, $indata);
 281                 $server_sock->syswrite($indata);
 282             } else {
 283                 print "Err\n";
 284                 goto END;
 285             }
 286         }
 287     }
 288
 289     END:
 290     print "Connection closed\n";
 291     if($server_sock) {
 292         $server_sock->close();
 293     }
 294     if($client_sock) {
 295         #Closing this also kills the child process
 296         $client_sock->close();
 297     }
 298     if($proxy_sock) {
 299         $proxy_sock->close();
 300     }
 301     if(!$self->debug) {
 302         select($oldstdout);
 303     }
 304     $self->serverconnects($self->serverconnects - 1);
 305     if ($self->serverconnects == 0) {
 306         die "serverpid is zero\n" if $self->serverpid == 0;
 307         print "Waiting for server process to close: "
 308               .$self->serverpid."\n";
 309         waitpid( $self->serverpid, 0);
 310         die "exit code $? from server process\n" if $? != 0;
 311     }
 312     return 1;
 313 }
 314
 315 sub process_packet
 316 {
 317     my ($self, $server, $packet) = @_;
 318     my $len_real;
 319     my $decrypt_len;
 320     my $data;
 321     my $recnum;
 322
 323     if ($server) {
 324         print "Received server packet\n";
 325     } else {
 326         print "Received client packet\n";
 327     }
 328
 329     print "Packet length = ".length($packet)."\n";
 330     print "Processing flight ".$self->flight."\n";
 331
 332     #Return contains the list of record found in the packet followed by the
 333     #list of messages in those records
 334     my @ret = TLSProxy::Record->get_records($server, $self->flight, $packet);
 335     push @{$self->record_list}, @{$ret[0]};
 336     push @{$self->{message_list}}, @{$ret[1]};
 337
 338     print "\n";
 339
 340     #Finished parsing. Call user provided filter here
 341     if(defined $self->filter) {
 342         $self->filter->($self);
 343     }
 344
 345     #Reconstruct the packet
 346     $packet = "";
 347     foreach my $record (@{$self->record_list}) {
 348         #We only replay the records for the current flight
 349         if ($record->flight != $self->flight) {
 350             next;
 351         }
 352         $packet .= $record->reconstruct_record();
 353     }
 354
 355     $self->{flight} = $self->{flight} + 1;
 356
 357     print "Forwarded packet length = ".length($packet)."\n\n";
 358
 359     return $packet;
 360 }
 361
 362 #Read accessors
 363 sub execute
 364 {
 365     my $self = shift;
 366     return $self->{execute};
 367 }
 368 sub cert
 369 {
 370     my $self = shift;
 371     return $self->{cert};
 372 }
 373 sub debug
 374 {
 375     my $self = shift;
 376     return $self->{debug};
 377 }
 378 sub flight
 379 {
 380     my $self = shift;
 381     return $self->{flight};
 382 }
 383 sub record_list
 384 {
 385     my $self = shift;
 386     return $self->{record_list};
 387 }
 388 sub success
 389 {
 390     my $self = shift;
 391     return $self->{success};
 392 }
 393 sub end
 394 {
 395     my $self = shift;
 396     return $self->{end};
 397 }
 398 sub supports_IPv6
 399 {
 400     my $self = shift;
 401     return $have_IPv6;
 402 }
 403
 404 #Read/write accessors
 405 sub proxy_addr
 406 {
 407     my $self = shift;
 408     if (@_) {
 409       $self->{proxy_addr} = shift;
 410     }
 411     return $self->{proxy_addr};
 412 }
 413 sub proxy_port
 414 {
 415     my $self = shift;
 416     if (@_) {
 417       $self->{proxy_port} = shift;
 418     }
 419     return $self->{proxy_port};
 420 }
 421 sub server_addr
 422 {
 423     my $self = shift;
 424     if (@_) {
 425       $self->{server_addr} = shift;
 426     }
 427     return $self->{server_addr};
 428 }
 429 sub server_port
 430 {
 431     my $self = shift;
 432     if (@_) {
 433       $self->{server_port} = shift;
 434     }
 435     return $self->{server_port};
 436 }
 437 sub filter
 438 {
 439     my $self = shift;
 440     if (@_) {
 441       $self->{filter} = shift;
 442     }
 443     return $self->{filter};
 444 }
 445 sub cipherc
 446 {
 447     my $self = shift;
 448     if (@_) {
 449       $self->{cipherc} = shift;
 450     }
 451     return $self->{cipherc};
 452 }
 453 sub ciphers
 454 {
 455     my $self = shift;
 456     if (@_) {
 457       $self->{ciphers} = shift;
 458     }
 459     return $self->{ciphers};
 460 }
 461 sub serverflags
 462 {
 463     my $self = shift;
 464     if (@_) {
 465       $self->{serverflags} = shift;
 466     }
 467     return $self->{serverflags};
 468 }
 469 sub clientflags
 470 {
 471     my $self = shift;
 472     if (@_) {
 473       $self->{clientflags} = shift;
 474     }
 475     return $self->{clientflags};
 476 }
 477 sub serverconnects
 478 {
 479     my $self = shift;
 480     if (@_) {
 481       $self->{serverconnects} = shift;
 482     }
 483     return $self->{serverconnects};
 484 }
 485 # This is a bit ugly because the caller is responsible for keeping the records
 486 # in sync with the updated message list; simply updating the message list isn't
 487 # sufficient to get the proxy to forward the new message.
 488 # But it does the trick for the one test (test_sslsessiontick) that needs it.
 489 sub message_list
 490 {
 491     my $self = shift;
 492     if (@_) {
 493         $self->{message_list} = shift;
 494     }
 495     return $self->{message_list};
 496 }
 497 sub serverpid
 498 {
 499     my $self = shift;
 500     if (@_) {
 501       $self->{serverpid} = shift;
 502     }
 503     return $self->{serverpid};
 504 }
 505
 506 sub fill_known_data
 507 {
 508     my $length = shift;
 509     my $ret = "";
 510     for (my $i = 0; $i < $length; $i++) {
 511         $ret .= chr($i);
 512     }
 513     return $ret;
 514 }
 515
 516 sub reneg
 517 {
 518     my $self = shift;
 519     if (@_) {
 520       $self->{reneg} = shift;
 521     }
 522     return $self->{reneg};
 523 }
 524
 525 1;