view release on metacpan or  search on metacpan

lib/Email/Abuse/Investigator.pm  view on Meta::CPAN

	# Validate and normalise the IP before interpolating into the URL path.
	# Strip RFC 4007 IPv6 zone IDs (%eth0 suffix) which would corrupt the URL,
	# then assert the result is a valid dotted-quad IPv4 or bare hex IPv6.
	(my $safe_ip = $ip) =~ s/%.*\z//;
	unless ($safe_ip =~ /\A\d{1,3}(?:\.\d{1,3}){3}\z/
	     || $safe_ip =~ /\A[0-9a-fA-F:]+\z/) {
		$self->_debug("_rdap_lookup: malformed IP '$ip' -- skipping");
		return {};
	}

	# Use the ARIN RDAP endpoint; it covers the ARIN region and redirects
	# for RIPE/APNIC/LACNIC/AfriNIC allocations.
	my $res = eval { $ua->get("https://rdap.arin.net/registry/ip/$safe_ip") };
	return {} unless $res && $res->is_success();

	my $j = $res->decoded_content();
	my %info;

	# Extract organisation name from the JSON response
	if ($j =~ /"name"\s*:\s*"([^"]+)"/)   { $info{org}    = $1 }
	if ($j =~ /"handle"\s*:\s*"([^"]+)"/) { $info{handle} = $1 }

t/edge_cases.t  view on Meta::CPAN

	my $a = Email::Abuse::Investigator->new(timeout => 1);
	lives_ok { $a->_raw_whois("test\x7Fdomain.example", 'localhost') }
		'DEL character in query does not croak';
};

# =============================================================================
# 39. _rdap_lookup -- IP FORMAT VALIDATION
# =============================================================================
# _rdap_lookup() validates $ip before placing it in the RDAP URL path and
# strips RFC 4007 IPv6 zone identifiers.  These tests exercise the validation
# layer without requiring a live RDAP endpoint.

{
	# Minimal fake UA and response objects: avoid requiring Test::MockObject.
	package t::FakeUA;
	sub new     { bless {}, shift }
	sub get     { bless {}, 't::FakeResponse' }
	package t::FakeResponse;
	sub is_success { 0 }
}

t/edge_cases.t  view on Meta::CPAN

		sub new     { bless { called => 0 }, shift }
		sub get     { $_[0]->{called} = 1; bless {}, 't::FakeResponse' }
		sub called  { $_[0]->{called} }
	}
	my $spy_ua = t::SpyUA->new();
	$a->{ua} = $spy_ua;

	my $r;
	lives_ok { $r = $a->_rdap_lookup('fe80::1%eth0') }
		'_rdap_lookup does not croak on zone-ID IPv6';
	is_deeply $r, {}, 'returns {} when RDAP endpoint returns failure';
	ok $spy_ua->called(), 'UA was called -- zone ID was stripped and IPv6 passed validation';
};

done_testing();