Email-Abuse-Investigator

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

    _domain_whois, _raw_whois, _provider_abuse_for_host,
    _provider_abuse_for_ip, _registrable, _header_value, _parse_date_to_epoch,
    and _parse_rfc2822_date.

  - Fixed Perl::Critic severity-3 findings: converted all `unless` with
    comparison operators to negated `if`; moved capture variables inside
    their conditionals in _rdap_lookup, _parse_auth_results, and
    _parse_whois_text; replaced multi-statement map block with a for loop.

  - Removed two hard-tab characters introduced in earlier edits (Object::Configure
    overlay comment on line ~643; logger condition in _debug).

0.09	Fri May 15 08:24:33 EDT 2026

  [Bug Fixes]

  - Fixed t/function.t section 28 (_analyse_domain) failing after
    2026-05-14: the WHOIS stub used hardcoded creation and expiry dates
    (2025-11-15 and 2026-11-15) that fell outside the 180-day
    recently_registered window and caused the registered/expiry
    assertions to fail.  Replaced with dynamic dates computed at

Changes  view on Meta::CPAN

    characters (0x01-0x08, 0x0B, 0x0C, 0x0E-0x1F) and DEL (0x7F) from
    any user-derived string before it is written to report() or
    abuse_report_text() output.  Tabs, LF, and CR are preserved.  High
    bytes (0x80-0xFF) are preserved for UTF-8 content.  Applied to all
    user-derived fields: IP info, organisation names, registrar names,
    flag detail strings, and header values.

  - Added Object::Configure integration to new().  The constructor now
    calls Object::Configure::configure($class, $params) after parameter
    validation, allowing per-class defaults to be loaded from a
    configuration file.  The returned hashref overlays the caller-supplied
    parameters before the object is blessed.

  - Added new Readonly constants: $MAX_MULTIPART_DEPTH (20),
    $CACHE_TTL_SECS (3600), $DEFAULT_TIMEOUT (10), $WHOIS_PORT (43),
    $WHOIS_READ_CHUNK (4096), $WHOIS_RAW_MAX (2048), $RECENT_REG_DAYS
    (180), $EXPIRY_WARN_DAYS (30), $SECS_PER_DAY (86400),
    $DATE_SKEW_DAYS (7), $TZ_MAX_POS_MINS (840), $TZ_MAX_NEG_MINS (720),
    $SCORE_HIGH (9), $SCORE_MEDIUM (5), $SCORE_LOW (2), %FLAG_WEIGHT,
    $ROLE_MAX_LEN (80), $ROLE_WRAP_LEN (66).  All previously magic
    numbers have been removed from the code body.

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

	qr/\[\s*([0-9a-fA-F:]+)\s*\]/,                  # [IPv6 address]
	qr/\(\s*[\w.-]*\s*\[?\s*([\d.]+)\s*\]?\s*\)/,   # (hostname [1.2.3.4])
	qr/from\s+[\w.-]+\s+([\d.]+)/,                  # from hostname addr
	qr/([\d]{1,3}\.[\d]{1,3}\.[\d]{1,3}\.[\d]{1,3})/, # bare dotted-quad fallback
);

# -----------------------------------------------------------------------
# Default configuration -- overridable via Object::Configure
# -----------------------------------------------------------------------

# Object::Configure may overlay
# values from a file before new() uses them.  Use Readonly for constants
# that should never be overridden at runtime.

# -----------------------------------------------------------------------
# Trusted domains (infrastructure -- never report these as abuse targets)
# Can be overrideen at runtime by Object::Configure
# -----------------------------------------------------------------------

my %TRUSTED_DOMAINS = map { $_ => 1 } qw(
	gmail.com googlemail.com yahoo.com outlook.com hotmail.com

t/integration.t  view on Meta::CPAN

	is $@, '', 'public methods work after deeply nested parse';
	ok defined $risk, 'risk_assessment() returns a defined value';

	restore_stubs();
};

# ---------------------------------------------------------------------------
# Scenario 26 — Object::Configure integration
#
# new() calls Object::Configure::configure($class, $params) and applies any
# values it returns as overlays.  These tests stub configure() to confirm the
# call is made with the correct arguments and that overlaid values take effect.
# ---------------------------------------------------------------------------
subtest 'Scenario 26a: Object::Configure — configure() called with correct args' => sub {
	restore_stubs();

	my @calls;
	{
		no warnings 'redefine';
		local *Object::Configure::configure = sub {
			push @calls, { class => $_[0], params => $_[1] };

t/integration.t  view on Meta::CPAN

			return $_[1];
		};
		my $a = Email::Abuse::Investigator->new(timeout => 7);
		ok scalar @calls > 0, 'Object::Configure::configure() called during new()';
		is $calls[0]{class}, 'Email::Abuse::Investigator',
			'configure() receives correct class name';
		is ref($calls[0]{params}), 'HASH', 'configure() receives hashref';
	}
};

subtest 'new() — Object::Configure overlay takes effect' => sub {
	{
		no warnings 'redefine';
		local *Object::Configure::configure = sub {
			return { %{ $_[1] }, timeout => 42, verbose => 1 };
		};
		my $a = Email::Abuse::Investigator->new();
		is $a->{timeout}, 42, 'configure() overlay applied to timeout';
		is $a->{verbose},  1, 'configure() overlay applied to verbose';
	}
};


# ---------------------------------------------------------------------------
# Scenario 27 — CHI cross-message cache: WHOIS not repeated across objects
#
# When CHI is installed, the second object analysing the same IP should hit
# the class-level cache and not repeat the WHOIS lookup.
# ---------------------------------------------------------------------------

t/unit.t  view on Meta::CPAN

		  return $_[1];
	 };
	 Email::Abuse::Investigator->new(timeout => 7);
	 ok scalar @calls > 0, 'Object::Configure::configure() called during new()';
	 is $calls[0]{class}, 'Email::Abuse::Investigator',
		  'configure() receives correct class name';
	 is ref($calls[0]{params}), 'HASH', 'configure() receives hashref';
	 }
};

subtest 'new() — Object::Configure overlay takes effect' => sub {
	 {
	 no warnings 'redefine';
	 local *Object::Configure::configure = sub {
		  return { %{ $_[1] }, timeout => 42, verbose => 1 };
	 };
	 my $a = Email::Abuse::Investigator->new();
	 is $a->{timeout}, 42, 'configure() overlay applied to timeout';
	 is $a->{verbose},  1, 'configure() overlay applied to verbose';
	 }
};

# _sanitise_output contract
subtest '_sanitise_output() — strips C0 controls, preserves printable' => sub {
	 my $fn = \&Email::Abuse::Investigator::_sanitise_output;
	 ok defined &Email::Abuse::Investigator::_sanitise_output,
	 '_sanitise_output is defined as a package function';
	 is $fn->('Hello, World!'), 'Hello, World!', 'printable ASCII unchanged';
	 is $fn->(undef), '',				 'undef returns empty string';