CGI-ACL
view release on metacpan or search on metacpan
# WRONG -- this allows everyone; allow_country is ignored
my $acl = CGI::ACL->new()->allow_country('US');
# RIGHT -- deny all countries first, then add permitted ones
my $acl = CGI::ACL->new()->deny_all_countries()->allow_country('US');
## deny\_cloud overrides allow\_ip
Cloud detection has the highest priority. An IP address that is listed
in `allow_ip()` is still blocked if its reverse DNS resolves to a cloud
provider hostname. This is intentional: cloud IPs can be reassigned, so
the rDNS check is more reliable than the IP address alone.
# This STILL blocks the IP if it is a cloud host
my $acl = CGI::ACL->new()
->deny_cloud()
->allow_ip('198.51.100.5'); # blocked if rDNS says EC2
## Localhost is not automatically allowed
Once any restriction is set, `127.0.0.1` is subject to the same rules
as any other address. If you need to allow local access (for example,
a health-check endpoint), add it explicitly.
my $acl = CGI::ACL->new()
->allow_ip('127.0.0.1') # must be explicit
->deny_all_countries()
lib/CGI/ACL.pm view on Meta::CPAN
# WRONG -- this allows everyone; allow_country is ignored
my $acl = CGI::ACL->new()->allow_country('US');
# RIGHT -- deny all countries first, then add permitted ones
my $acl = CGI::ACL->new()->deny_all_countries()->allow_country('US');
=head2 deny_cloud overrides allow_ip
Cloud detection has the highest priority. An IP address that is listed
in C<allow_ip()> is still blocked if its reverse DNS resolves to a cloud
provider hostname. This is intentional: cloud IPs can be reassigned, so
the rDNS check is more reliable than the IP address alone.
# This STILL blocks the IP if it is a cloud host
my $acl = CGI::ACL->new()
->deny_cloud()
->allow_ip('198.51.100.5'); # blocked if rDNS says EC2
=head2 Localhost is not automatically allowed
Once any restriction is set, C<127.0.0.1> is subject to the same rules
as any other address. If you need to allow local access (for example,
a health-check endpoint), add it explicitly.
my $acl = CGI::ACL->new()
->allow_ip('127.0.0.1') # must be explicit
->deny_all_countries()
t/function.t view on Meta::CPAN
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 {
t/locales.t view on Meta::CPAN
# ââ Locale scenario: explicit deny by language region âââââââââââââââââââââââ
# Purpose: test deny-listing specific countries without wildcard (default-allow)
subtest 'Explicit deny: block FR and CN, allow others by default' => sub {
# Default-allow mode: deny only the listed countries
my $acl = CGI::ACL->new()
->deny_country($config{CC_FR})
->deny_country($config{CC_CN});
diag "Explicit deny: deny_countries=" . join(',', sort keys %{$acl->{deny_countries}}) if $ENV{TEST_VERBOSE};
# Denied countries must be blocked
is(denied_at($acl, $config{IP_FR}, lingua => lingua_for($config{IP_FR})), 1, 'FR denied (explicit deny list)');
is(denied_at($acl, $config{IP_CN}, lingua => lingua_for($config{IP_CN})), 1, 'CN denied (explicit deny list)');
# All other countries must be allowed (default-allow)
is(denied_at($acl, $config{IP_GB}, lingua => lingua_for($config{IP_GB})), 0, 'GB allowed (default-allow, not in deny list)');
is(denied_at($acl, $config{IP_US}, lingua => lingua_for($config{IP_US})), 0, 'US allowed (default-allow, not in deny list)');
is(denied_at($acl, $config{IP_DE}, lingua => lingua_for($config{IP_DE})), 0, 'DE allowed (default-allow, not in deny list)');
};
# ââ Locale scenario: arrayref country list âââââââââââââââââââââââââââââââââââ
( run in 1.122 second using v1.01-cache-2.11-cpan-800906f7e73 )