view release on metacpan or  search on metacpan

t/local/36_verify.t  view on Meta::CPAN

    my $verify_cb = sub { $verify_result = Net::SSLeay::X509_STORE_CTX_get_error($_[1]); return $_[0];};

    my $ssl = Net::SSLeay::new($ctx);
    Net::SSLeay::set_verify($ssl, Net::SSLeay::VERIFY_PEER(), $verify_cb);
    Net::SSLeay::set_fd($ssl, $cl);

    return $ssl;
}

# SSL client - connect to server and test different verification
# settings
sub client {
    my ($ctx, $cl);
    foreach my $task (qw(
		      policy_checks_ok policy_checks_fail
		      hostname_checks_ok hostname_checks_fail
		      wildcard_checks
		      finish))
    {
	$ctx = new_ctx();
	is(Net::SSLeay::CTX_load_verify_locations($ctx, $ca_pem, $ca_dir), 1, "load_verify_locations($ca_pem $ca_dir)");

	$cl = $server->connect();

	test_policy_checks($ctx, $cl, 1)   if $task eq 'policy_checks_ok';
	test_policy_checks($ctx, $cl, 0)   if $task eq 'policy_checks_fail';
	test_hostname_checks($ctx, $cl, 1) if $task eq 'hostname_checks_ok';
	test_hostname_checks($ctx, $cl, 0) if $task eq 'hostname_checks_fail';
	test_wildcard_checks($ctx, $cl) if $task eq 'wildcard_checks';
	last if $task eq 'finish'; # Leaves $cl alive

	close($cl) || die("client close: $!");
    }

    # Tell the server to quit and see that our connection is still up
    $ctx = new_ctx();
    my $ssl = Net::SSLeay::new($ctx);
    Net::SSLeay::set_fd($ssl, $cl);
    Net::SSLeay::connect($ssl);
    my $end = "end";
    Net::SSLeay::ssl_write_all($ssl, $end);
    Net::SSLeay::shutdown($ssl);
    ok($end eq Net::SSLeay::ssl_read_all($ssl), 'Successful termination');
    Net::SSLeay::free($ssl);
    close($cl) || die("client final close: $!");
    return;
}

# SSL server - just accept connnections and exit when told to by
# the client
sub run_server
{
    my $pid;
    defined($pid = fork()) or BAIL_OUT("failed to fork: $!");

    return if $pid != 0;

    $SIG{'PIPE'} = 'IGNORE';
    my $ctx = new_ctx();
    Net::SSLeay::set_cert_and_key($ctx, $cert_pem, $key_pem);
    my $ret = Net::SSLeay::CTX_check_private_key($ctx);
    BAIL_OUT("Server: CTX_check_private_key failed: $cert_pem, $key_pem") unless $ret == 1;
    if (defined &Net::SSLeay::CTX_set_num_tickets) {
        # TLS 1.3 server sends session tickets after a handhake as part of
        # the SSL_accept(). If a client finishes all its job including closing
        # TCP connectino before a server sends the tickets, SSL_accept() fails
        # with SSL_ERROR_SYSCALL and EPIPE errno and the server receives
        # SIGPIPE signal. <https://github.com/openssl/openssl/issues/6904>
        my $ret = Net::SSLeay::CTX_set_num_tickets($ctx, 0);
        BAIL_OUT("Session tickets disabled") unless $ret;
    }

    while (1)
    {
	my $cl = $server->accept() or BAIL_OUT("accept failed: $!");
	my $ssl = Net::SSLeay::new($ctx);

	Net::SSLeay::set_fd($ssl, fileno($cl));
	my $ret = Net::SSLeay::accept($ssl);
	next unless $ret == 1;

	# Termination request or other message from client
	my $msg = Net::SSLeay::ssl_read_all($ssl);
	if (defined $msg and $msg eq 'end')
	{
	    Net::SSLeay::ssl_write_all($ssl, 'end');
	    Net::SSLeay::shutdown($ssl);
	    Net::SSLeay::free($ssl);
	    close($cl) || die("server close: $!");
	    $server->close() || die("server listen socket close: $!");
	    exit (0);
	}
    }
}