decoded results from the CPAN

decoded

Email-Abuse-Investigator

view release on metacpan or search on metacpan

	# report() shows risk assessment section with HIGH
	my $report = $a->report();
	like $report, qr/RISK ASSESSMENT:\s*HIGH/, 'HIGH risk level in report';

	restore_stubs();
};

# ---------------------------------------------------------------------------
# Scenario 8 â€” Trusted relay excluded; two external hops â†’ high confidence
#
# POD description item 1: "skips private/trusted IPs".
# Also exercises the trusted_relays constructor option.
# ---------------------------------------------------------------------------
subtest 'Scenario 8: trusted relay excluded; two external hops give high confidence' => sub {
	restore_stubs();
	install_stubs(
		rdns	=> sub {
			my (undef, $ip) = @_;
			return 'mail.attacker.example'	if $ip eq '91.198.174.10';
			return 'relay.legitrelay.example' if $ip eq '62.105.128.5';
			return undef;
		},
		whois_ip => { org => 'Attacker ISP', abuse => 'abuse@attacker-isp.example' },
		domain_whois => undef,
	);

	my $a = Email::Abuse::Investigator->new(
		trusted_relays => ['62.105.128.0/24'],  # our own relay
	);
	$a->parse_email(make_raw_email(
		received => [
			# Top (most recent): our trusted relay accepted from external relay
			'from relay.legitrelay.example (relay.legitrelay.example [62.105.128.5]) by mx.test',
			# Middle: an external relay accepted from the attacker
			'from mail.attacker.example (mail.attacker.example [91.198.174.10]) by relay.legitrelay.example',
			# Bottom: the attacker sent directly from this IP
			'from attacker (attacker [91.198.174.10]) by mail.attacker.example',
		],
		from => 'attacker@attacker.example',
		body => 'Spam content here.',
	));

	my $orig = $a->originating_ip();

	# The trusted relay (62.105.128.5) must be excluded
	ok $orig->{ip} ne '62.105.128.5', 'trusted relay IP excluded from origin';

	# Two non-trusted hops (91.198.174.10 appears twice) â†’ high confidence
	is $orig->{confidence}, 'high',		 'two external hops â†’ high confidence';
	is $orig->{ip}, '91.198.174.10',		'attacker IP identified as origin';

	# Abuse contact for the attacker's IP present
	my @contacts = $a->abuse_contacts();
	ok scalar(grep { lc($_->{address}) eq 'abuse@attacker-isp.example' } @contacts),
		'attacker ISP abuse contact in contacts';

	restore_stubs();
};

# ---------------------------------------------------------------------------
# Scenario 9 â€” MIME-encoded headers decoded in report()
#
# POD synopsis: the full pipeline with MIME-encoded From: and Subject:.
# Verifies that report() shows decoded text, not raw encoded-word strings.
# ---------------------------------------------------------------------------
subtest 'Scenario 9: MIME-encoded From: and Subject: decoded in report' => sub {
	restore_stubs();
	install_stubs(
		rdns	 => 'mail.sender.example',
		resolve  => undef,
		whois_ip => { org => 'Sender ISP', abuse => 'abuse@sender-isp.example' },
		domain_whois => undef,
	);

	my $enc_from = '=?UTF-8?B?' . encode_base64('eharmony Partner', '') . '?=';
	my $enc_subj = '=?UTF-8?B?' . encode_base64('Ready to Find Someone Special?', '') . '?=';

	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_raw_email(
		received => 'from sender (sender [91.198.174.1]) by mx.test',
		from	 => qq{"$enc_from" <peacelight\@firmluminary.example>},
		subject  => $enc_subj,
		body	 => 'Find the joy of real love today.',
	));

	my $report = $a->report();

	# Decoded display name appears in report
	like $report, qr/eharmony Partner/,			'decoded From: display name in report';
	like $report, qr/Ready to Find Someone Special/, 'decoded Subject in report';

	# The decoded form leads; raw encoding appears in brackets after
	like $report, qr/eharmony Partner.*\[encoded:/s,
		'decoded form appears before the bracketed raw encoded value';

	restore_stubs();
};

