view release on metacpan or  search on metacpan

t/integration.t  view on Meta::CPAN

use Readonly;
use Scalar::Util qw(refaddr);
use Socket qw(AF_INET);

# Load the module under test (and key integration partners)
BEGIN {
	use_ok('CGI::ACL')           or BAIL_OUT('CGI::ACL failed to load');
	use_ok('CGI::Lingua')        or BAIL_OUT('CGI::Lingua failed to load');
	use_ok('Object::Configure')  or BAIL_OUT('Object::Configure failed to load');
}

# ── Configuration ────────────────────────────────────────────────────────────

# Fixed test values — no magic strings or numbers anywhere else in the file
Readonly my %config => (
	# RFC 5737 / RFC 3849 documentation addresses (safe to use in tests)
	RFC_IP_1          => '203.0.113.5',    # TEST-NET-3
	RFC_IP_2          => '198.51.100.1',   # TEST-NET-2
	RFC_CIDR          => '192.0.2.0/24',   # TEST-NET-1
	CIDR_INSIDE       => '192.0.2.42',     # inside RFC_CIDR
	CIDR_OUTSIDE      => '10.0.0.1',       # outside RFC_CIDR
	IPv6_ADDR         => '2001:db8::1',    # RFC 3849 documentation IPv6
	IPv6_ADDR2        => '2001:db8::2',    # second documentation IPv6
	LOCAL_IP          => '127.0.0.1',      # loopback

	# Real-world IPs with stable GeoIP registrations
	IP_GB             => '212.159.106.41', # F9 Broadband, United Kingdom
	IP_US             => '130.14.25.184',  # NCBI, United States
	IP_RU             => '87.226.159.0',   # Russian Federation

	# Country codes (lowercase per ISO 3166-1)
	COUNTRY_GB        => 'gb',
	COUNTRY_US        => 'us',
	COUNTRY_RU        => 'ru',
	COUNTRY_BR        => 'br',
	WILDCARD          => '*',

	# Cloud provider hostnames for mocking _verified_rdns
	AWS_HOST          => 'ec2-1-2-3-4.compute-1.amazonaws.com',
	GCP_HOST          => '203-0-113-5.bc.googleusercontent.com',
	NONCLOUD_HOST     => 'mail.example.com',
);

# ── Helpers ───────────────────────────────────────────────────────────────────

# Run all_denied() with a fixed REMOTE_ADDR without polluting the global env
sub denied_at {
	my ($acl, $addr, @rest) = @_;
	local $ENV{REMOTE_ADDR} = $addr;
	return $acl->all_denied(@rest);
}

# Per-run lingua cache: each IP address makes exactly one WHOIS query for the
# entire test run.  CGI::Lingua caches the resolved country inside the object;
# subsequent calls to country() on the cached object return the stored value
# without a new network round-trip.
#
# local $_ protects the caller's loop variable: CGI::Lingua and the WHOIS
# modules it calls use $_ internally (e.g. in grep/map inside
# Net::Whois::IANA), and without localisation that clobbers map/grep
# iterations in the calling code, producing scrambled results.
my %_lingua_cache;
sub lingua_for {
	my $addr = shift;
	unless(exists $_lingua_cache{$addr}) {
		local $_;
		local $ENV{REMOTE_ADDR} = $addr;
		my $l = CGI::Lingua->new(supported => ['en']);
		do { local $SIG{__WARN__} = sub {}; $l->country() };
		$_lingua_cache{$addr} = $l;
	}
	return $_lingua_cache{$addr};
}

# ── RIPE WHOIS availability check ─────────────────────────────────────────────
# Subtests that rely on RIPE-registered IPs (GB, RU) are wrapped in a SKIP
# block when RIPE's WHOIS server is rate-limiting.  ARIN (US) and APNIC (CN)
# use independent servers and are unaffected.
#
# Pre-resolve now so every subsequent lingua_for() call hits the cache and makes
# zero additional WHOIS requests.
my %_ripe_ips = map { $config{$_} => 1 } qw(IP_GB IP_RU);
my $ripe_ok = 1;

# Pre-resolve RIPE IPs once: populates the lingua cache and detects rate-limiting.
# Using lingua_for() here means zero additional WHOIS calls inside the subtests.
for my $ip (sort keys %_ripe_ips) {
	my $country = do { local $SIG{__WARN__} = sub {}; lingua_for($ip)->country() };
	unless(defined $country) {
		$ripe_ok = 0;
		last;
	}
}

# ─────────────────────────────────────────────────────────────────────────────
# Scenario: SYNOPSIS workflow
# Purpose: the exact example from the module POD must work end-to-end
# ─────────────────────────────────────────────────────────────────────────────
subtest 'SYNOPSIS workflow: UK-only subnet site' => sub {
	# Build the ACL described in the SYNOPSIS
	my $acl = CGI::ACL->new()
		->deny_country($config{WILDCARD})
		->allow_country('GB')
		->allow_ip($config{RFC_CIDR});

	isa_ok($acl, 'CGI::ACL', 'ACL object created from SYNOPSIS chain');

	# UK IP inside the allowed CIDR passes both checks
	local $ENV{REMOTE_ADDR} = $config{CIDR_INSIDE};
	my $lingua = CGI::Lingua->new(supported => ['en']);
	diag "SYNOPSIS: CIDR inside, country=" . ($lingua->country() // 'undef') if $ENV{TEST_VERBOSE};

	# IP is in the allowed CIDR — access should be granted without checking country
	is($acl->all_denied(lingua => $lingua), 0, 'CIDR-inside IP is allowed');

	# US IP (not GB and not in allowed CIDR) must be denied
	local $ENV{REMOTE_ADDR} = $config{IP_US};
	my $us_lingua = lingua_for($config{IP_US});
	diag "SYNOPSIS: US IP, country=" . ($us_lingua->country() // 'undef') if $ENV{TEST_VERBOSE};
	is($acl->all_denied(lingua => $us_lingua), 1, 'US IP denied (not in CIDR, not GB)');
};