view release on metacpan or  search on metacpan

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

# Entry criteria:
#   $domain -- a registrable domain name string.
#
# Exit status:
#   Returns { org, abuse } hashref; empty hashref on failure.

sub _parse_domain_whois_abuse :Private {
	my ($self, $domain) = @_;
	my $raw = $self->_domain_whois($domain) // return {};
	my %info;
	if ($raw =~ /Registrar:\s*(.+)/i) {
		($info{org} = $1) =~ s/\s+$//;
	}
	# Try multiple field name patterns for the abuse email
	for my $pat (
		qr/Registrar Abuse Contact Email:\s*(\S+\@\S+)/i,
		qr/Abuse Contact Email:\s*(\S+\@\S+)/i,
		qr/abuse-contact:\s*(\S+\@\S+)/i,
	) {
		if (!$info{abuse} && $raw =~ $pat) {
			($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.
#   LWP::UserAgent must be installed.
#
# Exit status:
#   Returns { org, abuse, country } hashref; empty hashref on failure.

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;
	}

	# 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/$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).
#   $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.
#
# 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';
	$self->_debug("WHOIS $server -> $query");

	# Choose the socket class based on what is installed.
	# IO::Socket::IP supports both IPv4 and IPv6 WHOIS servers.
	my $sock_class = $HAS_IO_SOCKET_IP ? 'IO::Socket::IP' : 'IO::Socket::INET';

	# Attempt TCP connection to port 43 on the WHOIS server
	my $sock = eval {
		$sock_class->new(
			PeerAddr => $server,
			PeerPort => $WHOIS_PORT,