view release on metacpan or  search on metacpan

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

			($info{abuse} = $1) =~ s/\s+$//;
		}
	}
	return \%info;
}

# _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.