view release on metacpan or  search on metacpan

t/extended_tests.t  view on Meta::CPAN

	# _verified_rdns has installed "local $SIG{ALRM} = sub { die 'DNS timeout' }"
	# so the signal triggers that handler, which die()s inside the eval,
	# setting $@.  The code then executes "return if $@ || !$hostname".
	my $guard = mock_scoped 'CGI::ACL::_rdns_forward' => sub {
		kill 'ALRM', $$;    # fire the alarm now — handler will die
		return ();           # never reached
	};

	diag "triggering SIGALRM inside _verified_rdns eval" if $ENV{TEST_VERBOSE};

	# 127.0.0.1 normally has a PTR record; gethostbyaddr should succeed,
	# so the code enters _rdns_forward before timing out.
	my $result = CGI::ACL::_verified_rdns($config{LOCAL_IP});

	is($result, undef, 'SIGALRM timeout causes _verified_rdns to return undef');
};

subtest '_verified_rdns(): SIGALRM path: alarm is cancelled after eval (no leak)' => sub {
	plan skip_all => 'SIGALRM not available on Windows' if $^O eq 'MSWin32';

	# Verify the outer alarm(0) cancels any lingering alarm after the eval.
	# If the alarm were not cancelled we could get a spurious SIGALRM later.
	my $guard = mock_scoped 'CGI::ACL::_rdns_forward' => sub {
		kill 'ALRM', $$;
		return ();
	};

	# Install a safety net: if alarm fires outside _verified_rdns it means
	# the alarm was NOT properly cancelled — that would be a bug.
	my $leaked = 0;
	local $SIG{ALRM} = sub { $leaked = 1 };

	CGI::ACL::_verified_rdns($config{LOCAL_IP});

	# Allow one event loop tick for any leaked alarm to fire
	select(undef, undef, undef, 0.05);

	ok(!$leaked, 'no alarm leak after _verified_rdns returns');
};

# ─────────────────────────────────────────────────────────────────────────────
# _verified_rdns() !$hostname BRANCH (line 922)
# Purpose: when gethostbyaddr returns undef (no PTR record) the code
# executes "return if $@ || !$hostname".  The !$hostname sub-path.
# ─────────────────────────────────────────────────────────────────────────────

subtest '_verified_rdns(): IP with no PTR record returns undef (!$hostname path)' => sub {
	plan skip_all => 'SIGALRM not available on Windows' if $^O eq 'MSWin32';

	# RFC 5737 TEST-NET addresses normally have no PTR record.
	# gethostbyaddr should return undef, exercising the !$hostname branch.
	diag "calling _verified_rdns on no-PTR IP $config{RFC5737_IP}" if $ENV{TEST_VERBOSE};

	my $result = CGI::ACL::_verified_rdns($config{RFC5737_IP});

	is($result, undef, 'no-PTR address returns undef via !$hostname branch');
};

# ─────────────────────────────────────────────────────────────────────────────
# WINDOWS PLATFORM PATH (unreachable on non-Windows)
# Lines 923-929 in lib/CGI/ACL.pm contain the Windows synchronous code path
# (no alarm, direct gethostbyaddr + _rdns_forward).  These lines execute only
# when $^O eq 'MSWin32'.  On macOS/Linux they are DEAD CODE and cannot be
# covered without mocking $^O itself, which is a Readonly built-in.
#
# COMMENTED OUT — shown here for review.  Do not enable unless running on
# Windows where the coverage will naturally be collected by the normal DNS
# tests.
#
# subtest '_verified_rdns(): Windows synchronous path' => sub {
#     plan skip_all => 'only on Windows' unless $^O eq 'MSWin32';
#     # On Windows, $^O is 'MSWin32', so gethostbyaddr and _rdns_forward
#     # are called without an alarm.  Lines 925-928 execute here.
#     my $guard = mock_scoped 'CGI::ACL::_rdns_forward'
#         => sub { ($config{LOCAL_IP}) };
#     my $result = CGI::ACL::_verified_rdns($config{LOCAL_IP});
#     ok(defined $result, 'Windows path returns hostname');
# };
# ─────────────────────────────────────────────────────────────────────────────

# ─────────────────────────────────────────────────────────────────────────────
# _verified_rdns() FORWARD-CONFIRMATION CONDITION (line 932)
# Purpose: the ternary "$hostname && grep { $_ eq $canonical } @forward_ips"
# must return $hostname when the forward list contains the canonical IP.
# ─────────────────────────────────────────────────────────────────────────────

subtest '_verified_rdns(): forward IP matches canonical — returns hostname' => sub {
	plan skip_all => 'SIGALRM not available on Windows' if $^O eq 'MSWin32';

	# 127.0.0.1 normally has a PTR; mock _rdns_forward to confirm it.
	my $guard = mock_scoped 'CGI::ACL::_rdns_forward'
		=> sub { ($config{LOCAL_IP}) };

	diag "forward-confirm: _rdns_forward returns LOCAL_IP" if $ENV{TEST_VERBOSE};

	my $result = CGI::ACL::_verified_rdns($config{LOCAL_IP});

	ok(defined($result), 'matching forward IP returns a hostname');
	like($result, qr/\S/, 'returned hostname is non-empty');
};

subtest '_verified_rdns(): forward IP list empty — returns undef' => sub {
	plan skip_all => 'SIGALRM not available on Windows' if $^O eq 'MSWin32';

	# Mock _rdns_forward to return an empty list; grep can never match,
	# so the ternary returns undef even though $hostname is defined.
	my $guard = mock_scoped 'CGI::ACL::_rdns_forward' => sub { () };

	diag "forward-confirm: _rdns_forward returns empty list" if $ENV{TEST_VERBOSE};

	my $result = CGI::ACL::_verified_rdns($config{LOCAL_IP});

	is($result, undef, 'empty forward list causes verification failure → undef');
};

# ─────────────────────────────────────────────────────────────────────────────
# all_denied(): COMBINED RESTRICTION PATHS
# Purpose: exercise paths that chain multiple restriction types together,
# giving Devel::Cover full LCSAJ coverage of the multi-branch decision tree.
# ─────────────────────────────────────────────────────────────────────────────

subtest 'all_denied(): allow_ip + deny_country — IP match bypasses country check' => sub {
	# Allowed IP is exempt from country restrictions.
	# Path: allowed_ips match → return 0 (skip country check).
	my $acl = CGI::ACL->new()
		->allow_ip($config{RFC5737_IP})
		->deny_country($config{WILDCARD});

	diag "allow_ip overrides deny_country(*) for allowed IP" if $ENV{TEST_VERBOSE};