Profile of IO/Socket/SSL.pm

Filename	/usr/local/lib/perl5/site_perl/IO/Socket/SSL.pm
Statements	Executed 268 statements in 49.6ms

Subroutines
Calls	P	F	Exclusive Time	Inclusive Time	Subroutine
1	1	1	22.2ms	29.4ms	IO::Socket::SSL::::BEGIN@20 IO::Socket::SSL::BEGIN@20
1	1	1	3.46ms	14.3ms	IO::Socket::SSL::::BEGIN@19 IO::Socket::SSL::BEGIN@19
1	1	1	207µs	694µs	IO::Socket::SSL::::BEGIN@308 IO::Socket::SSL::BEGIN@308
1	1	1	172µs	6.55ms	IO::Socket::SSL::::init IO::Socket::SSL::init
1	1	1	140µs	184µs	IO::Socket::SSL::::BEGIN@389 IO::Socket::SSL::BEGIN@389
1	1	1	84µs	645µs	IO::Socket::SSL::::BEGIN@27 IO::Socket::SSL::BEGIN@27
1	1	1	70µs	191µs	IO::Socket::SSL::::BEGIN@70 IO::Socket::SSL::BEGIN@70
1	1	1	54µs	444µs	IO::Socket::SSL::::BEGIN@46 IO::Socket::SSL::BEGIN@46
1	1	1	51µs	397µs	IO::Socket::SSL::::BEGIN@47 IO::Socket::SSL::BEGIN@47
1	1	1	50µs	268µs	IO::Socket::SSL::::BEGIN@58 IO::Socket::SSL::BEGIN@58
1	1	1	47µs	5.66ms	IO::Socket::SSL::::BEGIN@18 IO::Socket::SSL::BEGIN@18
1	1	1	47µs	111µs	IO::Socket::SSL::::BEGIN@1891 IO::Socket::SSL::BEGIN@1891
8	2	1	46µs	46µs	IO::Socket::SSL::::CORE:match IO::Socket::SSL::CORE:match (opcode)
1	1	1	45µs	360µs	IO::Socket::SSL::SSL_Context::BEGIN@2169
1	1	1	45µs	356µs	IO::Socket::SSL::::BEGIN@48 IO::Socket::SSL::BEGIN@48
1	1	1	44µs	344µs	IO::Socket::SSL::::BEGIN@49 IO::Socket::SSL::BEGIN@49
1	1	1	44µs	57µs	IO::Socket::SSL::::BEGIN@247 IO::Socket::SSL::BEGIN@247
1	1	1	42µs	410µs	IO::Socket::SSL::SSL_Context::BEGIN@2168
1	1	1	35µs	90µs	IO::Socket::SSL::::BEGIN@261 IO::Socket::SSL::BEGIN@261
1	1	1	35µs	209µs	IO::Socket::SSL::::BEGIN@53 IO::Socket::SSL::BEGIN@53
1	1	1	33µs	240µs	IO::Socket::SSL::::BEGIN@291 IO::Socket::SSL::BEGIN@291
1	1	1	33µs	225µs	IO::Socket::SSL::::BEGIN@293 IO::Socket::SSL::BEGIN@293
1	1	1	32µs	237µs	IO::Socket::SSL::SSL_Context::BEGIN@2159
1	1	1	32µs	42µs	IO::Socket::SSL::Session_Cache::BEGIN@2848
1	1	1	31µs	193µs	IO::Socket::SSL::::BEGIN@59 IO::Socket::SSL::BEGIN@59
1	1	1	30µs	216µs	IO::Socket::SSL::::BEGIN@57 IO::Socket::SSL::BEGIN@57
1	1	1	29µs	36µs	IO::Socket::SSL::SSL_Context::BEGIN@2160
1	1	1	29µs	40µs	IO::Socket::SSL::SSL_HANDLE::BEGIN@2128
1	1	1	28µs	93µs	IO::Socket::SSL::::BEGIN@231 IO::Socket::SSL::BEGIN@231
1	1	1	28µs	71µs	IO::Socket::SSL::::BEGIN@2051 IO::Socket::SSL::BEGIN@2051
1	1	1	28µs	202µs	IO::Socket::SSL::SSL_Context::BEGIN@2166
1	1	1	27µs	167µs	IO::Socket::SSL::::BEGIN@250 IO::Socket::SSL::BEGIN@250
1	1	1	27µs	240µs	IO::Socket::SSL::::BEGIN@23 IO::Socket::SSL::BEGIN@23
1	1	1	26µs	246µs	IO::Socket::SSL::::BEGIN@55 IO::Socket::SSL::BEGIN@55
1	1	1	25µs	25µs	IO::Socket::SSL::::BEGIN@21 IO::Socket::SSL::BEGIN@21
1	1	1	24µs	158µs	IO::Socket::SSL::SSL_HANDLE::BEGIN@2129
1	1	1	24µs	220µs	IO::Socket::SSL::::BEGIN@282 IO::Socket::SSL::BEGIN@282
1	1	1	24µs	208µs	IO::Socket::SSL::::BEGIN@52 IO::Socket::SSL::BEGIN@52
1	1	1	24µs	75µs	IO::Socket::SSL::::BEGIN@398 IO::Socket::SSL::BEGIN@398
1	1	1	24µs	38µs	IO::Socket::SSL::::BEGIN@24 IO::Socket::SSL::BEGIN@24
1	1	1	23µs	321µs	IO::Socket::SSL::::BEGIN@22 IO::Socket::SSL::BEGIN@22
1	1	1	21µs	223µs	IO::Socket::SSL::SSL_Context::BEGIN@2165
1	1	1	20µs	193µs	IO::Socket::SSL::::BEGIN@56 IO::Socket::SSL::BEGIN@56
0	0	0	0s	0s	IO::Socket::SSL::::CLONE IO::Socket::SSL::CLONE
0	0	0	0s	0s	IO::Socket::SSL::::DEBUG IO::Socket::SSL::DEBUG
0	0	0	0s	0s	IO::Socket::SSL::::DESTROY IO::Socket::SSL::DESTROY
0	0	0	0s	0s	IO::Socket::SSL::::INIT IO::Socket::SSL::INIT
0	0	0	0s	0s	IO::Socket::SSL::OCSP_Cache::::get IO::Socket::SSL::OCSP_Cache::get
0	0	0	0s	0s	IO::Socket::SSL::OCSP_Cache::::new IO::Socket::SSL::OCSP_Cache::new
0	0	0	0s	0s	IO::Socket::SSL::OCSP_Cache::::put IO::Socket::SSL::OCSP_Cache::put
0	0	0	0s	0s	IO::Socket::SSL::OCSP_Resolver::add_response
0	0	0	0s	0s	IO::Socket::SSL::OCSP_Resolver::hard_error
0	0	0	0s	0s	IO::Socket::SSL::OCSP_Resolver::::newIO::Socket::SSL::OCSP_Resolver::new
0	0	0	0s	0s	IO::Socket::SSL::OCSP_Resolver::requests
0	0	0	0s	0s	IO::Socket::SSL::OCSP_Resolver::resolve_blocking
0	0	0	0s	0s	IO::Socket::SSL::OCSP_Resolver::soft_error
0	0	0	0s	0s	IO::Socket::SSL::SSL_Context::::CLONE IO::Socket::SSL::SSL_Context::CLONE
0	0	0	0s	0s	IO::Socket::SSL::SSL_Context::::DESTROY IO::Socket::SSL::SSL_Context::DESTROY
0	0	0	0s	0s	IO::Socket::SSL::SSL_Context::__ANON__[:2300]
0	0	0	0s	0s	IO::Socket::SSL::SSL_Context::__ANON__[:2647]
0	0	0	0s	0s	IO::Socket::SSL::SSL_Context::__ANON__[:2665]
0	0	0	0s	0s	IO::Socket::SSL::SSL_Context::__ANON__[:2678]
0	0	0	0s	0s	IO::Socket::SSL::SSL_Context::__ANON__[:2763]
0	0	0	0s	0s	IO::Socket::SSL::SSL_Context::__ANON__[:2794]
0	0	0	0s	0s	IO::Socket::SSL::SSL_Context::has_session_cache
0	0	0	0s	0s	IO::Socket::SSL::SSL_Context::::new IO::Socket::SSL::SSL_Context::new
0	0	0	0s	0s	IO::Socket::SSL::SSL_HANDLE::::BINMODE IO::Socket::SSL::SSL_HANDLE::BINMODE
0	0	0	0s	0s	IO::Socket::SSL::SSL_HANDLE::::CLOSE IO::Socket::SSL::SSL_HANDLE::CLOSE
0	0	0	0s	0s	IO::Socket::SSL::SSL_HANDLE::::FILENO IO::Socket::SSL::SSL_HANDLE::FILENO
0	0	0	0s	0s	IO::Socket::SSL::SSL_HANDLE::::GETC IO::Socket::SSL::SSL_HANDLE::GETC
0	0	0	0s	0s	IO::Socket::SSL::SSL_HANDLE::::PRINT IO::Socket::SSL::SSL_HANDLE::PRINT
0	0	0	0s	0s	IO::Socket::SSL::SSL_HANDLE::::PRINTF IO::Socket::SSL::SSL_HANDLE::PRINTF
0	0	0	0s	0s	IO::Socket::SSL::SSL_HANDLE::::READ IO::Socket::SSL::SSL_HANDLE::READ
0	0	0	0s	0s	IO::Socket::SSL::SSL_HANDLE::::READLINE IO::Socket::SSL::SSL_HANDLE::READLINE
0	0	0	0s	0s	IO::Socket::SSL::SSL_HANDLE::::TELL IO::Socket::SSL::SSL_HANDLE::TELL
0	0	0	0s	0s	IO::Socket::SSL::SSL_HANDLE::TIEHANDLE
0	0	0	0s	0s	IO::Socket::SSL::SSL_HANDLE::::WRITE IO::Socket::SSL::SSL_HANDLE::WRITE
0	0	0	0s	0s	IO::Socket::SSL::Session_Cache::DESTROY
0	0	0	0s	0s	IO::Socket::SSL::Session_Cache::add_session
0	0	0	0s	0s	IO::Socket::SSL::Session_Cache::del_session
0	0	0	0s	0s	IO::Socket::SSL::Session_Cache::get_session
0	0	0	0s	0s	IO::Socket::SSL::Session_Cache::::newIO::Socket::SSL::Session_Cache::new
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:1569] IO::Socket::SSL::__ANON__[:1569]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:1573] IO::Socket::SSL::__ANON__[:1573]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:1578] IO::Socket::SSL::__ANON__[:1578]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:1579] IO::Socket::SSL::__ANON__[:1579]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:1584] IO::Socket::SSL::__ANON__[:1584]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:1585] IO::Socket::SSL::__ANON__[:1585]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:1798] IO::Socket::SSL::__ANON__[:1798]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:1904] IO::Socket::SSL::__ANON__[:1904]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:2041] IO::Socket::SSL::__ANON__[:2041]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:2076] IO::Socket::SSL::__ANON__[:2076]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:271] IO::Socket::SSL::__ANON__[:271]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:323] IO::Socket::SSL::__ANON__[:323]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:330] IO::Socket::SSL::__ANON__[:330]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:399] IO::Socket::SSL::__ANON__[:399]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:439] IO::Socket::SSL::__ANON__[:439]
0	0	0	0s	0s	IO::Socket::SSL::::__ANON__[:98] IO::Socket::SSL::__ANON__[:98]
0	0	0	0s	0s	IO::Socket::SSL::::_generic_read IO::Socket::SSL::_generic_read
0	0	0	0s	0s	IO::Socket::SSL::::_generic_write IO::Socket::SSL::_generic_write
0	0	0	0s	0s	IO::Socket::SSL::::_get_ctx_object IO::Socket::SSL::_get_ctx_object
0	0	0	0s	0s	IO::Socket::SSL::::_get_ssl_object IO::Socket::SSL::_get_ssl_object
0	0	0	0s	0s	IO::Socket::SSL::::_internal_error IO::Socket::SSL::_internal_error
0	0	0	0s	0s	IO::Socket::SSL::::_invalid_object IO::Socket::SSL::_invalid_object
0	0	0	0s	0s	IO::Socket::SSL::::_skip_rw_error IO::Socket::SSL::_skip_rw_error
0	0	0	0s	0s	IO::Socket::SSL::::_update_peer IO::Socket::SSL::_update_peer
0	0	0	0s	0s	IO::Socket::SSL::::accept IO::Socket::SSL::accept
0	0	0	0s	0s	IO::Socket::SSL::::accept_SSL IO::Socket::SSL::accept_SSL
0	0	0	0s	0s	IO::Socket::SSL::::alpn_selected IO::Socket::SSL::alpn_selected
0	0	0	0s	0s	IO::Socket::SSL::::can_alpn IO::Socket::SSL::can_alpn
0	0	0	0s	0s	IO::Socket::SSL::::can_client_sni IO::Socket::SSL::can_client_sni
0	0	0	0s	0s	IO::Socket::SSL::::can_ecdh IO::Socket::SSL::can_ecdh
0	0	0	0s	0s	IO::Socket::SSL::::can_ipv6 IO::Socket::SSL::can_ipv6
0	0	0	0s	0s	IO::Socket::SSL::::can_npn IO::Socket::SSL::can_npn
0	0	0	0s	0s	IO::Socket::SSL::::can_ocsp IO::Socket::SSL::can_ocsp
0	0	0	0s	0s	IO::Socket::SSL::::can_server_sni IO::Socket::SSL::can_server_sni
0	0	0	0s	0s	IO::Socket::SSL::::can_ticket_keycb IO::Socket::SSL::can_ticket_keycb
0	0	0	0s	0s	IO::Socket::SSL::::close IO::Socket::SSL::close
0	0	0	0s	0s	IO::Socket::SSL::::configure IO::Socket::SSL::configure
0	0	0	0s	0s	IO::Socket::SSL::::configure_SSL IO::Socket::SSL::configure_SSL
0	0	0	0s	0s	IO::Socket::SSL::::connect IO::Socket::SSL::connect
0	0	0	0s	0s	IO::Socket::SSL::::connect_SSL IO::Socket::SSL::connect_SSL
0	0	0	0s	0s	IO::Socket::SSL::::context_init IO::Socket::SSL::context_init
0	0	0	0s	0s	IO::Socket::SSL::::default_ca IO::Socket::SSL::default_ca
0	0	0	0s	0s	IO::Socket::SSL::dump_peer_certificate
0	0	0	0s	0s	IO::Socket::SSL::::error IO::Socket::SSL::error
0	0	0	0s	0s	IO::Socket::SSL::::errstr IO::Socket::SSL::errstr
0	0	0	0s	0s	IO::Socket::SSL::::fatal_ssl_error IO::Socket::SSL::fatal_ssl_error
0	0	0	0s	0s	IO::Socket::SSL::::fdopen IO::Socket::SSL::fdopen
0	0	0	0s	0s	IO::Socket::SSL::::fileno IO::Socket::SSL::fileno
0	0	0	0s	0s	IO::Socket::SSL::::get_cipher IO::Socket::SSL::get_cipher
0	0	0	0s	0s	IO::Socket::SSL::::get_fingerprint IO::Socket::SSL::get_fingerprint
0	0	0	0s	0s	IO::Socket::SSL::::get_fingerprint_bin IO::Socket::SSL::get_fingerprint_bin
0	0	0	0s	0s	IO::Socket::SSL::::get_peer_certificate IO::Socket::SSL::get_peer_certificate
0	0	0	0s	0s	IO::Socket::SSL::::get_servername IO::Socket::SSL::get_servername
0	0	0	0s	0s	IO::Socket::SSL::::get_ssleay_error IO::Socket::SSL::get_ssleay_error
0	0	0	0s	0s	IO::Socket::SSL::::get_sslversion IO::Socket::SSL::get_sslversion
0	0	0	0s	0s	IO::Socket::SSL::::get_sslversion_int IO::Socket::SSL::get_sslversion_int
0	0	0	0s	0s	IO::Socket::SSL::::getc IO::Socket::SSL::getc
0	0	0	0s	0s	IO::Socket::SSL::::getline IO::Socket::SSL::getline
0	0	0	0s	0s	IO::Socket::SSL::::getlines IO::Socket::SSL::getlines
0	0	0	0s	0s	IO::Socket::SSL::::import IO::Socket::SSL::import
0	0	0	0s	0s	IO::Socket::SSL::::is_SSL IO::Socket::SSL::is_SSL
0	0	0	0s	0s	IO::Socket::SSL::::issuer_name IO::Socket::SSL::issuer_name
0	0	0	0s	0s	IO::Socket::SSL::::kill_socket IO::Socket::SSL::kill_socket
0	0	0	0s	0s	IO::Socket::SSL::::new_from_fd IO::Socket::SSL::new_from_fd
0	0	0	0s	0s	IO::Socket::SSL::next_proto_negotiated
0	0	0	0s	0s	IO::Socket::SSL::::opened IO::Socket::SSL::opened
0	0	0	0s	0s	IO::Socket::SSL::::opening IO::Socket::SSL::opening
0	0	0	0s	0s	IO::Socket::SSL::::peek IO::Socket::SSL::peek
0	0	0	0s	0s	IO::Socket::SSL::::peer_certificate IO::Socket::SSL::peer_certificate
0	0	0	0s	0s	IO::Socket::SSL::::pending IO::Socket::SSL::pending
0	0	0	0s	0s	IO::Socket::SSL::::print IO::Socket::SSL::print
0	0	0	0s	0s	IO::Socket::SSL::::printf IO::Socket::SSL::printf
0	0	0	0s	0s	IO::Socket::SSL::::read IO::Socket::SSL::read
0	0	0	0s	0s	IO::Socket::SSL::::readline IO::Socket::SSL::readline
0	0	0	0s	0s	IO::Socket::SSL::::recv IO::Socket::SSL::recv
0	0	0	0s	0s	IO::Socket::SSL::::send IO::Socket::SSL::send
0	0	0	0s	0s	IO::Socket::SSL::::set_args_filter_hack IO::Socket::SSL::set_args_filter_hack
0	0	0	0s	0s	IO::Socket::SSL::::set_client_defaults IO::Socket::SSL::set_client_defaults
0	0	0	0s	0s	IO::Socket::SSL::::set_default_context IO::Socket::SSL::set_default_context
0	0	0	0s	0s	IO::Socket::SSL::set_default_session_cache
0	0	0	0s	0s	IO::Socket::SSL::::set_defaults IO::Socket::SSL::set_defaults
0	0	0	0s	0s	IO::Socket::SSL::::set_server_defaults IO::Socket::SSL::set_server_defaults
0	0	0	0s	0s	IO::Socket::SSL::::setbuf IO::Socket::SSL::setbuf
0	0	0	0s	0s	IO::Socket::SSL::::setvbuf IO::Socket::SSL::setvbuf
0	0	0	0s	0s	IO::Socket::SSL::::sock_certificate IO::Socket::SSL::sock_certificate
0	0	0	0s	0s	IO::Socket::SSL::::socketToSSL IO::Socket::SSL::socketToSSL
0	0	0	0s	0s	IO::Socket::SSL::::socket_to_SSL IO::Socket::SSL::socket_to_SSL
0	0	0	0s	0s	IO::Socket::SSL::::start_SSL IO::Socket::SSL::start_SSL
0	0	0	0s	0s	IO::Socket::SSL::::stat IO::Socket::SSL::stat
0	0	0	0s	0s	IO::Socket::SSL::::stop_SSL IO::Socket::SSL::stop_SSL
0	0	0	0s	0s	IO::Socket::SSL::::subject_name IO::Socket::SSL::subject_name
0	0	0	0s	0s	IO::Socket::SSL::::sysread IO::Socket::SSL::sysread
0	0	0	0s	0s	IO::Socket::SSL::::syswrite IO::Socket::SSL::syswrite
0	0	0	0s	0s	IO::Socket::SSL::::truncate IO::Socket::SSL::truncate
0	0	0	0s	0s	IO::Socket::SSL::::ungetc IO::Socket::SSL::ungetc
0	0	0	0s	0s	IO::Socket::SSL::::verify_hostname IO::Socket::SSL::verify_hostname
0	0	0	0s	0s	IO::Socket::SSL::verify_hostname_of_cert
0	0	0	0s	0s	IO::Socket::SSL::::want_read IO::Socket::SSL::want_read
0	0	0	0s	0s	IO::Socket::SSL::::want_write IO::Socket::SSL::want_write
0	0	0	0s	0s	IO::Socket::SSL::::write IO::Socket::SSL::write

Call graph for these subroutines as a Graphviz dot language file.

