view release on metacpan or  search on metacpan

local/lib/perl5/IO/Socket/SSL.pm  view on Meta::CPAN

    my $openssldir;

    sub default_ca {
	if (@_) {
	    # user defined default CA or reset
	    if ( @_ > 1 ) {
		%default_ca = @_;
		$ca_detected  = 0;
	    } elsif ( my $path = shift ) {
		%default_ca = $CHECK_SSL_PATH->($path);
		$ca_detected  = 0;
	    } else {
		$ca_detected = undef;
	    }
	}
	return %default_ca if defined $ca_detected;

	# SSLEAY_DIR was 5 up to OpenSSL 1.1, then switched to 4 and got
	# renamed to OPENSSL_DIR. Unfortunately it is not exported as constant
	# by Net::SSLeay so we use the fixed number.
	$openssldir ||=
	    Net::SSLeay::SSLeay_version(5) =~m{^OPENSSLDIR: "(.+)"$} ? $1 :
	    Net::SSLeay::SSLeay_version(4) =~m{^OPENSSLDIR: "(.+)"$} ? $1 :
	    'cannot-determine-openssldir-from-ssleay-version';

	# (re)detect according to openssl crypto/cryptlib.h
	my $dir = $ENV{SSL_CERT_DIR}
	    || ( $^O =~m{vms}i ? "SSLCERTS:":"$openssldir/certs" );
	if ( opendir(my $dh,$dir)) {
	    FILES: for my $f (  grep { m{^[a-f\d]{8}(\.\d+)?$} } readdir($dh) ) {
		open( my $fh,'<',"$dir/$f") or next;
		while (my $line = <$fh>) {
		    $line =~m{^-+BEGIN (X509 |TRUSTED |)CERTIFICATE-} or next;
		    $default_ca{SSL_ca_path} = $dir;
		    last FILES;
		}
	    }
	}
	my $file = $ENV{SSL_CERT_FILE}
	    || ( $^O =~m{vms}i ? "SSLCERTS:cert.pem":"$openssldir/cert.pem" );
	if ( open(my $fh,'<',$file)) {
	    while (my $line = <$fh>) {
		$line =~m{^-+BEGIN (X509 |TRUSTED |)CERTIFICATE-} or next;
		$default_ca{SSL_ca_file} = $file;
		last;
	    }
	}

	$default_ca{SSL_ca_file} = Mozilla::CA::SSL_ca_file() if ! %default_ca && do {
		local $SIG{__DIE__};
		eval { require Mozilla::CA; 1 };
	    };

	$ca_detected = 1;
	return %default_ca;
    }
}


# Export some stuff
# inet4|inet6|debug will be handled by myself, everything
# else will be handled the Exporter way
sub import {
    my $class = shift;

    my @export;
    foreach (@_) {
	if ( /^inet4$/i ) {
	    # explicitly fall back to inet4
	    @ISA = 'IO::Socket::INET';
	    @caller_force_inet4 = caller(); # save for warnings for 'inet6' case
	} elsif ( /^inet6$/i ) {
	    # check if we have already ipv6 as base
	    if ( ! UNIVERSAL::isa( $class, 'IO::Socket::INET6')
		and ! UNIVERSAL::isa( $class, 'IO::Socket::IP' )) {
		# either we don't support it or we disabled it by explicitly
		# loading it with 'inet4'. In this case re-enable but warn
		# because this is probably an error
		if ( CAN_IPV6 ) {
		    @ISA = ( CAN_IPV6 );
		    warn "IPv6 support re-enabled in __PACKAGE__, got disabled in file $caller_force_inet4[1] line $caller_force_inet4[2]";
		} else {
		    die "INET6 is not supported, install IO::Socket::IP";
		}
	    }
	} elsif ( /^:?debug(\d+)/ ) {
	    $DEBUG=$1;
	} else {
	    push @export,$_
	}
    }

    @_ = ( $class,@export );
    goto &Exporter::import;
}

my %SSL_OBJECT;
my %CREATED_IN_THIS_THREAD;
sub CLONE { %CREATED_IN_THIS_THREAD = (); }

# all keys used internally, these should be cleaned up at end
my @all_my_keys = qw(
    _SSL_arguments
    _SSL_certificate
    _SSL_ctx
    _SSL_fileno
    _SSL_in_DESTROY
    _SSL_ioclass_downgrade
    _SSL_ioclass_upgraded
    _SSL_last_err
    _SSL_object
    _SSL_ocsp_verify
    _SSL_opened
    _SSL_opening
    _SSL_servername
    _SSL_msg_callback
);


# we have callbacks associated with contexts, but have no way to access the
# current SSL object from these callbacks. To work around this
# CURRENT_SSL_OBJECT will be set before calling Net::SSLeay::{connect,accept}
# and reset afterwards, so we have access to it inside _internal_error.
my $CURRENT_SSL_OBJECT;

# You might be expecting to find a new() subroutine here, but that is
# not how IO::Socket::INET works.  All configuration gets performed in
# the calls to configure() and either connect() or accept().

#Call to configure occurs when a new socket is made using
#IO::Socket::INET.  Returns false (empty list) on failure.
sub configure {