view release on metacpan or  search on metacpan

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

		push @out, '';
		for my $hop (@trail) {
			push @out, '  IP           : ' . (_sanitise_output($hop->{ip}) // '(unknown)');
			push @out, '  Envelope for : ' . _sanitise_output($hop->{for}) if $hop->{for};
			push @out, '  Server ID    : ' . _sanitise_output($hop->{id})  if $hop->{id};
			push @out, '';
		}
	}

	# Embedded URLs section -- grouped by hostname
	push @out, '[ EMBEDDED HTTP/HTTPS URLs ]';
	my @urls = $self->embedded_urls();
	if (@urls) {
		my (%host_order, %host_meta, %host_paths);
		my $seq = 0;
		for my $u (@urls) {
			my $h = $u->{host};
			unless (exists $host_order{$h}) {
				$host_order{$h} = $seq++;
				$host_meta{$h}  = {
					ip      => $u->{ip},

t/function.t  view on Meta::CPAN

	no warnings 'redefine';
	local *Email::Abuse::Investigator::_resolve_host = sub { '1.2.3.4' };
	local *Email::Abuse::Investigator::_whois_ip	 = sub { { org=>'Test Org', abuse=>'abuse@testorg.example', country=>'US' } };
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };

	my $report = $a->report();
	like $report, qr/Email::Abuse::Investigator Report/,  'report title';
	like $report, qr/RISK ASSESSMENT/,			  'risk section';
	like $report, qr/ORIGINATING HOST/,			 'originating host section';
	like $report, qr/120\.88\.161\.249/,			'originating IP';
	like $report, qr/EMBEDDED HTTP\/HTTPS URLs/,	'url section';
	like $report, qr/URL SHORTENER/,			   'shortener warning';
	like $report, qr/CONTACT \/ REPLY-TO DOMAINS/, 'domains section';
	like $report, qr/WHERE TO SEND ABUSE REPORTS/, 'contacts section';
	like $report, qr/Ready to Find Love/,		   'encoded subject decoded';

	# No-origin path
	my $b = Email::Abuse::Investigator->new();
	$b->parse_email("From: x\@y.com\nSubject: s\n\nbody");
	$b->{_origin}		 = undef;
	$b->{_urls}		   = [];

t/unit.t  view on Meta::CPAN

		no warnings 'redefine';
		local *Email::Abuse::Investigator::_resolve_host = sub { '1.2.3.4' };
		local *Email::Abuse::Investigator::_whois_ip	 = sub {
			{ org => 'Test Org', abuse => 'abuse@testorg.example', country => 'US' }
		};
		local *Email::Abuse::Investigator::_domain_whois = sub { undef };
		my $r = $a->report();
		like $r, qr/Email::Abuse::Investigator Report/, 'report title present';
		like $r, qr/RISK ASSESSMENT/,			 'RISK ASSESSMENT present';
		like $r, qr/ORIGINATING HOST/,			'ORIGINATING HOST present';
		like $r, qr/EMBEDDED HTTP\/HTTPS URLs/,	'EMBEDDED HTTP/HTTPS URLs present';
		like $r, qr/CONTACT \/ REPLY-TO DOMAINS/, 'CONTACT/REPLY-TO DOMAINS present';
		like $r, qr/WHERE TO SEND ABUSE REPORTS/, 'WHERE TO SEND ABUSE REPORTS present';
	}
	restore_net();
};

subtest 'report() — idempotent on same object' => sub {
	stub_net();
	no warnings 'redefine';
	local *Email::Abuse::Investigator::_domain_whois = sub { undef };