Email-Abuse-Investigator

 view release on metacpan or  search on metacpan

t/edge_cases.t  view on Meta::CPAN

		'181-day-old date beyond 180-day window';
};

subtest '_parse_date_to_epoch -- unknown DD-Mon-YYYY month returns undef' => sub {
	my $a = new_ok('Email::Abuse::Investigator');
	is $a->_parse_date_to_epoch('15-Xyz-2024'), undef,
		'unknown month abbreviation returns undef';
};

# =============================================================================
# 7. MIME DECODING -- PATHOLOGICAL ENCODED-WORDS
# =============================================================================

subtest '_decode_mime_words -- empty base64 payload' => sub {
	my $a = new_ok('Email::Abuse::Investigator');
	my $r;
	lives_ok { $r = $a->_decode_mime_words('=?UTF-8?B??=') }
		'empty base64 payload does not die';
	is $r, '', 'empty payload decodes to empty string';
};

subtest '_decode_mime_words -- invalid base64 characters do not die' => sub {
	my $a = new_ok('Email::Abuse::Investigator');
	my $r;
	lives_ok { $r = $a->_decode_mime_words('=?UTF-8?B?not!!valid@@b64?=') }
		'invalid base64 does not die';
	ok defined $r, 'invalid base64 returns defined value';
};

subtest '_decode_mime_words -- 4 KB base64 payload' => sub {
	my $a = new_ok('Email::Abuse::Investigator');
	my $payload = encode_base64('A' x 4096, '');
	my $r;
	lives_ok { $r = $a->_decode_mime_words("=?UTF-8?B?${payload}?=") }
		'4 KB encoded-word does not die';
	ok length($r) > 0, '4 KB payload decodes to non-empty string';
};

subtest '_decode_mime_words -- QP with truncated trailing =' => sub {
	my $a = new_ok('Email::Abuse::Investigator');
	my $r;
	lives_ok { $r = $a->_decode_mime_words('=?UTF-8?Q?Hello=?=') }
		'truncated QP does not die';
	ok defined $r, 'truncated QP returns defined value';
};

subtest '_decode_mime_words -- unknown charset does not die' => sub {
	my $a = new_ok('Email::Abuse::Investigator');
	my $r;
	lives_ok {
		$r = $a->_decode_mime_words(
			'=?X-NONEXISTENT-12345?B?' . encode_base64('test','') . '?=')
	} 'unknown charset does not die';
	ok defined $r, 'unknown charset returns defined value';
};

subtest '_decode_mime_words -- multiple encoded-words in one string' => sub {
	my $a = new_ok('Email::Abuse::Investigator');
	my $s = '=?UTF-8?B?' . encode_base64('Hello', '') . '?= '
		  . '=?UTF-8?B?' . encode_base64('World', '') . '?=';
	is $a->_decode_mime_words($s), 'Hello World', 'multiple words decoded';
};

# =============================================================================
# 8. MULTIPART -- DEGENERATE STRUCTURES
# =============================================================================

subtest 'multipart -- boundary in Content-Type but absent from body' => sub {
	null_net();
	my $a = new_ok('Email::Abuse::Investigator');
	lives_ok {
		$a->parse_email(
			"Content-Type: multipart/alternative; boundary=\"MISSING\"\n\n"
			. "This body has no boundary markers at all.")
	} 'missing multipart boundary in body does not die';
	restore_net();
};

subtest 'multipart -- parts with no Content-Type header' => sub {
	null_net();
	my $a = new_ok('Email::Abuse::Investigator');
	lives_ok {
		$a->parse_email(
			"Content-Type: multipart/alternative; boundary=\"B\"\n\n"
			. "--B\r\nX-Custom: foo\r\n\r\npart one\r\n"
			. "--B\r\nX-Custom: bar\r\n\r\npart two\r\n"
			. "--B--\r\n")
	} 'multipart parts with no Content-Type do not die';
	restore_net();
};

subtest 'multipart -- boundary containing regex metacharacters' => sub {
	null_net();
	my $a = new_ok('Email::Abuse::Investigator');
	my $bnd = 'b+o.u*n[d]a(r)y^$';
	lives_ok {
		$a->parse_email(
			"Content-Type: multipart/alternative; boundary=\"$bnd\"\n\n"
			. "--$bnd\r\nContent-Type: text/plain\r\n\r\ntext\r\n"
			. "--$bnd--\r\n")
	} 'boundary with regex metacharacters does not die';
	restore_net();
};

subtest 'multipart -- empty sub-part body' => sub {
	null_net();
	my $a = new_ok('Email::Abuse::Investigator');
	lives_ok {
		$a->parse_email(
			"Content-Type: multipart/alternative; boundary=\"B\"\n\n"
			. "--B\r\nContent-Type: text/plain\r\n\r\n"
			. "--B\r\nContent-Type: text/html\r\n\r\n<p>html</p>\r\n"
			. "--B--\r\n")
	} 'empty multipart sub-part body does not die';
	restore_net();
};

# =============================================================================
# 9. URL EXTRACTION -- PATHOLOGICAL INPUTS
# =============================================================================



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