Line	State ments	Time on line	Calls	Time in subs	Code
1					#vim: set sts=4 sw=4 ts=8 ai:
2					#
3					# IO::Socket::SSL:
4					# provide an interface to SSL connections similar to IO::Socket modules
5					#
6					# Current Code Shepherd: Steffen Ullrich <sullr at cpan.org>
7					# Code Shepherd before: Peter Behroozi, <behrooz at fas.harvard.edu>
8					#
9					# The original version of this module was written by
10					# Marko Asplund, <marko.asplund at kronodoc.fi>, who drew from
11					# Crypt::SSLeay (Net::SSL) by Gisle Aas.
12					#
13
14					package IO::Socket::SSL;
15
16	1	3µs			our $VERSION = '2.051';
17
18	2	86µs	2	11.3ms	# spent 5.66ms (47µs+5.61) within IO::Socket::SSL::BEGIN@18 which was called: # once (47µs+5.61ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 18 use IO::Socket; # spent 5.66ms making 1 call to IO::Socket::SSL::BEGIN@18 # spent 5.61ms making 1 call to IO::Socket::import
19	3	456µs	3	14.4ms	# spent 14.3ms (3.46+10.8) within IO::Socket::SSL::BEGIN@19 which was called: # once (3.46ms+10.8ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 19 use Net::SSLeay 1.46; # spent 14.3ms making 1 call to IO::Socket::SSL::BEGIN@19 # spent 89µs making 1 call to Exporter::import # spent 23µs making 1 call to version::_VERSION
20	2	384µs	1	29.4ms	# spent 29.4ms (22.2+7.25) within IO::Socket::SSL::BEGIN@20 which was called: # once (22.2ms+7.25ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 20 use IO::Socket::SSL::PublicSuffix; # spent 29.4ms making 1 call to IO::Socket::SSL::BEGIN@20
21	2	75µs	1	25µs	# spent 25µs within IO::Socket::SSL::BEGIN@21 which was called: # once (25µs+0s) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 21 use Exporter (); # spent 25µs making 1 call to IO::Socket::SSL::BEGIN@21
22	2	66µs	2	618µs	# spent 321µs (23+298) within IO::Socket::SSL::BEGIN@22 which was called: # once (23µs+298µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 22 use Errno qw( EWOULDBLOCK EAGAIN ETIMEDOUT EINTR EPIPE ); # spent 321µs making 1 call to IO::Socket::SSL::BEGIN@22 # spent 298µs making 1 call to Exporter::import
23	2	59µs	2	453µs	# spent 240µs (27+213) within IO::Socket::SSL::BEGIN@23 which was called: # once (27µs+213µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 23 use Carp; # spent 240µs making 1 call to IO::Socket::SSL::BEGIN@23 # spent 213µs making 1 call to Exporter::import
24	2	230µs	2	52µs	# spent 38µs (24+14) within IO::Socket::SSL::BEGIN@24 which was called: # once (24µs+14µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 24 use strict; # spent 38µs making 1 call to IO::Socket::SSL::BEGIN@24 # spent 14µs making 1 call to strict::import
25
26	1	2µs			my $use_threads;
27					# spent 645µs (84+560) within IO::Socket::SSL::BEGIN@27 which was called: # once (84µs+560µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 35 BEGIN {
28	1	3µs			die "no support for weaken - please install Scalar::Util" if ! do {
29	1	8µs			local $SIG{__DIE__};
30	3	18µs	1	311µs	eval { require Scalar::Util; Scalar::Util->import("weaken"); 1 } # spent 311µs making 1 call to Exporter::import
31	1	5µs			\|\| eval { require WeakRef; WeakRef->import("weaken"); 1 }
32					};
33	1	8µs			require Config;
34	1	22µs	1	249µs	$use_threads = $Config::Config{usethreads}; # spent 249µs making 1 call to Config::FETCH
35	1	174µs	1	645µs	} # spent 645µs making 1 call to IO::Socket::SSL::BEGIN@27
36
37
38					# results from commonly used constant functions from Net::SSLeay for fast access
39	1	15µs	1	148µs	my $Net_SSLeay_ERROR_WANT_READ = Net::SSLeay::ERROR_WANT_READ(); # spent 148µs making 1 call to Net::SSLeay::AUTOLOAD
40	1	10µs	1	94µs	my $Net_SSLeay_ERROR_WANT_WRITE = Net::SSLeay::ERROR_WANT_WRITE(); # spent 94µs making 1 call to Net::SSLeay::AUTOLOAD
41	1	9µs	1	91µs	my $Net_SSLeay_ERROR_SYSCALL = Net::SSLeay::ERROR_SYSCALL(); # spent 91µs making 1 call to Net::SSLeay::AUTOLOAD
42	1	8µs	1	6µs	my $Net_SSLeay_VERIFY_NONE = Net::SSLeay::VERIFY_NONE(); # spent 6µs making 1 call to Net::SSLeay::VERIFY_NONE
43	1	7µs	1	6µs	my $Net_SSLeay_VERIFY_PEER = Net::SSLeay::VERIFY_PEER(); # spent 6µs making 1 call to Net::SSLeay::VERIFY_PEER
44
45
46	2	126µs	3	828µs	# spent 444µs (54+390) within IO::Socket::SSL::BEGIN@46 which was called: # once (54µs+390µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 46 use constant SSL_VERIFY_NONE => &Net::SSLeay::VERIFY_NONE; # spent 444µs making 1 call to IO::Socket::SSL::BEGIN@46 # spent 201µs making 1 call to constant::import # spent 183µs making 1 call to Net::SSLeay::AUTOLOAD
47	2	95µs	3	738µs	# spent 397µs (51+346) within IO::Socket::SSL::BEGIN@47 which was called: # once (51µs+346µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 47 use constant SSL_VERIFY_PEER => &Net::SSLeay::VERIFY_PEER; # spent 397µs making 1 call to IO::Socket::SSL::BEGIN@47 # spent 216µs making 1 call to constant::import # spent 125µs making 1 call to Net::SSLeay::AUTOLOAD
48	2	115µs	3	662µs	# spent 356µs (45+311) within IO::Socket::SSL::BEGIN@48 which was called: # once (45µs+311µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 48 use constant SSL_VERIFY_FAIL_IF_NO_PEER_CERT => Net::SSLeay::VERIFY_FAIL_IF_NO_PEER_CERT(); # spent 356µs making 1 call to IO::Socket::SSL::BEGIN@48 # spent 185µs making 1 call to constant::import # spent 121µs making 1 call to Net::SSLeay::AUTOLOAD
49	2	84µs	3	638µs	# spent 344µs (44+299) within IO::Socket::SSL::BEGIN@49 which was called: # once (44µs+299µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 49 use constant SSL_VERIFY_CLIENT_ONCE => Net::SSLeay::VERIFY_CLIENT_ONCE(); # spent 344µs making 1 call to IO::Socket::SSL::BEGIN@49 # spent 184µs making 1 call to constant::import # spent 110µs making 1 call to Net::SSLeay::AUTOLOAD
50
51					# from openssl/ssl.h; should be better in Net::SSLeay
52	2	83µs	2	393µs	# spent 208µs (24+184) within IO::Socket::SSL::BEGIN@52 which was called: # once (24µs+184µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 52 use constant SSL_SENT_SHUTDOWN => 1; # spent 208µs making 1 call to IO::Socket::SSL::BEGIN@52 # spent 184µs making 1 call to constant::import
53	2	73µs	2	383µs	# spent 209µs (35+174) within IO::Socket::SSL::BEGIN@53 which was called: # once (35µs+174µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 53 use constant SSL_RECEIVED_SHUTDOWN => 2; # spent 209µs making 1 call to IO::Socket::SSL::BEGIN@53 # spent 174µs making 1 call to constant::import
54
55	2	75µs	2	466µs	# spent 246µs (26+220) within IO::Socket::SSL::BEGIN@55 which was called: # once (26µs+220µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 55 use constant SSL_OCSP_NO_STAPLE => 0b00001; # spent 246µs making 1 call to IO::Socket::SSL::BEGIN@55 # spent 220µs making 1 call to constant::import
56	2	79µs	2	367µs	# spent 193µs (20+174) within IO::Socket::SSL::BEGIN@56 which was called: # once (20µs+174µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 56 use constant SSL_OCSP_MUST_STAPLE => 0b00010; # spent 193µs making 1 call to IO::Socket::SSL::BEGIN@56 # spent 174µs making 1 call to constant::import
57	2	79µs	2	401µs	# spent 216µs (30+186) within IO::Socket::SSL::BEGIN@57 which was called: # once (30µs+186µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 57 use constant SSL_OCSP_FAIL_HARD => 0b00100; # spent 216µs making 1 call to IO::Socket::SSL::BEGIN@57 # spent 186µs making 1 call to constant::import
58	2	77µs	2	486µs	# spent 268µs (50+218) within IO::Socket::SSL::BEGIN@58 which was called: # once (50µs+218µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 58 use constant SSL_OCSP_FULL_CHAIN => 0b01000; # spent 268µs making 1 call to IO::Socket::SSL::BEGIN@58 # spent 218µs making 1 call to constant::import
59	2	306µs	2	354µs	# spent 193µs (31+162) within IO::Socket::SSL::BEGIN@59 which was called: # once (31µs+162µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 59 use constant SSL_OCSP_TRY_STAPLE => 0b10000; # spent 193µs making 1 call to IO::Socket::SSL::BEGIN@59 # spent 162µs making 1 call to constant::import
60
61					# capabilities of underlying Net::SSLeay/openssl
62	1	2µs			my $can_client_sni; # do we support SNI on the client side
63					my $can_server_sni; # do we support SNI on the server side
64					my $can_npn; # do we support NPN (obsolete)
65					my $can_alpn; # do we support ALPN
66					my $can_ecdh; # do we support ECDH key exchange
67					my $can_ocsp; # do we support OCSP
68					my $can_ocsp_staple; # do we support OCSP stapling
69					my $can_tckt_keycb; # TLS ticket key callback
70					# spent 191µs (70+122) within IO::Socket::SSL::BEGIN@70 which was called: # once (70µs+122µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 87 BEGIN {
71	1	11µs	1	113µs	$can_client_sni = Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000; # spent 113µs making 1 call to Net::SSLeay::AUTOLOAD
72	1	2µs			$can_server_sni = defined &Net::SSLeay::get_servername;
73	1	3µs			$can_npn = defined &Net::SSLeay::P_next_proto_negotiated;
74	1	2µs			$can_alpn = defined &Net::SSLeay::CTX_set_alpn_protos;
75	1	7µs	1	4µs	$can_ecdh = defined &Net::SSLeay::CTX_set_tmp_ecdh && # spent 4µs making 1 call to Net::SSLeay::OPENSSL_VERSION_NUMBER
76					# There is a regression with elliptic curves on 1.0.1d with 64bit
77					# http://rt.openssl.org/Ticket/Display.html?id=2975
78					( Net::SSLeay::OPENSSL_VERSION_NUMBER() != 0x1000104f
79					\|\| length(pack("P",0)) == 4 );
80	1	6µs			$can_ocsp = defined &Net::SSLeay::OCSP_cert2ids
81					# OCSP got broken in 1.75..1.77
82					&& ($Net::SSLeay::VERSION < 1.75 \|\| $Net::SSLeay::VERSION > 1.77);
83	1	2µs			$can_ocsp_staple = $can_ocsp
84					&& defined &Net::SSLeay::set_tlsext_status_type;
85	1	10µs			$can_tckt_keycb = defined &Net::SSLeay::CTX_set_tlsext_ticket_getkey_cb
86					&& $Net::SSLeay::VERSION >= 1.80;
87	1	781µs	1	191µs	} # spent 191µs making 1 call to IO::Socket::SSL::BEGIN@70
88
89	1	4µs			my $algo2digest = do {
90	1	2µs			my %digest;
91					sub {
92					my $digest_name = shift;
93					return $digest{$digest_name} \|\|= do {
94					Net::SSLeay::SSLeay_add_ssl_algorithms();
95					Net::SSLeay::EVP_get_digestbyname($digest_name)
96					or die "Digest algorithm $digest_name is not available";
97					};
98					}
99	1	10µs			};
100
101
102					# global defaults
103	1	11µs			my %DEFAULT_SSL_ARGS = (
104					SSL_check_crl => 0,
105					SSL_version => 'SSLv23:!SSLv3:!SSLv2', # consider both SSL3.0 and SSL2.0 as broken
106					SSL_verify_callback => undef,
107					SSL_verifycn_scheme => undef, # fallback cn verification
108					SSL_verifycn_publicsuffix => undef, # fallback default list verification
109					#SSL_verifycn_name => undef, # use from PeerAddr/PeerHost - do not override in set_args_filter_hack 'use_defaults'
110					SSL_npn_protocols => undef, # meaning depends whether on server or client side
111					SSL_alpn_protocols => undef, # list of protocols we'll accept/send, for example ['http/1.1','spdy/3.1']
112
113					# https://wiki.mozilla.org/Security/Server_Side_TLS, 2016/04/20
114					# "Old backward compatibility" for best compatibility
115					# .. "Most ciphers that are not clearly broken and dangerous to use are supported"
116					SSL_cipher_list => 'ECDHE-ECDSA-CHACHA20-POLY1305:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-AES256-GCM-SHA384:DHE-RSA-AES128-GCM-SHA256:DHE-DSS-AES128-GCM-SHA256:kEDH+AESGCM:ECDHE-RSA-AES128-SHA256:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA:ECDHE-ECDSA-AES128-SHA:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA:ECDHE-ECDSA-AES256-SHA:DHE-RSA-AES128-SHA256:DHE-RSA-AES128-SHA:DHE-DSS-AES128-SHA256:DHE-RSA-AES256-SHA256:DHE-DSS-AES256-SHA:DHE-RSA-AES256-SHA:ECDHE-RSA-DES-CBC3-SHA:ECDHE-ECDSA-DES-CBC3-SHA:EDH-RSA-DES-CBC3-SHA:AES128-GCM-SHA256:AES256-GCM-SHA384:AES128-SHA256:AES256-SHA256:AES128-SHA:AES256-SHA:AES:DES-CBC3-SHA:HIGH:SEED:!aNULL:!eNULL:!EXPORT:!DES:!RC4:!MD5:!PSK:!RSAPSK:!aDH:!aECDH:!EDH-DSS-DES-CBC3-SHA:!KRB5-DES-CBC3-SHA:!SRP',
117					);
118
119	1	12µs			my %DEFAULT_SSL_CLIENT_ARGS = (
120					%DEFAULT_SSL_ARGS,
121					SSL_verify_mode => SSL_VERIFY_PEER,
122
123					SSL_ca_file => undef,
124					SSL_ca_path => undef,
125
126					# older versions of F5 BIG-IP hang when getting SSL client hello >255 bytes
127					# http://support.f5.com/kb/en-us/solutions/public/13000/000/sol13037.html
128					# http://guest:guest@rt.openssl.org/Ticket/Display.html?id=2771
129					# Ubuntu worked around this by disabling TLSv1_2 on the client side for
130					# a while. Later a padding extension was added to OpenSSL to work around
131					# broken F5 but then IronPort croaked because it did not understand this
132					# extension so it was disabled again :(
133					# Firefox, Chrome and IE11 use TLSv1_2 but use only a few ciphers, so
134					# that packet stays small enough. We try the same here.
135
136					SSL_cipher_list => join(" ",
137
138					# SSLabs report for Chrome 48/OSX.
139					# This also includes the fewer ciphers Firefox uses.
140					'ECDHE-ECDSA-AES128-GCM-SHA256',
141					'ECDHE-RSA-AES128-GCM-SHA256',
142					'DHE-RSA-AES128-GCM-SHA256',
143					'ECDHE-ECDSA-CHACHA20-POLY1305',
144					'ECDHE-RSA-CHACHA20-POLY1305',
145					'ECDHE-ECDSA-AES256-SHA',
146					'ECDHE-RSA-AES256-SHA',
147					'DHE-RSA-AES256-SHA',
148					'ECDHE-ECDSA-AES128-SHA',
149					'ECDHE-RSA-AES128-SHA',
150					'DHE-RSA-AES128-SHA',
151					'AES128-GCM-SHA256',
152					'AES256-SHA',
153					'AES128-SHA',
154					'DES-CBC3-SHA',
155
156					# IE11/Edge has some more ciphers, notably SHA384 and DSS
157					# we don't offer the -AES128-SHA256 and -AES256-SHA384 non-GCM
158					# ciphers IE/Edge offers because they look like a large mismatch
159					# between a very strong HMAC and a comparably weak (but sufficient)
160					# encryption. Similar all browsers which do SHA384 can do ECDHE
161					# so skip the DHE*SHA384 ciphers.
162					'ECDHE-RSA-AES256-GCM-SHA384',
163					'ECDHE-ECDSA-AES256-GCM-SHA384',
164					# 'ECDHE-RSA-AES256-SHA384',
165					# 'ECDHE-ECDSA-AES256-SHA384',
166					# 'ECDHE-RSA-AES128-SHA256',
167					# 'ECDHE-ECDSA-AES128-SHA256',
168					# 'DHE-RSA-AES256-GCM-SHA384',
169					# 'AES256-GCM-SHA384',
170					'AES256-SHA256',
171					# 'AES128-SHA256',
172					'DHE-DSS-AES256-SHA256',
173					# 'DHE-DSS-AES128-SHA256',
174					'DHE-DSS-AES256-SHA',
175					'DHE-DSS-AES128-SHA',
176					'EDH-DSS-DES-CBC3-SHA',
177
178					# Just to make sure, that we don't accidentally add bad ciphers above.
179					# This includes dropping RC4 which is no longer supported by modern
180					# browsers and also excluded in the SSL libraries of Python and Ruby.
181					"!EXP !MEDIUM !LOW !eNULL !aNULL !RC4 !DES !MD5 !PSK !SRP"
182					)
183					);
184
185					# set values inside _init to work with perlcc, RT#95452
186	1	1µs			my %DEFAULT_SSL_SERVER_ARGS;
187
188					# Initialization of OpenSSL internals
189					# This will be called once during compilation - perlcc users might need to
190					# call it again by hand, see RT#95452
191					{
192	1	4µs			# spent 6.55ms (172µs+6.38) within IO::Socket::SSL::init which was called: # once (172µs+6.38ms) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 233 sub init {
193					# library_init returns false if the library was already initialized.
194					# This way we can find out if the library needs to be re-initialized
195					# inside code compiled with perlcc
196	1	511µs	1	494µs	Net::SSLeay::library_init() or return; # spent 494µs making 1 call to Net::SSLeay::library_init
197
198	1	4.47ms	1	4.46ms	Net::SSLeay::load_error_strings(); # spent 4.46ms making 1 call to Net::SSLeay::load_error_strings
199	1	56µs	1	43µs	Net::SSLeay::OpenSSL_add_all_digests(); # spent 43µs making 1 call to Net::SSLeay::OpenSSL_add_all_digests
200	1	11µs	1	86µs	Net::SSLeay::randomize(); # spent 86µs making 1 call to Net::SSLeay::AUTOLOAD
201
202					%DEFAULT_SSL_SERVER_ARGS = (
203					%DEFAULT_SSL_ARGS,
204					SSL_verify_mode => SSL_VERIFY_NONE,
205					SSL_honor_cipher_order => 1, # trust server to know the best cipher
206	1	36µs			SSL_dh => do {
207	1	42µs	2	18µs	my $bio = Net::SSLeay::BIO_new(Net::SSLeay::BIO_s_mem()); # spent 11µs making 1 call to Net::SSLeay::BIO_new # spent 8µs making 1 call to Net::SSLeay::BIO_s_mem
208					# generated with: openssl dhparam 2048
209	1	22µs	1	10µs	Net::SSLeay::BIO_write($bio,<<'DH'); # spent 10µs making 1 call to Net::SSLeay::BIO_write
210					-----BEGIN DH PARAMETERS-----
211					MIIBCAKCAQEAr8wskArj5+1VCVsnWt/RUR7tXkHJ7mGW7XxrLSPOaFyKyWf8lZht
212					iSY2Lc4oa4Zw8wibGQ3faeQu/s8fvPq/aqTxYmyHPKCMoze77QJHtrYtJAosB9SY
213					CN7s5Hexxb5/vQ4qlQuOkVrZDiZO9GC4KaH9mJYnCoAsXDhDft6JT0oRVSgtZQnU
214					gWFKShIm+JVjN94kGs0TcBEesPTK2g8XVHK9H8AtSUb9BwW2qD/T5RmgNABysApO
215					Ps2vlkxjAHjJcqc3O+OiImKik/X2rtBTZjpKmzN3WWTB0RJZCOWaLlDO81D01o1E
216					aZecz3Np9KIYey900f+X7zC2bJxEHp95ywIBAg==
217					-----END DH PARAMETERS-----
218					DH
219	1	64µs	1	50µs	my $dh = Net::SSLeay::PEM_read_bio_DHparams($bio); # spent 50µs making 1 call to Net::SSLeay::PEM_read_bio_DHparams
220	1	22µs	1	9µs	Net::SSLeay::BIO_free($bio); # spent 9µs making 1 call to Net::SSLeay::BIO_free
221	1	2µs			$dh or die "no DH";
222	1	3µs			$dh;
223					},
224					$can_ecdh ? ( SSL_ecdh_curve => 'prime256v1' ):(),
225					);
226					}
227					# Call it once at compile time and try it at INIT.
228					# This should catch all cases of including the module, e.g. 'use' (INIT) or
229					# 'require' (compile time) and works also with perlcc
230					{
231	3	208µs	2	159µs	# spent 93µs (28+65) within IO::Socket::SSL::BEGIN@231 which was called: # once (28µs+65µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 231 no warnings; # spent 93µs making 1 call to IO::Socket::SSL::BEGIN@231 # spent 65µs making 1 call to warnings::unimport
232					INIT { init() }
233	1	8µs	1	6.55ms	init(); # spent 6.55ms making 1 call to IO::Socket::SSL::init
234					}
235					}
236
237					# global defaults which can be changed using set_defaults
238					# either key/value can be set or it can just be set to an external hash
239	1	3µs			my $GLOBAL_SSL_ARGS = {};
240	1	2µs			my $GLOBAL_SSL_CLIENT_ARGS = {};
241	1	2µs			my $GLOBAL_SSL_SERVER_ARGS = {};
242
243					# hack which is used to filter bad settings from used modules
244	1	2µs			my $FILTER_SSL_ARGS = undef;
245
246					# non-XS Versions of Scalar::Util will fail
247					# spent 57µs (44+14) within IO::Socket::SSL::BEGIN@247 which was called: # once (44µs+14µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 252 BEGIN{
248	1	20µs			die "You need the XS Version of Scalar::Util for dualvar() support" if !do {
249	2	6µs			local $SIG{__DIE__}; local $SIG{__WARN__}; # be silent
250	5	154µs	3	321µs	# spent 167µs (27+140) within IO::Socket::SSL::BEGIN@250 which was called: # once (27µs+140µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 250 eval { use Scalar::Util 'dualvar'; dualvar(0,''); 1 }; # spent 167µs making 1 call to IO::Socket::SSL::BEGIN@250 # spent 140µs making 1 call to Exporter::import # spent 14µs making 1 call to Scalar::Util::dualvar
251					};
252	1	203µs	1	57µs	} # spent 57µs making 1 call to IO::Socket::SSL::BEGIN@247
253
254					# get constants for SSL_OP_NO_* now, instead calling the related functions
255					# every time we setup a connection
256	1	2µs			my %SSL_OP_NO;
257	1	6µs			for(qw( SSLv2 SSLv3 TLSv1 TLSv1_1 TLSv11:TLSv1_1 TLSv1_2 TLSv12:TLSv1_2 )) {
258	7	100µs	7	36µs	my ($k,$op) = m{:} ? split(m{:},$_,2) : ($_,$_); # spent 36µs making 7 calls to IO::Socket::SSL::CORE:match, avg 5µs/call
259	7	16µs			my $sub = "Net::SSLeay::OP_NO_$op";
260	7	49µs			local $SIG{__DIE__};
261	16	487µs	9	753µs	# spent 90µs (35+55) within IO::Socket::SSL::BEGIN@261 which was called: # once (35µs+55µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 261 $SSL_OP_NO{$k} = eval { no strict 'refs'; &$sub } \|\| 0; # spent 594µs making 5 calls to Net::SSLeay::AUTOLOAD, avg 119µs/call # spent 90µs making 1 call to IO::Socket::SSL::BEGIN@261 # spent 55µs making 1 call to strict::unimport # spent 9µs making 1 call to Net::SSLeay::OP_NO_TLSv1_1 # spent 6µs making 1 call to Net::SSLeay::OP_NO_TLSv1_2
262					}
263
264					# Make SSL_CTX_clear_options accessible through SSL_CTX_ctrl unless it is
265					# already implemented in Net::SSLeay
266	1	4µs			if (!defined &Net::SSLeay::CTX_clear_options) {
267					*Net::SSLeay::CTX_clear_options = sub {
268					my ($ctx,$opt) = @_;
269					# 77 = SSL_CTRL_CLEAR_OPTIONS
270					Net::SSLeay::CTX_ctrl($ctx,77,$opt,0);
271	1	11µs			};
272					}
273
274					# Try to work around problems with alternative trust path by default, RT#104759
275	1	2µs			my $DEFAULT_X509_STORE_flags = 0;
276					{
277	2	7µs			local $SIG{__DIE__};
278	2	15µs	1	111µs	eval { $DEFAULT_X509_STORE_flags \|= Net::SSLeay::X509_V_FLAG_TRUSTED_FIRST() }; # spent 111µs making 1 call to Net::SSLeay::AUTOLOAD
279					}
280
281					our $DEBUG;
282	2	124µs	2	416µs	# spent 220µs (24+196) within IO::Socket::SSL::BEGIN@282 which was called: # once (24µs+196µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 282 use vars qw(@ISA $SSL_ERROR @EXPORT); # spent 220µs making 1 call to IO::Socket::SSL::BEGIN@282 # spent 196µs making 1 call to vars::import
283
284					{
285					# These constants will be used in $! at return from SSL_connect,
286					# SSL_accept, _generic_(read\|write), thus notifying the caller
287					# the usual way of problems. Like with EWOULDBLOCK, EINPROGRESS..
288					# these are especially important for non-blocking sockets
289
290	2	5µs			my $x = $Net_SSLeay_ERROR_WANT_READ;
291	2	135µs	3	448µs	# spent 240µs (33+207) within IO::Socket::SSL::BEGIN@291 which was called: # once (33µs+207µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 291 use constant SSL_WANT_READ => dualvar( \$x, 'SSL wants a read first' ); # spent 240µs making 1 call to IO::Socket::SSL::BEGIN@291 # spent 200µs making 1 call to constant::import # spent 7µs making 1 call to Scalar::Util::dualvar
292	1	2µs			my $y = $Net_SSLeay_ERROR_WANT_WRITE;
293	2	868µs	3	418µs	# spent 225µs (33+193) within IO::Socket::SSL::BEGIN@293 which was called: # once (33µs+193µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 293 use constant SSL_WANT_WRITE => dualvar( \$y, 'SSL wants a write first' ); # spent 225µs making 1 call to IO::Socket::SSL::BEGIN@293 # spent 182µs making 1 call to constant::import # spent 10µs making 1 call to Scalar::Util::dualvar
294
295	1	9µs			@EXPORT = qw(
296					SSL_WANT_READ SSL_WANT_WRITE SSL_VERIFY_NONE SSL_VERIFY_PEER
297					SSL_VERIFY_FAIL_IF_NO_PEER_CERT SSL_VERIFY_CLIENT_ONCE
298					SSL_OCSP_NO_STAPLE SSL_OCSP_TRY_STAPLE SSL_OCSP_MUST_STAPLE
299					SSL_OCSP_FAIL_HARD SSL_OCSP_FULL_CHAIN
300					$SSL_ERROR GEN_DNS GEN_IPADD
301					);
302					}
303
304	1	8µs			my @caller_force_inet4; # in case inet4 gets forced we store here who forced it
305
306					my $IOCLASS;
307					my $family_key; # 'Domain'\|\|'Family'
308					# spent 694µs (207+488) within IO::Socket::SSL::BEGIN@308 which was called: # once (207µs+488µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 372 BEGIN {
309					# declare @ISA depending of the installed socket class
310
311					# try to load inet_pton from Socket or Socket6 and make sure it is usable
312	2	9µs			local $SIG{__DIE__}; local $SIG{__WARN__}; # be silent
313					my $ip6 = eval {
314	1	10µs			require Socket;
315	1	45µs	1	29µs	Socket->VERSION(1.95); # spent 29µs making 1 call to version::_VERSION
316	1	26µs	1	14µs	my $ok = Socket::inet_pton( AF_INET6(),'::1') && AF_INET6(); # spent 14µs making 1 call to Socket::inet_pton
317	1	11µs	1	220µs	$ok && Socket->import( qw/inet_pton NI_NUMERICHOST NI_NUMERICSERV/ ); # spent 220µs making 1 call to Exporter::import
318					# behavior different to Socket6::getnameinfo - wrap
319					*_getnameinfo = sub {
320					my ($err,$host,$port) = Socket::getnameinfo(@_) or return;
321					return if $err;
322					return ($host,$port);
323	1	15µs			};
324	1	2µs			$ok;
325	1	4µs			} \|\| eval {
326					require Socket6;
327					my $ok = Socket6::inet_pton( AF_INET6(),'::1') && AF_INET6();
328					$ok && Socket6->import( qw/inet_pton NI_NUMERICHOST NI_NUMERICSERV/ );
329					# behavior different to Socket::getnameinfo - wrap
330					*_getnameinfo = sub { return Socket6::getnameinfo(@_); };
331					$ok;
332					};
333
334					# try IO::Socket::IP or IO::Socket::INET6 for IPv6 support
335	1	2µs			$family_key = 'Domain'; # traditional
336	1	3µs			if ( $ip6 ) {
337					# if we have IO::Socket::IP >= 0.31 we will use this in preference
338					# because it can handle both IPv4 and IPv6
339	1	14µs			if ( eval {
340	1	12µs			require IO::Socket::IP;
341	1	30µs	1	13µs	IO::Socket::IP->VERSION(0.31) # spent 13µs making 1 call to version::_VERSION
342					}) {
343	1	31µs			@ISA = qw(IO::Socket::IP);
344	1	7µs	1	211µs	constant->import( CAN_IPV6 => "IO::Socket::IP" ); # spent 211µs making 1 call to constant::import
345	1	2µs			$family_key = 'Family';
346	1	2µs			$IOCLASS = "IO::Socket::IP";
347
348					# if we have IO::Socket::INET6 we will use this not IO::Socket::INET
349					# because it can handle both IPv4 and IPv6
350					# require at least 2.62 because of several problems before that version
351					} elsif( eval { require IO::Socket::INET6; IO::Socket::INET6->VERSION(2.62) } ) {
352					@ISA = qw(IO::Socket::INET6);
353					constant->import( CAN_IPV6 => "IO::Socket::INET6" );
354					$IOCLASS = "IO::Socket::INET6";
355					} else {
356					$ip6 = 0;
357					}
358					}
359
360					# fall back to IO::Socket::INET for IPv4 only
361	1	2µs			if ( ! $ip6 ) {
362					@ISA = qw(IO::Socket::INET);
363					$IOCLASS = "IO::Socket::INET";
364					constant->import( CAN_IPV6 => '' );
365					}
366
367					#Make $DEBUG another name for $Net::SSLeay::trace
368	1	11µs			*DEBUG = \$Net::SSLeay::trace;
369
370					#Compatibility
371	1	12µs			*ERROR = \$SSL_ERROR;
372	1	440µs	1	694µs	} # spent 694µs making 1 call to IO::Socket::SSL::BEGIN@308
373
374
375					sub DEBUG {
376					$DEBUG or return;
377					my (undef,$file,$line,$sub) = caller(1);
378					if ($sub =~m{^IO::Socket::SSL::(?:error\|(_internal_error))$}) {
379					(undef,$file,$line) = caller(2) if $1;
380					} else {
381					(undef,$file,$line) = caller;
382					}
383					my $msg = shift;
384					$file = '...'.substr( $file,-17 ) if length($file)>20;
385					$msg = sprintf $msg,@_ if @_;
386					print STDERR "DEBUG: $file:$line: $msg\n";
387					}
388
389					# spent 184µs (140+44) within IO::Socket::SSL::BEGIN@389 which was called: # once (140µs+44µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 404 BEGIN {
390					# import some constants from Net::SSLeay or use hard-coded defaults
391					# if Net::SSLeay isn't recent enough to provide the constants
392	1	7µs			my %const = (
393					NID_CommonName => 13,
394					GEN_DNS => 2,
395					GEN_IPADD => 7,
396					);
397	1	20µs			while ( my ($name,$value) = each %const ) {
398	2	198µs	2	125µs	# spent 75µs (24+51) within IO::Socket::SSL::BEGIN@398 which was called: # once (24µs+51µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 398 no strict 'refs'; # spent 75µs making 1 call to IO::Socket::SSL::BEGIN@398 # spent 51µs making 1 call to strict::unimport
399	6	134µs	3	44µs	*{$name} = UNIVERSAL::can( 'Net::SSLeay', $name ) \|\| sub { $value }; # spent 44µs making 3 calls to UNIVERSAL::can, avg 15µs/call
400					}
401
402	1	7µs			*idn_to_ascii = \&IO::Socket::SSL::PublicSuffix::idn_to_ascii;
403	1	10µs			*idn_to_unicode = \&IO::Socket::SSL::PublicSuffix::idn_to_unicode;
404	1	17.0ms	1	184µs	} # spent 184µs making 1 call to IO::Socket::SSL::BEGIN@389
405
406	1	19µs	1	10µs	my $OPENSSL_LIST_SEPARATOR = $^O =~m{^(?:(dos\|os2\|mswin32\|netware)\|vms)$}i # spent 10µs making 1 call to IO::Socket::SSL::CORE:match
407					? $1 ? ';' : ',' : ':';
408					my $CHECK_SSL_PATH = sub {
409					my %args = (@_ == 1) ? ('',@_) : @_;
410					for my $type (keys %args) {
411					my $path = $args{$type};
412					if (!$type) {
413					delete $args{$type};
414					$type = (ref($path) \|\| -d $path) ? 'SSL_ca_path' : 'SSL_ca_file';
415					$args{$type} = $path;
416					}
417
418					next if ref($path) eq 'SCALAR' && ! $$path;
419					if ($type eq 'SSL_ca_file') {
420					die "SSL_ca_file $path can't be used: $!"
421					if ! open(my $fh,'<',$path);
422					} elsif ($type eq 'SSL_ca_path') {
423					$path = [ split($OPENSSL_LIST_SEPARATOR,$path) ] if !ref($path);
424					my @err;
425					for my $d (ref($path) ? @$path : $path) {
426					if (! -d $d) {
427					push @err, "SSL_ca_path $d does not exist";
428					} elsif (! opendir(my $dh,$d)) {
429					push @err, "SSL_ca_path $d is not accessible: $!"
430					} else {
431					@err = ();
432					last
433					}
434					}
435					die "@err" if @err;
436					}
437					}
438					return %args;
439	1	12µs			};
440
441
442					{
443	1	2µs			my %default_ca;
444					my $ca_detected; # 0: never detect, undef: need to (re)detect
445	1	2µs			my $openssldir;
446
447					sub default_ca {
448					if (@_) {
449					# user defined default CA or reset
450					if ( @_ > 1 ) {
451					%default_ca = @_;
452					$ca_detected = 0;
453					} elsif ( my $path = shift ) {
454					%default_ca = $CHECK_SSL_PATH->($path);
455					$ca_detected = 0;
456					} else {
457					$ca_detected = undef;
458					}
459					}
460					return %default_ca if defined $ca_detected;
461
462					# SSLEAY_DIR was 5 up to OpenSSL 1.1, then switched to 4 and got
463					# renamed to OPENSSL_DIR. Unfortunately it is not exported as constant
464					# by Net::SSLeay so we use the fixed number.
465					$openssldir \|\|=
466					Net::SSLeay::SSLeay_version(5) =~m{^OPENSSLDIR: "(.+)"$} ? $1 :
467					Net::SSLeay::SSLeay_version(4) =~m{^OPENSSLDIR: "(.+)"$} ? $1 :
468					'cannot-determine-openssldir-from-ssleay-version';
469
470					# (re)detect according to openssl crypto/cryptlib.h
471					my $dir = $ENV{SSL_CERT_DIR}
472					\|\| ( $^O =~m{vms}i ? "SSLCERTS:":"$openssldir/certs" );
473					if ( opendir(my $dh,$dir)) {
474					FILES: for my $f ( grep { m{^[a-f\d]{8}(\.\d+)?$} } readdir($dh) ) {
475					open( my $fh,'<',"$dir/$f") or next;
476					while (my $line = <$fh>) {
477					$line =~m{^-+BEGIN (X509 \|TRUSTED \|)CERTIFICATE-} or next;
478					$default_ca{SSL_ca_path} = $dir;
479					last FILES;
480					}
481					}
482					}
483					my $file = $ENV{SSL_CERT_FILE}
484					\|\| ( $^O =~m{vms}i ? "SSLCERTS:cert.pem":"$openssldir/cert.pem" );
485					if ( open(my $fh,'<',$file)) {
486					while (my $line = <$fh>) {
487					$line =~m{^-+BEGIN (X509 \|TRUSTED \|)CERTIFICATE-} or next;
488					$default_ca{SSL_ca_file} = $file;
489					last;
490					}
491					}
492
493					$default_ca{SSL_ca_file} = Mozilla::CA::SSL_ca_file() if ! %default_ca && do {
494					local $SIG{__DIE__};
495					eval { require Mozilla::CA; 1 };
496					};
497
498					$ca_detected = 1;
499					return %default_ca;
500					}
501					}
502
503
504					# Export some stuff
505					# inet4\|inet6\|debug will be handled by myself, everything
506					# else will be handled the Exporter way
507	1	3µs			sub import {
508					my $class = shift;
509
510					my @export;
511					foreach (@_) {
512					if ( /^inet4$/i ) {
513					# explicitly fall back to inet4
514					@ISA = 'IO::Socket::INET';
515					@caller_force_inet4 = caller(); # save for warnings for 'inet6' case
516					} elsif ( /^inet6$/i ) {
517					# check if we have already ipv6 as base
518					if ( ! UNIVERSAL::isa( $class, 'IO::Socket::INET6')
519					and ! UNIVERSAL::isa( $class, 'IO::Socket::IP' )) {
520					# either we don't support it or we disabled it by explicitly
521					# loading it with 'inet4'. In this case re-enable but warn
522					# because this is probably an error
523					if ( CAN_IPV6 ) {
524					@ISA = ( CAN_IPV6 );
525					warn "IPv6 support re-enabled in __PACKAGE__, got disabled in file $caller_force_inet4[1] line $caller_force_inet4[2]";
526					} else {
527					die "INET6 is not supported, install IO::Socket::IP";
528					}
529					}
530					} elsif ( /^:?debug(\d+)/ ) {
531					$DEBUG=$1;
532					} else {
533					push @export,$_
534					}
535					}
536
537					@_ = ( $class,@export );
538					goto &Exporter::import;
539					}
540
541	1	2µs			my %SSL_OBJECT;
542					my %CREATED_IN_THIS_THREAD;
543					sub CLONE { %CREATED_IN_THIS_THREAD = (); }
544
545					# all keys used internally, these should be cleaned up at end
546	1	7µs			my @all_my_keys = qw(
547					_SSL_arguments
548					_SSL_certificate
549					_SSL_ctx
550					_SSL_fileno
551					_SSL_in_DESTROY
552					_SSL_ioclass_downgrade
553					_SSL_ioclass_upgraded
554					_SSL_last_err
555					_SSL_object
556					_SSL_ocsp_verify
557					_SSL_opened
558					_SSL_opening
559					_SSL_servername
560					);
561
562
563					# we have callbacks associated with contexts, but have no way to access the
564					# current SSL object from these callbacks. To work around this
565					# CURRENT_SSL_OBJECT will be set before calling Net::SSLeay::{connect,accept}
566					# and reset afterwards, so we have access to it inside _internal_error.
567	1	2µs			my $CURRENT_SSL_OBJECT;
568
569					# You might be expecting to find a new() subroutine here, but that is
570					# not how IO::Socket::INET works. All configuration gets performed in
571					# the calls to configure() and either connect() or accept().
572
573					#Call to configure occurs when a new socket is made using
574					#IO::Socket::INET. Returns false (empty list) on failure.
575					sub configure {
576					my ($self, $arg_hash) = @_;
577					return _invalid_object() unless($self);
578
579					# force initial blocking
580					# otherwise IO::Socket::SSL->new might return undef if the
581					# socket is nonblocking and it fails to connect immediately
582					# for real nonblocking behavior one should create a nonblocking
583					# socket and later call connect explicitly
584					my $blocking = delete $arg_hash->{Blocking};
585
586					# because Net::HTTPS simple redefines blocking() to {} (e.g.
587					# return undef) and IO::Socket::INET does not like this we
588					# set Blocking only explicitly if it was set
589					$arg_hash->{Blocking} = 1 if defined ($blocking);
590
591					$self->configure_SSL($arg_hash) \|\| return;
592
593					if ($arg_hash->{$family_key} \|\|= $arg_hash->{Domain} \|\| $arg_hash->{Family}) {
594					# Hack to work around the problem that IO::Socket::IP defaults to
595					# AI_ADDRCONFIG which creates problems if we have only the loopback
596					# interface. If we already know the family this flag is more harmful
597					# then useful.
598					$arg_hash->{GetAddrInfoFlags} = 0 if $IOCLASS eq 'IO::Socket::IP'
599					&& ! defined $arg_hash->{GetAddrInfoFlags};
600					}
601					return $self->_internal_error("@ISA configuration failed",0)
602					if ! $self->SUPER::configure($arg_hash);
603
604					$self->blocking(0) if defined $blocking && !$blocking;
605					return $self;
606					}
607
608					sub configure_SSL {
609					my ($self, $arg_hash) = @_;
610
611					$arg_hash->{Proto} \|\|= 'tcp';
612					my $is_server = $arg_hash->{SSL_server};
613					if ( ! defined $is_server ) {
614					$is_server = $arg_hash->{SSL_server} = $arg_hash->{Listen} \|\| 0;
615					}
616
617					# add user defined defaults, maybe after filtering
618					$FILTER_SSL_ARGS->($is_server,$arg_hash) if $FILTER_SSL_ARGS;
619
620					delete @{*$self}{@all_my_keys};
621					${*$self}{_SSL_opened} = $is_server;
622					${*$self}{_SSL_arguments} = $arg_hash;
623
624					# this adds defaults to $arg_hash as a side effect!
625					${*$self}{'_SSL_ctx'} = IO::Socket::SSL::SSL_Context->new($arg_hash)
626					or return;
627
628					return $self;
629					}
630
631
632					sub _skip_rw_error {
633					my ($self,$ssl,$rv) = @_;
634					my $err = Net::SSLeay::get_error($ssl,$rv);
635					if ( $err == $Net_SSLeay_ERROR_WANT_READ) {
636					$SSL_ERROR = SSL_WANT_READ;
637					} elsif ( $err == $Net_SSLeay_ERROR_WANT_WRITE) {
638					$SSL_ERROR = SSL_WANT_WRITE;
639					} else {
640					return $err;
641					}
642					$! \|\|= EWOULDBLOCK;
643					${*$self}{_SSL_last_err} = [$SSL_ERROR,4] if ref($self);
644					Net::SSLeay::ERR_clear_error();
645					return 0;
646					}
647
648
649					# Call to connect occurs when a new client socket is made using IO::Socket::*
650					sub connect {
651					my $self = shift \|\| return _invalid_object();
652					return $self if ${*$self}{'_SSL_opened'}; # already connected
653
654					if ( ! ${*$self}{'_SSL_opening'} ) {
655					# call SUPER::connect if the underlying socket is not connected
656					# if this fails this might not be an error (e.g. if $! = EINPROGRESS
657					# and socket is nonblocking this is normal), so keep any error
658					# handling to the client
659					$DEBUG>=2 && DEBUG('socket not yet connected' );
660					$self->SUPER::connect(@_) \|\| return;
661					$DEBUG>=2 && DEBUG('socket connected' );
662
663					# IO::Socket works around systems, which return EISCONN or similar
664					# on non-blocking re-connect by returning true, even if $! is set
665					# but it does not clear $!, so do it here
666					$! = undef;
667
668					# don't continue with connect_SSL if SSL_startHandshake is set to 0
669					my $sh = ${*$self}{_SSL_arguments}{SSL_startHandshake};
670					return $self if defined $sh && ! $sh;
671					}
672					return $self->connect_SSL;
673					}
674
675
676					sub connect_SSL {
677					my $self = shift;
678					my $args = @_>1 ? {@_}: $_[0]\|\|{};
679					return $self if ${*$self}{'_SSL_opened'}; # already connected
680
681					my ($ssl,$ctx);
682					if ( ! ${*$self}{'_SSL_opening'} ) {
683					# start ssl connection
684					$DEBUG>=2 && DEBUG('ssl handshake not started' );
685					${*$self}{'_SSL_opening'} = 1;
686					my $arg_hash = ${*$self}{'_SSL_arguments'};
687
688					my $fileno = ${*$self}{'_SSL_fileno'} = fileno($self);
689					return $self->_internal_error("Socket has no fileno",9)
690					if ! defined $fileno;
691
692					$ctx = ${*$self}{'_SSL_ctx'}; # Reference to real context
693					$ssl = ${*$self}{'_SSL_object'} = Net::SSLeay::new($ctx->{context})
694					\|\| return $self->error("SSL structure creation failed");
695					$CREATED_IN_THIS_THREAD{$ssl} = 1 if $use_threads;
696					$SSL_OBJECT{$ssl} = [$self,0];
697					weaken($SSL_OBJECT{$ssl}[0]);
698
699					Net::SSLeay::set_fd($ssl, $fileno)
700					\|\| return $self->error("SSL filehandle association failed");
701
702					if ( $can_client_sni ) {
703					my $host;
704					if ( exists $arg_hash->{SSL_hostname} ) {
705					# explicitly given
706					# can be set to undef/'' to not use extension
707					$host = $arg_hash->{SSL_hostname}
708					} elsif ( $host = $arg_hash->{PeerAddr} \|\| $arg_hash->{PeerHost} ) {
709					# implicitly given
710					$host =~s{:[a-zA-Z0-9_\-]+$}{};
711					# should be hostname, not IPv4/6
712					$host = undef if $host !~m{[a-z_]} or $host =~m{:};
713					}
714					# define SSL_CTRL_SET_TLSEXT_HOSTNAME 55
715					# define TLSEXT_NAMETYPE_host_name 0
716					if ($host) {
717					$DEBUG>=2 && DEBUG("using SNI with hostname $host");
718					Net::SSLeay::ctrl($ssl,55,0,$host);
719					} else {
720					$DEBUG>=2 && DEBUG("not using SNI because hostname is unknown");
721					}
722					} elsif ( $arg_hash->{SSL_hostname} ) {
723					return $self->_internal_error(
724					"Client side SNI not supported for this openssl",9);
725					} else {
726					$DEBUG>=2 && DEBUG("not using SNI because openssl is too old");
727					}
728
729					$arg_hash->{PeerAddr} \|\| $arg_hash->{PeerHost} \|\| $self->_update_peer;
730					if ( $ctx->{verify_name_ref} ) {
731					# need target name for update
732					my $host = $arg_hash->{SSL_verifycn_name}
733					\|\| $arg_hash->{SSL_hostname};
734					if ( ! defined $host ) {
735					if ( $host = $arg_hash->{PeerAddr} \|\| $arg_hash->{PeerHost} ) {
736					$host =~s{:[a-zA-Z0-9_\-]+$}{};
737					}
738					}
739					${$ctx->{verify_name_ref}} = $host;
740					}
741
742					my $ocsp = $ctx->{ocsp_mode};
743					if ( $ocsp & SSL_OCSP_NO_STAPLE ) {
744					# don't try stapling
745					} elsif ( ! $can_ocsp_staple ) {
746					croak("OCSP stapling not support") if $ocsp & SSL_OCSP_MUST_STAPLE;
747					} elsif ( $ocsp & (SSL_OCSP_TRY_STAPLE\|SSL_OCSP_MUST_STAPLE)) {
748					# staple by default if verification enabled
749					${*$self}{_SSL_ocsp_verify} = undef;
750					Net::SSLeay::set_tlsext_status_type($ssl,
751					Net::SSLeay::TLSEXT_STATUSTYPE_ocsp());
752					$DEBUG>=2 && DEBUG("request OCSP stapling");
753					}
754
755					if ($ctx->{session_cache}
756					and my $session = $ctx->{session_cache}->get_session(
757					$arg_hash->{SSL_session_key} \|\| do {
758					my $host = $arg_hash->{PeerAddr} \|\| $arg_hash->{PeerHost};
759					my $port = $arg_hash->{PeerPort} \|\| $arg_hash->{PeerService};
760					$port ? "$host:$port" : $host;
761					}
762					)) {
763					Net::SSLeay::set_session($ssl, $session);
764					}
765					}
766
767					$ssl \|\|= ${*$self}{'_SSL_object'};
768
769					$SSL_ERROR = $! = undef;
770					my $timeout = exists $args->{Timeout}
771					? $args->{Timeout}
772					: ${*$self}{io_socket_timeout}; # from IO::Socket
773					if ( defined($timeout) && $timeout>0 && $self->blocking(0) ) {
774					$DEBUG>=2 && DEBUG( "set socket to non-blocking to enforce timeout=$timeout" );
775					# timeout was given and socket was blocking
776					# enforce timeout with now non-blocking socket
777					} else {
778					# timeout does not apply because invalid or socket non-blocking
779					$timeout = undef;
780					}
781
782					my $start = defined($timeout) && time();
783					{
784					$SSL_ERROR = undef;
785					$CURRENT_SSL_OBJECT = $self;
786					$DEBUG>=3 && DEBUG("call Net::SSLeay::connect" );
787					my $rv = Net::SSLeay::connect($ssl);
788					$CURRENT_SSL_OBJECT = undef;
789					$DEBUG>=3 && DEBUG("done Net::SSLeay::connect -> $rv" );
790					if ( $rv < 0 ) {
791					if ( my $err = $self->_skip_rw_error( $ssl,$rv )) {
792					$self->error("SSL connect attempt failed");
793					delete ${*$self}{'_SSL_opening'};
794					${*$self}{'_SSL_opened'} = -1;
795					$DEBUG>=1 && DEBUG( "fatal SSL error: $SSL_ERROR" );
796					return $self->fatal_ssl_error();
797					}
798
799					$DEBUG>=2 && DEBUG('ssl handshake in progress' );
800					# connect failed because handshake needs to be completed
801					# if socket was non-blocking or no timeout was given return with this error
802					return if ! defined($timeout);
803
804					# wait until socket is readable or writable
805					my $rv;
806					if ( $timeout>0 ) {
807					my $vec = '';
808					vec($vec,$self->fileno,1) = 1;
809					$DEBUG>=2 && DEBUG( "waiting for fd to become ready: $SSL_ERROR" );
810					$rv =
811					$SSL_ERROR == SSL_WANT_READ ? select( $vec,undef,undef,$timeout) :
812					$SSL_ERROR == SSL_WANT_WRITE ? select( undef,$vec,undef,$timeout) :
813					undef;
814					} else {
815					$DEBUG>=2 && DEBUG("handshake failed because no more time" );
816					$! = ETIMEDOUT
817					}
818					if ( ! $rv ) {
819					$DEBUG>=2 && DEBUG("handshake failed because socket did not became ready" );
820					# failed because of timeout, return
821					$! \|\|= ETIMEDOUT;
822					delete ${*$self}{'_SSL_opening'};
823					${*$self}{'_SSL_opened'} = -1;
824					$self->blocking(1); # was blocking before
825					return
826					}
827
828					# socket is ready, try non-blocking connect again after recomputing timeout
829					$DEBUG>=2 && DEBUG("socket ready, retrying connect" );
830					my $now = time();
831					$timeout -= $now - $start;
832					$start = $now;
833					redo;
834
835					} elsif ( $rv == 0 ) {
836					delete ${*$self}{'_SSL_opening'};
837					$DEBUG>=2 && DEBUG("connection failed - connect returned 0" );
838					$self->error("SSL connect attempt failed because of handshake problems" );
839					${*$self}{'_SSL_opened'} = -1;
840					return $self->fatal_ssl_error();
841					}
842					}
843
844					$DEBUG>=2 && DEBUG('ssl handshake done' );
845					# ssl connect successful
846					delete ${*$self}{'_SSL_opening'};
847					${*$self}{'_SSL_opened'}=1;
848					if (defined($timeout)) {
849					$self->blocking(1); # reset back to blocking
850					$! = undef; # reset errors from non-blocking
851					}
852
853					$ctx \|\|= ${*$self}{'_SSL_ctx'};
854
855					if ( my $ocsp_result = ${*$self}{_SSL_ocsp_verify} ) {
856					# got result from OCSP stapling
857					if ( $ocsp_result->[0] > 0 ) {
858					$DEBUG>=3 && DEBUG("got OCSP success with stapling");
859					# successful validated
860					} elsif ( $ocsp_result->[0] < 0 ) {
861					# Permanent problem with validation because certificate
862					# is either self-signed or the issuer cannot be found.
863					# Ignore here, because this will cause other errors too.
864					$DEBUG>=3 && DEBUG("got OCSP failure with stapling: %s",
865					$ocsp_result->[1]);
866					} else {
867					# definitely revoked
868					$DEBUG>=3 && DEBUG("got OCSP revocation with stapling: %s",
869					$ocsp_result->[1]);
870					$self->_internal_error($ocsp_result->[1],5);
871					return $self->fatal_ssl_error();
872					}
873					} elsif ( $ctx->{ocsp_mode} & SSL_OCSP_MUST_STAPLE ) {
874					$self->_internal_error("did not receive the required stapled OCSP response",5);
875					return $self->fatal_ssl_error();
876					}
877
878					if ( $ctx->{session_cache}
879					and my $session = Net::SSLeay::get1_session($ssl)) {
880					my $arg_hash = ${*$self}{'_SSL_arguments'};
881					$ctx->{session_cache}->add_session(
882					$arg_hash->{SSL_session_key} \|\| do {
883					my $host = $arg_hash->{PeerAddr} \|\| $arg_hash->{PeerHost}
884					\|\| $self->_update_peer;
885					my $port = $arg_hash->{PeerPort} \|\| $arg_hash->{PeerService};
886					$port ? "$host:$port" : $host;
887					},
888					$session
889					);
890					}
891
892					tie *{$self}, "IO::Socket::SSL::SSL_HANDLE", $self;
893
894					return $self;
895					}
896
897					# called if PeerAddr is not set in ${*$self}{'_SSL_arguments'}
898					# this can be the case if start_SSL is called with a normal IO::Socket::INET
899					# so that PeerAddr\|PeerPort are not set from args
900					# returns PeerAddr
901					sub _update_peer {
902					my $self = shift;
903					my $arg_hash = ${*$self}{'_SSL_arguments'};
904					eval {
905					my $sockaddr = getpeername( $self );
906					my $af = sockaddr_family($sockaddr);
907					if( CAN_IPV6 && $af == AF_INET6 ) {
908					my (undef, $host, $port) = _getnameinfo($sockaddr,
909					NI_NUMERICHOST \| NI_NUMERICSERV);
910					$arg_hash->{PeerPort} = $port;
911					$arg_hash->{PeerAddr} = $host;
912					} else {
913					my ($port,$addr) = sockaddr_in( $sockaddr);
914					$arg_hash->{PeerPort} = $port;
915					$arg_hash->{PeerAddr} = inet_ntoa( $addr );
916					}
917					}
918					}
919
920					#Call to accept occurs when a new client connects to a server using
921					#IO::Socket::SSL
922					sub accept {
923					my $self = shift \|\| return _invalid_object();
924					my $class = shift \|\| 'IO::Socket::SSL';
925
926					my $socket = ${*$self}{'_SSL_opening'};
927					if ( ! $socket ) {
928					# underlying socket not done
929					$DEBUG>=2 && DEBUG('no socket yet' );
930					$socket = $self->SUPER::accept($class) \|\| return;
931					$DEBUG>=2 && DEBUG('accept created normal socket '.$socket );
932
933					# don't continue with accept_SSL if SSL_startHandshake is set to 0
934					my $sh = ${*$self}{_SSL_arguments}{SSL_startHandshake};
935					if (defined $sh && ! $sh) {
936					${$socket}{_SSL_ctx} = ${$self}{_SSL_ctx};
937					${*$socket}{_SSL_arguments} = {
938					%{${*$self}{_SSL_arguments}},
939					SSL_server => 0,
940					};
941					$DEBUG>=2 && DEBUG('will not start SSL handshake yet');
942					return wantarray ? ($socket, getpeername($socket) ) : $socket
943					}
944					}
945
946					$self->accept_SSL($socket) \|\| return;
947					$DEBUG>=2 && DEBUG('accept_SSL ok' );
948
949					return wantarray ? ($socket, getpeername($socket) ) : $socket;
950					}
951
952					sub accept_SSL {
953					my $self = shift;
954					my $socket = ( @_ && UNIVERSAL::isa( $_[0], 'IO::Handle' )) ? shift : $self;
955					my $args = @_>1 ? {@_}: $_[0]\|\|{};
956
957					my $ssl;
958					if ( ! ${*$self}{'_SSL_opening'} ) {
959					$DEBUG>=2 && DEBUG('starting sslifying' );
960					${*$self}{'_SSL_opening'} = $socket;
961					if ($socket != $self) {
962					${$socket}{_SSL_ctx} = ${$self}{_SSL_ctx};
963					${*$socket}{_SSL_arguments} = {
964					%{${*$self}{_SSL_arguments}},
965					SSL_server => 0
966					};
967					}
968
969					my $fileno = ${*$socket}{'_SSL_fileno'} = fileno($socket);
970					return $socket->_internal_error("Socket has no fileno",9)
971					if ! defined $fileno;
972
973					$ssl = ${*$socket}{_SSL_object} =
974					Net::SSLeay::new(${*$socket}{_SSL_ctx}{context})
975					\|\| return $socket->error("SSL structure creation failed");
976					$CREATED_IN_THIS_THREAD{$ssl} = 1 if $use_threads;
977					$SSL_OBJECT{$ssl} = [$socket,1];
978					weaken($SSL_OBJECT{$ssl}[0]);
979
980					Net::SSLeay::set_fd($ssl, $fileno)
981					\|\| return $socket->error("SSL filehandle association failed");
982					}
983
984					$ssl \|\|= ${*$socket}{'_SSL_object'};
985
986					$SSL_ERROR = $! = undef;
987					#$DEBUG>=2 && DEBUG('calling ssleay::accept' );
988
989					my $timeout = exists $args->{Timeout}
990					? $args->{Timeout}
991					: ${*$self}{io_socket_timeout}; # from IO::Socket
992					if ( defined($timeout) && $timeout>0 && $socket->blocking(0) ) {
993					# timeout was given and socket was blocking
994					# enforce timeout with now non-blocking socket
995					} else {
996					# timeout does not apply because invalid or socket non-blocking
997					$timeout = undef;
998					}
999
1000					my $start = defined($timeout) && time();
1001					{
1002					$SSL_ERROR = undef;
1003					$CURRENT_SSL_OBJECT = $self;
1004					my $rv = Net::SSLeay::accept($ssl);
1005					$CURRENT_SSL_OBJECT = undef;
1006					$DEBUG>=3 && DEBUG( "Net::SSLeay::accept -> $rv" );
1007					if ( $rv < 0 ) {
1008					if ( my $err = $socket->_skip_rw_error( $ssl,$rv )) {
1009					$socket->error("SSL accept attempt failed");
1010					delete ${*$self}{'_SSL_opening'};
1011					${*$socket}{'_SSL_opened'} = -1;
1012					return $socket->fatal_ssl_error();
1013					}
1014
1015					# accept failed because handshake needs to be completed
1016					# if socket was non-blocking or no timeout was given return with this error
1017					return if ! defined($timeout);
1018
1019					# wait until socket is readable or writable
1020					my $rv;
1021					if ( $timeout>0 ) {
1022					my $vec = '';
1023					vec($vec,$socket->fileno,1) = 1;
1024					$rv =
1025					$SSL_ERROR == SSL_WANT_READ ? select( $vec,undef,undef,$timeout) :
1026					$SSL_ERROR == SSL_WANT_WRITE ? select( undef,$vec,undef,$timeout) :
1027					undef;
1028					} else {
1029					$! = ETIMEDOUT
1030					}
1031					if ( ! $rv ) {
1032					# failed because of timeout, return
1033					$! \|\|= ETIMEDOUT;
1034					delete ${*$self}{'_SSL_opening'};
1035					${*$socket}{'_SSL_opened'} = -1;
1036					$socket->blocking(1); # was blocking before
1037					return
1038					}
1039
1040					# socket is ready, try non-blocking accept again after recomputing timeout
1041					my $now = time();
1042					$timeout -= $now - $start;
1043					$start = $now;
1044					redo;
1045
1046					} elsif ( $rv == 0 ) {
1047					$socket->error("SSL accept attempt failed because of handshake problems" );
1048					delete ${*$self}{'_SSL_opening'};
1049					${*$socket}{'_SSL_opened'} = -1;
1050					return $socket->fatal_ssl_error();
1051					}
1052					}
1053
1054					$DEBUG>=2 && DEBUG('handshake done, socket ready' );
1055					# socket opened
1056					delete ${*$self}{'_SSL_opening'};
1057					${*$socket}{'_SSL_opened'} = 1;
1058					if (defined($timeout)) {
1059					$socket->blocking(1); # reset back to blocking
1060					$! = undef; # reset errors from non-blocking
1061					}
1062
1063					tie *{$socket}, "IO::Socket::SSL::SSL_HANDLE", $socket;
1064
1065					return $socket;
1066					}
1067
1068
1069					####### I/O subroutines ########################
1070
1071					sub _generic_read {
1072					my ($self, $read_func, undef, $length, $offset) = @_;
1073					my $ssl = ${*$self}{_SSL_object} \|\| return;
1074					my $buffer=\$_[2];
1075
1076					$SSL_ERROR = $! = undef;
1077					my ($data,$rwerr) = $read_func->($ssl, $length);
1078					while ( ! defined($data)) {
1079					if ( my $err = $self->_skip_rw_error( $ssl, defined($rwerr) ? $rwerr:-1 )) {
1080					if ($err == $Net_SSLeay_ERROR_SYSCALL) {
1081					# OpenSSL 1.1.0c+ : EOF can now result in SSL_read returning -1
1082					if (not $!) {
1083					# SSL_ERROR_SYSCALL but not errno -> treat as EOF
1084					$data = '';
1085					last;
1086					}
1087					}
1088					$self->error("SSL read error");
1089					}
1090					return;
1091					}
1092
1093					$length = length($data);
1094					$$buffer = '' if !defined $$buffer;
1095					$offset \|\|= 0;
1096					if ($offset>length($$buffer)) {
1097					$$buffer.="\0" x ($offset-length($$buffer)); #mimic behavior of read
1098					}
1099
1100					substr($$buffer, $offset, length($$buffer), $data);
1101					return $length;
1102					}
1103
1104					sub read {
1105					my $self = shift;
1106					${*$self}{_SSL_object} && return _generic_read($self,
1107					$self->blocking ? \&Net::SSLeay::ssl_read_all : \&Net::SSLeay::read,
1108					@_
1109					);
1110
1111					# fall back to plain read if we are not required to use SSL yet
1112					return $self->SUPER::read(@_);
1113					}
1114
1115					# contrary to the behavior of read sysread can read partial data
1116					sub sysread {
1117					my $self = shift;
1118					${*$self}{_SSL_object} && return _generic_read( $self,
1119					\&Net::SSLeay::read, @_ );
1120
1121					# fall back to plain sysread if we are not required to use SSL yet
1122					my $rv = $self->SUPER::sysread(@_);
1123					return $rv;
1124					}
1125
1126					sub peek {
1127					my $self = shift;
1128					${*$self}{_SSL_object} && return _generic_read( $self,
1129					\&Net::SSLeay::peek, @_ );
1130
1131					# fall back to plain peek if we are not required to use SSL yet
1132					# emulate peek with recv(...,MS_PEEK) - peek(buf,len,offset)
1133					return if ! defined recv($self,my $buf,$_[1],MSG_PEEK);
1134					$_[0] = $_[2] ? substr($_[0],0,$_[2]).$buf : $buf;
1135					return length($buf);
1136					}
1137
1138
1139					sub _generic_write {
1140					my ($self, $write_all, undef, $length, $offset) = @_;
1141
1142					my $ssl = ${*$self}{_SSL_object} \|\| return;
1143					my $buffer = \$_[2];
1144
1145					my $buf_len = length($$buffer);
1146					$length \|\|= $buf_len;
1147					$offset \|\|= 0;
1148					return $self->_internal_error("Invalid offset for SSL write",9)
1149					if $offset>$buf_len;
1150					return 0 if ($offset == $buf_len);
1151
1152					$SSL_ERROR = $! = undef;
1153					my $written;
1154					if ( $write_all ) {
1155					my $data = $length < $buf_len-$offset ? substr($$buffer, $offset, $length) : $$buffer;
1156					($written, my $errs) = Net::SSLeay::ssl_write_all($ssl, $data);
1157					# ssl_write_all returns number of bytes written
1158					$written = undef if ! $written && $errs;
1159					} else {
1160					$written = Net::SSLeay::write_partial( $ssl,$offset,$length,$$buffer );
1161					# write_partial does SSL_write which returns -1 on error
1162					$written = undef if $written < 0;
1163					}
1164					if ( !defined($written) ) {
1165					if ( my $err = $self->_skip_rw_error( $ssl,-1 )) {
1166					# if $! is not set with ERROR_SYSCALL then report as EPIPE
1167					$! \|\|= EPIPE if $err == $Net_SSLeay_ERROR_SYSCALL;
1168					$self->error("SSL write error ($err)");
1169					}
1170					return;
1171					}
1172
1173					return $written;
1174					}
1175
1176					# if socket is blocking write() should return only on error or
1177					# if all data are written
1178					sub write {
1179					my $self = shift;
1180					${*$self}{_SSL_object} && return _generic_write( $self,
1181					scalar($self->blocking),@_ );
1182
1183					# fall back to plain write if we are not required to use SSL yet
1184					return $self->SUPER::write(@_);
1185					}
1186
1187					# contrary to write syswrite() returns already if only
1188					# a part of the data is written
1189					sub syswrite {
1190					my $self = shift;
1191					${*$self}{_SSL_object} && return _generic_write($self,0,@_);
1192
1193					# fall back to plain syswrite if we are not required to use SSL yet
1194					return $self->SUPER::syswrite(@_);
1195					}
1196
1197					sub print {
1198					my $self = shift;
1199					my $string = join(($, or ''), @_, ($\ or ''));
1200					return $self->write( $string );
1201					}
1202
1203					sub printf {
1204					my ($self,$format) = (shift,shift);
1205					return $self->write(sprintf($format, @_));
1206					}
1207
1208					sub getc {
1209					my ($self, $buffer) = (shift, undef);
1210					return $buffer if $self->read($buffer, 1, 0);
1211					}
1212
1213					sub readline {
1214					my $self = shift;
1215					${*$self}{_SSL_object} or return $self->SUPER::getline;
1216
1217					if ( not defined $/ or wantarray) {
1218					# read all and split
1219
1220					my $buf = '';
1221					while (1) {
1222					my $rv = $self->sysread($buf,2**16,length($buf));
1223					if ( ! defined $rv ) {
1224					next if $! == EINTR; # retry
1225					last if $! == EWOULDBLOCK \|\| $! == EAGAIN; # use everything so far
1226					return; # return error
1227					} elsif ( ! $rv ) {
1228					last
1229					}
1230					}
1231
1232					if ( ! defined $/ ) {
1233					return $buf
1234					} elsif ( ref($/)) {
1235					my $size = ${$/};
1236					die "bad value in ref \$/: $size" unless $size>0;
1237					return $buf=~m{\G(.{1,$size})}g;
1238					} elsif ( $/ eq '' ) {
1239					return $buf =~m{\G(.*\n\n+\|.+)}g;
1240					} else {
1241					return $buf =~m{\G(.*$/\|.+)}g;
1242					}
1243					}
1244
1245					# read only one line
1246					if ( ref($/) ) {
1247					my $size = ${$/};
1248					# read record of $size bytes
1249					die "bad value in ref \$/: $size" unless $size>0;
1250					my $buf = '';
1251					while ( $size>length($buf)) {
1252					my $rv = $self->sysread($buf,$size-length($buf),length($buf));
1253					if ( ! defined $rv ) {
1254					next if $! == EINTR; # retry
1255					last if $! == EWOULDBLOCK \|\| $! == EAGAIN; # use everything so far
1256					return; # return error
1257					} elsif ( ! $rv ) {
1258					last
1259					}
1260					}
1261					return $buf;
1262					}
1263
1264					my ($delim0,$delim1) = $/ eq '' ? ("\n\n","\n"):($/,'');
1265
1266					# find first occurrence of $delim0 followed by as much as possible $delim1
1267					my $buf = '';
1268					my $eod = 0; # pointer into $buf after $delim0 $delim1*
1269					my $ssl = $self->_get_ssl_object or return;
1270					while (1) {
1271
1272					# wait until we have more data or eof
1273					my $poke = Net::SSLeay::peek($ssl,1);
1274					if ( ! defined $poke or $poke eq '' ) {
1275					next if $! == EINTR;
1276					}
1277
1278					my $skip = 0;
1279
1280					# peek into available data w/o reading
1281					my $pending = Net::SSLeay::pending($ssl);
1282					if ( $pending and
1283					( my $pb = Net::SSLeay::peek( $ssl,$pending )) ne '' ) {
1284					$buf .= $pb
1285					} else {
1286					return $buf eq '' ? ():$buf;
1287					}
1288					if ( !$eod ) {
1289					my $pos = index( $buf,$delim0 );
1290					if ( $pos<0 ) {
1291					$skip = $pending
1292					} else {
1293					$eod = $pos + length($delim0); # pos after delim0
1294					}
1295					}
1296
1297					if ( $eod ) {
1298					if ( $delim1 ne '' ) {
1299					# delim0 found, check for as much delim1 as possible
1300					while ( index( $buf,$delim1,$eod ) == $eod ) {
1301					$eod+= length($delim1);
1302					}
1303					}
1304					$skip = $pending - ( length($buf) - $eod );
1305					}
1306
1307					# remove data from $self which I already have in buf
1308					while ( $skip>0 ) {
1309					if ($self->sysread(my $p,$skip,0)) {
1310					$skip -= length($p);
1311					next;
1312					}
1313					$! == EINTR or last;
1314					}
1315
1316					if ( $eod and ( $delim1 eq '' or $eod < length($buf))) {
1317					# delim0 found and there can be no more delim1 pending
1318					last
1319					}
1320					}
1321					return substr($buf,0,$eod);
1322					}
1323
1324					sub close {
1325					my $self = shift \|\| return _invalid_object();
1326					my $close_args = (ref($_[0]) eq 'HASH') ? $_[0] : {@_};
1327
1328					return if ! $self->stop_SSL(
1329					SSL_fast_shutdown => 1,
1330					%$close_args,
1331					_SSL_ioclass_downgrade => 0,
1332					);
1333
1334					if ( ! $close_args->{_SSL_in_DESTROY} ) {
1335					untie( *$self );
1336					undef ${*$self}{_SSL_fileno};
1337					return $self->SUPER::close;
1338					}
1339					return 1;
1340					}
1341
1342					sub is_SSL {
1343					my $self = pop;
1344					return ${*$self}{_SSL_object} && 1
1345					}
1346
1347					sub stop_SSL {
1348					my $self = shift \|\| return _invalid_object();
1349					my $stop_args = (ref($_[0]) eq 'HASH') ? $_[0] : {@_};
1350					$stop_args->{SSL_no_shutdown} = 1 if ! ${*$self}{_SSL_opened};
1351
1352					if (my $ssl = ${*$self}{'_SSL_object'}) {
1353					if ( ! $stop_args->{SSL_no_shutdown} ) {
1354					my $status = Net::SSLeay::get_shutdown($ssl);
1355
1356					my $timeout =
1357					not($self->blocking) ? undef :
1358					exists $stop_args->{Timeout} ? $stop_args->{Timeout} :
1359					${*$self}{io_socket_timeout}; # from IO::Socket
1360					if ($timeout) {
1361					$self->blocking(0);
1362					$timeout += time();
1363					}
1364
1365					while (1) {
1366					if ( $status & SSL_SENT_SHUTDOWN and
1367					$status & SSL_RECEIVED_SHUTDOWN
1368
1369					\|\| $stop_args->{SSL_fast_shutdown}) {
1370					# shutdown complete
1371					last;
1372					}
1373					if ((${*$self}{'_SSL_opened'}\|\|0) <= 0) {
1374					# not really open, thus don't expect shutdown to return
1375					# something meaningful
1376					last;
1377					}
1378
1379					# initiate or complete shutdown
1380					local $SIG{PIPE} = 'IGNORE';
1381					my $rv = Net::SSLeay::shutdown($ssl);
1382					if ( $rv < 0 ) {
1383					# non-blocking socket?
1384					if ( ! $timeout ) {
1385					$self->_skip_rw_error( $ssl,$rv );
1386					# need to try again
1387					return;
1388					}
1389
1390					# don't use _skip_rw_error so that existing error does
1391					# not get cleared
1392					my $wait = $timeout - time();
1393					last if $wait<=0;
1394					vec(my $vec = '',fileno($self),1) = 1;
1395					my $err = Net::SSLeay::get_error($ssl,$rv);
1396					if ( $err == $Net_SSLeay_ERROR_WANT_READ) {
1397					select($vec,undef,undef,$wait)
1398					} elsif ( $err == $Net_SSLeay_ERROR_WANT_READ) {
1399					select(undef,$vec,undef,$wait)
1400					} else {
1401					last;
1402					}
1403					}
1404
1405					$status \|= SSL_SENT_SHUTDOWN;
1406					$status \|= SSL_RECEIVED_SHUTDOWN if $rv>0;
1407					}
1408					$self->blocking(1) if $timeout;
1409					}
1410
1411					# destroy allocated objects for SSL and untie
1412					# do not destroy CTX unless explicitly specified
1413					Net::SSLeay::free($ssl);
1414					delete ${*$self}{_SSL_object};
1415					if (my $cert = delete ${*$self}{'_SSL_certificate'}) {
1416					Net::SSLeay::X509_free($cert);
1417					}
1418					${*$self}{'_SSL_opened'} = 0;
1419					untie(*$self);
1420					}
1421
1422					if ($stop_args->{'SSL_ctx_free'}) {
1423					my $ctx = delete ${*$self}{'_SSL_ctx'};
1424					$ctx && $ctx->DESTROY();
1425					}
1426
1427
1428					if ( ! $stop_args->{_SSL_in_DESTROY} ) {
1429
1430					my $downgrade = $stop_args->{_SSL_ioclass_downgrade};
1431					if ( $downgrade \|\| ! defined $downgrade ) {
1432					# rebless to original class from start_SSL
1433					if ( my $orig_class = delete ${*$self}{'_SSL_ioclass_upgraded'} ) {
1434					bless $self,$orig_class;
1435					# FIXME: if original class was tied too we need to restore the tie
1436					# remove all _SSL related from *$self
1437					my @sslkeys = grep { m{^_?SSL_} } keys %{*$self};
1438					delete @{*$self}{@sslkeys} if @sslkeys;
1439					}
1440					}
1441					}
1442					return 1;
1443					}
1444
1445
1446					sub fileno {
1447					my $self = shift;
1448					my $fn = ${*$self}{'_SSL_fileno'};
1449					return defined($fn) ? $fn : $self->SUPER::fileno();
1450					}
1451
1452
1453					####### IO::Socket::SSL specific functions #######
1454					# _get_ssl_object is for internal use ONLY!
1455					sub _get_ssl_object {
1456					my $self = shift;
1457					return ${*$self}{'_SSL_object'} \|\|
1458					IO::Socket::SSL->_internal_error("Undefined SSL object",9);
1459					}
1460
1461					# _get_ctx_object is for internal use ONLY!
1462					sub _get_ctx_object {
1463					my $self = shift;
1464					my $ctx_object = ${*$self}{_SSL_ctx};
1465					return $ctx_object && $ctx_object->{context};
1466					}
1467
1468					# default error for undefined arguments
1469					sub _invalid_object {
1470					return IO::Socket::SSL->_internal_error("Undefined IO::Socket::SSL object",9);
1471					}
1472
1473
1474					sub pending {
1475					my $ssl = shift()->_get_ssl_object \|\| return;
1476					return Net::SSLeay::pending($ssl);
1477					}
1478
1479					sub start_SSL {
1480					my ($class,$socket) = (shift,shift);
1481					return $class->_internal_error("Not a socket",9) if ! ref($socket);
1482					my $arg_hash = @_ == 1 ? $_[0] : {@_};
1483					my %to = exists $arg_hash->{Timeout} ? ( Timeout => delete $arg_hash->{Timeout} ) :();
1484					my $original_class = ref($socket);
1485					if ( ! $original_class ) {
1486					$socket = ($original_class = $ISA[0])->new_from_fd($socket,'<+')
1487					or return $class->_internal_error(
1488					"creating $original_class from file handle failed",9);
1489					}
1490					my $original_fileno = (UNIVERSAL::can($socket, "fileno"))
1491					? $socket->fileno : CORE::fileno($socket);
1492					return $class->_internal_error("Socket has no fileno",9)
1493					if ! defined $original_fileno;
1494
1495					bless $socket, $class;
1496					$socket->configure_SSL($arg_hash) or bless($socket, $original_class) && return;
1497
1498					${*$socket}{'_SSL_fileno'} = $original_fileno;
1499					${*$socket}{'_SSL_ioclass_upgraded'} = $original_class
1500					if $class ne $original_class;
1501
1502					my $start_handshake = $arg_hash->{SSL_startHandshake};
1503					if ( ! defined($start_handshake) \|\| $start_handshake ) {
1504					# if we have no callback force blocking mode
1505					$DEBUG>=2 && DEBUG( "start handshake" );
1506					my $was_blocking = $socket->blocking(1);
1507					my $result = ${*$socket}{'_SSL_arguments'}{SSL_server}
1508					? $socket->accept_SSL(%to)
1509					: $socket->connect_SSL(%to);
1510					if ( $result ) {
1511					$socket->blocking(0) if ! $was_blocking;
1512					return $socket;
1513					} else {
1514					# upgrade to SSL failed, downgrade socket to original class
1515					if ( $original_class ) {
1516					bless($socket,$original_class);
1517					$socket->blocking(0) if ! $was_blocking
1518					&& $socket->can('blocking');
1519					}
1520					return;
1521					}
1522					} else {
1523					$DEBUG>=2 && DEBUG( "don't start handshake: $socket" );
1524					return $socket; # just return upgraded socket
1525					}
1526
1527					}
1528
1529					sub new_from_fd {
1530					my ($class, $fd) = (shift,shift);
1531					# Check for accidental inclusion of MODE in the argument list
1532					if (length($_[0]) < 4) {
1533					(my $mode = $_[0]) =~ tr/+<>//d;
1534					shift unless length($mode);
1535					}
1536					my $handle = $ISA[0]->new_from_fd($fd, '+<')
1537					\|\| return($class->error("Could not create socket from file descriptor."));
1538
1539					# Annoying workaround for Perl 5.6.1 and below:
1540					$handle = $ISA[0]->new_from_fd($handle, '+<');
1541
1542					return $class->start_SSL($handle, @_);
1543					}
1544
1545
1546					sub dump_peer_certificate {
1547					my $ssl = shift()->_get_ssl_object \|\| return;
1548					return Net::SSLeay::dump_peer_certificate($ssl);
1549					}
1550
1551	1	5µs			if ( defined &Net::SSLeay::get_peer_cert_chain
1552					&& $Net::SSLeay::VERSION >= 1.58 ) {
1553					*peer_certificates = sub {
1554					my $self = shift;
1555					my $ssl = $self->_get_ssl_object \|\| return;
1556					my @chain = Net::SSLeay::get_peer_cert_chain($ssl);
1557					@chain = () if @chain && !$self->peer_certificate; # work around #96013
1558					if ( ${*$self}{_SSL_arguments}{SSL_server} ) {
1559					# in the client case the chain contains the peer certificate,
1560					# in the server case not
1561					# this one has an increased reference counter, the other not
1562					if ( my $peer = Net::SSLeay::get_peer_certificate($ssl)) {
1563					Net::SSLeay::X509_free($peer);
1564					unshift @chain, $peer;
1565					}
1566					}
1567					return @chain;
1568
1569					}
1570	1	8µs			} else {
1571					*peer_certificates = sub {
1572					die "peer_certificates needs Net::SSLeay>=1.58";
1573					}
1574					}
1575
1576					{
1577					my %dispatcher = (
1578					issuer => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_issuer_name( shift )) },
1579					subject => sub { Net::SSLeay::X509_NAME_oneline( Net::SSLeay::X509_get_subject_name( shift )) },
1580					commonName => sub {
1581					my $cn = Net::SSLeay::X509_NAME_get_text_by_NID(
1582					Net::SSLeay::X509_get_subject_name( shift ), NID_CommonName);
1583					$cn;
1584					},
1585					subjectAltNames => sub { Net::SSLeay::X509_get_subjectAltNames( shift ) },
1586	1	19µs			);
1587
1588					# alternative names
1589	1	3µs			$dispatcher{authority} = $dispatcher{issuer};
1590	1	3µs			$dispatcher{owner} = $dispatcher{subject};
1591	1	2µs			$dispatcher{cn} = $dispatcher{commonName};
1592
1593					sub peer_certificate {
1594					my ($self,$field,$reload) = @_;
1595					my $ssl = $self->_get_ssl_object or return;
1596
1597					Net::SSLeay::X509_free(delete ${*$self}{_SSL_certificate})
1598					if $reload && ${*$self}{_SSL_certificate};
1599					my $cert = ${*$self}{_SSL_certificate}
1600					\|\|= Net::SSLeay::get_peer_certificate($ssl)
1601					or return $self->error("Could not retrieve peer certificate");
1602
1603					if ($field) {
1604					my $sub = $dispatcher{$field} or croak
1605					"invalid argument for peer_certificate, valid are: ".join( " ",keys %dispatcher ).
1606					"\nMaybe you need to upgrade your Net::SSLeay";
1607					return $sub->($cert);
1608					} else {
1609					return $cert
1610					}
1611					}
1612
1613					sub sock_certificate {
1614					my ($self,$field) = @_;
1615					my $ssl = $self->_get_ssl_object \|\| return;
1616					my $cert = Net::SSLeay::get_certificate( $ssl ) \|\| return;
1617					if ($field) {
1618					my $sub = $dispatcher{$field} or croak
1619					"invalid argument for sock_certificate, valid are: ".join( " ",keys %dispatcher ).
1620					"\nMaybe you need to upgrade your Net::SSLeay";
1621					return $sub->($cert);
1622					} else {
1623					return $cert
1624					}
1625					}
1626
1627
1628					# known schemes, possible attributes are:
1629					# - wildcards_in_alt (0, 'full_label', 'anywhere')
1630					# - wildcards_in_cn (0, 'full_label', 'anywhere')
1631					# - check_cn (0, 'always', 'when_only')
1632					# unfortunately there are a lot of different schemes used, see RFC 6125 for a
1633					# summary, which references all of the following except RFC4217/ftp
1634
1635	1	10µs			my %scheme = (
1636					none => {}, # do not check
1637					# default set is a superset of all the others and thus worse than a more
1638					# specific set, but much better than not verifying name at all
1639					default => {
1640					wildcards_in_cn => 'anywhere',
1641					wildcards_in_alt => 'anywhere',
1642					check_cn => 'always',
1643					ip_in_cn => 1,
1644					},
1645					);
1646
1647	1	8µs			for(qw(
1648					rfc2818
1649					rfc3920 xmpp
1650					rfc4217 ftp
1651					)) {
1652	5	47µs			$scheme{$_} = {
1653					wildcards_in_cn => 'anywhere',
1654					wildcards_in_alt => 'anywhere',
1655					check_cn => 'when_only',
1656					}
1657					}
1658
1659	1	6µs			for(qw(www http)) {
1660	2	18µs			$scheme{$_} = {
1661					wildcards_in_cn => 'anywhere',
1662					wildcards_in_alt => 'anywhere',
1663					check_cn => 'when_only',
1664					ip_in_cn => 4,
1665					}
1666					}
1667
1668	1	7µs			for(qw(
1669					rfc4513 ldap
1670					)) {
1671	2	20µs			$scheme{$_} = {
1672					wildcards_in_cn => 0,
1673					wildcards_in_alt => 'full_label',
1674					check_cn => 'always',
1675					};
1676					}
1677
1678	1	13µs			for(qw(
1679					rfc2595 smtp
1680					rfc4642 imap pop3 acap
1681					rfc5539 nntp
1682					rfc5538 netconf
1683					rfc5425 syslog
1684					rfc5953 snmp
1685					)) {
1686	14	128µs			$scheme{$_} = {
1687					wildcards_in_cn => 'full_label',
1688					wildcards_in_alt => 'full_label',
1689					check_cn => 'always'
1690					};
1691					}
1692	1	3µs			for(qw(
1693					rfc5971 gist
1694					)) {
1695	2	20µs			$scheme{$_} = {
1696					wildcards_in_cn => 'full_label',
1697					wildcards_in_alt => 'full_label',
1698					check_cn => 'when_only',
1699					};
1700					}
1701
1702	1	6µs			for(qw(
1703					rfc5922 sip
1704					)) {
1705	2	13µs			$scheme{$_} = {
1706					wildcards_in_cn => 0,
1707					wildcards_in_alt => 0,
1708					check_cn => 'always',
1709					};
1710					}
1711
1712
1713					# function to verify the hostname
1714					#
1715					# as every application protocol has its own rules to do this
1716					# we provide some default rules as well as a user-defined
1717					# callback
1718
1719					sub verify_hostname_of_cert {
1720					my $identity = shift;
1721					my $cert = shift;
1722					my $scheme = shift \|\| 'default';
1723					my $publicsuffix = shift;
1724					if ( ! ref($scheme) ) {
1725					$DEBUG>=3 && DEBUG( "scheme=$scheme cert=$cert" );
1726					$scheme = $scheme{$scheme} \|\| croak("scheme $scheme not defined");
1727					}
1728
1729					return 1 if ! %$scheme; # 'none'
1730					$identity =~s{\.+$}{}; # ignore absolutism
1731
1732					# get data from certificate
1733					my $commonName = $dispatcher{cn}->($cert);
1734					my @altNames = $dispatcher{subjectAltNames}->($cert);
1735					$DEBUG>=3 && DEBUG("identity=$identity cn=$commonName alt=@altNames" );
1736
1737					if ( my $sub = $scheme->{callback} ) {
1738					# use custom callback
1739					return $sub->($identity,$commonName,@altNames);
1740					}
1741
1742					# is the given hostname an IP address? Then we have to convert to network byte order [RFC791][RFC2460]
1743
1744					my $ipn;
1745					if ( CAN_IPV6 and $identity =~m{:} ) {
1746					# no IPv4 or hostname have ':' in it, try IPv6.
1747					$identity =~m{[^\da-fA-F:\.]} and return; # invalid characters in name
1748					$ipn = inet_pton(AF_INET6,$identity) or return; # invalid name
1749					} elsif ( my @ip = $identity =~m{^(\d+)(?:\.(\d+)\.(\d+)\.(\d+)\|[\d\.]*)$} ) {
1750					# check for invalid IP/hostname
1751					return if 4 != @ip or 4 != grep { defined($_) && $_<256 } @ip;
1752					$ipn = pack("CCCC",@ip);
1753					} else {
1754					# assume hostname, check for umlauts etc
1755					if ( $identity =~m{[^a-zA-Z0-9_.\-]} ) {
1756					$identity =~m{\0} and return; # $identity has \\0 byte
1757					$identity = idn_to_ascii($identity)
1758					or return; # conversation to IDNA failed
1759					$identity =~m{[^a-zA-Z0-9_.\-]}
1760					and return; # still junk inside
1761					}
1762					}
1763
1764					# do the actual verification
1765					my $check_name = sub {
1766					my ($name,$identity,$wtyp,$publicsuffix) = @_;
1767					$name =~s{\.+$}{}; # ignore absolutism
1768					$name eq '' and return;
1769					$wtyp \|\|= '';
1770					my $pattern;
1771					### IMPORTANT!
1772					# We accept only a single wildcard and only for a single part of the FQDN
1773					# e.g. *.example.org does match www.example.org but not bla.www.example.org
1774					# The RFCs are in this regard unspecific but we don't want to have to
1775					# deal with certificates like .com, .co.uk or even *
1776					# see also http://nils.toedtmann.net/pub/subjectAltName.txt .
1777					# Also, we fall back to full_label matches if the identity is an IDNA
1778					# name, see RFC6125 and the discussion at
1779					# http://bugs.python.org/issue17997#msg194950
1780					if ( $wtyp eq 'anywhere' and $name =~m{^([a-zA-Z0-9_\-])\(.+)} ) {
1781					return if $1 ne '' and substr($identity,0,4) eq 'xn--'; # IDNA
1782					$pattern = qr{^\Q$1\E[a-zA-Z0-9_\-]+\Q$2\E$}i;
1783					} elsif ( $wtyp =~ m{^(?:full_label\|leftmost)$}
1784					and $name =~m{^\*(\..+)$} ) {
1785					$pattern = qr{^[a-zA-Z0-9_\-]+\Q$1\E$}i;
1786					} else {
1787					return lc($identity) eq lc($name);
1788					}
1789					if ( $identity =~ $pattern ) {
1790					$publicsuffix = IO::Socket::SSL::PublicSuffix->default
1791					if ! defined $publicsuffix;
1792					return 1 if $publicsuffix eq '';
1793					my @labels = split( m{\.+}, $identity );
1794					my $tld = $publicsuffix->public_suffix(\@labels,+1);
1795					return 1 if @labels > ( $tld ? 0+@$tld : 1 );
1796					}
1797					return;
1798					};
1799
1800
1801					my $alt_dnsNames = 0;
1802					while (@altNames) {
1803					my ($type, $name) = splice (@altNames, 0, 2);
1804					if ( $ipn and $type == GEN_IPADD ) {
1805					# exact match needed for IP
1806					# $name is already packed format (inet_xton)
1807					return 1 if $ipn eq $name;
1808
1809					} elsif ( ! $ipn and $type == GEN_DNS ) {
1810					$name =~s/\s+$//; $name =~s/^\s+//;
1811					$alt_dnsNames++;
1812					$check_name->($name,$identity,$scheme->{wildcards_in_alt},$publicsuffix)
1813					and return 1;
1814					}
1815					}
1816
1817					if ( $scheme->{check_cn} eq 'always' or
1818					$scheme->{check_cn} eq 'when_only' and !$alt_dnsNames ) {
1819					if ( ! $ipn ) {
1820					$check_name->($commonName,$identity,$scheme->{wildcards_in_cn},$publicsuffix)
1821					and return 1;
1822					} elsif ( $scheme->{ip_in_cn} ) {
1823					if ( $identity eq $commonName ) {
1824					return 1 if
1825					$scheme->{ip_in_cn} == 4 ? length($ipn) == 4 :
1826					$scheme->{ip_in_cn} == 6 ? length($ipn) == 8 :
1827					1;
1828					}
1829					}
1830					}
1831
1832					return 0; # no match
1833					}
1834					}
1835
1836	1	3µs			sub verify_hostname {
1837					my $self = shift;
1838					my $host = shift;
1839					my $cert = $self->peer_certificate;
1840					return verify_hostname_of_cert( $host,$cert,@_ );
1841					}
1842
1843
1844					sub get_servername {
1845					my $self = shift;
1846					return ${*$self}{_SSL_servername} \|\|= do {
1847					my $ssl = $self->_get_ssl_object or return;
1848					Net::SSLeay::get_servername($ssl);
1849					};
1850					}
1851
1852					sub get_fingerprint_bin {
1853					my ($self,$algo,$cert,$key_only) = @_;
1854					$cert \|\|= $self->peer_certificate;
1855					return $key_only
1856					? Net::SSLeay::X509_pubkey_digest($cert, $algo2digest->($algo \|\| 'sha256'))
1857					: Net::SSLeay::X509_digest($cert, $algo2digest->($algo \|\| 'sha256'));
1858					}
1859
1860					sub get_fingerprint {
1861					my ($self,$algo,$cert,$key_only) = @_;
1862					$algo \|\|= 'sha256';
1863					my $fp = get_fingerprint_bin($self,$algo,$cert,$key_only) or return;
1864					return $algo.'$'.($key_only ? 'pub$':'').unpack('H*',$fp);
1865					}
1866
1867					sub get_cipher {
1868					my $ssl = shift()->_get_ssl_object \|\| return;
1869					return Net::SSLeay::get_cipher($ssl);
1870					}
1871
1872					sub get_sslversion {
1873					my $ssl = shift()->_get_ssl_object \|\| return;
1874					my $version = Net::SSLeay::version($ssl) or return;
1875					return
1876					$version == 0x0303 ? 'TLSv1_2' :
1877					$version == 0x0302 ? 'TLSv1_1' :
1878					$version == 0x0301 ? 'TLSv1' :
1879					$version == 0x0300 ? 'SSLv3' :
1880					$version == 0x0002 ? 'SSLv2' :
1881					$version == 0xfeff ? 'DTLS1' :
1882					undef;
1883					}
1884
1885					sub get_sslversion_int {
1886					my $ssl = shift()->_get_ssl_object \|\| return;
1887					return Net::SSLeay::version($ssl);
1888					}
1889
1890	1	4µs			if ($can_ocsp) {
1891	2	2.56ms	2	175µs	# spent 111µs (47+64) within IO::Socket::SSL::BEGIN@1891 which was called: # once (47µs+64µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 1891 no warnings 'once'; # spent 111µs making 1 call to IO::Socket::SSL::BEGIN@1891 # spent 64µs making 1 call to warnings::unimport
1892					*ocsp_resolver = sub {
1893					my $self = shift;
1894					my $ssl = $self->_get_ssl_object \|\| return;
1895					my $ctx = ${*$self}{_SSL_ctx};
1896					return IO::Socket::SSL::OCSP_Resolver->new(
1897					$ssl,
1898					$ctx->{ocsp_cache} \|\|= IO::Socket::SSL::OCSP_Cache->new,
1899					$ctx->{ocsp_mode} & SSL_OCSP_FAIL_HARD,
1900					@_ ? \@_ :
1901					$ctx->{ocsp_mode} & SSL_OCSP_FULL_CHAIN ? [ $self->peer_certificates ]:
1902					[ $self->peer_certificate ]
1903					);
1904	1	9µs			};
1905					}
1906
1907					sub errstr {
1908					my $self = shift;
1909					my $oe = ref($self) && ${*$self}{_SSL_last_err};
1910					return $oe ? $oe->[0] : $SSL_ERROR \|\| '';
1911					}
1912
1913					sub fatal_ssl_error {
1914					my $self = shift;
1915					my $error_trap = ${*$self}{'_SSL_arguments'}->{'SSL_error_trap'};
1916					$@ = $self->errstr;
1917					if (defined $error_trap and ref($error_trap) eq 'CODE') {
1918					$error_trap->($self, $self->errstr()."\n".$self->get_ssleay_error());
1919					} elsif ( ${*$self}{'_SSL_ioclass_upgraded'}
1920					\|\| ${*$self}{_SSL_arguments}{SSL_keepSocketOnError}) {
1921					# downgrade only
1922					$DEBUG>=3 && DEBUG('downgrading SSL only, not closing socket' );
1923					$self->stop_SSL;
1924					} else {
1925					# kill socket
1926					$self->close
1927					}
1928					return;
1929					}
1930
1931					sub get_ssleay_error {
1932					#Net::SSLeay will print out the errors itself unless we explicitly
1933					#undefine $Net::SSLeay::trace while running print_errs()
1934					local $Net::SSLeay::trace;
1935					return Net::SSLeay::print_errs('SSL error: ') \|\| '';
1936					}
1937
1938					# internal errors, e.g. unsupported features, hostname check failed etc
1939					# _SSL_last_err contains severity so that on error chains we can decide if one
1940					# error should replace the previous one or if this is just a less specific
1941					# follow-up error, e.g. configuration failed because certificate failed because
1942					# hostname check went wrong:
1943					# 0 - fallback errors
1944					# 4 - errors bubbled up from OpenSSL (sub error, r/w error)
1945					# 5 - hostname or OCSP verification failed
1946					# 9 - fatal problems, e.g. missing feature, no fileno...
1947					# _SSL_last_err and SSL_ERROR are only replaced if the error has a higher
1948					# severity than the previous one
1949
1950					sub _internal_error {
1951					my ($self, $error, $severity) = @_;
1952					$error = dualvar( -1, $error );
1953					$self = $CURRENT_SSL_OBJECT if !ref($self) && $CURRENT_SSL_OBJECT;
1954					if (ref($self)) {
1955					my $oe = ${*$self}{_SSL_last_err};
1956					if (!$oe \|\| $oe->[1] <= $severity) {
1957					${*$self}{_SSL_last_err} = [$error,$severity];
1958					$SSL_ERROR = $error;
1959					$DEBUG && DEBUG("local error: $error");
1960					} else {
1961					$DEBUG && DEBUG("ignoring less severe local error '$error', keep '$oe->[0]'");
1962					}
1963					} else {
1964					$SSL_ERROR = $error;
1965					$DEBUG && DEBUG("global error: $error");
1966					}
1967					return;
1968					}
1969
1970					# OpenSSL errors
1971					sub error {
1972					my ($self, $error) = @_;
1973					my @err;
1974					while ( my $err = Net::SSLeay::ERR_get_error()) {
1975					push @err, Net::SSLeay::ERR_error_string($err);
1976					$DEBUG>=2 && DEBUG( $error."\n".$self->get_ssleay_error());
1977					}
1978					$error .= ' '.join(' ',@err) if @err;
1979					return $self->_internal_error($error,4) if $error;
1980					return;
1981					}
1982
1983					sub can_client_sni { return $can_client_sni }
1984					sub can_server_sni { return $can_server_sni }
1985					sub can_npn { return $can_npn }
1986					sub can_alpn { return $can_alpn }
1987					sub can_ecdh { return $can_ecdh }
1988					sub can_ipv6 { return CAN_IPV6 }
1989					sub can_ocsp { return $can_ocsp }
1990					sub can_ticket_keycb { return $can_tckt_keycb }
1991
1992					sub DESTROY {
1993					my $self = shift or return;
1994					my $ssl = ${*$self}{_SSL_object} or return;
1995					delete $SSL_OBJECT{$ssl};
1996					if (!$use_threads or delete $CREATED_IN_THIS_THREAD{$ssl}) {
1997					$self->close(_SSL_in_DESTROY => 1, SSL_no_shutdown => 1)
1998					if ${*$self}{'_SSL_opened'};
1999					}
2000					delete @{*$self}{@all_my_keys};
2001					}
2002
2003
2004					#######Extra Backwards Compatibility Functionality#######
2005					sub socket_to_SSL { IO::Socket::SSL->start_SSL(@_); }
2006					sub socketToSSL { IO::Socket::SSL->start_SSL(@_); }
2007					sub kill_socket { shift->close }
2008
2009					sub issuer_name { return(shift()->peer_certificate("issuer")) }
2010					sub subject_name { return(shift()->peer_certificate("subject")) }
2011					sub get_peer_certificate { return shift() }
2012
2013					sub context_init {
2014					return($GLOBAL_SSL_ARGS = (ref($_[0]) eq 'HASH') ? $_[0] : {@_});
2015					}
2016
2017					sub set_default_context {
2018					$GLOBAL_SSL_ARGS->{'SSL_reuse_ctx'} = shift;
2019					}
2020
2021					sub set_default_session_cache {
2022					$GLOBAL_SSL_ARGS->{SSL_session_cache} = shift;
2023					}
2024
2025
2026					{
2027					my $set_defaults = sub {
2028					my $args = shift;
2029					for(my $i=0;$i<@$args;$i+=2 ) {
2030					my ($k,$v) = @{$args}[$i,$i+1];
2031					if ( $k =~m{^SSL_} ) {
2032					$_->{$k} = $v for(@_);
2033					} elsif ( $k =~m{^(name\|scheme)$} ) {
2034					$_->{"SSL_verifycn_$k"} = $v for (@_);
2035					} elsif ( $k =~m{^(callback\|mode)$} ) {
2036					$_->{"SSL_verify_$k"} = $v for(@_);
2037					} else {
2038					$_->{"SSL_$k"} = $v for(@_);
2039					}
2040					}
2041	1	8µs			};
2042					sub set_defaults {
2043					my %args = @_;
2044					$set_defaults->(\@_,
2045					$GLOBAL_SSL_ARGS,
2046					$GLOBAL_SSL_CLIENT_ARGS,
2047					$GLOBAL_SSL_SERVER_ARGS
2048					);
2049					}
2050					{ # deprecated API
2051	3	1.31ms	2	113µs	# spent 71µs (28+43) within IO::Socket::SSL::BEGIN@2051 which was called: # once (28µs+43µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 2051 no warnings; # spent 71µs making 1 call to IO::Socket::SSL::BEGIN@2051 # spent 43µs making 1 call to warnings::unimport
2052	1	3µs			*set_ctx_defaults = \&set_defaults;
2053					}
2054					sub set_client_defaults {
2055					my %args = @_;
2056					$set_defaults->(\@_, $GLOBAL_SSL_CLIENT_ARGS );
2057					}
2058					sub set_server_defaults {
2059					my %args = @_;
2060					$set_defaults->(\@_, $GLOBAL_SSL_SERVER_ARGS );
2061					}
2062					}
2063
2064	1	3µs			sub set_args_filter_hack {
2065					my $sub = shift;
2066					if ( ref $sub ) {
2067					$FILTER_SSL_ARGS = $sub;
2068					} elsif ( $sub eq 'use_defaults' ) {
2069					# override args with defaults
2070					$FILTER_SSL_ARGS = sub {
2071					my ($is_server,$args) = @_;
2072					%$args = ( %$args, $is_server
2073					? ( %DEFAULT_SSL_SERVER_ARGS, %$GLOBAL_SSL_SERVER_ARGS )
2074					: ( %DEFAULT_SSL_CLIENT_ARGS, %$GLOBAL_SSL_CLIENT_ARGS )
2075					);
2076					}
2077					}
2078					}
2079
2080					sub next_proto_negotiated {
2081					my $self = shift;
2082					return $self->_internal_error("NPN not supported in Net::SSLeay",9) if ! $can_npn;
2083					my $ssl = $self->_get_ssl_object \|\| return;
2084					return Net::SSLeay::P_next_proto_negotiated($ssl);
2085					}
2086
2087					sub alpn_selected {
2088					my $self = shift;
2089					return $self->_internal_error("ALPN not supported in Net::SSLeay",9) if ! $can_alpn;
2090					my $ssl = $self->_get_ssl_object \|\| return;
2091					return Net::SSLeay::P_alpn_selected($ssl);
2092					}
2093
2094					sub opened {
2095					my $self = shift;
2096					return IO::Handle::opened($self) && ${*$self}{'_SSL_opened'};
2097					}
2098
2099					sub opening {
2100					my $self = shift;
2101					return ${*$self}{'_SSL_opening'};
2102					}
2103
2104					sub want_read { shift->errstr == SSL_WANT_READ }
2105					sub want_write { shift->errstr == SSL_WANT_WRITE }
2106
2107
2108					#Redundant IO::Handle functionality
2109					sub getline { return(scalar shift->readline()) }
2110					sub getlines {
2111					return(shift->readline()) if wantarray();
2112					croak("Use of getlines() not allowed in scalar context");
2113					}
2114
2115					#Useless IO::Handle functionality
2116					sub truncate { croak("Use of truncate() not allowed with SSL") }
2117					sub stat { croak("Use of stat() not allowed with SSL" ) }
2118					sub setbuf { croak("Use of setbuf() not allowed with SSL" ) }
2119					sub setvbuf { croak("Use of setvbuf() not allowed with SSL" ) }
2120					sub fdopen { croak("Use of fdopen() not allowed with SSL" ) }
2121
2122					#Unsupported socket functionality
2123					sub ungetc { croak("Use of ungetc() not implemented in IO::Socket::SSL") }
2124					sub send { croak("Use of send() not implemented in IO::Socket::SSL; use print/printf/syswrite instead") }
2125					sub recv { croak("Use of recv() not implemented in IO::Socket::SSL; use read/sysread instead") }
2126
2127					package IO::Socket::SSL::SSL_HANDLE;
2128	2	84µs	2	52µs	# spent 40µs (29+11) within IO::Socket::SSL::SSL_HANDLE::BEGIN@2128 which was called: # once (29µs+11µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 2128 use strict; # spent 40µs making 1 call to IO::Socket::SSL::SSL_HANDLE::BEGIN@2128 # spent 11µs making 1 call to strict::import
2129	2	661µs	2	292µs	# spent 158µs (24+134) within IO::Socket::SSL::SSL_HANDLE::BEGIN@2129 which was called: # once (24µs+134µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 2129 use Errno 'EBADF'; # spent 158µs making 1 call to IO::Socket::SSL::SSL_HANDLE::BEGIN@2129 # spent 134µs making 1 call to Exporter::import
2130	1	7µs			weaken = IO::Socket::SSL::weaken;
2131
2132					sub TIEHANDLE {
2133					my ($class, $handle) = @_;
2134					weaken($handle);
2135					bless \$handle, $class;
2136					}
2137
2138					sub READ { ${shift()}->sysread(@_) }
2139					sub READLINE { ${shift()}->readline(@_) }
2140					sub GETC { ${shift()}->getc(@_) }
2141
2142					sub PRINT { ${shift()}->print(@_) }
2143					sub PRINTF { ${shift()}->printf(@_) }
2144					sub WRITE { ${shift()}->syswrite(@_) }
2145
2146					sub FILENO { ${shift()}->fileno(@_) }
2147
2148					sub TELL { $! = EBADF; return -1 }
2149					sub BINMODE { return 0 } # not perfect, but better than not implementing the method
2150
2151					sub CLOSE { #<---- Do not change this function!
2152					my $ssl = ${$_[0]};
2153					local @_;
2154					$ssl->close();
2155					}
2156
2157
2158					package IO::Socket::SSL::SSL_Context;
2159	2	76µs	2	442µs	# spent 237µs (32+205) within IO::Socket::SSL::SSL_Context::BEGIN@2159 which was called: # once (32µs+205µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 2159 use Carp; # spent 237µs making 1 call to IO::Socket::SSL::SSL_Context::BEGIN@2159 # spent 205µs making 1 call to Exporter::import
2160	2	91µs	2	44µs	# spent 36µs (29+7) within IO::Socket::SSL::SSL_Context::BEGIN@2160 which was called: # once (29µs+7µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 2160 use strict; # spent 36µs making 1 call to IO::Socket::SSL::SSL_Context::BEGIN@2160 # spent 8µs making 1 call to strict::import
2161
2162	1	2µs			my %CTX_CREATED_IN_THIS_THREAD;
2163	1	3µs			DEBUG = IO::Socket::SSL::DEBUG;
2164
2165	2	72µs	2	426µs	# spent 223µs (21+203) within IO::Socket::SSL::SSL_Context::BEGIN@2165 which was called: # once (21µs+203µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 2165 use constant SSL_MODE_ENABLE_PARTIAL_WRITE => 1; # spent 223µs making 1 call to IO::Socket::SSL::SSL_Context::BEGIN@2165 # spent 202µs making 1 call to constant::import
2166	2	108µs	2	376µs	# spent 202µs (28+174) within IO::Socket::SSL::SSL_Context::BEGIN@2166 which was called: # once (28µs+174µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 2166 use constant SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER => 2; # spent 202µs making 1 call to IO::Socket::SSL::SSL_Context::BEGIN@2166 # spent 174µs making 1 call to constant::import
2167
2168	2	105µs	3	774µs	# spent 410µs (42+369) within IO::Socket::SSL::SSL_Context::BEGIN@2168 which was called: # once (42µs+369µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 2168 use constant FILETYPE_PEM => Net::SSLeay::FILETYPE_PEM(); # spent 410µs making 1 call to IO::Socket::SSL::SSL_Context::BEGIN@2168 # spent 212µs making 1 call to constant::import # spent 151µs making 1 call to Net::SSLeay::AUTOLOAD
2169	2	9.66ms	3	671µs	# spent 360µs (45+315) within IO::Socket::SSL::SSL_Context::BEGIN@2169 which was called: # once (45µs+315µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 2169 use constant FILETYPE_ASN1 => Net::SSLeay::FILETYPE_ASN1(); # spent 360µs making 1 call to IO::Socket::SSL::SSL_Context::BEGIN@2169 # spent 195µs making 1 call to constant::import # spent 116µs making 1 call to Net::SSLeay::AUTOLOAD
2170
2171	1	28µs	3	314µs	my $DEFAULT_SSL_OP = &Net::SSLeay::OP_ALL # spent 314µs making 3 calls to Net::SSLeay::AUTOLOAD, avg 105µs/call
2172					\| &Net::SSLeay::OP_SINGLE_DH_USE
2173					\| ($can_ecdh && &Net::SSLeay::OP_SINGLE_ECDH_USE);
2174
2175					# Note that the final object will actually be a reference to the scalar
2176					# (C-style pointer) returned by Net::SSLeay::CTX_*_new() so that
2177					# it can be blessed.
2178					sub new {
2179					my $class = shift;
2180					#DEBUG( "$class @_" );
2181					my $arg_hash = (ref($_[0]) eq 'HASH') ? $_[0] : {@_};
2182
2183					my $is_server = $arg_hash->{SSL_server};
2184					my %defaults = $is_server
2185					? (%DEFAULT_SSL_SERVER_ARGS, %$GLOBAL_SSL_ARGS, %$GLOBAL_SSL_SERVER_ARGS)
2186					: (%DEFAULT_SSL_CLIENT_ARGS, %$GLOBAL_SSL_ARGS, %$GLOBAL_SSL_CLIENT_ARGS);
2187					if ( $defaults{SSL_reuse_ctx} ) {
2188					# ignore default context if there are args to override it
2189					delete $defaults{SSL_reuse_ctx}
2190					if grep { m{^SSL_(?!verifycn_name\|hostname)$} } keys %$arg_hash;
2191					}
2192					%$arg_hash = ( %defaults, %$arg_hash ) if %defaults;
2193
2194					if (my $ctx = $arg_hash->{'SSL_reuse_ctx'}) {
2195					if ($ctx->isa('IO::Socket::SSL::SSL_Context') and
2196					$ctx->{context}) {
2197					# valid context
2198					} elsif ( $ctx = ${*$ctx}{_SSL_ctx} ) {
2199					# reuse context from existing SSL object
2200					}
2201					return $ctx
2202					}
2203
2204					# common problem forgetting to set SSL_use_cert
2205					# if client cert is given by user but SSL_use_cert is undef, assume that it
2206					# should be set
2207					if ( ! $is_server && ! defined $arg_hash->{SSL_use_cert}
2208					&& ( grep { $arg_hash->{$_} } qw(SSL_cert SSL_cert_file))
2209					&& ( grep { $arg_hash->{$_} } qw(SSL_key SSL_key_file)) ) {
2210					$arg_hash->{SSL_use_cert} = 1
2211					}
2212
2213					# if any of SSL_ca* is set don't set the other SSL_ca*
2214					# from defaults
2215					if ( $arg_hash->{SSL_ca} ) {
2216					$arg_hash->{SSL_ca_file} \|\|= undef
2217					$arg_hash->{SSL_ca_path} \|\|= undef
2218					} elsif ( $arg_hash->{SSL_ca_path} ) {
2219					$arg_hash->{SSL_ca_file} \|\|= undef
2220					} elsif ( $arg_hash->{SSL_ca_file} ) {
2221					$arg_hash->{SSL_ca_path} \|\|= undef;
2222					}
2223
2224					# add library defaults
2225					$arg_hash->{SSL_use_cert} = $is_server if ! defined $arg_hash->{SSL_use_cert};
2226
2227
2228					# Avoid passing undef arguments to Net::SSLeay
2229					defined($arg_hash->{$_}) or delete($arg_hash->{$_}) for(keys %$arg_hash);
2230
2231					# check SSL CA, cert etc arguments
2232					# some apps set keys '' to signal that it is not set, replace with undef
2233					for (qw( SSL_cert SSL_cert_file SSL_key SSL_key_file
2234					SSL_ca SSL_ca_file SSL_ca_path
2235					SSL_fingerprint )) {
2236					$arg_hash->{$_} = undef if defined $arg_hash->{$_}
2237					and $arg_hash->{$_} eq '';
2238					}
2239					for(qw(SSL_cert_file SSL_key_file)) {
2240					defined( my $file = $arg_hash->{$_} ) or next;
2241					for my $f (ref($file) eq 'HASH' ? values(%$file):$file ) {
2242					die "$_ $f can't be used: $!" if ! open(my $fh,'<',$f)
2243					}
2244					}
2245
2246					my $verify_mode = $arg_hash->{SSL_verify_mode} \|\| 0;
2247					if ( $verify_mode != $Net_SSLeay_VERIFY_NONE) {
2248					for (qw(SSL_ca_file SSL_ca_path)) {
2249					$CHECK_SSL_PATH->($_ => $arg_hash->{$_} \|\| next);
2250					}
2251					} elsif ( $verify_mode ne '0' ) {
2252					# some users use the string 'SSL_VERIFY_PEER' instead of the constant
2253					die "SSL_verify_mode must be a number and not a string";
2254					}
2255
2256					my $self = bless {},$class;
2257
2258					my $vcn_scheme = delete $arg_hash->{SSL_verifycn_scheme};
2259					my $vcn_publicsuffix = delete $arg_hash->{SSL_verifycn_publicsuffix};
2260					if ( ! $is_server and $verify_mode & 0x01 and
2261					! $vcn_scheme \|\| $vcn_scheme ne 'none' ) {
2262
2263					# gets updated during configure_SSL
2264					my $verify_name;
2265					$self->{verify_name_ref} = \$verify_name;
2266
2267					my $vcb = $arg_hash->{SSL_verify_callback};
2268					$arg_hash->{SSL_verify_callback} = sub {
2269					my ($ok,$ctx_store,$certname,$error,$cert,$depth) = @_;
2270					$ok = $vcb->($ok,$ctx_store,$certname,$error,$cert,$depth) if $vcb;
2271					$ok or return 0;
2272
2273					return $ok if $depth != 0;
2274
2275					my $host = $verify_name \|\| ref($vcn_scheme) && $vcn_scheme->{callback} && 'unknown';
2276					if ( ! $host ) {
2277					if ( $vcn_scheme ) {
2278					IO::Socket::SSL->_internal_error(
2279					"Cannot determine peer hostname for verification",8);
2280					return 0;
2281					}
2282					warn "Cannot determine hostname of peer for verification. ".
2283					"Disabling default hostname verification for now. ".
2284					"Please specify hostname with SSL_verifycn_name and better set SSL_verifycn_scheme too.\n";
2285					return $ok;
2286					} elsif ( ! $vcn_scheme && $host =~m{^[\d.]+$\|:} ) {
2287					# don't try to verify IP by default
2288					return $ok;
2289					}
2290
2291
2292					# verify name
2293					my $rv = IO::Socket::SSL::verify_hostname_of_cert(
2294					$host,$cert,$vcn_scheme,$vcn_publicsuffix );
2295					if ( ! $rv ) {
2296					IO::Socket::SSL->_internal_error(
2297					"hostname verification failed",5);
2298					}
2299					return $rv;
2300					};
2301					}
2302
2303					if ($is_server) {
2304					if ($arg_hash->{SSL_ticket_keycb} && !$can_tckt_keycb) {
2305					warn "Ticket Key Callback is not supported - ignoring option SSL_ticket_keycb\n";
2306					delete $arg_hash->{SSL_ticket_keycb};
2307					}
2308					}
2309
2310
2311					my $ssl_op = $DEFAULT_SSL_OP;
2312
2313					my $ver;
2314					for (split(/\s:\s/,$arg_hash->{SSL_version})) {
2315					m{^(!?)(?:(SSL(?:v2\|v3\|v23\|v2/3))\|(TLSv1(?:_?[12])?))$}i
2316					or croak("invalid SSL_version specified");
2317					my $not = $1;
2318					( my $v = lc($2\|\|$3) ) =~s{^(...)}{\U$1};
2319					if ( $not ) {
2320					$ssl_op \|= $SSL_OP_NO{$v};
2321					} else {
2322					croak("cannot set multiple SSL protocols in SSL_version")
2323					if $ver && $v ne $ver;
2324					$ver = $v;
2325					$ver =~s{/}{}; # interpret SSLv2/3 as SSLv23
2326					$ver =~s{(TLSv1)(\d)}{$1\_$2}; # TLSv1_1
2327					}
2328					}
2329
2330					my $ctx_new_sub = UNIVERSAL::can( 'Net::SSLeay',
2331					$ver eq 'SSLv2' ? 'CTX_v2_new' :
2332					$ver eq 'SSLv3' ? 'CTX_v3_new' :
2333					$ver eq 'TLSv1' ? 'CTX_tlsv1_new' :
2334					$ver eq 'TLSv1_1' ? 'CTX_tlsv1_1_new' :
2335					$ver eq 'TLSv1_2' ? 'CTX_tlsv1_2_new' :
2336					'CTX_new'
2337					) or return IO::Socket::SSL->_internal_error("SSL Version $ver not supported",9);
2338
2339					# For SNI in server mode we need a separate context for each certificate.
2340					my %ctx;
2341					if ($is_server) {
2342					my %sni;
2343					for my $opt (qw(SSL_key SSL_key_file SSL_cert SSL_cert_file)) {
2344					my $val = $arg_hash->{$opt} or next;
2345					if ( ref($val) eq 'HASH' ) {
2346					while ( my ($host,$v) = each %$val ) {
2347					$sni{lc($host)}{$opt} = $v;
2348					}
2349					}
2350					}
2351					while (my ($host,$v) = each %sni) {
2352					$ctx{$host} = { %$arg_hash, %$v };
2353					}
2354					}
2355					$ctx{''} = $arg_hash if ! %ctx;
2356
2357					while (my ($host,$arg_hash) = each %ctx) {
2358					# replace value in %ctx with real context
2359					my $ctx = $ctx_new_sub->() or return
2360					IO::Socket::SSL->error("SSL Context init failed");
2361					$CTX_CREATED_IN_THIS_THREAD{$ctx} = 1 if $use_threads;
2362
2363					# SSL_OP_CIPHER_SERVER_PREFERENCE
2364					$ssl_op \|= 0x00400000 if $arg_hash->{SSL_honor_cipher_order};
2365
2366					if ($ver eq 'SSLv23' && !($ssl_op & $SSL_OP_NO{SSLv3})) {
2367					# At least LibreSSL disables SSLv3 by default in SSL_CTX_new.
2368					# If we really want SSL3.0 we need to explicitly allow it with
2369					# SSL_CTX_clear_options.
2370					Net::SSLeay::CTX_clear_options($ctx,$SSL_OP_NO{SSLv3});
2371					}
2372
2373					Net::SSLeay::CTX_set_options($ctx,$ssl_op);
2374
2375					# if we don't set session_id_context if client certificate is expected
2376					# client session caching will fail
2377					# if user does not provide explicit id just use the stringification
2378					# of the context
2379					if($arg_hash->{SSL_server} and my $id =
2380					$arg_hash->{SSL_session_id_context} \|\|
2381					( $arg_hash->{SSL_verify_mode} & 0x01 ) && "$ctx" ) {
2382					Net::SSLeay::CTX_set_session_id_context($ctx,$id,length($id));
2383					}
2384
2385					# SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER makes syswrite return if at least one
2386					# buffer was written and not block for the rest
2387					# SSL_MODE_ENABLE_PARTIAL_WRITE can be necessary for non-blocking because we
2388					# cannot guarantee, that the location of the buffer stays constant
2389					Net::SSLeay::CTX_set_mode( $ctx,
2390					SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER\|SSL_MODE_ENABLE_PARTIAL_WRITE);
2391
2392					if ( my $proto_list = $arg_hash->{SSL_npn_protocols} ) {
2393					return IO::Socket::SSL->_internal_error("NPN not supported in Net::SSLeay",9)
2394					if ! $can_npn;
2395					if($arg_hash->{SSL_server}) {
2396					# on server side SSL_npn_protocols means a list of advertised protocols
2397					Net::SSLeay::CTX_set_next_protos_advertised_cb($ctx, $proto_list);
2398					} else {
2399					# on client side SSL_npn_protocols means a list of preferred protocols
2400					# negotiation algorithm used is "as-openssl-implements-it"
2401					Net::SSLeay::CTX_set_next_proto_select_cb($ctx, $proto_list);
2402					}
2403					}
2404
2405					if ( my $proto_list = $arg_hash->{SSL_alpn_protocols} ) {
2406					return IO::Socket::SSL->_internal_error("ALPN not supported in Net::SSLeay",9)
2407					if ! $can_alpn;
2408					if($arg_hash->{SSL_server}) {
2409					Net::SSLeay::CTX_set_alpn_select_cb($ctx, $proto_list);
2410					} else {
2411					Net::SSLeay::CTX_set_alpn_protos($ctx, $proto_list);
2412					}
2413					}
2414
2415					if ($arg_hash->{SSL_ticket_keycb}) {
2416					my $cb = $arg_hash->{SSL_ticket_keycb};
2417					($cb,my $arg) = ref($cb) eq 'CODE' ? ($cb):@$cb;
2418					Net::SSLeay::CTX_set_tlsext_ticket_getkey_cb($ctx,$cb,$arg);
2419					}
2420
2421					# Try to apply SSL_ca even if SSL_verify_mode is 0, so that they can be
2422					# used to verify OCSP responses.
2423					# If applying fails complain only if verify_mode != VERIFY_NONE.
2424					if ( $arg_hash->{SSL_ca}
2425					\|\| defined $arg_hash->{SSL_ca_file}
2426					\|\| defined $arg_hash->{SSL_ca_path} ) {
2427					my $file = $arg_hash->{SSL_ca_file};
2428					$file = undef if ref($file) eq 'SCALAR' && ! $$file;
2429					my $dir = $arg_hash->{SSL_ca_path};
2430					$dir = undef if ref($dir) eq 'SCALAR' && ! $$dir;
2431					if ( $arg_hash->{SSL_ca} ) {
2432					my $store = Net::SSLeay::CTX_get_cert_store($ctx);
2433					for (@{$arg_hash->{SSL_ca}}) {
2434					Net::SSLeay::X509_STORE_add_cert($store,$_) or
2435					return IO::Socket::SSL->error(
2436					"Failed to add certificate to CA store");
2437					}
2438					}
2439					$dir = join($OPENSSL_LIST_SEPARATOR,@$dir) if ref($dir);
2440					if ( $file \|\| $dir and ! Net::SSLeay::CTX_load_verify_locations(
2441					$ctx, $file \|\| '', $dir \|\| '')) {
2442					return IO::Socket::SSL->error(
2443					"Invalid certificate authority locations")
2444					if $verify_mode != $Net_SSLeay_VERIFY_NONE;
2445					}
2446					} elsif ( my %ca = IO::Socket::SSL::default_ca()) {
2447					# no CA path given, continue with system defaults
2448					my $dir = $ca{SSL_ca_path};
2449					$dir = join($OPENSSL_LIST_SEPARATOR,@$dir) if ref($dir);
2450					if (! Net::SSLeay::CTX_load_verify_locations( $ctx,
2451					$ca{SSL_ca_file} \|\| '',$dir \|\| '')
2452					&& $verify_mode != $Net_SSLeay_VERIFY_NONE) {
2453					return IO::Socket::SSL->error(
2454					"Invalid default certificate authority locations")
2455					}
2456					}
2457
2458					if ($is_server && ($verify_mode & $Net_SSLeay_VERIFY_PEER)) {
2459					if ($arg_hash->{SSL_client_ca}) {
2460					for (@{$arg_hash->{SSL_client_ca}}) {
2461					return IO::Socket::SSL->error(
2462					"Failed to add certificate to client CA list") if
2463					! Net::SSLeay::CTX_add_client_CA($ctx,$_);
2464					}
2465					}
2466					if ($arg_hash->{SSL_client_ca_file}) {
2467					my $list = Net::SSLeay::load_client_CA_file(
2468					$arg_hash->{SSL_client_ca_file}) or
2469					return IO::Socket::SSL->error(
2470					"Failed to load certificate to client CA list");
2471					Net::SSLeay::CTX_set_client_CA_list($ctx,$list);
2472					}
2473					}
2474
2475					my $X509_STORE_flags = $DEFAULT_X509_STORE_flags;
2476					if ($arg_hash->{'SSL_check_crl'}) {
2477					$X509_STORE_flags \|= Net::SSLeay::X509_V_FLAG_CRL_CHECK();
2478					if ($arg_hash->{'SSL_crl_file'}) {
2479					my $bio = Net::SSLeay::BIO_new_file($arg_hash->{'SSL_crl_file'}, 'r');
2480					my $crl = Net::SSLeay::PEM_read_bio_X509_CRL($bio);
2481					Net::SSLeay::BIO_free($bio);
2482					if ( $crl ) {
2483					Net::SSLeay::X509_STORE_add_crl(Net::SSLeay::CTX_get_cert_store($ctx), $crl);
2484					} else {
2485					return IO::Socket::SSL->error("Invalid certificate revocation list");
2486					}
2487					}
2488					}
2489
2490					Net::SSLeay::X509_STORE_set_flags(
2491					Net::SSLeay::CTX_get_cert_store($ctx),
2492					$X509_STORE_flags
2493					) if $X509_STORE_flags;
2494
2495					Net::SSLeay::CTX_set_default_passwd_cb($ctx,$arg_hash->{SSL_passwd_cb})
2496					if $arg_hash->{SSL_passwd_cb};
2497
2498					my ($havekey,$havecert);
2499					if ( my $x509 = $arg_hash->{SSL_cert} ) {
2500					# binary, e.g. X509*
2501					# we have either a single certificate or a list with
2502					# a chain of certificates
2503					my @x509 = ref($x509) eq 'ARRAY' ? @$x509: ($x509);
2504					my $cert = shift @x509;
2505					Net::SSLeay::CTX_use_certificate( $ctx,$cert )
2506					\|\| return IO::Socket::SSL->error("Failed to use Certificate");
2507					foreach my $ca (@x509) {
2508					Net::SSLeay::CTX_add_extra_chain_cert( $ctx,$ca )
2509					\|\| return IO::Socket::SSL->error("Failed to use Certificate");
2510					}
2511					$havecert = 'OBJ';
2512					} elsif ( my $f = $arg_hash->{SSL_cert_file} ) {
2513					# try to load chain from PEM or certificate from ASN1
2514					if (Net::SSLeay::CTX_use_certificate_chain_file($ctx,$f)) {
2515					$havecert = 'PEM';
2516					} elsif (Net::SSLeay::CTX_use_certificate_file($ctx,$f,FILETYPE_ASN1)) {
2517					$havecert = 'DER';
2518					} else {
2519					# try to load certificate, key and chain from PKCS12 file
2520					my ($key,$cert,@chain) = Net::SSLeay::P_PKCS12_load_file($f,1);
2521					if (!$cert and $arg_hash->{SSL_passwd_cb}
2522					and defined( my $pw = $arg_hash->{SSL_passwd_cb}->(0))) {
2523					($key,$cert,@chain) = Net::SSLeay::P_PKCS12_load_file($f,1,$pw);
2524					}
2525					PKCS12: while ($cert) {
2526					Net::SSLeay::CTX_use_certificate($ctx,$cert) or last;
2527					# Net::SSLeay::P_PKCS12_load_file is implemented using
2528					# OpenSSL PKCS12_parse which according to the source code
2529					# returns the chain with the last CA certificate first (i.e.
2530					# reverse order as in the PKCS12 file). This is not
2531					# documented but given the age of this function we'll assume
2532					# that this will stay this way in the future.
2533					while (my $ca = pop @chain) {
2534					Net::SSLeay::CTX_add_extra_chain_cert($ctx,$ca)
2535					or last PKCS12;
2536					}
2537					last if $key && ! Net::SSLeay::CTX_use_PrivateKey($ctx,$key);
2538					$havecert = 'PKCS12';
2539					last;
2540					}
2541					$havekey = 'PKCS12' if $key;
2542					Net::SSLeay::X509_free($cert) if $cert;
2543					Net::SSLeay::EVP_PKEY_free($key) if $key;
2544					# don't free @chain, because CTX_add_extra_chain_cert
2545					# did not duplicate the certificates
2546					}
2547					$havecert or return IO::Socket::SSL->error(
2548					"Failed to load certificate from file (no PEM, DER or PKCS12)");
2549					}
2550
2551					if (!$havecert \|\| $havekey) {
2552					# skip SSL_key_*
2553					} elsif ( my $pkey = $arg_hash->{SSL_key} ) {
2554					# binary, e.g. EVP_PKEY*
2555					Net::SSLeay::CTX_use_PrivateKey($ctx, $pkey)
2556					\|\| return IO::Socket::SSL->error("Failed to use Private Key");
2557					$havekey = 'MEM';
2558					} elsif ( my $f = $arg_hash->{SSL_key_file}
2559					\|\| (($havecert eq 'PEM') ? $arg_hash->{SSL_cert_file}:undef) ) {
2560					for my $ft ( FILETYPE_PEM, FILETYPE_ASN1 ) {
2561					if (Net::SSLeay::CTX_use_PrivateKey_file($ctx,$f,$ft)) {
2562					$havekey = ($ft == FILETYPE_PEM) ? 'PEM':'DER';
2563					last;
2564					}
2565					}
2566					$havekey or return IO::Socket::SSL->error(
2567					"Failed to load key from file (no PEM or DER)");
2568					}
2569
2570					# replace arg_hash with created context
2571					$ctx{$host} = $ctx;
2572					}
2573
2574					if ($arg_hash->{'SSL_server'} \|\| $arg_hash->{'SSL_use_cert'}) {
2575
2576					if ( my $f = $arg_hash->{SSL_dh_file} ) {
2577					my $bio = Net::SSLeay::BIO_new_file( $f,'r' )
2578					\|\| return IO::Socket::SSL->error( "Failed to open DH file $f" );
2579					my $dh = Net::SSLeay::PEM_read_bio_DHparams($bio);
2580					Net::SSLeay::BIO_free($bio);
2581					$dh \|\| return IO::Socket::SSL->error( "Failed to read PEM for DH from $f - wrong format?" );
2582					my $rv;
2583					for (values (%ctx)) {
2584					$rv = Net::SSLeay::CTX_set_tmp_dh( $_,$dh ) or last;
2585					}
2586					Net::SSLeay::DH_free( $dh );
2587					$rv \|\| return IO::Socket::SSL->error( "Failed to set DH from $f" );
2588					} elsif ( my $dh = $arg_hash->{SSL_dh} ) {
2589					# binary, e.g. DH*
2590
2591					for( values %ctx ) {
2592					Net::SSLeay::CTX_set_tmp_dh( $_,$dh ) \|\| return
2593					IO::Socket::SSL->error( "Failed to set DH from SSL_dh" );
2594					}
2595					}
2596
2597					if ( my $curve = $arg_hash->{SSL_ecdh_curve} ) {
2598					return IO::Socket::SSL->_internal_error(
2599					"ECDH curve needs Net::SSLeay>=1.56 and OpenSSL>=1.0",9)
2600					if ! $can_ecdh;
2601					if ( $curve !~ /^\d+$/ ) {
2602					# name of curve, find NID
2603					$curve = Net::SSLeay::OBJ_txt2nid($curve)
2604					\|\| return IO::Socket::SSL->error(
2605					"cannot find NID for curve name '$curve'");
2606					}
2607					my $ecdh = Net::SSLeay::EC_KEY_new_by_curve_name($curve) or
2608					return IO::Socket::SSL->error(
2609					"cannot create curve for NID $curve");
2610					for( values %ctx ) {
2611					Net::SSLeay::CTX_set_tmp_ecdh($_,$ecdh) or
2612					return IO::Socket::SSL->error(
2613					"failed to set ECDH curve context");
2614					}
2615					Net::SSLeay::EC_KEY_free($ecdh);
2616					}
2617					}
2618
2619					my $verify_cb = $arg_hash->{SSL_verify_callback};
2620					my @accept_fp;
2621					if ( my $fp = $arg_hash->{SSL_fingerprint} ) {
2622					for( ref($fp) ? @$fp : $fp) {
2623					my ($algo,$pubkey,$digest) = m{^([\w-]+)\$(pub\$)?([a-f\d:]+)$}i;
2624					return IO::Socket::SSL->_internal_error("invalid fingerprint '$_'",9)
2625					if ! $algo;
2626					$algo = lc($algo);
2627					( $digest = lc($digest) ) =~s{:}{}g;
2628					push @accept_fp,[ $algo, $pubkey \|\| '', pack('H*',$digest) ]
2629					}
2630					}
2631					my $verify_fingerprint = @accept_fp && do {
2632					my $fail;
2633					sub {
2634					my ($ok,$cert,$depth) = @_;
2635					$fail = 1 if ! $ok;
2636					return 1 if $depth>0; # to let us continue with verification
2637					# Check fingerprint only from top certificate.
2638					my %fp;
2639					for(@accept_fp) {
2640					my $fp = $fp{$_->[0],$_->[1]} \|\|= $_->[1]
2641					? Net::SSLeay::X509_pubkey_digest($cert,$algo2digest->($_->[0]))
2642					: Net::SSLeay::X509_digest($cert,$algo2digest->($_->[0]));
2643					next if $fp ne $_->[2];
2644					return 1;
2645					}
2646					return ! $fail;
2647					}
2648					};
2649					my $verify_callback = ( $verify_cb \|\| @accept_fp ) && sub {
2650					my ($ok, $ctx_store) = @_;
2651					my ($certname,$cert,$error,$depth);
2652					if ($ctx_store) {
2653					$cert = Net::SSLeay::X509_STORE_CTX_get_current_cert($ctx_store);
2654					$error = Net::SSLeay::X509_STORE_CTX_get_error($ctx_store);
2655					$depth = Net::SSLeay::X509_STORE_CTX_get_error_depth($ctx_store);
2656					$certname =
2657					Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_issuer_name($cert)).
2658					Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($cert));
2659					$error &&= Net::SSLeay::ERR_error_string($error);
2660					}
2661					$DEBUG>=3 && DEBUG( "ok=$ok [$depth] $certname" );
2662					$ok = $verify_cb->($ok,$ctx_store,$certname,$error,$cert,$depth) if $verify_cb;
2663					$ok = $verify_fingerprint->($ok,$cert,$depth) if $verify_fingerprint && $cert;
2664					return $ok;
2665					};
2666
2667					if ( $^O eq 'darwin' ) {
2668					# explicitly set error code to disable use of apples TEA patch
2669					# https://hynek.me/articles/apple-openssl-verification-surprises/
2670					my $vcb = $verify_callback;
2671					$verify_callback = sub {
2672					my $rv = $vcb ? &$vcb : $_[0];
2673					if ( $rv != 1 ) {
2674					# 50 - X509_V_ERR_APPLICATION_VERIFICATION: application verification failure
2675					Net::SSLeay::X509_STORE_CTX_set_error($_[1], 50);
2676					}
2677					return $rv;
2678					};
2679					}
2680					Net::SSLeay::CTX_set_verify($_, $verify_mode, $verify_callback)
2681					for (values %ctx);
2682
2683					my $staple_callback = $arg_hash->{SSL_ocsp_staple_callback};
2684					if ( !$is_server && $can_ocsp_staple ) {
2685					$self->{ocsp_cache} = $arg_hash->{SSL_ocsp_cache};
2686					my $status_cb = sub {
2687					my ($ssl,$resp) = @_;
2688					my $iossl = $SSL_OBJECT{$ssl} or
2689					die "no IO::Socket::SSL object found for SSL $ssl";
2690					$iossl->[1] and do {
2691					# we must return with 1 or it will be called again
2692					# and because we have no SSL object we must make the error global
2693					Carp::cluck($IO::Socket::SSL::SSL_ERROR
2694					= "OCSP callback on server side");
2695					return 1;
2696					};
2697					$iossl = $iossl->[0];
2698
2699					# if we have a callback use this
2700					# callback must not free or copy $resp !!
2701					if ( $staple_callback ) {
2702					$staple_callback->($iossl,$resp);
2703					return 1;
2704					}
2705
2706					# default callback does verification
2707					if ( ! $resp ) {
2708					$DEBUG>=3 && DEBUG("did not get stapled OCSP response");
2709					return 1;
2710					}
2711					$DEBUG>=3 && DEBUG("got stapled OCSP response");
2712					my $status = Net::SSLeay::OCSP_response_status($resp);
2713					if ($status != Net::SSLeay::OCSP_RESPONSE_STATUS_SUCCESSFUL()) {
2714					$DEBUG>=3 && DEBUG("bad status of stapled OCSP response: ".
2715					Net::SSLeay::OCSP_response_status_str($status));
2716					return 1;
2717					}
2718					if (!eval { Net::SSLeay::OCSP_response_verify($ssl,$resp) }) {
2719					$DEBUG>=3 && DEBUG("verify of stapled OCSP response failed");
2720					return 1;
2721					}
2722					my (@results,$hard_error);
2723					my @chain = $iossl->peer_certificates;
2724					for my $cert (@chain) {
2725					my $certid = eval { Net::SSLeay::OCSP_cert2ids($ssl,$cert) };
2726					if (!$certid) {
2727					$DEBUG>=3 && DEBUG("cannot create OCSP_CERTID: $@");
2728					push @results,[-1,$@];
2729					last;
2730					}
2731					($status) = Net::SSLeay::OCSP_response_results($resp,$certid);
2732					if ($status && $status->[2]) {
2733					my $cache = ${*$iossl}{_SSL_ctx}{ocsp_cache};
2734					if (!$status->[1]) {
2735					push @results,[1,$status->[2]{nextUpdate}];
2736					$cache && $cache->put($certid,$status->[2]);
2737					} elsif ( $status->[2]{statusType} ==
2738					Net::SSLeay::V_OCSP_CERTSTATUS_GOOD()) {
2739					push @results,[1,$status->[2]{nextUpdate}];
2740					$cache && $cache->put($certid,{
2741					%{$status->[2]},
2742					expire => time()+120,
2743					soft_error => $status->[1],
2744					});
2745					} else {
2746					push @results,($hard_error = [0,$status->[1]]);
2747					$cache && $cache->put($certid,{
2748					%{$status->[2]},
2749					hard_error => $status->[1],
2750					});
2751					}
2752					}
2753					}
2754					# return result of lead certificate, this should be in chain[0] and
2755					# thus result[0], but we better check. But if we had any hard_error
2756					# return this instead
2757					if ($hard_error) {
2758					${*$iossl}{_SSL_ocsp_verify} = $hard_error;
2759					} elsif (@results and $chain[0] == $iossl->peer_certificate) {
2760					${*$iossl}{_SSL_ocsp_verify} = $results[0];
2761					}
2762					return 1;
2763					};
2764					Net::SSLeay::CTX_set_tlsext_status_cb($_,$status_cb) for (values %ctx);
2765					}
2766
2767					if ( my $cl = $arg_hash->{SSL_cipher_list} ) {
2768					for (keys %ctx) {
2769					Net::SSLeay::CTX_set_cipher_list($ctx{$_}, ref($cl)
2770					? $cl->{$_} \|\| $cl->{''} \|\| $DEFAULT_SSL_ARGS{SSL_cipher_list} \|\| next
2771					: $cl
2772					) \|\| return IO::Socket::SSL->error("Failed to set SSL cipher list");
2773					}
2774					}
2775
2776					# Main context is default context or any other if no default context.
2777					my $ctx = $ctx{''} \|\| (values %ctx)[0];
2778					if (keys(%ctx) > 1 \|\| ! exists $ctx{''}) {
2779					$can_server_sni or return IO::Socket::SSL->_internal_error(
2780					"Server side SNI not supported for this openssl/Net::SSLeay",9);
2781
2782					Net::SSLeay::CTX_set_tlsext_servername_callback($ctx, sub {
2783					my $ssl = shift;
2784					my $host = Net::SSLeay::get_servername($ssl);
2785					$host = '' if ! defined $host;
2786					my $snictx = $ctx{lc($host)} \|\| $ctx{''} or do {
2787					$DEBUG>1 and DEBUG(
2788					"cannot get context from servername '$host'");
2789					return 0;
2790					};
2791					$DEBUG>1 and DEBUG("set context from servername $host");
2792					Net::SSLeay::set_SSL_CTX($ssl,$snictx) if $snictx != $ctx;
2793					return 1;
2794					});
2795					}
2796
2797					if ( my $cb = $arg_hash->{SSL_create_ctx_callback} ) {
2798					$cb->($_) for values (%ctx);
2799					}
2800
2801					$self->{context} = $ctx;
2802					$self->{verify_mode} = $arg_hash->{SSL_verify_mode};
2803					$self->{ocsp_mode} =
2804					defined($arg_hash->{SSL_ocsp_mode}) ? $arg_hash->{SSL_ocsp_mode} :
2805					$self->{verify_mode} ? IO::Socket::SSL::SSL_OCSP_TRY_STAPLE() :
2806					0;
2807					$DEBUG>=3 && DEBUG( "new ctx $ctx" );
2808
2809					if ( my $cache = $arg_hash->{SSL_session_cache} ) {
2810					# use predefined cache
2811					$self->{session_cache} = $cache
2812					} elsif ( my $size = $arg_hash->{SSL_session_cache_size}) {
2813					$self->{session_cache} = IO::Socket::SSL::Session_Cache->new( $size );
2814					}
2815
2816					return $self;
2817					}
2818
2819
2820					sub has_session_cache {
2821					return defined shift->{session_cache};
2822					}
2823
2824
2825					sub CLONE { %CTX_CREATED_IN_THIS_THREAD = (); }
2826					sub DESTROY {
2827					my $self = shift;
2828					if ( my $ctx = $self->{context} ) {
2829					$DEBUG>=3 && DEBUG("free ctx $ctx open=".join( " ",keys %CTX_CREATED_IN_THIS_THREAD ));
2830					if (!$use_threads or delete $CTX_CREATED_IN_THIS_THREAD{$ctx} ) {
2831					# remove any verify callback for this context
2832					if ( $self->{verify_mode}) {
2833					$DEBUG>=3 && DEBUG("free ctx $ctx callback" );
2834					Net::SSLeay::CTX_set_verify($ctx, 0,undef);
2835					}
2836					if ( $self->{ocsp_error_ref}) {
2837					$DEBUG>=3 && DEBUG("free ctx $ctx tlsext_status_cb" );
2838					Net::SSLeay::CTX_set_tlsext_status_cb($ctx,undef);
2839					}
2840					$DEBUG>=3 && DEBUG("OK free ctx $ctx" );
2841					Net::SSLeay::CTX_free($ctx);
2842					}
2843					}
2844					delete(@{$self}{'context','session_cache'});
2845					}
2846
2847					package IO::Socket::SSL::Session_Cache;
2848	2	4.80ms	2	52µs	# spent 42µs (32+10) within IO::Socket::SSL::Session_Cache::BEGIN@2848 which was called: # once (32µs+10µs) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 2848 use strict; # spent 42µs making 1 call to IO::Socket::SSL::Session_Cache::BEGIN@2848 # spent 10µs making 1 call to strict::import
2849
2850					sub new {
2851					my ($class, $size) = @_;
2852					$size>0 or return;
2853					return bless { _maxsize => $size }, $class;
2854					}
2855
2856
2857					sub del_session {
2858					my ($self, $key) = @_;
2859					my $val = delete $self->{$key} or return;
2860					Net::SSLeay::SESSION_free($val->{session});
2861					$val->{prev}{next} = $val->{next};
2862					$val->{next}{prev} = $val->{prev};
2863					if ($val != $self->{_head}) {
2864					# keep head
2865					} elsif ($val == $val->{next}) {
2866					# single element in cache, drop it
2867					$self->{_head} = undef
2868					} else {
2869					# point to next element in cache
2870					$self->{_head} = $val->{next}
2871					}
2872					}
2873
2874					sub get_session {
2875					my ($self, $key) = @_;
2876					my $session = $self->{$key} \|\| return;
2877					return $session->{session} if ($self->{'_head'} eq $session);
2878					$session->{prev}->{next} = $session->{next};
2879					$session->{next}->{prev} = $session->{prev};
2880					$session->{next} = $self->{'_head'};
2881					$session->{prev} = $self->{'_head'}->{prev};
2882					$self->{'_head'}->{prev} = $self->{'_head'}->{prev}->{next} = $session;
2883					$self->{'_head'} = $session;
2884					return $session->{session};
2885					}
2886
2887					sub add_session {
2888					my ($self, $key, $val) = @_;
2889					return if ($key eq '_maxsize' or $key eq '_head');
2890
2891					if ( my $have = $self->{$key} ) {
2892					Net::SSLeay::SESSION_free( $have->{session} );
2893					$have->{session} = $val;
2894					return get_session($self,$key); # will put key on front
2895					}
2896
2897					my $session = $self->{$key} = { session => $val, key => $key };
2898
2899					if ( keys(%$self) > $self->{_maxsize}+2) {
2900					my $last = $self->{'_head'}->{prev};
2901					Net::SSLeay::SESSION_free($last->{session});
2902					delete($self->{$last->{key}});
2903					$self->{'_head'}->{prev} = $self->{'_head'}->{prev}->{prev};
2904					delete($self->{'_head'}) if ($self->{'_maxsize'} == 1);
2905					}
2906
2907					if ($self->{'_head'}) {
2908					$session->{next} = $self->{'_head'};
2909					$session->{prev} = $self->{'_head'}->{prev};
2910					$self->{'_head'}->{prev}->{next} = $session;
2911					$self->{'_head'}->{prev} = $session;
2912					} else {
2913					$session->{next} = $session->{prev} = $session;
2914					}
2915					$self->{'_head'} = $session;
2916					return $session;
2917					}
2918
2919					sub DESTROY {
2920					my $self = shift;
2921					delete(@{$self}{'_head','_maxsize'});
2922					for (values %$self) {
2923					Net::SSLeay::SESSION_free($_->{session} \|\| next);
2924					}
2925					}
2926
- -
2929					package IO::Socket::SSL::OCSP_Cache;
2930
2931					sub new {
2932					my ($class,$size) = @_;
2933					return bless {
2934					'' => { _lru => 0, size => $size \|\| 100 }
2935					},$class;
2936					}
2937					sub get {
2938					my ($self,$id) = @_;
2939					my $e = $self->{$id} or return;
2940					$e->{_lru} = $self->{''}{_lru}++;
2941					if ( $e->{expire} && time()<$e->{expire}) {
2942					delete $self->{$id};
2943					return;
2944					}
2945					if ( $e->{nextUpdate} && time()<$e->{nextUpdate} ) {
2946					delete $self->{$id};
2947					return;
2948					}
2949					return $e;
2950					}
2951
2952					sub put {
2953					my ($self,$id,$e) = @_;
2954					$self->{$id} = $e;
2955					$e->{_lru} = $self->{''}{_lru}++;
2956					my $del = keys(%$self) - $self->{''}{size};
2957					if ($del>0) {
2958					my @k = sort { $self->{$a}{_lru} <=> $self->{$b}{_lru} } keys %$self;
2959					delete @{$self}{ splice(@k,0,$del) };
2960					}
2961					return $e;
2962					}
2963
2964					package IO::Socket::SSL::OCSP_Resolver;
2965	1	4µs			DEBUG = IO::Socket::SSL::DEBUG;
2966
2967					# create a new resolver
2968					# $ssl - the ssl object
2969					# $cache - OCSP_Cache object (put,get)
2970					# $failhard - flag if we should fail hard on OCSP problems
2971					# $certs - list of certs to verify
2972					sub new {
2973					my ($class,$ssl,$cache,$failhard,$certs) = @_;
2974					my (%todo,$done,$hard_error,@soft_error);
2975					for my $cert (@$certs) {
2976					# skip entries which have no OCSP uri or where we cannot get a certid
2977					# (e.g. self-signed or where we don't have the issuer)
2978					my $subj = Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($cert));
2979					my $uri = Net::SSLeay::P_X509_get_ocsp_uri($cert) or do {
2980					$DEBUG>2 && DEBUG("no URI for certificate $subj");
2981					push @soft_error,"no ocsp_uri for $subj";
2982					next;
2983					};
2984					my $certid = eval { Net::SSLeay::OCSP_cert2ids($ssl,$cert) } or do {
2985					$DEBUG>2 && DEBUG("no OCSP_CERTID for certificate $subj: $@");
2986					push @soft_error,"no certid for $subj: $@";
2987					next;
2988					};
2989					if (!($done = $cache->get($certid))) {
2990					push @{ $todo{$uri}{ids} }, $certid;
2991					push @{ $todo{$uri}{subj} }, $subj;
2992					} elsif ( $done->{hard_error} ) {
2993					# one error is enough to fail validation
2994					$hard_error = $done->{hard_error};
2995					%todo = ();
2996					last;
2997					} elsif ( $done->{soft_error} ) {
2998					push @soft_error,$done->{soft_error};
2999					}
3000					}
3001					while ( my($uri,$v) = each %todo) {
3002					my $ids = $v->{ids};
3003					$v->{req} = Net::SSLeay::i2d_OCSP_REQUEST(
3004					Net::SSLeay::OCSP_ids2req(@$ids));
3005					}
3006					$hard_error \|\|= '' if ! %todo;
3007					return bless {
3008					ssl => $ssl,
3009					cache => $cache,
3010					failhard => $failhard,
3011					hard_error => $hard_error,
3012					soft_error => @soft_error ? join("; ",@soft_error) : undef,
3013					todo => \%todo,
3014					},$class;
3015					}
3016
3017					# return current result, e.g. '' for no error, else error
3018					# if undef we have no final result yet
3019					sub hard_error { return shift->{hard_error} }
3020					sub soft_error { return shift->{soft_error} }
3021
3022					# return hash with uri => ocsp_request_data for open requests
3023					sub requests {
3024					my $todo = shift()->{todo};
3025					return map { ($_,$todo->{$_}{req}) } keys %$todo;
3026					}
3027
3028					# add new response
3029					sub add_response {
3030					my ($self,$uri,$resp) = @_;
3031					my $todo = delete $self->{todo}{$uri};
3032					return $self->{error} if ! $todo \|\| $self->{error};
3033
3034					my ($req,@soft_error,@hard_error);
3035
3036					# do we have a response
3037					if (!$resp) {
3038					@soft_error = "http request for OCSP failed; subject: ".
3039					join("; ",@{$todo->{subj}});
3040
3041					# is it a valid OCSP_RESPONSE
3042					} elsif ( ! eval { $resp = Net::SSLeay::d2i_OCSP_RESPONSE($resp) }) {
3043					@soft_error = "invalid response (no OCSP_RESPONSE); subject: ".
3044					join("; ",@{$todo->{subj}});
3045					# hopefully short-time error
3046					$self->{cache}->put($_,{
3047					soft_error => "@soft_error",
3048					expire => time()+10,
3049					}) for (@{$todo->{ids}});
3050					# is the OCSP response status success
3051					} elsif (
3052					( my $status = Net::SSLeay::OCSP_response_status($resp))
3053					!= Net::SSLeay::OCSP_RESPONSE_STATUS_SUCCESSFUL()
3054					){
3055					@soft_error = "OCSP response failed: ".
3056					Net::SSLeay::OCSP_response_status_str($status).
3057					"; subject: ".join("; ",@{$todo->{subj}});
3058					# hopefully short-time error
3059					$self->{cache}->put($_,{
3060					soft_error => "@soft_error",
3061					expire => time()+10,
3062					}) for (@{$todo->{ids}});
3063
3064					# does nonce match the request and can the signature be verified
3065					} elsif ( ! eval {
3066					$req = Net::SSLeay::d2i_OCSP_REQUEST($todo->{req});
3067					Net::SSLeay::OCSP_response_verify($self->{ssl},$resp,$req);
3068					}) {
3069					if ($@) {
3070					@soft_error = $@
3071					} else {
3072					my @err;
3073					while ( my $err = Net::SSLeay::ERR_get_error()) {
3074					push @soft_error, Net::SSLeay::ERR_error_string($err);
3075					}
3076					@soft_error = 'failed to verify OCSP response; subject: '.
3077					join("; ",@{$todo->{subj}}) if ! @soft_error;
3078					}
3079					# configuration problem or we don't know the signer
3080					$self->{cache}->put($_,{
3081					soft_error => "@soft_error",
3082					expire => time()+120,
3083					}) for (@{$todo->{ids}});
3084
3085					# extract results from response
3086					} elsif ( my @result =
3087					Net::SSLeay::OCSP_response_results($resp,@{$todo->{ids}})) {
3088					my (@found,@miss);
3089					for my $rv (@result) {
3090					if ($rv->[2]) {
3091					push @found,$rv->[0];
3092					if (!$rv->[1]) {
3093					# no error
3094					$self->{cache}->put($rv->[0],$rv->[2]);
3095					} elsif ( $rv->[2]{statusType} ==
3096					Net::SSLeay::V_OCSP_CERTSTATUS_GOOD()) {
3097					# soft error, like response after nextUpdate
3098					push @soft_error,$rv->[1]."; subject: ".
3099					join("; ",@{$todo->{subj}});
3100					$self->{cache}->put($rv->[0],{
3101					%{$rv->[2]},
3102					soft_error => "@soft_error",
3103					expire => time()+120,
3104					});
3105					} else {
3106					# hard error
3107					$self->{cache}->put($rv->[0],$rv->[2]);
3108					push @hard_error, $rv->[1]."; subject: ".
3109					join("; ",@{$todo->{subj}});
3110					}
3111					} else {
3112					push @miss,$rv->[0];
3113					}
3114					}
3115					if (@miss && @found) {
3116					# we sent multiple responses, but server answered only to one
3117					# try again
3118					$self->{todo}{$uri} = $todo;
3119					$todo->{ids} = \@miss;
3120					$todo->{req} = Net::SSLeay::i2d_OCSP_REQUEST(
3121					Net::SSLeay::OCSP_ids2req(@miss));
3122					$DEBUG>=2 && DEBUG("$uri just answered ".@found." of ".(@found+@miss)." requests");
3123					}
3124					} else {
3125					@soft_error = "no data in response; subject: ".
3126					join("; ",@{$todo->{subj}});
3127					# probably configuration problem
3128					$self->{cache}->put($_,{
3129					soft_error => "@soft_error",
3130					expire => time()+120,
3131					}) for (@{$todo->{ids}});
3132					}
3133
3134					Net::SSLeay::OCSP_REQUEST_free($req) if $req;
3135					if ($self->{failhard}) {
3136					push @hard_error,@soft_error;
3137					@soft_error = ();
3138					}
3139					if (@soft_error) {
3140					$self->{soft_error} .= "; " if $self->{soft_error};
3141					$self->{soft_error} .= "$uri: ".join('; ',@soft_error);
3142					}
3143					if (@hard_error) {
3144					$self->{hard_error} = "$uri: ".join('; ',@hard_error);
3145					%{$self->{todo}} = ();
3146					} elsif ( ! %{$self->{todo}} ) {
3147					$self->{hard_error} = ''
3148					}
3149					return $self->{hard_error};
3150					}
3151
3152					# make all necessary requests to get OCSP responses blocking
3153					sub resolve_blocking {
3154					my ($self,%args) = @_;
3155					while ( my %todo = $self->requests ) {
3156					eval { require HTTP::Tiny } or die "need HTTP::Tiny installed";
3157					# OCSP responses have their own signature, so we don't need SSL verification
3158					my $ua = HTTP::Tiny->new(verify_SSL => 0,%args);
3159					while (my ($uri,$reqdata) = each %todo) {
3160					$DEBUG && DEBUG("sending OCSP request to $uri");
3161					my $resp = $ua->request('POST',$uri, {
3162					headers => { 'Content-type' => 'application/ocsp-request' },
3163					content => $reqdata
3164					});
3165					$DEBUG && DEBUG("got OCSP response from $uri code=$resp->{status}");
3166					defined ($self->add_response($uri,
3167					$resp->{success} && $resp->{content}))
3168					&& last;
3169					}
3170					}
3171					$DEBUG>=2 && DEBUG("no more open OCSP requests");
3172					return $self->{hard_error};
3173					}
3174
3175	1	128µs			1;
3176
3177					__END__

					# spent 46µs within IO::Socket::SSL::CORE:match which was called 8 times, avg 6µs/call: # 7 times (36µs+0s) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 258, avg 5µs/call # once (10µs+0s) by Mail::SpamAssassin::Plugin::SpamCop::BEGIN@53 at line 406 sub IO::Socket::SSL::CORE:match; # opcode