# ---------------------------------------------------------------------------
# Scenario 10 â€” Domain intelligence pipeline (POD Algorithm section)
#
# POD: "For each unique non-infrastructure domain â€¦ A record â†’ web hosting,
#	   MX record â†’ mail hosting, NS record â†’ DNS hosting, WHOIS â†’ registrar"
# Simulates a domain whose web host, MX host, and NS host are all different
# companies â€” verifying that all three are independently reported.
# ---------------------------------------------------------------------------
subtest 'Scenario 10: domain intelligence pipeline â€” web/MX/NS all different' => sub {
	restore_stubs();
	install_stubs(
		rdns	=> 'mail.sender.example',
		resolve => sub {
			my (undef, $host) = @_;
			my %map = (
				'spamdom.example'	  => '104.21.0.1',
				'mail.spamdom.example' => '74.125.0.1',
				'ns1.spamdom.example'  => '198.41.0.1',
			);
			return $map{$host};
		},
		whois_ip => sub {
			my (undef, $ip) = @_;
			my %data = (
				'104.21.0.1'   => { org => 'Cloudflare Inc',  abuse => 'abuse@cloudflare.com' },
				'74.125.0.1'   => { org => 'Google LLC',	  abuse => 'network-abuse@google.com' },
				'198.41.0.1'   => { org => 'VeriSign Inc',	abuse => 'abuse@verisign.example' },
				'91.198.174.1' => { org => 'Sender ISP',	  abuse => 'abuse@sender.example' },
			);
			return $data{$ip} // {};
		},
		domain_whois => sub {
			my (undef, $dom) = @_;
			return undef unless $dom eq 'spamdom.example';
			return <<'WHOIS';
Registrar: GoDaddy.com LLC
Registrar Abuse Contact Email: abuse@godaddy.com
Creation Date: 2020-01-15
Registry Expiry Date: 2030-01-15
WHOIS
		},
	);

	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_raw_email(
		received => 'from sender (sender [91.198.174.1]) by mx.test',
		from	 => 'Spammer <spam@spamdom.example>',
		body	 => 'Contact us at info@spamdom.example',
	));

	# Pre-populate the domain cache with fully resolved data
	# (simulates what _analyse_domain would produce with Net::DNS present)
	$a->{_domain_info}{'spamdom.example'} = {
		web_ip   => '104.21.0.1',
		web_org  => 'Cloudflare Inc',
		web_abuse => 'abuse@cloudflare.com',

t/integration.t view on Meta::CPAN

		domain_whois => undef,
	);

	# GoDaddy as the From: account provider â€” a form-only provider
	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_raw_email(
		received => 'from test (test [91.198.174.1]) by mx.test',
		from	 => 'Registrar Abuse <abuse@godaddy.com>',
		body	 => 'Domain registration spam.',
	));
	# Clear origin and URLs so only the From: contact route fires
	$a->{_origin}         = undef;
	$a->{_urls}           = [];
	$a->{_mailto_domains} = [];

	my @forms = $a->form_contacts();
	ok @forms > 0, 'GoDaddy form contact found (precondition)';

	my $art = $a->abuse_report_text();
	like $art, qr/WEB-FORM REPORTS REQUIRED/i,
		'abuse_report_text() contains WEB-FORM REPORTS REQUIRED section';
	like $art, qr/godaddy/i,
		'GoDaddy form URL appears in abuse_report_text()';

	restore_stubs();
};

# ---------------------------------------------------------------------------
# Scenario 40 â€” MIME-encoded Subject triggers encoded_subject LOW flag
#
# POD risk_assessment: a Base64 or QP encoded Subject header raises the
# 'encoded_subject' LOW flag because it may be filter evasion.
# ---------------------------------------------------------------------------
subtest 'Scenario 40: MIME-encoded Subject triggers encoded_subject LOW flag' => sub {
	restore_stubs();
	install_stubs(
		rdns	 => 'mail.enc-subj.example',
		whois_ip => { org => 'Enc ISP', abuse => 'abuse@enc-isp.example' },
		domain_whois => undef,
	);

	# Base64-encoded Subject that decodes to plain ASCII
	my $enc_subj = '=?UTF-8?B?' . encode_base64('Win a free prize today!', '') . '?=';

	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_raw_email(
		received => 'from enc (enc [91.198.174.1]) by mx.test',
		subject  => $enc_subj,
		body	 => 'No links here.',
	));

	my $risk       = $a->risk_assessment();
	my @flag_names = map { $_->{flag} } @{ $risk->{flags} };

	ok scalar(grep { $_ eq 'encoded_subject' } @flag_names),
		'encoded_subject flag raised for MIME-encoded Subject';

	my ($es_flag) = grep { $_->{flag} eq 'encoded_subject' } @{ $risk->{flags} };
	is $es_flag->{severity}, 'LOW', 'encoded_subject has LOW severity';
	like $es_flag->{detail}, qr/Win a free prize today!/,
		'flag detail contains the decoded subject text';

	# The report should decode and display the subject
	my $report = $a->report();
	like $report, qr/Win a free prize today!/, 'decoded Subject appears in report';

	restore_stubs();
};

