172445Sassar# Copyright 2016-2018 The OpenSSL Project Authors. All Rights Reserved. 2178825Sdfr# 3178825Sdfr# Licensed under the Apache License 2.0 (the "License"). You may not use 4233294Sstas# this file except in compliance with the License. You can obtain a copy 572445Sassar# in the file LICENSE in the source distribution or at 672445Sassar# https://www.openssl.org/source/license.html 772445Sassar 872445Sassaruse strict; 972445Sassaruse POSIX ":sys_wait_h"; 1072445Sassar 1172445Sassarpackage TLSProxy::Proxy; 1272445Sassar 1372445Sassaruse File::Spec; 1472445Sassaruse IO::Socket; 1572445Sassaruse IO::Select; 1672445Sassaruse TLSProxy::Record; 1772445Sassaruse TLSProxy::Message; 1872445Sassaruse TLSProxy::ClientHello; 1972445Sassaruse TLSProxy::ServerHello; 2072445Sassaruse TLSProxy::EncryptedExtensions; 2172445Sassaruse TLSProxy::Certificate; 2272445Sassaruse TLSProxy::CertificateRequest; 2372445Sassaruse TLSProxy::CertificateVerify; 2472445Sassaruse TLSProxy::ServerKeyExchange; 2572445Sassaruse TLSProxy::NewSessionTicket; 2672445Sassar 2772445Sassarmy $have_IPv6; 2872445Sassarmy $IP_factory; 2972445Sassar 3072445SassarBEGIN 3172445Sassar{ 3272445Sassar # IO::Socket::IP is on the core module list, IO::Socket::INET6 isn't. 3372445Sassar # However, IO::Socket::INET6 is older and is said to be more widely 3472445Sassar # deployed for the moment, and may have less bugs, so we try the latter 3572445Sassar # first, then fall back on the core modules. Worst case scenario, we 3672445Sassar # fall back to IO::Socket::INET, only supports IPv4. 3772445Sassar eval { 3872445Sassar require IO::Socket::INET6; 3978527Sassar my $s = IO::Socket::INET6->new( 4072445Sassar LocalAddr => "::1", 4172445Sassar LocalPort => 0, 42178825Sdfr Listen=>1, 4372445Sassar ); 44178825Sdfr $s or die "\n"; 45178825Sdfr $s->close(); 4672445Sassar }; 4772445Sassar if ($@ eq "") { 4872445Sassar $IP_factory = sub { IO::Socket::INET6->new(Domain => AF_INET6, @_); }; 49233294Sstas $have_IPv6 = 1; 5072445Sassar } else { 51178825Sdfr eval { 52178825Sdfr require IO::Socket::IP; 53178825Sdfr my $s = IO::Socket::IP->new( 54178825Sdfr LocalAddr => "::1", 55178825Sdfr LocalPort => 0, 56178825Sdfr Listen=>1, 57178825Sdfr ); 58178825Sdfr $s or die "\n"; 59178825Sdfr $s->close(); 60178825Sdfr }; 61178825Sdfr if ($@ eq "") { 62178825Sdfr $IP_factory = sub { IO::Socket::IP->new(@_); }; 63178825Sdfr $have_IPv6 = 1; 64178825Sdfr } else { 65178825Sdfr $IP_factory = sub { IO::Socket::INET->new(@_); }; 66178825Sdfr $have_IPv6 = 0; 67178825Sdfr } 68178825Sdfr } 69178825Sdfr} 70178825Sdfr 71178825Sdfrmy $is_tls13 = 0; 72178825Sdfrmy $ciphersuite = undef; 73178825Sdfr 74178825Sdfrsub new 75233294Sstas{ 76178825Sdfr my $class = shift; 77178825Sdfr my ($filter, 78178825Sdfr $execute, 79178825Sdfr $cert, 80178825Sdfr $debug) = @_; 81178825Sdfr 82178825Sdfr my $self = { 83178825Sdfr #Public read/write 84178825Sdfr proxy_addr => $have_IPv6 ? "[::1]" : "127.0.0.1", 85178825Sdfr filter => $filter, 86178825Sdfr serverflags => "", 87178825Sdfr clientflags => "", 88178825Sdfr serverconnects => 1, 89178825Sdfr reneg => 0, 90178825Sdfr sessionfile => undef, 91178825Sdfr 92178825Sdfr #Public read 93178825Sdfr proxy_port => 0, 94178825Sdfr server_port => 0, 95178825Sdfr serverpid => 0, 96178825Sdfr clientpid => 0, 97178825Sdfr execute => $execute, 98178825Sdfr cert => $cert, 9972445Sassar debug => $debug, 10072445Sassar cipherc => "", 10172445Sassar ciphersuitesc => "", 102178825Sdfr ciphers => "AES128-SHA", 103178825Sdfr ciphersuitess => "TLS_AES_128_GCM_SHA256", 104178825Sdfr flight => -1, 105178825Sdfr direction => -1, 106178825Sdfr partial => ["", ""], 107178825Sdfr record_list => [], 108178825Sdfr message_list => [], 109178825Sdfr }; 110178825Sdfr 111178825Sdfr # Create the Proxy socket 11272445Sassar my $proxaddr = $self->{proxy_addr}; 11372445Sassar $proxaddr =~ s/[\[\]]//g; # Remove [ and ] 11472445Sassar my @proxyargs = ( 115178825Sdfr LocalHost => $proxaddr, 116178825Sdfr LocalPort => 0, 117178825Sdfr Proto => "tcp", 118178825Sdfr Listen => SOMAXCONN, 119178825Sdfr ); 120178825Sdfr 121178825Sdfr if (my $sock = $IP_factory->(@proxyargs)) { 122233294Sstas $self->{proxy_sock} = $sock; 123233294Sstas $self->{proxy_port} = $sock->sockport(); 124233294Sstas $self->{proxy_addr} = $sock->sockhost(); 125178825Sdfr $self->{proxy_addr} =~ s/(.*:.*)/[$1]/; 126178825Sdfr print "Proxy started on port ", 127178825Sdfr "$self->{proxy_addr}:$self->{proxy_port}\n"; 128178825Sdfr # use same address for s_server 129178825Sdfr $self->{server_addr} = $self->{proxy_addr}; 130178825Sdfr } else { 131178825Sdfr warn "Failed creating proxy socket (".$proxaddr.",0): $!\n"; 132178825Sdfr } 133178825Sdfr 134178825Sdfr return bless $self, $class; 135178825Sdfr} 136178825Sdfr 137178825Sdfrsub DESTROY 138178825Sdfr{ 139178825Sdfr my $self = shift; 140178825Sdfr 141178825Sdfr $self->{proxy_sock}->close() if $self->{proxy_sock}; 142178825Sdfr} 143178825Sdfr 14472445Sassarsub clearClient 145127808Snectar{ 146178825Sdfr my $self = shift; 14772445Sassar 148127808Snectar $self->{cipherc} = ""; 14972445Sassar $self->{ciphersuitec} = ""; 150127808Snectar $self->{flight} = -1; 151127808Snectar $self->{direction} = -1; 152178825Sdfr $self->{partial} = ["", ""]; 15372445Sassar $self->{record_list} = []; 15472445Sassar $self->{message_list} = []; 15572445Sassar $self->{clientflags} = ""; 156127808Snectar $self->{sessionfile} = undef; 157127808Snectar $self->{clientpid} = 0; 158127808Snectar $is_tls13 = 0; 15972445Sassar $ciphersuite = undef; 16072445Sassar 16172445Sassar TLSProxy::Message->clear(); 16272445Sassar TLSProxy::Record->clear(); 163127808Snectar} 164127808Snectar 165127808Snectarsub clear 166127808Snectar{ 167127808Snectar my $self = shift; 168127808Snectar 169127808Snectar $self->clearClient; 170178825Sdfr $self->{ciphers} = "AES128-SHA"; 17172445Sassar $self->{ciphersuitess} = "TLS_AES_128_GCM_SHA256"; 172178825Sdfr $self->{serverflags} = ""; 173127808Snectar $self->{serverconnects} = 1; 174178825Sdfr $self->{serverpid} = 0; 17572445Sassar $self->{reneg} = 0; 176127808Snectar} 177127808Snectar 178127808Snectarsub restart 179127808Snectar{ 180127808Snectar my $self = shift; 181127808Snectar 182127808Snectar $self->clear; 18372445Sassar $self->start; 18472445Sassar} 185127808Snectar 186127808Snectarsub clientrestart 187127808Snectar{ 188127808Snectar my $self = shift; 189127808Snectar 190127808Snectar $self->clear; 191127808Snectar $self->clientstart; 192127808Snectar} 19372445Sassar 19472445Sassarsub connect_to_server 195127808Snectar{ 196127808Snectar my $self = shift; 197127808Snectar my $servaddr = $self->{server_addr}; 198127808Snectar 199127808Snectar $servaddr =~ s/[\[\]]//g; # Remove [ and ] 200127808Snectar 201127808Snectar my $sock = $IP_factory->(PeerAddr => $servaddr, 202127808Snectar PeerPort => $self->{server_port}, 203178825Sdfr Proto => 'tcp'); 204127808Snectar if (!defined($sock)) { 205127808Snectar my $err = $!; 206178825Sdfr kill(3, $self->{real_serverpid}); 207127808Snectar die "unable to connect: $err\n"; 208127808Snectar } 20972445Sassar 210178825Sdfr $self->{server_sock} = $sock; 211127808Snectar} 212178825Sdfr 213178825Sdfrsub start 214178825Sdfr{ 215127808Snectar my ($self) = shift; 216178825Sdfr my $pid; 217178825Sdfr 218178825Sdfr if ($self->{proxy_sock} == 0) { 219178825Sdfr return 0; 22072445Sassar } 221178825Sdfr 222178825Sdfr my $execcmd = $self->execute 223178825Sdfr ." s_server -max_protocol TLSv1.3 -no_comp -rev -engine ossltest" 224233294Sstas #In TLSv1.3 we issue two session tickets. The default session id 225178825Sdfr #callback gets confused because the ossltest engine causes the same 22672445Sassar #session id to be created twice due to the changed random number 227127808Snectar #generation. Using "-ext_cache" replaces the default callback with a 228178825Sdfr #different one that doesn't get confused. 229178825Sdfr ." -ext_cache" 230127808Snectar ." -accept $self->{server_addr}:0" 231178825Sdfr ." -cert ".$self->cert." -cert2 ".$self->cert 23272445Sassar ." -naccept ".$self->serverconnects; 233127808Snectar if ($self->ciphers ne "") { 23472445Sassar $execcmd .= " -cipher ".$self->ciphers; 23572445Sassar } 23672445Sassar if ($self->ciphersuitess ne "") { 23772445Sassar $execcmd .= " -ciphersuites ".$self->ciphersuitess; 23872445Sassar } 23972445Sassar if ($self->serverflags ne "") { 24072445Sassar $execcmd .= " ".$self->serverflags; 241178825Sdfr } 242127808Snectar if ($self->debug) { 24372445Sassar print STDERR "Server command: $execcmd\n"; 244127808Snectar } 245178825Sdfr 246127808Snectar open(my $savedin, "<&STDIN"); 24772445Sassar 248127808Snectar # Temporarily replace STDIN so that sink process can inherit it... 249178825Sdfr $pid = open(STDIN, "$execcmd 2>&1 |") or die "Failed to $execcmd: $!\n"; 25072445Sassar $self->{real_serverpid} = $pid; 251178825Sdfr 252178825Sdfr # Process the output from s_server until we find the ACCEPT line, which 253178825Sdfr # tells us what the accepting address and port are. 254127808Snectar while (<>) { 255178825Sdfr print; 256178825Sdfr s/\R$//; # Better chomp 257178825Sdfr next unless (/^ACCEPT\s.*:(\d+)$/); 258178825Sdfr $self->{server_port} = $1; 25972445Sassar last; 260178825Sdfr } 261178825Sdfr 262178825Sdfr if ($self->{server_port} == 0) { 263178825Sdfr # This actually means that s_server exited, because otherwise 264178825Sdfr # we would still searching for ACCEPT... 26572445Sassar waitpid($pid, 0); 266178825Sdfr die "no ACCEPT detected in '$execcmd' output: $?\n"; 267178825Sdfr } 26872445Sassar 26972445Sassar # Just make sure everything else is simply printed [as separate lines]. 27072445Sassar # The sub process simply inherits our STD* and will keep consuming 27172445Sassar # server's output and printing it as long as there is anything there, 27272445Sassar # out of our way. 27372445Sassar my $error; 27472445Sassar $pid = undef; 27572445Sassar if (eval { require Win32::Process; 1; }) { 27672445Sassar if (Win32::Process::Create(my $h, $^X, "perl -ne print", 0, 0, ".")) { 27772445Sassar $pid = $h->GetProcessID(); 27872445Sassar $self->{proc_handle} = $h; # hold handle till next round [or exit] 27972445Sassar } else { 28072445Sassar $error = Win32::FormatMessage(Win32::GetLastError()); 28172445Sassar } 28272445Sassar } else { 28372445Sassar if (defined($pid = fork)) { 28472445Sassar $pid or exec("$^X -ne print") or exit($!); 28572445Sassar } else { 28672445Sassar $error = $!; 28772445Sassar } 288178825Sdfr } 289178825Sdfr 290178825Sdfr # Change back to original stdin 291178825Sdfr open(STDIN, "<&", $savedin); 292178825Sdfr close($savedin); 293178825Sdfr 294178825Sdfr if (!defined($pid)) { 295178825Sdfr kill(3, $self->{real_serverpid}); 296178825Sdfr die "Failed to capture s_server's output: $error\n"; 297233294Sstas } 298233294Sstas 299233294Sstas $self->{serverpid} = $pid; 300178825Sdfr 301178825Sdfr print STDERR "Server responds on ", 302178825Sdfr "$self->{server_addr}:$self->{server_port}\n"; 303178825Sdfr 304178825Sdfr # Connect right away... 305178825Sdfr $self->connect_to_server(); 306178825Sdfr 30772445Sassar return $self->clientstart; 30872445Sassar} 30972445Sassar 310233294Sstassub clientstart 31172445Sassar{ 312233294Sstas my ($self) = shift; 313233294Sstas 314178825Sdfr if ($self->execute) { 31572445Sassar my $pid; 31672445Sassar my $execcmd = $self->execute 317178825Sdfr ." s_client -max_protocol TLSv1.3 -engine ossltest" 318233294Sstas ." -connect $self->{proxy_addr}:$self->{proxy_port}"; 319233294Sstas if ($self->cipherc ne "") { 320233294Sstas $execcmd .= " -cipher ".$self->cipherc; 321233294Sstas } 322233294Sstas if ($self->ciphersuitesc ne "") { 32372445Sassar $execcmd .= " -ciphersuites ".$self->ciphersuitesc; 324233294Sstas } 325233294Sstas if ($self->clientflags ne "") { 32672445Sassar $execcmd .= " ".$self->clientflags; 327233294Sstas } 328233294Sstas if ($self->clientflags !~ m/-(no)?servername/) { 329233294Sstas $execcmd .= " -servername localhost"; 33072445Sassar } 33172445Sassar if (defined $self->sessionfile) { 33272445Sassar $execcmd .= " -ign_eof"; 33372445Sassar } 33472445Sassar if ($self->debug) { 33572445Sassar print STDERR "Client command: $execcmd\n"; 336233294Sstas } 337233294Sstas 33872445Sassar open(my $savedout, ">&STDOUT"); 339233294Sstas # If we open pipe with new descriptor, attempt to close it, 340233294Sstas # explicitly or implicitly, would incur waitpid and effectively 341233294Sstas # dead-lock... 342233294Sstas if (!($pid = open(STDOUT, "| $execcmd"))) { 343233294Sstas my $err = $!; 34472445Sassar kill(3, $self->{real_serverpid}); 34572445Sassar die "Failed to $execcmd: $err\n"; 34672445Sassar } 34772445Sassar $self->{clientpid} = $pid; 34872445Sassar 34972445Sassar # queue [magic] input 35072445Sassar print $self->reneg ? "R" : "test"; 35172445Sassar 35272445Sassar # this closes client's stdin without waiting for its pid 35372445Sassar open(STDOUT, ">&", $savedout); 35472445Sassar close($savedout); 35572445Sassar } 35672445Sassar 35772445Sassar # Wait for incoming connection from client 358178825Sdfr my $fdset = IO::Select->new($self->{proxy_sock}); 35972445Sassar if (!$fdset->can_read(60)) { 36072445Sassar kill(3, $self->{real_serverpid}); 36172445Sassar die "s_client didn't try to connect\n"; 36272445Sassar } 36372445Sassar 36472445Sassar my $client_sock; 36572445Sassar if(!($client_sock = $self->{proxy_sock}->accept())) { 36672445Sassar warn "Failed accepting incoming connection: $!\n"; 36772445Sassar return 0; 36872445Sassar } 36972445Sassar 37072445Sassar print "Connection opened\n"; 37172445Sassar 37272445Sassar my $server_sock = $self->{server_sock}; 37372445Sassar my $indata; 374233294Sstas 375233294Sstas #Wait for either the server socket or the client socket to become readable 376233294Sstas $fdset = IO::Select->new($server_sock, $client_sock); 377233294Sstas my @ready; 378233294Sstas my $ctr = 0; 379233294Sstas local $SIG{PIPE} = "IGNORE"; 380233294Sstas $self->{saw_session_ticket} = undef; 381233294Sstas while($fdset->count && $ctr < 10) { 38272445Sassar if (defined($self->{sessionfile})) { 383178825Sdfr # s_client got -ign_eof and won't be exiting voluntarily, so we 38472445Sassar # look for data *and* session ticket... 38572445Sassar last if TLSProxy::Message->success() 38672445Sassar && $self->{saw_session_ticket}; 38772445Sassar } 38872445Sassar if (!(@ready = $fdset->can_read(1))) { 38972445Sassar $ctr++; 390178825Sdfr next; 39172445Sassar } 392178825Sdfr foreach my $hand (@ready) { 39372445Sassar if ($hand == $server_sock) { 394178825Sdfr if ($server_sock->sysread($indata, 16384)) { 395178825Sdfr if ($indata = $self->process_packet(1, $indata)) { 396178825Sdfr $client_sock->syswrite($indata) or goto END; 397178825Sdfr } 398178825Sdfr $ctr = 0; 399233294Sstas } else { 400178825Sdfr $fdset->remove($server_sock); 401178825Sdfr $client_sock->shutdown(SHUT_WR); 402178825Sdfr } 40372445Sassar } elsif ($hand == $client_sock) { 404178825Sdfr if ($client_sock->sysread($indata, 16384)) { 405233294Sstas if ($indata = $self->process_packet(0, $indata)) { 406178825Sdfr $server_sock->syswrite($indata) or goto END; 40772445Sassar } 408178825Sdfr $ctr = 0; 409178825Sdfr } else { 410233294Sstas $fdset->remove($client_sock); 411233294Sstas $server_sock->shutdown(SHUT_WR); 412233294Sstas } 413233294Sstas } else { 414178825Sdfr kill(3, $self->{real_serverpid}); 415233294Sstas die "Unexpected handle"; 416178825Sdfr } 417233294Sstas } 418178825Sdfr } 419233294Sstas 420178825Sdfr if ($ctr >= 10) { 421233294Sstas kill(3, $self->{real_serverpid}); 422178825Sdfr die "No progress made"; 423178825Sdfr } 424233294Sstas 42572445Sassar END: 426178825Sdfr print "Connection closed\n"; 427178825Sdfr if($server_sock) { 428178825Sdfr $server_sock->close(); 429178825Sdfr $self->{server_sock} = undef; 430178825Sdfr } 431233294Sstas if($client_sock) { 432178825Sdfr #Closing this also kills the child process 433178825Sdfr $client_sock->close(); 434178825Sdfr } 435178825Sdfr 436178825Sdfr my $pid; 437178825Sdfr if (--$self->{serverconnects} == 0) { 438178825Sdfr $pid = $self->{serverpid}; 439178825Sdfr print "Waiting for 'perl -ne print' process to close: $pid...\n"; 440178825Sdfr $pid = waitpid($pid, 0); 441178825Sdfr if ($pid > 0) { 442178825Sdfr die "exit code $? from 'perl -ne print' process\n" if $? != 0; 443178825Sdfr } elsif ($pid == 0) { 444178825Sdfr kill(3, $self->{real_serverpid}); 44572445Sassar die "lost control over $self->{serverpid}?"; 44672445Sassar } 44772445Sassar $pid = $self->{real_serverpid}; 44872445Sassar print "Waiting for s_server process to close: $pid...\n"; 44972445Sassar # it's done already, just collect the exit code [and reap]... 450178825Sdfr waitpid($pid, 0); 45172445Sassar die "exit code $? from s_server process\n" if $? != 0; 452233294Sstas } else { 453178825Sdfr # It's a bit counter-intuitive spot to make next connection to 454178825Sdfr # the s_server. Rationale is that established connection works 455233294Sstas # as synchronization point, in sense that this way we know that 456178825Sdfr # s_server is actually done with current session... 457178825Sdfr $self->connect_to_server(); 458178825Sdfr } 459178825Sdfr $pid = $self->{clientpid}; 46072445Sassar print "Waiting for s_client process to close: $pid...\n"; 461178825Sdfr waitpid($pid, 0); 462178825Sdfr 463178825Sdfr return 1; 464178825Sdfr} 46572445Sassar 466178825Sdfrsub process_packet 467178825Sdfr{ 468178825Sdfr my ($self, $server, $packet) = @_; 469178825Sdfr my $len_real; 47072445Sassar my $decrypt_len; 47172445Sassar my $data; 47272445Sassar my $recnum; 473233294Sstas 474178825Sdfr if ($server) { 475178825Sdfr print "Received server packet\n"; 476178825Sdfr } else { 477178825Sdfr print "Received client packet\n"; 478178825Sdfr } 479178825Sdfr 480178825Sdfr if ($self->{direction} != $server) { 481178825Sdfr $self->{flight} = $self->{flight} + 1; 482178825Sdfr $self->{direction} = $server; 483178825Sdfr } 484178825Sdfr 485178825Sdfr print "Packet length = ".length($packet)."\n"; 486178825Sdfr print "Processing flight ".$self->flight."\n"; 487178825Sdfr 488178825Sdfr #Return contains the list of record found in the packet followed by the 489178825Sdfr #list of messages in those records and any partial message 49072445Sassar my @ret = TLSProxy::Record->get_records($server, $self->flight, 491178825Sdfr $self->{partial}[$server].$packet); 492178825Sdfr $self->{partial}[$server] = $ret[2]; 493178825Sdfr push @{$self->{record_list}}, @{$ret[0]}; 494178825Sdfr push @{$self->{message_list}}, @{$ret[1]}; 495178825Sdfr 496178825Sdfr print "\n"; 497178825Sdfr 498178825Sdfr if (scalar(@{$ret[0]}) == 0 or length($ret[2]) != 0) { 499178825Sdfr return ""; 500178825Sdfr } 50172445Sassar 50272445Sassar #Finished parsing. Call user provided filter here 50372445Sassar if (defined $self->filter) { 50472445Sassar $self->filter->($self); 505178825Sdfr } 506178825Sdfr 507233294Sstas #Take a note on NewSessionTicket 508178825Sdfr foreach my $message (reverse @{$self->{message_list}}) { 509178825Sdfr if ($message->{mt} == TLSProxy::Message::MT_NEW_SESSION_TICKET) { 51072445Sassar $self->{saw_session_ticket} = 1; 51172445Sassar last; 51272445Sassar } 513178825Sdfr } 514178825Sdfr 515178825Sdfr #Reconstruct the packet 516178825Sdfr $packet = ""; 517178825Sdfr foreach my $record (@{$self->record_list}) { 518178825Sdfr $packet .= $record->reconstruct_record($server); 519178825Sdfr } 52072445Sassar 52172445Sassar print "Forwarded packet length = ".length($packet)."\n\n"; 52272445Sassar 52372445Sassar return $packet; 524178825Sdfr} 525178825Sdfr 526233294Sstas#Read accessors 527178825Sdfrsub execute 528178825Sdfr{ 529178825Sdfr my $self = shift; 530178825Sdfr return $self->{execute}; 531178825Sdfr} 532178825Sdfrsub cert 533178825Sdfr{ 534178825Sdfr my $self = shift; 535233294Sstas return $self->{cert}; 536178825Sdfr} 537178825Sdfrsub debug 538178825Sdfr{ 53972445Sassar my $self = shift; 540178825Sdfr return $self->{debug}; 54172445Sassar} 54272445Sassarsub flight 543178825Sdfr{ 544178825Sdfr my $self = shift; 545178825Sdfr return $self->{flight}; 546178825Sdfr} 547178825Sdfrsub record_list 548178825Sdfr{ 549178825Sdfr my $self = shift; 550178825Sdfr return $self->{record_list}; 55172445Sassar} 552178825Sdfrsub success 553178825Sdfr{ 554178825Sdfr my $self = shift; 555233294Sstas return $self->{success}; 556178825Sdfr} 557178825Sdfrsub end 558178825Sdfr{ 559178825Sdfr my $self = shift; 56072445Sassar return $self->{end}; 56172445Sassar} 56272445Sassarsub supports_IPv6 563178825Sdfr{ 564178825Sdfr my $self = shift; 565178825Sdfr return $have_IPv6; 566178825Sdfr} 567178825Sdfrsub proxy_addr 568233294Sstas{ 569178825Sdfr my $self = shift; 570178825Sdfr return $self->{proxy_addr}; 57172445Sassar} 57272445Sassarsub proxy_port 57372445Sassar{ 574178825Sdfr my $self = shift; 57572445Sassar return $self->{proxy_port}; 576178825Sdfr} 577178825Sdfrsub server_addr 578178825Sdfr{ 579178825Sdfr my $self = shift; 580178825Sdfr return $self->{server_addr}; 581233294Sstas} 582178825Sdfrsub server_port 583178825Sdfr{ 58472445Sassar my $self = shift; 58572445Sassar return $self->{server_port}; 58672445Sassar} 58772445Sassarsub serverpid 588178825Sdfr{ 589178825Sdfr my $self = shift; 590178825Sdfr return $self->{serverpid}; 59172445Sassar} 592178825Sdfrsub clientpid 593178825Sdfr{ 594178825Sdfr my $self = shift; 595178825Sdfr return $self->{clientpid}; 596178825Sdfr} 59772445Sassar 59872445Sassar#Read/write accessors 59972445Sassarsub filter 600178825Sdfr{ 601178825Sdfr my $self = shift; 602178825Sdfr if (@_) { 603178825Sdfr $self->{filter} = shift; 604178825Sdfr } 605178825Sdfr return $self->{filter}; 606178825Sdfr} 607178825Sdfrsub cipherc 608178825Sdfr{ 60972445Sassar my $self = shift; 61072445Sassar if (@_) { 61172445Sassar $self->{cipherc} = shift; 612178825Sdfr } 613178825Sdfr return $self->{cipherc}; 614233294Sstas} 615233294Sstassub ciphersuitesc 616233294Sstas{ 61772445Sassar my $self = shift; 618178825Sdfr if (@_) { 619178825Sdfr $self->{ciphersuitesc} = shift; 620178825Sdfr } 62172445Sassar return $self->{ciphersuitesc}; 62272445Sassar} 62372445Sassarsub ciphers 624178825Sdfr{ 625178825Sdfr my $self = shift; 626178825Sdfr if (@_) { 627178825Sdfr $self->{ciphers} = shift; 628178825Sdfr } 629178825Sdfr return $self->{ciphers}; 630233294Sstas} 631233294Sstassub ciphersuitess 632178825Sdfr{ 633178825Sdfr my $self = shift; 634178825Sdfr if (@_) { 635178825Sdfr $self->{ciphersuitess} = shift; 636178825Sdfr } 637233294Sstas return $self->{ciphersuitess}; 638178825Sdfr} 639178825Sdfrsub serverflags 640178825Sdfr{ 641178825Sdfr my $self = shift; 642233294Sstas if (@_) { 643233294Sstas $self->{serverflags} = shift; 644178825Sdfr } 64572445Sassar return $self->{serverflags}; 64672445Sassar} 647233294Sstassub clientflags 648178825Sdfr{ 649178825Sdfr my $self = shift; 650178825Sdfr if (@_) { 65172445Sassar $self->{clientflags} = shift; 652233294Sstas } 653233294Sstas return $self->{clientflags}; 654233294Sstas} 655233294Sstassub serverconnects 656233294Sstas{ 657178825Sdfr my $self = shift; 658233294Sstas if (@_) { 659233294Sstas $self->{serverconnects} = shift; 660233294Sstas } 661178825Sdfr return $self->{serverconnects}; 662178825Sdfr} 663178825Sdfr# This is a bit ugly because the caller is responsible for keeping the records 664178825Sdfr# in sync with the updated message list; simply updating the message list isn't 66572445Sassar# sufficient to get the proxy to forward the new message. 666233294Sstas# But it does the trick for the one test (test_sslsessiontick) that needs it. 667178825Sdfrsub message_list 668178825Sdfr{ 669178825Sdfr my $self = shift; 670178825Sdfr if (@_) { 671178825Sdfr $self->{message_list} = shift; 672178825Sdfr } 673178825Sdfr return $self->{message_list}; 674178825Sdfr} 675178825Sdfr 676178825Sdfrsub fill_known_data 677178825Sdfr{ 678178825Sdfr my $length = shift; 679178825Sdfr my $ret = ""; 680178825Sdfr for (my $i = 0; $i < $length; $i++) { 68172445Sassar $ret .= chr($i); 68272445Sassar } 68372445Sassar return $ret; 684178825Sdfr} 685178825Sdfr 686178825Sdfrsub is_tls13 687233294Sstas{ 688178825Sdfr my $class = shift; 689178825Sdfr if (@_) { 690178825Sdfr $is_tls13 = shift; 691178825Sdfr } 692178825Sdfr return $is_tls13; 693233294Sstas} 694233294Sstas 695233294Sstassub reneg 696178825Sdfr{ 697178825Sdfr my $self = shift; 698178825Sdfr if (@_) { 699178825Sdfr $self->{reneg} = shift; 700178825Sdfr } 701178825Sdfr return $self->{reneg}; 702178825Sdfr} 703178825Sdfr 704178825Sdfr#Setting a sessionfile means that the client will not close until the given 705178825Sdfr#file exists. This is useful in TLSv1.3 where otherwise s_client will close 706178825Sdfr#immediately at the end of the handshake, but before the session has been 707233294Sstas#received from the server. A side effect of this is that s_client never sends 708178825Sdfr#a close_notify, so instead we consider success to be when it sends application 709178825Sdfr#data over the connection. 710178825Sdfrsub sessionfile 711178825Sdfr{ 712178825Sdfr my $self = shift; 713178825Sdfr if (@_) { 714178825Sdfr $self->{sessionfile} = shift; 715178825Sdfr TLSProxy::Message->successondata(1); 716178825Sdfr } 717178825Sdfr return $self->{sessionfile}; 718178825Sdfr} 719178825Sdfr 720178825Sdfrsub ciphersuite 721178825Sdfr{ 72272445Sassar my $class = shift; 72372445Sassar if (@_) { 72472445Sassar $ciphersuite = shift; 725178825Sdfr } 72672445Sassar return $ciphersuite; 727178825Sdfr} 72872445Sassar 729178825Sdfr1; 73072445Sassar