Email-Abuse-Investigator
view release on metacpan or search on metacpan
lib/Email/Abuse/Investigator.pm view on Meta::CPAN
# date not too far in the past or future.
#
# Entry criteria:
# $flag -- accumulator coderef.
#
# Exit status:
# Returns nothing; side effects via $flag closure.
sub _risk_check_date :Private {
my ($self, $flag) = @_;
my $date_raw = $self->_header_value('date');
if (!$date_raw || $date_raw !~ /\S/) {
$flag->('MEDIUM', 'missing_date',
'No Date: header -- violates RFC 5322; common in spam');
return;
}
# Check for an implausible timezone offset (outside real-world bounds)
if ($date_raw =~ /([+-])(\d{2})(\d{2})\s*$/) {
my ($sign, $hh, $mm) = ($1, $2, $3);
my $offset_mins = $hh * 60 + $mm;
my $implausible = $mm >= 60
|| ($sign eq '+' && $offset_mins > $TZ_MAX_POS_MINS)
|| ($sign eq '-' && $offset_mins > $TZ_MAX_NEG_MINS);
if ($implausible) {
$flag->('MEDIUM', 'implausible_timezone',
"Date: '$date_raw' contains an implausible timezone offset "
. "($sign$hh$mm) -- header is likely forged");
}
}
# Check for dates more than DATE_SKEW_DAYS outside the analysis window
my $date_epoch = _parse_rfc2822_date($date_raw);
return unless defined $date_epoch;
my $delta = time() - $date_epoch;
if ($delta > $DATE_SKEW_DAYS * $SECS_PER_DAY) {
$flag->('LOW', 'suspicious_date',
"Date: '$date_raw' is more than $DATE_SKEW_DAYS days in the past");
} elsif ($delta < -($DATE_SKEW_DAYS * $SECS_PER_DAY)) {
$flag->('LOW', 'suspicious_date',
"Date: '$date_raw' is more than $DATE_SKEW_DAYS days in the future");
}
}
# _risk_check_identity( $flag )
#
# Purpose:
# Check From: display-name spoofing, free webmail, Reply-To mismatch,
# undisclosed recipients, and MIME-encoded Subject.
#
# Entry criteria:
# $flag -- accumulator coderef.
#
# Exit status:
# Returns nothing; side effects via $flag closure.
sub _risk_check_identity :Private {
my ($self, $flag) = @_;
my $from_raw = $self->_header_value('from') // '';
my $from_decoded = $self->_decode_mime_words($from_raw);
# Display-name domain spoofing: "PayPal paypal.com" <phish@evil.example>
if ($from_decoded =~ /^"?([^"<]+?)"?\s*<([^>]+)>/) {
my ($display, $addr) = ($1, $2);
while ($display =~ /\b([\w-]+\.(?:com|net|org|io|co|uk|au|gov|edu))\b/gi) {
my $disp_domain = lc $1;
my ($addr_domain) = $addr =~ /\@([\w.-]+)/;
$addr_domain = lc($addr_domain // '');
my $reg_disp = _registrable($disp_domain);
my $reg_addr = _registrable($addr_domain);
if ($reg_disp && $reg_addr && $reg_disp ne $reg_addr) {
$flag->('HIGH', 'display_name_domain_spoof',
"From: display name mentions '$disp_domain' but actual address is <$addr>");
}
}
}
# Free webmail sender flag (no corporate infrastructure)
if ($from_raw =~ /\@(gmail|yahoo|hotmail|outlook|live|aol|protonmail|yandex)\./i
|| $from_raw =~ /\@mail\.ru(?:[\s>]|$)/i) {
$flag->('MEDIUM', 'free_webmail_sender',
"Message sent from free webmail address ($from_raw)");
}
# Reply-To differs from From: -- replies harvested by different address
my $reply_to = $self->_header_value('reply-to');
if ($reply_to) {
my ($from_addr) = $from_raw =~ /([\w.+%-]+\@[\w.-]+)/;
my ($reply_addr) = $reply_to =~ /([\w.+%-]+\@[\w.-]+)/;
if ($from_addr && $reply_addr && lc($from_addr) ne lc($reply_addr)) {
$flag->('MEDIUM', 'reply_to_differs_from_from',
"Reply-To ($reply_addr) differs from From: ($from_addr)");
}
}
# Undisclosed or absent To: header
my $to = $self->_header_value('to') // '';
if ($to =~ /undisclosed|:;/ || $to eq '') {
$flag->('MEDIUM', 'undisclosed_recipients',
"To: header is '$to' -- message was bulk-sent with hidden recipient list");
}
# MIME-encoded Subject (potential filter evasion)
my $subj_raw = $self->_header_value('subject') // '';
if ($subj_raw =~ /=\?[^?]+\?[BQ]\?/i) {
$flag->('LOW', 'encoded_subject',
"Subject line is MIME-encoded: '$subj_raw' (decoded: '"
. $self->_decode_mime_words($subj_raw) . "')");
}
}
# _risk_check_urls_and_domains( $flag )
#
# Purpose:
# Check embedded URLs for shorteners and plain HTTP, and contact domains
# for recent registration, imminent expiry, and lookalike brand names.
#
# Entry criteria:
# $flag -- accumulator coderef.
#
# Exit status:
# Returns nothing; side effects via $flag closure.
sub _risk_check_urls_and_domains :Private {
my ($self, $flag) = @_;
my (%shortener_seen, %cloaker_seen, %url_host_seen);
for my $u ($self->embedded_urls()) {
# Skip trusted infrastructure -- these are not spam indicators
next unless($u->{host});
my $bare = lc $u->{host};
next unless defined($bare);
$bare =~ s/^www\.//;
next if $self->{trusted_domains}->{$bare};
next if $TRUSTED_DOMAINS{$bare};
# URL shortener hides real destination
if(($URL_SHORTENERS{$bare} || $self->{url_shorteners}->{$bare}) && !$shortener_seen{$bare}++) {
$flag->('MEDIUM', 'url_shortener',
"$u->{host} is a URL shortener -- the real destination is hidden");
}
# Cloud object-store / CDN used as a redirect cloaker
if ($self->_is_redirect_cloaker($bare) && !$cloaker_seen{$bare}++) {
$flag->('MEDIUM', 'redirect_cloaker',
"$u->{host} is a cloud storage or CDN host used as a redirect cloaker -- the real phishing destination is hidden behind a client-side redirect");
}
# Plain HTTP provides no encryption
if ($u->{url} =~ m{^http://}i && !$url_host_seen{ $u->{host} }++) {
$flag->('LOW', 'http_not_https',
"$u->{host} linked over plain HTTP -- no encryption");
}
}
# Domain-level checks against contact/reply domains
for my $d ($self->mailto_domains()) {
# Recently registered domain is a common phishing indicator
if ($d->{recently_registered}) {
$flag->('HIGH', 'recently_registered_domain',
"$d->{domain} was registered $d->{registered} (less than ${\$RECENT_REG_DAYS} days ago)");
}
# Domain expiry checks
if ($d->{expires}) {
if(my $exp = $self->_parse_date_to_epoch($d->{expires})) {
my $now = time();
my $remaining = $exp - $now;
if ($remaining > 0 && $remaining < $EXPIRY_WARN_DAYS * $SECS_PER_DAY) {
lib/Email/Abuse/Investigator.pm view on Meta::CPAN
software, received chain tracking IDs, embedded URLs, contact domain
intelligence, and recommended abuse contacts.
Use C<report()> for human review or ticketing systems. Use
C<abuse_report_text()> for sending to ISP abuse desks.
=head3 Usage
print $analyser->report();
open my $fh, '>', 'report.txt' or croak "Cannot open: $!";
print $fh $analyser->report();
close $fh;
=head3 Arguments
None. C<parse_email()> must have been called first.
=head3 Returns
A plain scalar string, newline-terminated, Unix line endings. Never empty
or undef.
=head3 Side Effects
Triggers all analysis methods if not already cached.
=head3 Notes
The report is idempotent: calling it multiple times on the same object
always returns an identical string. All user-derived content is sanitised
before output.
=head3 API Specification
=head4 Input
[]
=head4 Output
{ type => 'string' }
=cut
sub report {
my $self = $_[0];
my @out;
# Banner header
push @out, '=' x 72;
push @out, " Email::Abuse::Investigator Report (v$VERSION)";
push @out, '=' x 72;
push @out, '';
# Envelope summary -- decode MIME encoded-words for readability
for my $f (qw(from reply-to return-path subject date message-id)) {
my $v = $self->_header_value($f);
next unless defined $v;
my $decoded = $self->_decode_mime_words($v);
my $label = ucfirst($f);
push @out, sprintf(' %-14s : %s', $label,
_sanitise_output($decoded ne $v ? "$decoded [encoded: $v]" : $v));
}
push @out, '';
# Risk assessment section
my $risk = $self->risk_assessment();
push @out, "[ RISK ASSESSMENT: $risk->{level} (score: $risk->{score}) ]";
if (@{ $risk->{flags} }) {
for my $f (@{ $risk->{flags} }) {
push @out, " [$f->{severity}] " . _sanitise_output($f->{detail});
}
} else {
push @out, ' (no specific red flags detected)';
}
push @out, '';
# Originating host section
push @out, '[ ORIGINATING HOST ]';
if(my $orig = $self->originating_ip()) {
push @out, ' IP : ' . _sanitise_output($orig->{ip});
push @out, ' Reverse DNS : ' . _sanitise_output($orig->{rdns}) if $orig->{rdns};
push @out, ' Country : ' . _sanitise_output($orig->{country}) if $orig->{country};
push @out, ' Organisation : ' . _sanitise_output($orig->{org}) if $orig->{org};
push @out, ' Abuse addr : ' . _sanitise_output($orig->{abuse}) if $orig->{abuse};
push @out, " Confidence : $orig->{confidence}";
push @out, ' Note : ' . _sanitise_output($orig->{note}) if $orig->{note};
} else {
push @out, ' (could not determine originating IP)';
}
push @out, '';
# Sending software section (omitted if none found)
my @sw = $self->sending_software();
if (@sw) {
push @out, '[ SENDING SOFTWARE / INFRASTRUCTURE CLUES ]';
for my $s (@sw) {
push @out, sprintf(' %-14s : %s', $s->{header}, _sanitise_output($s->{value}));
push @out, " Note : $s->{note}";
push @out, '';
}
}
# Received chain tracking IDs (only hops with id or for are shown)
my @trail = grep { defined $_->{id} || defined $_->{for} }
$self->received_trail();
if (@trail) {
push @out, '[ RECEIVED CHAIN TRACKING IDs ]';
push @out, ' (Supply these to the relevant ISP abuse team to trace the session)';
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) {
lib/Email/Abuse/Investigator.pm view on Meta::CPAN
# decode the body (including multipart), extract sending-software
# fingerprints, and populate per-hop tracking data.
#
# Entry criteria:
# $text -- defined scalar, already dereferenced by parse_email().
# $self->{_sending_sw} and $self->{_rcvd_tracking} reset to [] by caller.
#
# Exit status:
# Returns undef silently if the header block is empty/whitespace-only.
# Otherwise all results are communicated via side effects on $self.
#
# Side effects:
# Populates _headers, _received, _body_plain, _body_html, _sending_sw,
# and _rcvd_tracking.
#
# Notes:
# Delegates to _decode_multipart() for multipart/* content types.
# Lines not matching the header pattern are silently discarded.
# Boundary extraction uses a simple regex; missing boundary causes the
# body to be skipped silently.
sub _split_message :Private {
my ($self, $text) = @_;
# Split at the first blank line (RFC 2822 header/body separator)
my ($header_block, $body_raw) = split /\r?\n\r?\n/, $text, 2;
return unless defined $header_block && $header_block =~ /\S/;
$body_raw //= '';
# Unfold RFC 2822 continuation lines (s2.2.3)
$header_block =~ s/\r?\n([ \t]+)/ $1/g;
# Parse each header line into a { name, value } pair
my @headers;
for my $line (split /\r?\n/, $header_block) {
if ($line =~ /^([\w-]+)\s*:\s*(.*)/) {
push @headers, { name => lc($1), value => $2 };
}
}
$self->{_headers} = \@headers;
# Collect all Received: header values (most-recent first, as in message)
$self->{_received} = [
map { $_->{value} }
grep { $_->{name} eq 'received' } @headers
];
# Determine content type and transfer encoding from top-level headers
my ($ct_h) = grep { $_->{name} eq 'content-type' } @headers;
my ($cte_h) = grep { $_->{name} eq 'content-transfer-encoding' } @headers;
my $ct = defined $ct_h ? $ct_h->{value} : '';
my $cte = defined $cte_h ? $cte_h->{value} : '';
# Decode multipart or single-part body as appropriate
if ($ct =~ /multipart/i) {
my ($boundary) = $ct =~ /boundary="?([^";]+)"?/i;
# Pass depth=0 to enforce the MAX_MULTIPART_DEPTH recursion guard
$self->_decode_multipart($body_raw, $boundary, 0) if $boundary;
} else {
my $decoded = $self->_decode_body($body_raw, $cte);
if ($ct =~ /html/i) { $self->{_body_html} = $decoded }
else { $self->{_body_plain} = $decoded }
}
$self->_debug(sprintf 'Parsed %d headers, %d Received lines',
scalar @headers, scalar @{ $self->{_received} });
# --- Sending software fingerprints ---
# These headers identify the mailer or shared-hosting script that sent
# the message; invaluable for shared-hosting abuse reports.
my %sw_notes = (
'x-php-originating-script' => 'PHP script on shared hosting -- report to hosting abuse team',
'x-source' => 'Source file on shared hosting -- report to hosting abuse team',
'x-source-host' => 'Sending hostname injected by shared hosting provider',
'x-source-args' => 'Command-line args injected by shared hosting provider',
'x-mailer' => 'Email client or bulk-mailer identifier',
'user-agent' => 'Email client identifier',
);
for my $sw_hdr (sort keys %sw_notes) {
my ($h) = grep { $_->{name} eq $sw_hdr } @headers;
next unless $h;
push @{ $self->{_sending_sw} }, {
header => $sw_hdr,
value => $h->{value},
note => $sw_notes{$sw_hdr},
};
}
# --- Per-hop tracking IDs from Received: chain ---
# Walk oldest-first (reverse) so _rcvd_tracking is oldest-first
for my $rcvd (reverse @{ $self->{_received} }) {
my $ip = $self->_extract_ip_from_received($rcvd);
my ($for_addr) = $rcvd =~ /\bfor\s+<?([^\s>]+\@[\w.-]+\.[\w]+)>?/i;
my ($srv_id) = $rcvd =~ /\bid\s+([\w.-]+)/i;
# Skip hops with no actionable tracking data
next unless defined $ip || defined $for_addr || defined $srv_id;
push @{ $self->{_rcvd_tracking} }, {
received => $rcvd,
ip => $ip,
for => $for_addr,
id => $srv_id,
};
}
}
# _decode_multipart( $body, $boundary, $depth )
#
# Purpose:
# Recursively split a MIME multipart body on its boundary and decode each
# text/plain and text/html part. Nested multipart/* containers are
# recursed into up to MAX_MULTIPART_DEPTH levels deep.
#
# Entry criteria:
# $body -- the raw body text of the multipart container.
# $boundary -- the boundary string from the Content-Type header.
# $depth -- current recursion depth (starts at 0 from _split_message).
#
# Exit status:
# Returns undef if $depth >= MAX_MULTIPART_DEPTH (recursion guard).
# Otherwise all results via side effects.
#
# Side effects:
# Appends decoded text to $self->{_body_plain} and $self->{_body_html}.
#
# Notes:
# Whitespace-only MIME segments between boundaries are silently skipped.
# Decoding errors are silenced; raw bytes are used as fallback.
sub _decode_multipart :Private {
my ($self, $body, $boundary, $depth) = @_;
$depth //= 0;
# Enforce the recursion depth limit to prevent stack exhaustion on
# pathological crafted messages with deeply nested multipart structures.
if ($depth >= $MAX_MULTIPART_DEPTH) {
Carp::carp 'Email::Abuse::Investigator: multipart nesting depth limit',
"($MAX_MULTIPART_DEPTH) exceeded; stopping recursion";
return;
}
# Split on the boundary marker; the (?:--)? suffix handles closing boundary
my @parts = split /--\Q$boundary\E(?:--)?/, $body;
for my $part (@parts) {
# Skip whitespace-only segments between boundaries
next unless $part =~ /\S/;
$part =~ s/^\r?\n//;
# Each MIME part has its own headers separated from body by a blank line
my ($phdr_block, $pbody) = split /\r?\n\r?\n/, $part, 2;
next unless defined $pbody;
# Unfold continuation header lines within this part
$phdr_block =~ s/\r?\n([ \t]+)/ $1/g;
# Parse this part's headers into a simple hash
my %phdr;
for my $line (split /\r?\n/, $phdr_block) {
$phdr{ lc($1) } = $2 if $line =~ /^([\w-]+)\s*:\s*(.*)/;
}
my $pct = $phdr{'content-type'} // '';
my $pcte = $phdr{'content-transfer-encoding'} // '';
# Nested multipart/* must be recursed into; without this URLs in
# multipart/alternative inside multipart/mixed would be missed.
if ($pct =~ /multipart/i) {
my ($inner_boundary) = $pct =~ /boundary\s*=\s*"?([^";]+)"?/i;
if ($inner_boundary) {
$inner_boundary =~ s/\s+$//;
# Increment depth counter for the recursion guard
$self->_decode_multipart($pbody, $inner_boundary, $depth + 1);
}
next;
}
# Decode transfer encoding and accumulate by content type
my $decoded = $self->_decode_body($pbody, $pcte);
if ($pct =~ /text\/html/i) { $self->{_body_html} .= $decoded }
elsif ($pct =~ /text/i || !$pct) { $self->{_body_plain} .= $decoded }
}
}
# _decode_body( $body, $cte ) -> string
#
# Purpose:
# Decode a MIME body part according to its Content-Transfer-Encoding.
#
# Entry criteria:
# $body -- raw body string (may be undef).
# $cte -- Content-Transfer-Encoding value string (may be undef).
#
# Exit status:
# Returns the decoded string, or the original string if the encoding is
# 7bit/8bit/binary or unrecognised.
#
# Notes:
# decode_qp and decode_base64 are imported from MIME:: modules; errors
# from malformed content are silenced by the eval wrappers they provide.
sub _decode_body :Private {
my ($self, $body, $cte) = @_;
$cte //= '';
return decode_qp($body) if $cte =~ /quoted-printable/i;
return decode_base64($body) if $cte =~ /base64/i;
return $body // '';
}
# -----------------------------------------------------------------------
# Private: Received-chain -> originating IP
# -----------------------------------------------------------------------
# _find_origin()
#
# Purpose:
# Walk the Received: chain (oldest-first) to find the first external IP,
# or fall back to X-Originating-IP. Enrich with rDNS and WHOIS.
#
# Entry criteria:
# $self->{_received} populated by _split_message().
# $self->{trusted_relays} set by new().
#
# Exit status:
# Returns { ip, rdns, org, abuse, country, confidence, note } on success.
# Returns undef if no usable IP can be identified.
#
# Side effects:
# Network I/O via _enrich_ip(): one PTR lookup, one RDAP/WHOIS query.
# Results are also stored in the CHI cross-message cache if available.
#
# Notes:
# confidence 'high' = 2+ distinct external IPs;
# 'medium' = exactly one external IP;
# 'low' = taken from X-Originating-IP.
sub _find_origin :Private {
my $self = $_[0];
my @candidates;
# Walk oldest-first (reverse) to collect external IPs
for my $hdr (reverse @{ $self->{_received} }) {
my $ip = $self->_extract_ip_from_received($hdr) // next;
next if $self->_is_private($ip);
next if $self->_is_trusted($ip);
push @candidates, $ip;
}
# Fall back to X-Originating-IP if no external IPs in Received: chain
unless (@candidates) {
my $xoip = $self->_header_value('x-originating-ip');
if ($xoip) {
$xoip =~ s/[\[\]\s]//g;
return $self->_enrich_ip($xoip, 'low',
lib/Email/Abuse/Investigator.pm view on Meta::CPAN
next unless $ip =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
next if grep { $_ > 255 } split /\./, $ip;
return $ip;
}
}
return;
}
# _is_private( $ip ) -> bool
#
# Purpose:
# Test whether an IP address falls in any private, reserved, or special-
# use range (IPv4 or IPv6) that should never be reported as a spam origin.
#
# Entry criteria:
# $ip -- a scalar IP string (IPv4 or IPv6); may be undef.
#
# Exit status:
# Returns 1 (true) if the IP is private/reserved, 0 (false) otherwise.
# Returns 1 for undef or empty strings.
#
# Notes:
# Uses the module-level @PRIVATE_RANGES array of pre-compiled regexes.
# Covers all ranges listed in RFC 1122, 1918, 5737, 6598, and RFC 4193.
sub _is_private :Private {
my ($self, $ip) = @_;
return 1 if !defined($ip) || $ip eq '';
for my $re (@PRIVATE_RANGES) { return 1 if $ip =~ $re }
return 0;
}
# _is_trusted( $ip ) -> bool
#
# Purpose:
# Test whether an IP address matches any entry in the caller-supplied
# trusted_relays list (exact IP or CIDR block).
#
# Entry criteria:
# $ip -- a defined IPv4 address string.
# $self->{trusted_relays} -- arrayref of exact IPs or CIDR strings.
#
# Exit status:
# Returns 1 (true) if the IP matches any trusted relay, 0 otherwise.
sub _is_trusted :Private {
my ($self, $ip) = @_;
for my $cidr (@{ $self->{trusted_relays} }) {
return 1 if $self->_ip_in_cidr($ip, $cidr);
}
return 0;
}
# -----------------------------------------------------------------------
# Private: HTTP/HTTPS URL extraction and resolution
# -----------------------------------------------------------------------
# _extract_and_resolve_urls() -> arrayref of url hashrefs
#
# Purpose:
# Extract all HTTP/HTTPS URLs from the decoded body, resolve each unique
# hostname to an IP, and enrich with WHOIS/RDAP data. Optionally uses
# AnyEvent::DNS to parallelise the DNS resolution step.
#
# Entry criteria:
# $self->{_body_plain} and $self->{_body_html} populated by _split_message().
#
# Exit status:
# Returns an arrayref of url hashrefs (possibly empty).
#
# Side effects:
# Network I/O per unique hostname: one A/AAAA lookup, one RDAP/WHOIS.
# Results stored in the CHI cross-message cache if available.
sub _extract_and_resolve_urls :Private {
my $self = $_[0];
my (%url_seen, %host_cache);
my @results;
my $combined = $self->{_body_plain} . "\n" . $self->{_body_html};
# Collect unique URLs from body
my @urls = grep { !$url_seen{$_}++ } $self->_extract_http_urls($combined);
# For URL-shortener and redirect-cloaker hosts, follow the redirect chain to
# discover the real destination (e.g. GCS bucket → phishing landing page).
# Done before DNS resolution so that destination hostnames can be parallelised.
# _follow_redirect_chain() is a :Protected seam that handles LWP availability
# internally — do not guard this block with $HAS_LWP so the seam can be
# stubbed unconditionally in tests regardless of whether LWP is installed.
for my $url (@urls) {
my ($host) = $url =~ m{https?://([^/:?\s#]+)}i;
next unless $host;
my $bare = lc $host;
$bare =~ s/^www\.//;
next unless $URL_SHORTENERS{$bare}
|| ($self->{url_shorteners} && $self->{url_shorteners}{$bare})
|| $self->_is_redirect_cloaker($bare);
my $dest = $self->_follow_redirect_chain($url);
next unless defined $dest && !$url_seen{$dest}++;
push @urls, $dest;
}
# Extract unique hostnames for parallel DNS resolution (including redirect destinations)
my %hostname_needed;
for my $url (@urls) {
my ($host) = $url =~ m{https?://([^/:?\s#]+)}i;
$hostname_needed{$host}++ if $host;
}
# Parallelise DNS lookups if AnyEvent::DNS is available
if ($HAS_ANYEVENT_DNS && scalar(keys %hostname_needed) > 1) {
$self->_parallel_resolve_hosts(\%hostname_needed, \%host_cache);
}
# Process each URL: resolve hostname and WHOIS-enrich
for my $url (@urls) {
my ($host) = $url =~ m{https?://([^/:?\s#]+)}i;
next unless $host;
# Resolve and WHOIS once per unique hostname, then cache the result
unless (exists $host_cache{$host}) {
lib/Email/Abuse/Investigator.pm view on Meta::CPAN
# LWP::UserAgent must be installed ($HAS_LWP must be true).
#
# Exit status:
# Returns the first URL that differs from the input after following the
# chain, or undef if no redirect was found or LWP is unavailable.
# Never returns the input $url unchanged.
#
# Side effects:
# Up to $REDIRECT_MAX_HOPS HTTP GET requests.
# Successful result cached in the cross-message CHI cache keyed
# "redirect:<url>" to avoid re-fetching across messages.
sub _follow_redirect_chain :Protected {
my ($self, $url) = @_;
return undef unless $HAS_LWP;
# Serve from cache when available
if ($_cache) {
my $cached = $_cache->get("redirect:$url");
return $cached if defined $cached;
}
# Dedicated no-follow UA so we can inspect each redirect hop manually.
# Stored separately from the RDAP UA ($self->{ua}) which needs auto-follow.
unless (defined $self->{_ua_nofollow}) {
my $ua = LWP::UserAgent->new(
timeout => $self->{timeout},
agent => "Email-Abuse-Investigator/$VERSION",
max_redirect => 0,
);
if ($HAS_CONN_CACHE) {
my $cc = LWP::ConnCache->new();
$cc->total_capacity(4);
$ua->conn_cache($cc);
}
$ua->env_proxy(1);
$self->{_ua_nofollow} = $ua;
}
my $ua = $self->{_ua_nofollow};
my $current = $url;
my $final;
for my $hop (1 .. $REDIRECT_MAX_HOPS) {
my $res = eval { $ua->get($current) };
last unless $res;
if ($res->is_redirect()) {
# HTTP 3xx: extract Location header
my $loc = $res->header('Location');
last unless defined $loc;
# Resolve relative Location URLs against the current base
if ($loc !~ m{^https?://}i) {
require URI;
$loc = URI->new_abs($loc, $current)->as_string();
}
$final = $loc;
$current = $loc;
} elsif ($res->is_success()) {
# 2xx: inspect body for client-side redirect patterns
my $body = $res->decoded_content() // '';
my $dest;
# <meta http-equiv="refresh" content="N; url=https://...">
if ($body =~ m{<meta[^>]+http-equiv\s*=\s*["']?refresh["']?[^>]+
content\s*=\s*["'][^"']*url\s*=\s*(https?://[^"'\s>]+)}xi) {
$dest = $1;
}
# window.location.replace("...") or window.location.href = "..."
elsif ($body =~ m{window\.location(?:\.replace\s*\(\s*|\.href\s*=\s*)
["'](https?://[^"']+)["']}xi) {
$dest = $1;
}
last unless defined $dest;
$final = $dest;
$current = $dest;
} else {
last;
}
}
# Cache for reuse across messages in this session
$_cache->set("redirect:$url", $final) if $_cache && defined $final;
return $final;
}
# _parallel_resolve_hosts( \%hostnames, \%cache )
#
# Purpose:
# Resolve multiple hostnames to IPs in parallel using AnyEvent::DNS.
# Populates the cache with resolved IPs so the sequential loop in
# _extract_and_resolve_urls() can skip the DNS step for pre-resolved hosts.
#
# Entry criteria:
# $hostnames_ref -- hashref keyed by hostname (values ignored).
# $cache_ref -- hashref to populate with { ip => '...' } results.
# AnyEvent::DNS must be installed ($HAS_ANYEVENT_DNS is true).
#
# Exit status:
# Returns undef; all results written to %$cache_ref via side effects.
#
# Notes:
# Errors (NXDOMAIN, timeout) are silently swallowed; the sequential
# resolution loop will return '(unresolved)' for those hosts.
sub _parallel_resolve_hosts :Private {
my ($self, $hostnames_ref, $cache_ref) = @_;
# Guard both conditions together: an empty hash must never reach condvar
# creation because $cv->recv would block forever with $pending == 0.
return unless $HAS_ANYEVENT_DNS && %$hostnames_ref;
# Build an AnyEvent condvar to wait for all lookups to complete
my $cv = AnyEvent->condvar;
my $pending = scalar keys %$hostnames_ref;
# AnyEvent::DNS::resolve is a method, not a standalone function.
# Use the global resolver singleton; passing a bare string as the
# first arg would make Perl treat the hostname as the invocant.
my $resolver = AnyEvent::DNS::resolver();
lib/Email/Abuse/Investigator.pm view on Meta::CPAN
# Collect from standard sender/reply headers
my %header_sources = (
'from' => 'From: header',
'reply-to' => 'Reply-To: header',
'return-path' => 'Return-Path: header',
'sender' => 'Sender: header',
);
for my $hname (sort keys %header_sources) {
my $val = $self->_header_value($hname) // next;
$record->($_, $header_sources{$hname})
for $self->_domains_from_text($val);
}
# Message-ID domain often reveals the real bulk-sending platform
my $mid = $self->_header_value('message-id');
if ($mid && $mid =~ /\@([\w.-]+)/) {
my $mid_dom = lc $1;
my $mid_reg = _registrable($mid_dom) // $mid_dom;
$record->($mid_dom, 'Message-ID: header')
unless $TRUSTED_DOMAINS{$mid_dom} || $TRUSTED_DOMAINS{$mid_reg} || $self->{trusted_domains}->{$mid_dom} || $self->{trusted_domains}->{$mid_reg};
}
# DKIM signing domain(s) -- the organisation that vouches for the message
my $auth = $self->_parse_auth_results_cached();
for my $dkim_d (@{ $auth->{dkim_domains} // [] }) {
$record->($dkim_d, 'DKIM-Signature: d= (signing domain)');
}
# List-Unsubscribe identifies the ESP or bulk sender
my $unsub = $self->_header_value('list-unsubscribe');
if ($unsub) {
while ($unsub =~ m{https?://([^/:?\s>]+)}gi) {
$record->(lc $1, 'List-Unsubscribe: header');
}
while ($unsub =~ m{mailto:[^@\s>]+\@([\w.-]+)}gi) {
$record->(lc $1, 'List-Unsubscribe: header');
}
}
# Body email addresses (mailto: and bare user@domain forms)
my $combined = $self->{_body_plain} . "\n" . $self->{_body_html};
$record->($_, 'email address / mailto in body')
for $self->_domains_from_text($combined);
# Run the full intelligence pipeline on each collected domain
my @results;
for my $entry (@domains_with_source) {
my $info = $self->_analyse_domain($entry->{domain});
push @results, { %$entry, %$info };
}
return \@results;
}
# _domains_from_text( $text ) -> list of domain strings
#
# Purpose:
# Extract unique domain names from mailto: links and bare user@domain
# addresses in a block of text.
#
# Entry criteria:
# $text -- a defined scalar of decoded body or header text.
#
# Exit status:
# Returns a list of lower-cased domain strings (possibly empty).
sub _domains_from_text :Private {
my ($self, $text) = @_;
my (%seen, @out);
# mailto: links (including HTML-entity-encoded @ signs from QP)
while ($text =~ /mailto:(?:[^@\s<>"]+)@([\w.-]+)/gi) {
my $dom = lc $1; $dom =~ s/\.$//;
push @out, $dom unless $seen{$dom}++;
}
# Bare user@domain patterns
while ($text =~ /\b[\w.+%-]+@([\w.-]+\.[a-zA-Z]{2,})\b/g) {
my $dom = lc $1; $dom =~ s/\.$//;
push @out, $dom unless $seen{$dom}++;
}
return @out;
}
# _analyse_domain( $domain ) -> hashref
#
# Purpose:
# Run the complete intelligence pipeline for a single domain: A record
# (web hosting), MX record (mail hosting), NS record (DNS hosting),
# and WHOIS (registrar, creation/expiry dates, abuse contact).
# Each IP is enriched via RDAP/WHOIS. Results are cached per domain
# in $self->{_domain_info} and in the CHI cross-message cache.
#
# Entry criteria:
# $domain -- lower-cased, no trailing dot, not in TRUSTED_DOMAINS.
# $self->{timeout} used for all network operations.
#
# Exit status:
# Always returns a hashref reference; never undef; may be empty ({}).
# Possible keys: web_ip, web_org, web_abuse, mx_host, mx_ip, mx_org,
# mx_abuse, ns_host, ns_ip, ns_org, ns_abuse, registrar,
# registrar_abuse, registered, expires, recently_registered, whois_raw.
#
# Side effects:
# Network I/O; writes result to $self->{_domain_info}{$domain} and CHI.
#
# Notes:
# MX/NS lookups require Net::DNS; absent without it.
# recently_registered is set to 1 (not 0) when the threshold is met.
# whois_raw is truncated to WHOIS_RAW_MAX bytes.
sub _analyse_domain :Private {
my ($self, $domain) = @_;
# Return the per-message cached result if already analysed
return $self->{_domain_info}{$domain}
if $self->{_domain_info}{$domain};
# Check the cross-message CHI cache before hitting the network
if ($_cache) {
my $cached = $_cache->get("dom:$domain");
if ($cached) {
lib/Email/Abuse/Investigator.pm view on Meta::CPAN
# _rdap_lookup( $ip ) -> hashref
#
# Purpose:
# Query the ARIN RDAP API for IP block ownership information. RDAP is
# preferred over raw WHOIS because it returns structured JSON.
#
# Entry criteria:
# $ip -- a defined IPv4 or IPv6 address string. RFC 4007 zone
# identifiers (e.g. %eth0 appended to link-local addresses)
# are stripped before validation. The remaining value must
# match dotted-quad IPv4 or bare hex-colon IPv6; malformed
# inputs return {} immediately without a network call.
# LWP::UserAgent must be installed.
#
# Exit status:
# Returns { org, abuse, country } hashref; empty hashref on failure or
# when $ip does not pass format validation.
#
# Security:
# $ip is validated before being interpolated into the RDAP URL path to
# prevent URL path manipulation. Zone IDs are stripped first because
# a literal '%' in the path would corrupt the URL.
sub _rdap_lookup :Protected {
my ($self, $ip) = @_;
return {} unless $HAS_LWP;
my $ua = $self->{ua};
if(!defined($ua)) {
$ua = LWP::UserAgent->new(
timeout => $self->{timeout},
agent => "Email-Abuse-Investigator/$VERSION",
);
if($HAS_CONN_CACHE) {
my $conn_cache = LWP::ConnCache->new();
$conn_cache->total_capacity(10);
$ua->conn_cache($conn_cache);
}
$ua->env_proxy(1);
$self->{ua} = $ua;
}
# Validate and normalise the IP before interpolating into the URL path.
# Strip RFC 4007 IPv6 zone IDs (%eth0 suffix) which would corrupt the URL,
# then assert the result is a valid dotted-quad IPv4 or bare hex IPv6.
(my $safe_ip = $ip) =~ s/%.*\z//;
unless ($safe_ip =~ /\A\d{1,3}(?:\.\d{1,3}){3}\z/
|| $safe_ip =~ /\A[0-9a-fA-F:]+\z/) {
$self->_debug("_rdap_lookup: malformed IP '$ip' -- skipping");
return {};
}
# Use the ARIN RDAP endpoint; it covers the ARIN region and redirects
# for RIPE/APNIC/LACNIC/AfriNIC allocations.
my $res = eval { $ua->get("https://rdap.arin.net/registry/ip/$safe_ip") };
return {} unless $res && $res->is_success();
my $j = $res->decoded_content();
my %info;
# Extract organisation name from the JSON response
if ($j =~ /"name"\s*:\s*"([^"]+)"/) { $info{org} = $1 }
if ($j =~ /"handle"\s*:\s*"([^"]+)"/) { $info{handle} = $1 }
# Extract abuse email from the vcardArray contact block
if ($j =~ /"abuse".*?"email"\s*:\s*"([^"]+)"/s) {
$info{abuse} = $1;
} elsif ($j =~ /"email"\s*:\s*"([^@"]+@[^"]+)"/) {
$info{abuse} = $1;
}
# Country code from the network's country field
if ($j =~ /"country"\s*:\s*"([A-Z]{2})"/) { $info{country} = $1 }
return \%info;
}
# _raw_whois( $query, $server ) -> string | undef
#
# Purpose:
# Open a TCP connection to a WHOIS server on port 43, send the query,
# and return the full response as a string. Uses IO::Select for read
# timeouts so that alarm() is never needed (alarm() is unreliable on
# Windows and in threaded Perl). Supports IPv6 WHOIS servers via
# IO::Socket::IP when that module is available.
#
# Entry criteria:
# $query -- the domain name or IP to query (defined, non-empty after
# stripping control characters; croaks if it becomes empty).
# $server -- the WHOIS server hostname (default: 'whois.iana.org').
# $self->{timeout} -- seconds used for connect and per-read waits.
#
# Exit status:
# Returns the raw WHOIS response string, or undef on connection/write failure.
# Croaks if $query is empty or contains only control characters.
#
# Security:
# All ASCII control characters (C0 range 0x00-0x1F and DEL 0x7F) are
# stripped from $query before it is sent to the socket. This prevents
# WHOIS protocol injection via CRLF sequences that could smuggle a second
# query into the same TCP stream. The guard is enforced at this
# :Protected boundary so subclass callers are also protected.
#
# Notes:
# Uses IO::Socket::IP (dual-stack) when available, falling back to
# IO::Socket::INET (IPv4 only) otherwise. The IO::Select loop reads
# until the server closes the connection or the per-read timeout expires.
sub _raw_whois :Protected {
my ($self, $query, $server) = @_;
$server //= 'whois.iana.org';
# Strip all C0/C1 control characters to prevent WHOIS protocol injection.
# Legitimate domain names and IP addresses never contain CR, LF, NUL, or
# any other control character; their presence indicates either a caller bug
# or hostile input embedded in a malicious email. This guard is placed at
# the :Protected boundary so subclass callers are also protected.
(my $safe_query = $query) =~ s/[\x00-\x1F\x7F]+//g;
lib/Email/Abuse/Investigator.pm view on Meta::CPAN
# -----------------------------------------------------------------------
# _enrich_ip( $ip, $confidence, $note ) -> origin hashref
#
# Purpose:
# Perform rDNS and WHOIS/RDAP for a single IP and package the results
# into the standard origin hashref returned by originating_ip().
#
# Entry criteria:
# $ip -- a defined, non-private IPv4 or IPv6 address string.
# $confidence -- 'high', 'medium', or 'low'.
# $note -- human-readable explanation of why this IP was chosen.
#
# Exit status:
# Returns { ip, rdns, org, abuse, country, confidence, note } hashref.
sub _enrich_ip :Private {
my ($self, $ip, $confidence, $note) = @_;
my $rdns = $self->_reverse_dns($ip);
my $whois = $self->_whois_ip($ip);
return {
ip => $ip,
rdns => $rdns // '(no reverse DNS)',
org => $whois->{org} // '(unknown)',
abuse => $whois->{abuse} // '(unknown)',
country => $whois->{country} // undef,
confidence => $confidence,
note => $note,
};
}
# _header_value( $name ) -> value_string | undef
#
# Purpose:
# Return the value of the first header matching the given lower-cased
# header name.
=head2 header_value( $name )
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 Usage
my $subj = $analyser->header_value('Subject');
my $from = $analyser->header_value('From');
my $msgid = $analyser->header_value('Message-ID');
=head3 Arguments
=over 4
=item C<$name> (string, required)
The header field name, e.g. C<'Subject'>, C<'From'>, C<'X-Mailer'>.
Comparison is case-insensitive.
=back
=head3 Returns
The raw header value string (not decoded), or C<undef> if the named header
is not present. When the same header appears more than once, only the value
of the first occurrence is returned.
=head3 Side Effects
None. Header data is pre-parsed during C<parse_email()>.
=head3 Notes
Header values are returned verbatim, including any MIME encoded-word sequences
(C<=?charset?B/Q?...?=>). Pass the result through C<_decode_mime_words()>
internally if human-readable output is needed.
=head3 API Specification
=head4 Input
{
name => { type => 'string', required => 1 },
}
=head4 Output
{ type => [ 'string', 'undef' ] }
=head3 Messages
None -- returns C<undef> on a missing header, never throws.
=cut
sub header_value {
my $self = shift;
my $params = Params::Validate::Strict::validate_strict({
args => Params::Get::get_params('name', \@_) || {},
schema => {
name => {
'type' => 'string',
'optional' => 0,
}
}
});
return if((!defined($params)) || !defined($params->{name}));
return if ref($params->{name});
return $self->_header_value($params->{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.
#
# Exit status:
# Returns epoch integer on success, undef if the string cannot be parsed.
sub _parse_date_to_epoch :Private {
my ($self, $str) = @_;
return unless $str;
# Clean the string of trailing whitespace/newlines
$str =~ s/^\s+|\s+$//g;
# Guard Regex: Validates the strict YYYY-MM-DDThh:mm:ssZ format
if ($str =~ /^(\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2})(?:\.\d+)?Z$/) {
# Parse the string
# We use 'strptime' to create a Time::Piece object.
# The 'Z' indicates UTC (Zulu time).
my $epoch = eval {
my $t = Time::Piece->strptime($1, '%Y-%m-%dT%H:%M:%S');
# Return seconds since the epoch
# Time::Piece handles the timezone offset internally when calling ->epoch
# strptime returns a local time object.
# We must subtract the local timezone offset to get the true UTC epoch.
return $t->epoch - $t->tzoffset->seconds;
};
return $epoch if defined $epoch;
}
my ($y, $m, $d);
if ($str =~ /^(\d{4})-(\d{2})-(\d{2})/) { ($y,$m,$d)=($1,$2,$3) }
lib/Email/Abuse/Investigator.pm view on Meta::CPAN
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Email-Abuse-Investigator>.
I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
You can find documentation for this module with the perldoc command.
perldoc Email::Abuse::Investigator
You can also look for information at:
=over 4
=item * MetaCPAN
L<https://metacpan.org/dist/Email-Abuse-Investigator>
=item * RT: CPAN's request tracker
L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Email-Abuse-Investigator>
=item * CPAN Testers' Matrix
L<http://matrix.cpantesters.org/?dist=Email-Abuse-Investigator>
=item * CPAN Testers Dependencies
L<http://deps.cpantesters.org/?module=Email-Abuse-Investigator>
=back
=head1 REQUIRED MODULES
The following modules are mandatory:
Readonly::Values::Months
Socket (core since Perl 5)
IO::Socket::INET (core since Perl 5)
MIME::QuotedPrint (core since Perl 5.8)
MIME::Base64 (core since Perl 5.8)
The following are optional but strongly recommended:
Net::DNS -- enables MX, NS, AAAA record lookups
LWP::UserAgent -- enables RDAP (faster and richer than raw WHOIS)
and following redirect chains for URL shorteners
and cloud-storage redirect cloakers
LWP::ConnCache -- enables HTTP connection reuse (used with LWP::UserAgent)
HTML::LinkExtor -- enables structural HTML link extraction with entity decoding
CHI -- enables cross-message IP/domain result caching
IO::Socket::IP -- enables IPv6 WHOIS connections
Domain::PublicSuffix -- enables accurate eTLD+1 domain normalisation
AnyEvent::DNS -- enables parallel DNS resolution for multiple URL hosts
=head1 LIMITATIONS
=over 4
=item No charset conversion
Body text is stored as raw bytes. Non-ASCII content (UTF-8, Latin-1,
ISO-2022-JP, etc.) is not decoded to Perl's internal Unicode representation.
URL and domain extraction from non-ASCII bodies may miss or misparse content.
Use C<Email::MIME> if full charset support is needed.
=item Hand-rolled MIME parser
The built-in MIME parser handles common cases but is not a conforming
implementation of RFC 2045/2046. It silently drops parts it cannot decode,
does not handle C<message/rfc822> attachments, and does not parse
C<Content-Disposition> filenames. Replace with C<Email::MIME> or
C<MIME::Entity> for production use with untrusted input.
=item IPv4-only CIDR matching for trusted_relays
C<_ip_in_cidr()> and the C<trusted_relays> constructor argument only support
IPv4 CIDR notation. IPv6 trusted relay entries are accepted but silently
never match.
=item WHOIS rate-limiting not handled
C<_raw_whois()> does not retry on rate-limit responses (typically a
"quota exceeded" reply). Under high-volume processing the module will
silently return empty enrichment data for affected IPs and domains.
=item Not thread-safe
The class-level C<$_cache> variable and the optional-module C<$HAS_*> flags
are shared across all threads. Create a separate object per thread and do
not share objects across threads.
=item DMARC policy not fetched
The module reads the C<Authentication-Results: dmarc=> result from the
message headers but does not perform live C<_dmarc.domain> TXT record
lookups. A missing DMARC result in the headers is not independently flagged.
=item C<abuse_contacts()> routes duplicated in C<form_contacts()>
Both methods iterate the same six discovery routes independently. Any new
discovery route must be added to both. A future refactor should share a
single routing pass.
=item CHI cache is a class-level mutable global
The cross-message cache is shared across all instances in the process.
Tests that populate the cache will affect subsequent tests. Pass the cache
in via C<new()> (not currently supported) to enable proper isolation.
=back
=encoding utf-8
=head1 FORMAL SPECIFICATION
=head2 new
-- Z notation (simplified)
new == [
timeout : N;
trusted_relays : seq STRING;
verbose : BOOL;
( run in 1.243 second using v1.01-cache-2.11-cpan-9169edd2b0e )