# ---------------------------------------------------------------------------
# Scenario 41 â€” unresolved_contacts() in full pipeline integration
#
# Exercises the unresolved_contacts() method as part of a real end-to-end
# pipeline: no internal state injection, all data flows from parse_email().
# Verifies that a domain with no WHOIS abuse contact surfaces as unresolved
# while a domain with a known abuse contact does not.
# ---------------------------------------------------------------------------
subtest 'Scenario 41: unresolved_contacts() full pipeline â€” unknown vs. known abuse' => sub {
	restore_stubs();
	install_stubs(
		rdns	 => 'mail.sender.example',
		resolve  => sub {
			my (undef, $host) = @_;
			return '91.198.174.10' if $host eq 'known-abuse.example';
			return '91.198.174.11' if $host eq 'unknown-abuse.example';
			return undef;
		},
		whois_ip => sub {
			my (undef, $ip) = @_;
			return { org => 'Known Corp',   abuse => 'abuse@known-abuse.example'  }
				if $ip eq '91.198.174.10';
			return { org => 'Unknown Corp', abuse => undef }
				if $ip eq '91.198.174.11';
			return {};
		},
		domain_whois => sub { undef },
	);

	my $a = Email::Abuse::Investigator->new();
	$a->parse_email(make_raw_email(
		received => 'from sender (sender [91.198.174.1]) by mx.test',
		# Both domains appear in the body so they are not From: spoofable sources
		from	 => 'spammer@sender.example',
		body	 => 'Visit https://unknown-abuse.example/buy '
		          . 'and https://known-abuse.example/page for our offers.',
	));

	my @unresolved = $a->unresolved_contacts();

	# unknown-abuse.example has no abuse contact â†’ must be in unresolved
	ok scalar(grep { $_->{domain} eq 'unknown-abuse.example' } @unresolved),
		'unknown-abuse.example appears in unresolved_contacts()';

	# known-abuse.example has an abuse contact â†’ must NOT be in unresolved
	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();
};

t/integration.t view on Meta::CPAN

# 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';

		# Module does not die and produces a report
		my $report = $a->report();
		ok defined $report && length($report), 'report() completes without Net::DNS';

		restore_stubs();
	});
};

# ---------------------------------------------------------------------------
# OD-2: Without HTML::LinkExtor
#
# HTML::LinkExtor parses HTML attributes and returns decoded URLs (e.g.
# &amp; â†’ &).  Without it only the plain-text regex pass runs, which matches
# the raw attribute value including HTML entities.
#
# Observable differences:
#   â€¢ With LinkExtor:    2 URL entries for the same host (decoded + raw entity)
#   â€¢ Without LinkExtor: 1 URL entry (raw entity form only)
#   â€¢ The URL string found without LinkExtor contains the literal '&amp;'
# ---------------------------------------------------------------------------
subtest 'OD-2: Without HTML::LinkExtor â€” HTML entity URLs not decoded; count differs' => sub {
	without_optionals(['HTML::LinkExtor'], sub {
		install_stubs(
			rdns    => 'mail.test.example',
			resolve => { 'example.com' => '91.198.174.51' },
			whois_ip => { org => 'Some ISP', abuse => 'abuse@someisp.example' },
			domain_whois => undef,
		);

		# HTML-only email: the href contains HTML-entity-encoded parameters.
		# The plain-text regex finds the raw attribute value (with &amp;).
		# HTML::LinkExtor would also find the entity-decoded form (&).
		my $html_body = '<a href="https://example.com/page?ref=1&amp;src=email">click</a>';
		my $a = Email::Abuse::Investigator->new();
		$a->parse_email(make_raw_email(
			received => 'from bad (bad [91.198.174.51]) by mx.test',
			ct       => 'text/html; charset=us-ascii',
			body     => $html_body,
		));

		my @urls = $a->embedded_urls();
		diag('URLs found: ' . join(', ', map { $_->{url} } @urls)) if $ENV{TEST_VERBOSE};

		# Without LinkExtor only the plain-text-regex result is present
		is scalar(@urls), 1,
			'without HTML::LinkExtor: only plain-text regex result (raw entity form)';

		like $urls[0]->{url}, qr/&amp;/,
			'URL contains raw HTML entity &amp; (not decoded by LinkExtor)';

		unlike $urls[0]->{url}, qr/ref=1&src=/,
			'decoded form absent without HTML::LinkExtor';

		is $urls[0]->{host}, 'example.com', 'host correctly extracted despite entity';

		restore_stubs();
	});
};

