#!/usr/bin/perl -w
use strict;
use JSON;
use LWP::UserAgent;
use Socket;
die unless($ENV{HOME});
my $cachedir="$ENV{HOME}/.ipinfo.cache";

my $waitifwhois=0;
$waitifwhois=shift @ARGV if(@ARGV and "-W" eq $ARGV[0]);
my $nodns=0;
$nodns=shift @ARGV if(@ARGV and "-w" eq $ARGV[0]);
die "usage: $0 [-W] [-w] <ip>\n" unless(1==@ARGV and $ARGV[0] =~ /^\d+\.\d+\.\d+\.\d+$/s);
my ($ip)=@ARGV;

unless($nodns) {
	die unless($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/s);
	my $raw=pack("C4",$1,$2,$3,$4);
	my $name=gethostbyaddr($raw,AF_INET);
	if(defined($name)) {
		print "$ip\t$name\n";
		exit 0;
	}
}

my $json;
mkdir($cachedir) or die unless(-d $cachedir);
if(-f "$cachedir/$ip.json") {
	open(JSON,"<","$cachedir/$ip.json") or die "open: $!";
	local $/=undef;
	$json=<JSON>;
	close(JSON) or die;
} else {
	if($waitifwhois) {
		print STDERR "Waiting on request for $ip";
		sleep(10);
		print STDERR "\n";
	}
	my $ua=LWP::UserAgent->new();
	$ua->agent("Whois Retriever v1");
# ARIN stupidly requires TLSv1.2:
	$ua->ssl_opts('SSL_version'=>'TLSv1_2');
	$ua->ssl_opts('SSL_verify_mode'=>0);
	my $req=HTTP::Request->new("GET"=>"https://rdap.arin.net/registry/ip/$ip");
	my $res=$ua->request($req);
	unless($res->is_success) {
		if("500 Can't connect to " eq substr($res->status_line,0,21)) {
# Compensate for some registrars' idiotic requirement for TLS 1.3:
			$json=`wget -qO - --no-check-certificate https://rdap-bootstrap.arin.net/bootstrap/ip/$ip`;
			goto COMPENSATED;
		}
		die $res->status_line;
	}
	$json=$res->content;
COMPENSATED:
	die unless($json);
	open(JSON,">","$cachedir/$ip.json") or die "open: $!";
	print JSON $json or die;
	close(JSON) or die;
}
my $obj=decode_json($json);
#print "handle: $$obj{handle}\n";
my $name=$$obj{name};
if(not defined($name) or $name =~ /^[-0-9A-Z]+$/s) {
	if($$obj{entities}) {
		foreach my $entity (grep {$$_{vcardArray}} @{$$obj{entities}}) {
			my @dumbarray=@{$$entity{vcardArray}};
			die unless(2==@dumbarray and "vcard" eq $dumbarray[0]);
			my %vcard=map {($$_[0],$$_[3])} @{$dumbarray[1]};
			$name=$vcard{fn};
			last;
		}
	}
}
unless(defined($name)) {
	die "can't figure out name for $ip";
}
# JSON.pm stupidly changes charsets away from Unicode, so we have to hard-code this one:
$name =~ s/ \xAD / - /gs; # why are they using a soft hyphen with spaces around it in 45.70.166.124?
$name =~ s/\xB7/*/gs; # &middot;
$name =~ s/\xC1/A/gs;
$name =~ s/\xC2/A/gs;
$name =~ s/\xC3/A/gs;
$name =~ s/\xC7/C/gs;
$name =~ s/\xC9/E/gs;
$name =~ s/\xCD/I/gs;
$name =~ s/\xD4/O/gs;
$name =~ s/\xD5/O/gs;
$name =~ s/\xDA/U/gs;
$name =~ s/\xE1/a/gs;
$name =~ s/\xE3/a/gs;
$name =~ s/\xE7/c/gs;
$name =~ s/\xE9/e/gs;
$name =~ s/\xF1/n/gs;
# And these are in some unspecified 1-byte charset so we just have to hard-code them as well:
$name =~ s/\xD1/N/gs;
$name =~ s/\xD3/O/gs;
$name =~ s/\xEA/e/gs;
$name =~ s/\xED/i/gs;
$name =~ s/\xF3/o/gs;
$name =~ s/\xF5/o/gs;
$name =~ s/\xFA/u/gs;
$name =~ s/\x{9F19}/{9F19}/gs; # found in 122.146.84.192
die "invalid character in name for $ip: ".unpack("C",$1) if($name =~ /([^ -~])/s);
my $net;
if($$obj{cidr0_cidrs} and not (1==@{$$obj{cidr0_cidrs}} and -1==$$obj{cidr0_cidrs}[0]{length})) {
	$net=join(",",map {"$$_{v4prefix}/$$_{length}"} @{$$obj{cidr0_cidrs}});
} elsif($$obj{startAddress} and $$obj{endAddress}) {
	die "invalid startAddress for $ip" unless($$obj{startAddress} =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/s);
	my $start=unpack("N",pack("C4",$1,$2,$3,$4));
	die "invalid endAddress for $ip" unless($$obj{endAddress} =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/s);
	my $end=unpack("N",pack("C4",$1,$2,$3,$4));
# Check if it's a CIDR
	my $mask=$start^$end;
	if(0==($mask&($mask+1)) and 0==($start&$mask) and $mask==($end&$mask)) {
		my $size=32;
		while($mask) {$mask>>=1;$size--;}
		$net="$$obj{startAddress}/$size";
		if(32==$size) {
			if($$obj{parentHandle} and $$obj{parentHandle} =~ /^\d+\.\d+\.\d+\.\d+\/(\d+)$/s and $1<32) {
				$net=$$obj{parentHandle};
			} elsif($$obj{parentHandle} and $$obj{parentHandle} =~ /^(\d+\.\d+\.\d+)\.0 - \1\.255$/s) {
				$net="$1.0/24";
			} elsif($$obj{parentHandle} and $$obj{parentHandle} =~ /^(\d+\.\d+)\.(\d+)\.0 - \1\.(\d+)\.255$/s) {
				my ($a,$b,$c)=($1,$2,$3);
				my $span=$c-$b+1;
				die $net if($span&($span-1)); # Make sure it's a power of 2
				die $net if($b&($span-1)); # Make sure it's aligned
				my $size=24;
				while(1<$span) {
					$size--;
					$span>>=1;
				}
				$net="$a.$b.0/$size";
			} else {
				die $net;
			}
		}
	} else {
		$net="$$obj{startAddress}-$$obj{endAddress}";
	}
} else {
	die "can't figure out network for $ip";
}
die "no listed netmask for $ip" if("0.0.0.0/0" eq $net);
print "$net\t$name\n";
0;
