]>
Commit | Line | Data |
---|---|---|
b6461792 | 1 | # Copyright 2016-2024 The OpenSSL Project Authors. All Rights Reserved. |
631c1206 | 2 | # |
9059ab42 | 3 | # Licensed under the Apache License 2.0 (the "License"). You may not use |
ac3d0e13 RS |
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 | |
631c1206 MC |
7 | |
8 | use strict; | |
5427976d | 9 | use POSIX ":sys_wait_h"; |
4439ed16 | 10 | use IPC::Open2; |
631c1206 MC |
11 | |
12 | package TLSProxy::Proxy; | |
13 | ||
14 | use File::Spec; | |
15 | use IO::Socket; | |
16 | use IO::Select; | |
17 | use TLSProxy::Record; | |
18 | use TLSProxy::Message; | |
19 | use TLSProxy::ClientHello; | |
a1accbb1 | 20 | use TLSProxy::ServerHello; |
a1c72cc2 | 21 | use TLSProxy::HelloVerifyRequest; |
9ce3ed2a | 22 | use TLSProxy::EncryptedExtensions; |
e96e0f8e | 23 | use TLSProxy::Certificate; |
dc5bcb88 | 24 | use TLSProxy::CertificateRequest; |
adb403de | 25 | use TLSProxy::CertificateVerify; |
a1accbb1 | 26 | use TLSProxy::ServerKeyExchange; |
7f6d90ac | 27 | use TLSProxy::NewSessionTicket; |
631c1206 | 28 | |
de5b3a86 | 29 | my $have_IPv6; |
72b65aa4 RL |
30 | my $IP_factory; |
31 | ||
de5b3a86 AP |
32 | BEGIN |
33 | { | |
34 | # IO::Socket::IP is on the core module list, IO::Socket::INET6 isn't. | |
35 | # However, IO::Socket::INET6 is older and is said to be more widely | |
36 | # deployed for the moment, and may have less bugs, so we try the latter | |
37 | # first, then fall back on the core modules. Worst case scenario, we | |
38 | # fall back to IO::Socket::INET, only supports IPv4. | |
39 | eval { | |
40 | require IO::Socket::INET6; | |
41 | my $s = IO::Socket::INET6->new( | |
42 | LocalAddr => "::1", | |
43 | LocalPort => 0, | |
44 | Listen=>1, | |
45 | ); | |
46 | $s or die "\n"; | |
47 | $s->close(); | |
48 | }; | |
49 | if ($@ eq "") { | |
66a60003 | 50 | $IP_factory = sub { IO::Socket::INET6->new(Domain => AF_INET6, @_); }; |
de5b3a86 AP |
51 | $have_IPv6 = 1; |
52 | } else { | |
53 | eval { | |
54 | require IO::Socket::IP; | |
55 | my $s = IO::Socket::IP->new( | |
56 | LocalAddr => "::1", | |
57 | LocalPort => 0, | |
58 | Listen=>1, | |
59 | ); | |
60 | $s or die "\n"; | |
61 | $s->close(); | |
62 | }; | |
63 | if ($@ eq "") { | |
64 | $IP_factory = sub { IO::Socket::IP->new(@_); }; | |
65 | $have_IPv6 = 1; | |
66 | } else { | |
67 | $IP_factory = sub { IO::Socket::INET->new(@_); }; | |
68 | $have_IPv6 = 0; | |
69 | } | |
70 | } | |
71 | } | |
72 | ||
20b65c7b | 73 | my $is_tls13 = 0; |
397f4f78 | 74 | my $ciphersuite = undef; |
20b65c7b | 75 | |
a1c72cc2 FWH |
76 | sub new { |
77 | my $class = shift; | |
78 | my ($filter, | |
79 | $execute, | |
80 | $cert, | |
81 | $debug) = @_; | |
82 | return init($class, $filter, $execute, $cert, $debug, 0); | |
83 | } | |
84 | ||
85 | sub new_dtls { | |
631c1206 MC |
86 | my $class = shift; |
87 | my ($filter, | |
88 | $execute, | |
89 | $cert, | |
90 | $debug) = @_; | |
a1c72cc2 FWH |
91 | return init($class, $filter, $execute, $cert, $debug, 1); |
92 | } | |
93 | ||
94 | sub init | |
95 | { | |
96 | my $class = shift; | |
97 | my ($filter, | |
98 | $execute, | |
99 | $cert, | |
100 | $debug, | |
101 | $isdtls) = @_; | |
631c1206 MC |
102 | |
103 | my $self = { | |
104 | #Public read/write | |
de5b3a86 | 105 | proxy_addr => $have_IPv6 ? "[::1]" : "127.0.0.1", |
a1c72cc2 | 106 | client_addr => $have_IPv6 ? "[::1]" : "127.0.0.1", |
631c1206 | 107 | filter => $filter, |
ddcc5e5b MC |
108 | serverflags => "", |
109 | clientflags => "", | |
110 | serverconnects => 1, | |
efab1586 | 111 | reneg => 0, |
1c361b4a | 112 | sessionfile => undef, |
631c1206 MC |
113 | |
114 | #Public read | |
a1c72cc2 | 115 | isdtls => $isdtls, |
6228b1da | 116 | proxy_port => 0, |
a1c72cc2 | 117 | client_port => 49152 + int(rand(65535 - 49152)), |
6228b1da AP |
118 | server_port => 0, |
119 | serverpid => 0, | |
120 | clientpid => 0, | |
631c1206 MC |
121 | execute => $execute, |
122 | cert => $cert, | |
123 | debug => $debug, | |
ddcc5e5b | 124 | cipherc => "", |
f865b081 MC |
125 | ciphersuitesc => "", |
126 | ciphers => "AES128-SHA", | |
127 | ciphersuitess => "TLS_AES_128_GCM_SHA256", | |
12636c14 BE |
128 | flight => -1, |
129 | direction => -1, | |
130 | partial => ["", ""], | |
631c1206 MC |
131 | record_list => [], |
132 | message_list => [], | |
631c1206 MC |
133 | }; |
134 | ||
135 | return bless $self, $class; | |
136 | } | |
137 | ||
c7454e1a RL |
138 | sub DESTROY |
139 | { | |
140 | my $self = shift; | |
141 | ||
142 | $self->{proxy_sock}->close() if $self->{proxy_sock}; | |
143 | } | |
144 | ||
5427976d | 145 | sub clearClient |
631c1206 MC |
146 | { |
147 | my $self = shift; | |
148 | ||
ddcc5e5b | 149 | $self->{cipherc} = ""; |
f865b081 | 150 | $self->{ciphersuitec} = ""; |
12636c14 BE |
151 | $self->{flight} = -1; |
152 | $self->{direction} = -1; | |
153 | $self->{partial} = ["", ""]; | |
631c1206 MC |
154 | $self->{record_list} = []; |
155 | $self->{message_list} = []; | |
ddcc5e5b | 156 | $self->{clientflags} = ""; |
1c361b4a | 157 | $self->{sessionfile} = undef; |
b72668a0 | 158 | $self->{clientpid} = 0; |
20b65c7b | 159 | $is_tls13 = 0; |
397f4f78 | 160 | $ciphersuite = undef; |
631c1206 MC |
161 | |
162 | TLSProxy::Message->clear(); | |
163 | TLSProxy::Record->clear(); | |
164 | } | |
165 | ||
5427976d MC |
166 | sub clear |
167 | { | |
168 | my $self = shift; | |
169 | ||
170 | $self->clearClient; | |
f865b081 MC |
171 | $self->{ciphers} = "AES128-SHA"; |
172 | $self->{ciphersuitess} = "TLS_AES_128_GCM_SHA256"; | |
5427976d MC |
173 | $self->{serverflags} = ""; |
174 | $self->{serverconnects} = 1; | |
175 | $self->{serverpid} = 0; | |
efab1586 | 176 | $self->{reneg} = 0; |
5427976d MC |
177 | } |
178 | ||
631c1206 MC |
179 | sub restart |
180 | { | |
181 | my $self = shift; | |
182 | ||
183 | $self->clear; | |
184 | $self->start; | |
185 | } | |
186 | ||
ddcc5e5b MC |
187 | sub clientrestart |
188 | { | |
189 | my $self = shift; | |
190 | ||
191 | $self->clear; | |
192 | $self->clientstart; | |
193 | } | |
194 | ||
6228b1da AP |
195 | sub connect_to_server |
196 | { | |
197 | my $self = shift; | |
198 | my $servaddr = $self->{server_addr}; | |
199 | ||
200 | $servaddr =~ s/[\[\]]//g; # Remove [ and ] | |
201 | ||
b4c1950d AP |
202 | my $sock = $IP_factory->(PeerAddr => $servaddr, |
203 | PeerPort => $self->{server_port}, | |
a1c72cc2 | 204 | Proto => $self->{isdtls} ? 'udp' : 'tcp'); |
b4c1950d AP |
205 | if (!defined($sock)) { |
206 | my $err = $!; | |
4439ed16 | 207 | kill(3, $self->{serverpid}); |
b4c1950d AP |
208 | die "unable to connect: $err\n"; |
209 | } | |
210 | ||
211 | $self->{server_sock} = $sock; | |
6228b1da AP |
212 | } |
213 | ||
631c1206 MC |
214 | sub start |
215 | { | |
216 | my ($self) = shift; | |
217 | my $pid; | |
218 | ||
a1c72cc2 FWH |
219 | # Create the Proxy socket |
220 | my $proxaddr = $self->{proxy_addr}; | |
221 | $proxaddr =~ s/[\[\]]//g; # Remove [ and ] | |
222 | my $clientaddr = $self->{client_addr}; | |
223 | $clientaddr =~ s/[\[\]]//g; # Remove [ and ] | |
224 | ||
225 | my @proxyargs; | |
226 | ||
227 | if ($self->{isdtls}) { | |
228 | @proxyargs = ( | |
229 | LocalHost => $proxaddr, | |
230 | LocalPort => 0, | |
231 | PeerHost => $clientaddr, | |
232 | PeerPort => $self->{client_port}, | |
233 | Proto => "udp", | |
234 | ); | |
235 | } else { | |
236 | @proxyargs = ( | |
237 | LocalHost => $proxaddr, | |
238 | LocalPort => 0, | |
239 | Proto => "tcp", | |
240 | Listen => SOMAXCONN, | |
241 | ); | |
242 | } | |
243 | ||
244 | if (my $sock = $IP_factory->(@proxyargs)) { | |
245 | $self->{proxy_sock} = $sock; | |
246 | $self->{proxy_port} = $sock->sockport(); | |
247 | $self->{proxy_addr} = $sock->sockhost(); | |
248 | $self->{proxy_addr} =~ s/(.*:.*)/[$1]/; | |
249 | print "Proxy started on port ", | |
250 | "$self->{proxy_addr}:$self->{proxy_port}\n"; | |
251 | # use same address for s_server | |
252 | $self->{server_addr} = $self->{proxy_addr}; | |
253 | } else { | |
254 | warn "Failed creating proxy socket (".$proxaddr.",0): $!\n"; | |
255 | } | |
256 | ||
c7454e1a RL |
257 | if ($self->{proxy_sock} == 0) { |
258 | return 0; | |
259 | } | |
260 | ||
6228b1da | 261 | my $execcmd = $self->execute |
a1c72cc2 | 262 | ." s_server -no_comp -engine ossltest -state" |
36ff232c MC |
263 | #In TLSv1.3 we issue two session tickets. The default session id |
264 | #callback gets confused because the ossltest engine causes the same | |
265 | #session id to be created twice due to the changed random number | |
266 | #generation. Using "-ext_cache" replaces the default callback with a | |
267 | #different one that doesn't get confused. | |
268 | ." -ext_cache" | |
de5b3a86 AP |
269 | ." -accept $self->{server_addr}:0" |
270 | ." -cert ".$self->cert." -cert2 ".$self->cert | |
6228b1da | 271 | ." -naccept ".$self->serverconnects; |
a1c72cc2 FWH |
272 | if ($self->{isdtls}) { |
273 | $execcmd .= " -dtls -max_protocol DTLSv1.2" | |
274 | # TLSProxy does not support message fragmentation. So | |
275 | # set a high mtu and fingers crossed. | |
276 | ." -mtu 1500"; | |
277 | } else { | |
278 | $execcmd .= " -rev -max_protocol TLSv1.3"; | |
279 | } | |
6228b1da AP |
280 | if ($self->ciphers ne "") { |
281 | $execcmd .= " -cipher ".$self->ciphers; | |
282 | } | |
283 | if ($self->ciphersuitess ne "") { | |
284 | $execcmd .= " -ciphersuites ".$self->ciphersuitess; | |
285 | } | |
286 | if ($self->serverflags ne "") { | |
287 | $execcmd .= " ".$self->serverflags; | |
288 | } | |
289 | if ($self->debug) { | |
290 | print STDERR "Server command: $execcmd\n"; | |
291 | } | |
292 | ||
4439ed16 FWH |
293 | $pid = IPC::Open2::open2(my $sout, my $sin, $execcmd) or die "Failed to $execcmd: $!\n"; |
294 | $self->{serverpid} = $pid; | |
6228b1da AP |
295 | |
296 | # Process the output from s_server until we find the ACCEPT line, which | |
297 | # tells us what the accepting address and port are. | |
4439ed16 | 298 | while (<$sout>) { |
3e94e2b1 FWH |
299 | print; |
300 | s/\R$//; # chomp does not work on windows. | |
6228b1da AP |
301 | next unless (/^ACCEPT\s.*:(\d+)$/); |
302 | $self->{server_port} = $1; | |
303 | last; | |
304 | } | |
305 | ||
306 | if ($self->{server_port} == 0) { | |
307 | # This actually means that s_server exited, because otherwise | |
308 | # we would still searching for ACCEPT... | |
6b3e8b94 AP |
309 | waitpid($pid, 0); |
310 | die "no ACCEPT detected in '$execcmd' output: $?\n"; | |
6228b1da AP |
311 | } |
312 | ||
6228b1da | 313 | print STDERR "Server responds on ", |
de5b3a86 | 314 | "$self->{server_addr}:$self->{server_port}\n"; |
6228b1da AP |
315 | |
316 | # Connect right away... | |
317 | $self->connect_to_server(); | |
631c1206 | 318 | |
b02b5743 | 319 | return $self->clientstart; |
ddcc5e5b MC |
320 | } |
321 | ||
322 | sub clientstart | |
323 | { | |
324 | my ($self) = shift; | |
631c1206 | 325 | |
a1c72cc2 FWH |
326 | my $succes = 1; |
327 | ||
631c1206 | 328 | if ($self->execute) { |
6228b1da AP |
329 | my $pid; |
330 | my $execcmd = $self->execute | |
a1c72cc2 | 331 | ." s_client -engine ossltest" |
de5b3a86 | 332 | ." -connect $self->{proxy_addr}:$self->{proxy_port}"; |
a1c72cc2 FWH |
333 | if ($self->{isdtls}) { |
334 | $execcmd .= " -dtls -max_protocol DTLSv1.2" | |
335 | # TLSProxy does not support message fragmentation. So | |
336 | # set a high mtu and fingers crossed. | |
337 | ." -mtu 1500" | |
338 | # UDP has no "accept" for sockets which means we need to | |
339 | # know were to send data back to. | |
340 | ." -bind $self->{client_addr}:$self->{client_port}"; | |
341 | } else { | |
342 | $execcmd .= " -max_protocol TLSv1.3"; | |
343 | } | |
6228b1da AP |
344 | if ($self->cipherc ne "") { |
345 | $execcmd .= " -cipher ".$self->cipherc; | |
346 | } | |
347 | if ($self->ciphersuitesc ne "") { | |
348 | $execcmd .= " -ciphersuites ".$self->ciphersuitesc; | |
349 | } | |
350 | if ($self->clientflags ne "") { | |
351 | $execcmd .= " ".$self->clientflags; | |
352 | } | |
de5b3a86 AP |
353 | if ($self->clientflags !~ m/-(no)?servername/) { |
354 | $execcmd .= " -servername localhost"; | |
355 | } | |
6228b1da AP |
356 | if (defined $self->sessionfile) { |
357 | $execcmd .= " -ign_eof"; | |
631c1206 | 358 | } |
6228b1da AP |
359 | if ($self->debug) { |
360 | print STDERR "Client command: $execcmd\n"; | |
361 | } | |
362 | ||
363 | open(my $savedout, ">&STDOUT"); | |
364 | # If we open pipe with new descriptor, attempt to close it, | |
365 | # explicitly or implicitly, would incur waitpid and effectively | |
366 | # dead-lock... | |
367 | if (!($pid = open(STDOUT, "| $execcmd"))) { | |
368 | my $err = $!; | |
4439ed16 | 369 | kill(3, $self->{serverpid}); |
6228b1da AP |
370 | die "Failed to $execcmd: $err\n"; |
371 | } | |
372 | $self->{clientpid} = $pid; | |
373 | ||
374 | # queue [magic] input | |
375 | print $self->reneg ? "R" : "test"; | |
376 | ||
377 | # this closes client's stdin without waiting for its pid | |
378 | open(STDOUT, ">&", $savedout); | |
379 | close($savedout); | |
631c1206 MC |
380 | } |
381 | ||
382 | # Wait for incoming connection from client | |
6228b1da | 383 | my $fdset = IO::Select->new($self->{proxy_sock}); |
bc661448 | 384 | if (!$fdset->can_read(60)) { |
4439ed16 | 385 | kill(3, $self->{serverpid}); |
6228b1da AP |
386 | die "s_client didn't try to connect\n"; |
387 | } | |
388 | ||
b02b5743 | 389 | my $client_sock; |
a1c72cc2 FWH |
390 | if($self->{isdtls}) { |
391 | $client_sock = $self->{proxy_sock} | |
392 | } elsif (!($client_sock = $self->{proxy_sock}->accept())) { | |
b02b5743 MC |
393 | warn "Failed accepting incoming connection: $!\n"; |
394 | return 0; | |
395 | } | |
631c1206 MC |
396 | |
397 | print "Connection opened\n"; | |
398 | ||
6228b1da | 399 | my $server_sock = $self->{server_sock}; |
631c1206 | 400 | my $indata; |
631c1206 MC |
401 | |
402 | #Wait for either the server socket or the client socket to become readable | |
6228b1da | 403 | $fdset = IO::Select->new($server_sock, $client_sock); |
631c1206 | 404 | my @ready; |
db0e0abb | 405 | my $ctr = 0; |
438e57a4 | 406 | local $SIG{PIPE} = "IGNORE"; |
17cde9c2 | 407 | $self->{saw_session_ticket} = undef; |
44420615 | 408 | while($fdset->count && $ctr < 10) { |
17cde9c2 | 409 | if (defined($self->{sessionfile})) { |
44420615 | 410 | # s_client got -ign_eof and won't be exiting voluntarily, so we |
17cde9c2 AP |
411 | # look for data *and* session ticket... |
412 | last if TLSProxy::Message->success() | |
413 | && $self->{saw_session_ticket}; | |
44420615 | 414 | } |
6228b1da | 415 | if (!(@ready = $fdset->can_read(1))) { |
a1c72cc2 FWH |
416 | last if TLSProxy::Message->success() |
417 | && $self->{saw_session_ticket}; | |
418 | ||
41300166 MC |
419 | $ctr++; |
420 | next; | |
421 | } | |
631c1206 MC |
422 | foreach my $hand (@ready) { |
423 | if ($hand == $server_sock) { | |
55fd5d3f AP |
424 | if ($server_sock->sysread($indata, 16384)) { |
425 | if ($indata = $self->process_packet(1, $indata)) { | |
426 | $client_sock->syswrite($indata) or goto END; | |
427 | } | |
428 | $ctr = 0; | |
429 | } else { | |
430 | $fdset->remove($server_sock); | |
431 | $client_sock->shutdown(SHUT_WR); | |
432 | } | |
631c1206 | 433 | } elsif ($hand == $client_sock) { |
55fd5d3f AP |
434 | if ($client_sock->sysread($indata, 16384)) { |
435 | if ($indata = $self->process_packet(0, $indata)) { | |
436 | $server_sock->syswrite($indata) or goto END; | |
437 | } | |
438 | $ctr = 0; | |
439 | } else { | |
440 | $fdset->remove($client_sock); | |
441 | $server_sock->shutdown(SHUT_WR); | |
442 | } | |
631c1206 | 443 | } else { |
4439ed16 | 444 | kill(3, $self->{serverpid}); |
41300166 | 445 | die "Unexpected handle"; |
631c1206 MC |
446 | } |
447 | } | |
448 | } | |
449 | ||
6228b1da | 450 | if ($ctr >= 10) { |
4439ed16 | 451 | kill(3, $self->{serverpid}); |
a1c72cc2 FWH |
452 | print "No progress made\n"; |
453 | $succes = 0; | |
6228b1da | 454 | } |
1c361b4a | 455 | |
631c1206 MC |
456 | END: |
457 | print "Connection closed\n"; | |
458 | if($server_sock) { | |
459 | $server_sock->close(); | |
6228b1da | 460 | $self->{server_sock} = undef; |
631c1206 MC |
461 | } |
462 | if($client_sock) { | |
463 | #Closing this also kills the child process | |
464 | $client_sock->close(); | |
465 | } | |
6228b1da AP |
466 | |
467 | my $pid; | |
468 | if (--$self->{serverconnects} == 0) { | |
469 | $pid = $self->{serverpid}; | |
6b3e8b94 AP |
470 | print "Waiting for s_server process to close: $pid...\n"; |
471 | # it's done already, just collect the exit code [and reap]... | |
6228b1da | 472 | waitpid($pid, 0); |
6b3e8b94 | 473 | die "exit code $? from s_server process\n" if $? != 0; |
018632ae | 474 | } else { |
6228b1da AP |
475 | # It's a bit counter-intuitive spot to make next connection to |
476 | # the s_server. Rationale is that established connection works | |
79c44b4e | 477 | # as synchronization point, in sense that this way we know that |
6228b1da AP |
478 | # s_server is actually done with current session... |
479 | $self->connect_to_server(); | |
5427976d | 480 | } |
6228b1da | 481 | $pid = $self->{clientpid}; |
17cde9c2 | 482 | print "Waiting for s_client process to close: $pid...\n"; |
6228b1da | 483 | waitpid($pid, 0); |
b72668a0 | 484 | |
a1c72cc2 | 485 | return $succes; |
631c1206 MC |
486 | } |
487 | ||
631c1206 MC |
488 | sub process_packet |
489 | { | |
490 | my ($self, $server, $packet) = @_; | |
491 | my $len_real; | |
492 | my $decrypt_len; | |
493 | my $data; | |
494 | my $recnum; | |
495 | ||
496 | if ($server) { | |
497 | print "Received server packet\n"; | |
498 | } else { | |
499 | print "Received client packet\n"; | |
500 | } | |
501 | ||
12636c14 BE |
502 | if ($self->{direction} != $server) { |
503 | $self->{flight} = $self->{flight} + 1; | |
504 | $self->{direction} = $server; | |
505 | } | |
506 | ||
631c1206 MC |
507 | print "Packet length = ".length($packet)."\n"; |
508 | print "Processing flight ".$self->flight."\n"; | |
509 | ||
510 | #Return contains the list of record found in the packet followed by the | |
12636c14 | 511 | #list of messages in those records and any partial message |
c53c2fec | 512 | my @ret = TLSProxy::Record->get_records($server, $self->flight, |
a1c72cc2 FWH |
513 | $self->{partial}[$server].$packet, |
514 | $self->{isdtls}); | |
515 | ||
12636c14 | 516 | $self->{partial}[$server] = $ret[2]; |
6228b1da | 517 | push @{$self->{record_list}}, @{$ret[0]}; |
631c1206 MC |
518 | push @{$self->{message_list}}, @{$ret[1]}; |
519 | ||
520 | print "\n"; | |
521 | ||
0e3ecaec | 522 | if (scalar(@{$ret[0]}) == 0 or length($ret[2]) != 0) { |
12636c14 BE |
523 | return ""; |
524 | } | |
525 | ||
631c1206 | 526 | #Finished parsing. Call user provided filter here |
12636c14 | 527 | if (defined $self->filter) { |
ddcc5e5b MC |
528 | $self->filter->($self); |
529 | } | |
631c1206 | 530 | |
17cde9c2 AP |
531 | #Take a note on NewSessionTicket |
532 | foreach my $message (reverse @{$self->{message_list}}) { | |
533 | if ($message->{mt} == TLSProxy::Message::MT_NEW_SESSION_TICKET) { | |
534 | $self->{saw_session_ticket} = 1; | |
535 | last; | |
536 | } | |
537 | } | |
538 | ||
631c1206 MC |
539 | #Reconstruct the packet |
540 | $packet = ""; | |
541 | foreach my $record (@{$self->record_list}) { | |
e60ce9c4 | 542 | $packet .= $record->reconstruct_record($server); |
631c1206 MC |
543 | } |
544 | ||
631c1206 MC |
545 | print "Forwarded packet length = ".length($packet)."\n\n"; |
546 | ||
547 | return $packet; | |
548 | } | |
549 | ||
550 | #Read accessors | |
551 | sub execute | |
552 | { | |
553 | my $self = shift; | |
554 | return $self->{execute}; | |
555 | } | |
556 | sub cert | |
557 | { | |
558 | my $self = shift; | |
559 | return $self->{cert}; | |
560 | } | |
561 | sub debug | |
562 | { | |
563 | my $self = shift; | |
564 | return $self->{debug}; | |
565 | } | |
566 | sub flight | |
567 | { | |
568 | my $self = shift; | |
569 | return $self->{flight}; | |
570 | } | |
571 | sub record_list | |
572 | { | |
573 | my $self = shift; | |
574 | return $self->{record_list}; | |
575 | } | |
631c1206 MC |
576 | sub success |
577 | { | |
578 | my $self = shift; | |
579 | return $self->{success}; | |
580 | } | |
581 | sub end | |
582 | { | |
583 | my $self = shift; | |
584 | return $self->{end}; | |
585 | } | |
72b65aa4 RL |
586 | sub supports_IPv6 |
587 | { | |
588 | my $self = shift; | |
589 | return $have_IPv6; | |
590 | } | |
631c1206 MC |
591 | sub proxy_addr |
592 | { | |
593 | my $self = shift; | |
631c1206 MC |
594 | return $self->{proxy_addr}; |
595 | } | |
596 | sub proxy_port | |
597 | { | |
598 | my $self = shift; | |
631c1206 MC |
599 | return $self->{proxy_port}; |
600 | } | |
601 | sub server_addr | |
602 | { | |
603 | my $self = shift; | |
631c1206 MC |
604 | return $self->{server_addr}; |
605 | } | |
606 | sub server_port | |
607 | { | |
608 | my $self = shift; | |
631c1206 MC |
609 | return $self->{server_port}; |
610 | } | |
6228b1da AP |
611 | sub serverpid |
612 | { | |
613 | my $self = shift; | |
614 | return $self->{serverpid}; | |
615 | } | |
616 | sub clientpid | |
617 | { | |
618 | my $self = shift; | |
619 | return $self->{clientpid}; | |
620 | } | |
621 | ||
622 | #Read/write accessors | |
631c1206 MC |
623 | sub filter |
624 | { | |
625 | my $self = shift; | |
626 | if (@_) { | |
96153874 | 627 | $self->{filter} = shift; |
631c1206 MC |
628 | } |
629 | return $self->{filter}; | |
630 | } | |
a1accbb1 MC |
631 | sub cipherc |
632 | { | |
633 | my $self = shift; | |
634 | if (@_) { | |
96153874 | 635 | $self->{cipherc} = shift; |
a1accbb1 MC |
636 | } |
637 | return $self->{cipherc}; | |
638 | } | |
f865b081 MC |
639 | sub ciphersuitesc |
640 | { | |
641 | my $self = shift; | |
642 | if (@_) { | |
643 | $self->{ciphersuitesc} = shift; | |
644 | } | |
645 | return $self->{ciphersuitesc}; | |
646 | } | |
a1accbb1 MC |
647 | sub ciphers |
648 | { | |
649 | my $self = shift; | |
650 | if (@_) { | |
96153874 | 651 | $self->{ciphers} = shift; |
a1accbb1 MC |
652 | } |
653 | return $self->{ciphers}; | |
654 | } | |
f865b081 MC |
655 | sub ciphersuitess |
656 | { | |
657 | my $self = shift; | |
658 | if (@_) { | |
659 | $self->{ciphersuitess} = shift; | |
660 | } | |
661 | return $self->{ciphersuitess}; | |
662 | } | |
ddcc5e5b MC |
663 | sub serverflags |
664 | { | |
665 | my $self = shift; | |
666 | if (@_) { | |
96153874 | 667 | $self->{serverflags} = shift; |
ddcc5e5b MC |
668 | } |
669 | return $self->{serverflags}; | |
670 | } | |
671 | sub clientflags | |
672 | { | |
673 | my $self = shift; | |
674 | if (@_) { | |
96153874 | 675 | $self->{clientflags} = shift; |
ddcc5e5b MC |
676 | } |
677 | return $self->{clientflags}; | |
678 | } | |
679 | sub serverconnects | |
680 | { | |
681 | my $self = shift; | |
682 | if (@_) { | |
96153874 | 683 | $self->{serverconnects} = shift; |
ddcc5e5b MC |
684 | } |
685 | return $self->{serverconnects}; | |
686 | } | |
cf7f8592 EK |
687 | # This is a bit ugly because the caller is responsible for keeping the records |
688 | # in sync with the updated message list; simply updating the message list isn't | |
689 | # sufficient to get the proxy to forward the new message. | |
690 | # But it does the trick for the one test (test_sslsessiontick) that needs it. | |
691 | sub message_list | |
692 | { | |
693 | my $self = shift; | |
694 | if (@_) { | |
695 | $self->{message_list} = shift; | |
696 | } | |
697 | return $self->{message_list}; | |
698 | } | |
8523288e DB |
699 | |
700 | sub fill_known_data | |
701 | { | |
702 | my $length = shift; | |
703 | my $ret = ""; | |
704 | for (my $i = 0; $i < $length; $i++) { | |
705 | $ret .= chr($i); | |
706 | } | |
707 | return $ret; | |
708 | } | |
efab1586 | 709 | |
20b65c7b MC |
710 | sub is_tls13 |
711 | { | |
712 | my $class = shift; | |
713 | if (@_) { | |
96153874 | 714 | $is_tls13 = shift; |
20b65c7b MC |
715 | } |
716 | return $is_tls13; | |
717 | } | |
efab1586 MC |
718 | |
719 | sub reneg | |
720 | { | |
721 | my $self = shift; | |
722 | if (@_) { | |
96153874 | 723 | $self->{reneg} = shift; |
efab1586 MC |
724 | } |
725 | return $self->{reneg}; | |
726 | } | |
727 | ||
1c361b4a MC |
728 | #Setting a sessionfile means that the client will not close until the given |
729 | #file exists. This is useful in TLSv1.3 where otherwise s_client will close | |
730 | #immediately at the end of the handshake, but before the session has been | |
731 | #received from the server. A side effect of this is that s_client never sends | |
732 | #a close_notify, so instead we consider success to be when it sends application | |
733 | #data over the connection. | |
734 | sub sessionfile | |
735 | { | |
736 | my $self = shift; | |
737 | if (@_) { | |
738 | $self->{sessionfile} = shift; | |
739 | TLSProxy::Message->successondata(1); | |
740 | } | |
741 | return $self->{sessionfile}; | |
742 | } | |
743 | ||
397f4f78 MC |
744 | sub ciphersuite |
745 | { | |
746 | my $class = shift; | |
747 | if (@_) { | |
748 | $ciphersuite = shift; | |
749 | } | |
750 | return $ciphersuite; | |
751 | } | |
752 | ||
4d7f5b82 FWH |
753 | sub isdtls |
754 | { | |
755 | my $self = shift; | |
756 | return $self->{isdtls}; #read-only | |
757 | } | |
758 | ||
631c1206 | 759 | 1; |