# With HTML::LinkExtor present the decoded form is ALSO found, giving 2 entries.
# This subtest only runs when LinkExtor IS available.
SKIP: {
	skip 'HTML::LinkExtor not installed', 1 unless eval { require HTML::LinkExtor; 1 };

	subtest 'OD-2b: With HTML::LinkExtor â€” entity-decoded AND raw-entity URLs both found' => sub {
		restore_stubs();
		install_stubs(
			rdns    => 'mail.test.example',
			resolve => { 'example.com' => '91.198.174.51' },
			whois_ip => { org => 'Some ISP', abuse => 'abuse@someisp.example' },
			domain_whois => undef,
		);

		my $html_body = '<a href="https://example.com/page?ref=1&amp;src=email">click</a>';
		my $a = Email::Abuse::Investigator->new();
		$a->parse_email(make_raw_email(
			received => 'from bad (bad [91.198.174.51]) by mx.test',
			ct       => 'text/html; charset=us-ascii',
			body     => $html_body,
		));

		my @urls = $a->embedded_urls();
		diag('URLs with LinkExtor: ' . join(', ', map { $_->{url} } @urls)) if $ENV{TEST_VERBOSE};

		is scalar(@urls), 2,
			'with HTML::LinkExtor: 2 URL entries â€” decoded and raw-entity forms';

		my @decoded = grep { $_->{url} =~ /ref=1&src=/ } @urls;
		my @raw     = grep { $_->{url} =~ /&amp;/     } @urls;
		ok scalar(@decoded), 'decoded URL (& not &amp;) present with LinkExtor';
		ok scalar(@raw),     'raw entity URL (&amp;) also present from plain-text regex';

		restore_stubs();
	};
}

# ---------------------------------------------------------------------------
# OD-3: Without LWP::UserAgent (and LWP::ConnCache)
#
# LWP::UserAgent is required by _follow_redirect_chain() (redirect cloaker
# resolution) and _rdap_lookup() (IP enrichment).  Without it:
#   â€¢ _follow_redirect_chain() returns undef immediately ($HAS_LWP = false)
#   â€¢ Redirect-cloaker URLs are found in embedded_urls() but their phishing
#     destination is NOT appended â€” only the original cloud-storage URL appears.
#
# We capture the reloaded _follow_redirect_chain before install_stubs()
# overwrites it with the default sub{undef}, then restore it so the real
# no-LWP code path is exercised rather than the generic stub.
# ---------------------------------------------------------------------------
subtest 'OD-3: Without LWP::UserAgent â€” redirect cloaker not resolved, module stable' => sub {
	without_optionals(['LWP::UserAgent', 'LWP::ConnCache'], sub {
		# Capture the reloaded (no-LWP) implementation before install_stubs overwrites it
		my $real_follow_redirect;
		{ no strict 'refs'; $real_follow_redirect = \&Email::Abuse::Investigator::_follow_redirect_chain; }

		install_stubs(
			rdns    => 'mail.test.example',
			resolve => { 'storage.googleapis.com' => '142.250.80.112' },
			whois_ip => sub {
				my (undef, $ip) = @_;
				return { org => 'Google LLC', abuse => 'google-cloud-compliance@google.com' }
					if $ip eq '142.250.80.112';
				return {};
			},
			domain_whois => undef,
		);

		# Restore the real no-LWP _follow_redirect_chain so the $HAS_LWP=false
		# code path is exercised, not the generic sub{undef} stub.
		{ no warnings 'redefine';
		  *Email::Abuse::Investigator::_follow_redirect_chain = $real_follow_redirect; }

		my $a = Email::Abuse::Investigator->new();
		$a->parse_email(make_raw_email(
			received => 'from bad (bad [91.198.174.99]) by mx.test',
			body     => 'Click: https://storage.googleapis.com/fakebucket/redir.html',
		));

		my @urls = $a->embedded_urls();
		diag('URLs without LWP: ' . join(', ', map { $_->{host} } @urls)) if $ENV{TEST_VERBOSE};

		# GCS URL is found (URL parsing does not require LWP)
		is scalar(grep { $_->{host} eq 'storage.googleapis.com' } @urls), 1,
			'redirect-cloaker URL present in embedded_urls() without LWP';

		# Redirect not followed â€” only the one original URL
		is scalar(@urls), 1,
			'phishing destination absent: _follow_redirect_chain returns undef without LWP';

		# Core pipeline methods are unaffected

( run in 0.605 second using v1.01-cache-2.11-cpan-9169edd2b0e )