99 lines
3.1 KiB
Perl
99 lines
3.1 KiB
Perl
# NOTE: Derived from blib\lib\Net\SSLeay.pm.
|
|
# Changes made here will be lost when autosplit is run again.
|
|
# See AutoSplit.pm.
|
|
package Net::SSLeay;
|
|
|
|
#line 1056 "blib\lib\Net\SSLeay.pm (autosplit into blib\lib\auto\Net\SSLeay\sslcat.al)"
|
|
###
|
|
### Basic request - response primitive (don't use for https)
|
|
###
|
|
|
|
sub sslcat { # address, port, message, $crt, $key --> reply / (reply,errs,cert)
|
|
my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
|
|
my ($ctx, $ssl, $got, $errs, $written);
|
|
|
|
($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
|
|
return (wantarray ? (undef, $errs) : undef) unless $got;
|
|
|
|
### Do SSL negotiation stuff
|
|
|
|
warn "Creating SSL $ssl_version context...\n" if $trace>2;
|
|
initialize(); # Will init at most once
|
|
|
|
$ctx = new_x_ctx();
|
|
goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;
|
|
|
|
CTX_set_options($ctx, &OP_ALL);
|
|
goto cleanup2 if $errs = print_errs('CTX_set_options');
|
|
|
|
warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
|
|
set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
|
|
|
|
warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
|
|
$ssl = new($ctx);
|
|
goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
|
|
|
|
warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
|
|
set_fd($ssl, fileno(SSLCAT_S));
|
|
goto cleanup if $errs = print_errs('set_fd');
|
|
|
|
warn "Entering SSL negotiation phase...\n" if $trace>2;
|
|
|
|
if ($trace>2) {
|
|
my $i = 0;
|
|
my $p = '';
|
|
my $cipher_list = 'Cipher list: ';
|
|
$p=Net::SSLeay::get_cipher_list($ssl,$i);
|
|
$cipher_list .= $p if $p;
|
|
do {
|
|
$i++;
|
|
$cipher_list .= ', ' . $p if $p;
|
|
$p=Net::SSLeay::get_cipher_list($ssl,$i);
|
|
} while $p;
|
|
$cipher_list .= '\n';
|
|
warn $cipher_list;
|
|
}
|
|
|
|
$got = Net::SSLeay::connect($ssl);
|
|
warn "SSLeay connect returned $got\n" if $trace>2;
|
|
goto cleanup if $errs = print_errs('SSL_connect');
|
|
|
|
my $server_cert = get_peer_certificate($ssl);
|
|
print_errs('get_peer_certificate');
|
|
if ($trace>1) {
|
|
warn "Cipher `" . get_cipher($ssl) . "'\n";
|
|
print_errs('get_ciper');
|
|
warn dump_peer_certificate($ssl);
|
|
}
|
|
|
|
### Connected. Exchange some data (doing repeated tries if necessary).
|
|
|
|
warn "sslcat $$: sending " . blength($out_message) . " bytes...\n"
|
|
if $trace==3;
|
|
warn "sslcat $$: sending `$out_message' (" . blength($out_message)
|
|
. " bytes)...\n" if $trace>3;
|
|
($written, $errs) = ssl_write_all($ssl, $out_message);
|
|
goto cleanup unless $written;
|
|
|
|
sleep $slowly if $slowly; # Closing too soon can abort broken servers
|
|
Net::SSLeay::shutdown($ssl); # Useful starting with OpenSSL 1.1.1e
|
|
CORE::shutdown SSLCAT_S, 1; # Half close --> No more output, send EOF to server
|
|
|
|
warn "waiting for reply...\n" if $trace>2;
|
|
($got, $errs) = ssl_read_all($ssl);
|
|
warn "Got " . blength($got) . " bytes.\n" if $trace==3;
|
|
warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
|
|
|
|
cleanup:
|
|
free ($ssl);
|
|
$errs .= print_errs('SSL_free');
|
|
cleanup2:
|
|
CTX_free ($ctx);
|
|
$errs .= print_errs('CTX_free');
|
|
close SSLCAT_S;
|
|
return wantarray ? ($got, $errs, $server_cert) : $got;
|
|
}
|
|
|
|
# end of Net::SSLeay::sslcat
|
|
1;
|