Email-Abuse-Investigator

 view release on metacpan or  search on metacpan

t/integration.t  view on Meta::CPAN

	ok !scalar(grep { $_->{domain} eq 'known-abuse.example' } @unresolved),
		'known-abuse.example does NOT appear in unresolved_contacts()';

	# All returned entries conform to the documented type values
	for my $u (@unresolved) {
		ok $u->{type} =~ /^(?:url_host|domain)$/,
			"type '$u->{type}' is a documented value";
	}

	restore_stubs();
};

# ---------------------------------------------------------------------------
# Scenario 42 — all_domains() union is stable across repeated calls
#
# all_domains() must return the same set on repeated calls (idempotent) and
# contain no duplicates even when the same domain appears as both a URL host
# and a mailto domain.
# ---------------------------------------------------------------------------
subtest 'Scenario 42: all_domains() is idempotent and deduplicates URL+mailto overlap' => sub {
	restore_stubs();
	install_stubs(
		rdns	 => 'mail.overlap.example',
		resolve  => { 'overlap.example' => '91.198.174.20' },
		whois_ip => { org => 'Overlap ISP', abuse => 'abuse@overlap.example' },
		domain_whois => undef,
	);

	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_raw_email(
		received => 'from ov (ov [91.198.174.20]) by mx.test',
		from	 => 'Sender <sender@overlap.example>',
		body	 => 'Click https://overlap.example/offer and reply to info@overlap.example',
	));

	my @first  = $a->all_domains();
	my @second = $a->all_domains();

	# Results are stable
	is scalar @second, scalar @first, 'all_domains() returns same count on second call';
	is_deeply \@first, \@second, 'all_domains() returns identical results on second call';

	# overlap.example appears in both URL hosts and mailto domains but should be listed once
	my @occurrences = grep { $_ eq 'overlap.example' } @first;
	is scalar @occurrences, 1,
		'overlap.example (URL host AND mailto domain) appears exactly once in all_domains()';

	restore_stubs();
};

# ===========================================================================
# Optional dependency graceful-degradation scenarios
#
# Each subtest uses without_optionals() to reload Email::Abuse::Investigator
# with specific $HAS_* flags cleared, then verifies the module's observable
# fallback behaviour through the public API only.
#
# Optional dependencies identified in the module:
#   Net::DNS          — MX / NS record lookups for domains
#   LWP::UserAgent    — RDAP enrichment + redirect-chain following
#   LWP::ConnCache    — LWP connection keep-alive (auxiliary to LWP::UserAgent)
#   HTML::LinkExtor   — Structural HTML link extraction (href/src/action attrs)
#   CHI               — Cross-message in-process WHOIS/RDAP cache
#   IO::Socket::IP    — IPv6-capable WHOIS socket (falls back to IO::Socket::INET)
#   Domain::PublicSuffix — PSL-based eTLD+1 normalisation
#   AnyEvent::DNS     — Parallel async DNS resolution
# ===========================================================================

# ---------------------------------------------------------------------------
# OD-1: Without Net::DNS
#
# Net::DNS provides MX and NS lookups inside _analyse_domain().  Without it
# the $HAS_NET_DNS guard prevents those lookups; the returned hashrefs must
# have no mx_* or ns_* keys.  All other domain fields (web_ip, registrar,
# etc.) still come from stubs and must remain present.
# ---------------------------------------------------------------------------
subtest 'OD-1: Without Net::DNS — mailto_domains() omits MX/NS keys, other fields intact' => sub {
	without_optionals(['Net::DNS'], sub {
		install_stubs(
			rdns     => 'mx.test.example',
			resolve  => { 'spammer.example' => '91.198.174.50' },
			whois_ip => { org => 'Bad ISP', abuse => 'abuse@badisp.example', country => 'XX' },
			domain_whois => sub {
				my (undef, $dom) = @_;
				return undef unless $dom eq 'spammer.example';
				return "Registrar: EvilReg Inc\n"
				     . "Registrar Abuse Contact Email: reg\@evilreg.example\n";
			},
		);

		my $a = Email::Abuse::Investigator->new();
		$a->parse_email(make_raw_email(
			received => 'from bad (bad [91.198.174.50]) by mx.test',
			from     => 'Phisher <crook@spammer.example>',
			body     => 'Send money.',
		));

		my @doms = $a->mailto_domains();
		ok scalar(@doms), 'mailto_domains() returns results without Net::DNS';

		my ($d) = grep { $_->{domain} eq 'spammer.example' } @doms;
		ok defined $d, 'spammer.example present in mailto_domains()';
		diag('Domain hashref keys: ' . join(', ', sort keys %$d)) if $ENV{TEST_VERBOSE};

		# MX keys must be absent — the $HAS_NET_DNS guard skips those lookups
		ok !exists $d->{mx_host},  'no mx_host key without Net::DNS';
		ok !exists $d->{mx_ip},    'no mx_ip key without Net::DNS';
		ok !exists $d->{mx_org},   'no mx_org key without Net::DNS';
		ok !exists $d->{mx_abuse}, 'no mx_abuse key without Net::DNS';

		# NS keys must also be absent
		ok !exists $d->{ns_host},  'no ns_host key without Net::DNS';
		ok !exists $d->{ns_ip},    'no ns_ip key without Net::DNS';
		ok !exists $d->{ns_org},   'no ns_org key without Net::DNS';
		ok !exists $d->{ns_abuse}, 'no ns_abuse key without Net::DNS';

		# Non-DNS fields still populated from stubs
		is $d->{domain},          'spammer.example',      'domain field present';
		is $d->{web_ip},          '91.198.174.50',        'web_ip from _resolve_host stub';
		is $d->{registrar_abuse}, 'reg@evilreg.example',  'registrar_abuse from domain_whois stub';



( run in 2.022 seconds using v1.01-cache-2.11-cpan-14f38c9f855 )