view release on metacpan or  search on metacpan

t/function.t  view on Meta::CPAN

	my $guard = mock_scoped 'CGI::ACL::_verified_rdns' => sub { $config{AZURE_HOST2} };
	is(CGI::ACL::_is_cloud_host($config{RFC5737_IP}), 1, 'Azure .azure.com hostname returns 1');
};

# Purpose: returns 1 for DigitalOcean hostname
subtest '_is_cloud_host() - returns 1 for DigitalOcean hostname (mocked)' => sub {
	my $guard = mock_scoped 'CGI::ACL::_verified_rdns' => sub { $config{DO_HOST} };
	is(CGI::ACL::_is_cloud_host($config{RFC5737_IP}), 1, 'DigitalOcean hostname returns 1');
};

# Purpose: returns 1 for Linode/Akamai hostname (.members.linode.com)
subtest '_is_cloud_host() - returns 1 for Linode hostname (mocked)' => sub {
	my $guard = mock_scoped 'CGI::ACL::_verified_rdns' => sub { $config{LINODE_HOST} };
	diag "Linode host: $config{LINODE_HOST}" if $ENV{TEST_VERBOSE};

	is(CGI::ACL::_is_cloud_host($config{RFC5737_IP}), 1, 'Linode hostname returns 1');
};

# Purpose: returns 1 for Hetzner Cloud hostname (contains 'hetzner')
subtest '_is_cloud_host() - returns 1 for Hetzner Cloud hostname (mocked)' => sub {
	my $guard = mock_scoped 'CGI::ACL::_verified_rdns' => sub { $config{HETZNER_HOST} };
	diag "Hetzner host: $config{HETZNER_HOST}" if $ENV{TEST_VERBOSE};

	is(CGI::ACL::_is_cloud_host($config{RFC5737_IP}), 1, 'Hetzner Cloud hostname returns 1');
};

# Purpose: returns 1 for Hetzner legacy dedicated server (.your-server.de)
subtest '_is_cloud_host() - returns 1 for Hetzner legacy hostname (mocked)' => sub {
	my $guard = mock_scoped 'CGI::ACL::_verified_rdns' => sub { $config{HETZNER_LEGACY_HOST} };
	is(CGI::ACL::_is_cloud_host($config{RFC5737_IP}), 1, 'Hetzner legacy hostname returns 1');
};

# Purpose: returns 1 for OVH Cloud hostname (.ovh.net)
subtest '_is_cloud_host() - returns 1 for OVH Cloud hostname (mocked)' => sub {
	my $guard = mock_scoped 'CGI::ACL::_verified_rdns' => sub { $config{OVH_HOST} };
	diag "OVH host: $config{OVH_HOST}" if $ENV{TEST_VERBOSE};

	is(CGI::ACL::_is_cloud_host($config{RFC5737_IP}), 1, 'OVH .ovh.net hostname returns 1');
};

# Purpose: returns 1 for OVH European IP range hostname (ip-N-N-N-N.eu)
subtest '_is_cloud_host() - returns 1 for OVH EU IP range hostname (mocked)' => sub {
	my $guard = mock_scoped 'CGI::ACL::_verified_rdns' => sub { $config{OVH_EU_HOST} };
	diag "OVH EU host: $config{OVH_EU_HOST}" if $ENV{TEST_VERBOSE};

	is(CGI::ACL::_is_cloud_host($config{RFC5737_IP}), 1, 'OVH EU hostname returns 1');
};

# Purpose: non-cloud hostname must return 0
subtest '_is_cloud_host() - returns 0 for non-cloud hostname (mocked)' => sub {
	my $guard = mock_scoped 'CGI::ACL::_verified_rdns' => sub { $config{NONCLOUD_HOST} };
	is(CGI::ACL::_is_cloud_host($config{RFC5737_IP}), 0, 'residential hostname returns 0');
};

