view release on metacpan or  search on metacpan

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

#   header name.
=head2 header_value

Returns the value of the first occurrence of a named header field, or
C<undef> if the header is absent.  The name comparison is case-insensitive.

=head3 API SPECIFICATION

  Input:  name => Str  (required) - header field name, e.g. 'Subject'
  Output: Str | undef

=head3 MESSAGES

  (none - returns undef on missing header, never throws)

=cut

sub header_value {
	my ($self, $name) = @_;
	return $self->_header_value($name);
}

#
# _header_value( $name ) -> string | undef
#
# Purpose:
#   Internal implementation for header_value().  Walks _headers list and
#   returns the value of the first matching header.
#
# Entry criteria:
#   $name -- a lower-cased header name string.
#   $self->{_headers} populated by _split_message().
#
# Exit status:
#   Returns the value string, or undef if the header is not present.

sub _header_value :Private {
	my ($self, $name) = @_;
	for my $h (@{ $self->{_headers} }) {
		return $h->{value} if $h->{name} eq lc($name);
	}
	return;
}

# _ip_in_cidr( $ip, $cidr ) -> bool
#
# Purpose:
#   Test whether an IPv4 address falls within a CIDR block or is an exact
#   match (when $cidr contains no '/' separator).
#
# Entry criteria:
#   $ip   -- a defined dotted-quad IPv4 address string.
#   $cidr -- a CIDR string like '10.0.0.0/8' or an exact IP.
#
# Exit status:
#   Returns 1 (true) if the IP is within the CIDR block, 0 otherwise.

sub _ip_in_cidr :Private {
	my ($self, $ip, $cidr) = @_;
	return $ip eq $cidr unless $cidr =~ m{/};
	my ($net_addr, $prefix) = split m{/}, $cidr;
	return 0 if !defined($prefix) || $prefix !~ /^\d+$/ || $prefix > 32;

	# Compute the network mask and compare masked network addresses
	my $mask  = ~0 << (32 - $prefix);
	my $net_n = unpack 'N', (inet_aton($net_addr) // return 0);
	my $ip_n  = unpack 'N', (inet_aton($ip)       // return 0);
	return ($ip_n & $mask) == ($net_n & $mask);
}

# _decode_mime_words( $str ) -> decoded_string
#
# Purpose:
#   Decode MIME encoded-words (=?charset?B/Q?...?=) in a header value
#   string for human-readable display in reports.
#
# Entry criteria:
#   $str -- a defined header value string; may be undef.
#
# Exit status:
#   Returns the decoded string, or '' if $str is undef.

sub _decode_mime_words :Private {
	my ($self, $str) = @_;
	return '' unless defined $str;
	# Replace each encoded-word with its decoded equivalent
	$str =~ s/=\?([^?]+)\?([BbQq])\?([^?]*)\?=/_decode_ew($1,$2,$3)/ge;
	return $str;
}

# _decode_ew( $charset, $enc, $text ) -> decoded_bytes
#
# Purpose:
#   Decode a single MIME encoded-word component (base64 or quoted-printable).
#
# Notes:
#   Non-UTF-8 charsets return raw bytes; good enough for display-name spoof
#   detection which only needs ASCII matching.

sub _decode_ew :Private {
	my ($charset, $enc, $text) = @_;
	my $raw;
	if (uc($enc) eq 'B') {
		$raw = decode_base64($text);
	} else {
		# Quoted-printable encoded-word uses underscore for space
		$text =~ s/_/ /g;
		$raw  = decode_qp($text);
	}
	return $raw;
}

# _parse_date_to_epoch( $str ) -> epoch_int | undef
#
# Purpose:
#   Parse common WHOIS date strings to a Unix epoch integer.
#   Handles YYYY-MM-DD, YYYY-MM-DDThh:mm:ssZ, and DD-Mon-YYYY formats.
#
# Entry criteria:
#   $str -- a defined date string; may be undef.
#