1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
# 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 2166 "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;
load_error_strings(); # Some bloat, but I'm after ease of use
SSLeay_add_ssl_algorithms(); # and debuggability.
randomize();
$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
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;
|