# Purpose: undef PTR (no record or verification failure) must return 0
subtest '_is_cloud_host() - returns 0 when _verified_rdns returns undef' => sub {
	my $guard = mock_scoped 'CGI::ACL::_verified_rdns' => sub { undef };
	is(CGI::ACL::_is_cloud_host($config{RFC5737_IP}), 0, 'undef PTR returns 0');
};

# Purpose: IPv6 cloud IP is also blocked when its PTR matches a cloud pattern
subtest '_is_cloud_host() - returns 1 for IPv6 cloud hostname (mocked)' => sub {
	my $guard = mock_scoped 'CGI::ACL::_verified_rdns' => sub { $config{AWS_HOST} };
	is(CGI::ACL::_is_cloud_host($config{IPv6_ADDR}), 1, 'IPv6 cloud host returns 1');
};

# ─────────────────────────────────────────────────────────────────────────────
# Subtest: _verified_rdns() (internal helper)
# Purpose: returns undef for invalid IPs; confirms forward lookup
# ─────────────────────────────────────────────────────────────────────────────
subtest '_verified_rdns() - invalid IPv4 string returns undef' => sub {
	# An obviously wrong string fails inet_aton, so the function returns undef
	my $result = CGI::ACL::_verified_rdns($config{INVALID_IP});
	diag "_verified_rdns('$config{INVALID_IP}') = " . (defined $result ? $result : 'undef') if $ENV{TEST_VERBOSE};
	is($result, undef, 'non-IP string returns undef');
};

# Purpose: out-of-range dotted quad also returns undef
subtest '_verified_rdns() - out-of-range IPv4 returns undef' => sub {
	my $result = CGI::ACL::_verified_rdns($config{INVALID_IP2});
	is($result, undef, 'out-of-range quad returns undef');
};

# Purpose: invalid IPv6 address fails inet_pton and returns undef
subtest '_verified_rdns() - invalid IPv6 string returns undef' => sub {
	my $result = CGI::ACL::_verified_rdns($config{IPv6_INVALID});
	is($result, undef, 'invalid IPv6 string returns undef');
};

# Purpose: a documentation-range IPv6 address (RFC 3849) has no PTR in any
# real DNS and should return undef via gethostbyaddr returning undef
subtest '_verified_rdns() - documentation IPv6 address returns undef (no PTR)' => sub {
	# 2001:db8::/32 is reserved and will never have a real PTR record;
	# gethostbyaddr on a packed IPv6 for this range should return undef
	my $result = CGI::ACL::_verified_rdns($config{IPv6_ADDR});
	diag "_verified_rdns(IPv6=$config{IPv6_ADDR}) = " . (defined $result ? $result : 'undef') if $ENV{TEST_VERBOSE};
	is($result, undef, 'documentation IPv6 with no PTR returns undef');
};

# Purpose: when forward confirmation fails the function returns undef
subtest '_verified_rdns() - forward confirmation mismatch returns undef' => sub {
	# Mock _rdns_forward so the confirmed IP list does NOT include LOCAL_IP
	my $guard = mock_scoped 'CGI::ACL::_rdns_forward' => sub {
		return ('10.0.0.1');    # deliberately wrong IP in forward list
	};

	# Use 127.0.0.1: gethostbyaddr returns 'localhost' on this machine,
	# but the mocked forward confirms a different IP, so verification fails.
	my $result = CGI::ACL::_verified_rdns($config{LOCAL_IP});
	is($result, undef, 'mismatched forward confirmation returns undef');
};

# Purpose: when forward confirmation succeeds the hostname is returned
subtest '_verified_rdns() - successful forward confirmation returns hostname' => sub {
	# Mock _rdns_forward to confirm 127.0.0.1 so verification succeeds
	my $guard = mock_scoped 'CGI::ACL::_rdns_forward' => sub {
		return ($config{LOCAL_IP});
	};

	# 127.0.0.1 should have a PTR on any standard POSIX system
	my $result = CGI::ACL::_verified_rdns($config{LOCAL_IP});