#!/usr/bin/perl -w use strict; use JSON; use LWP::UserAgent; use Socket; die unless($ENV{HOME}); my $cachedir="$ENV{HOME}/.ipinfo.cache"; my $nodns=0; $nodns=shift @ARGV if(@ARGV and "-w" eq $ARGV[0]); die "usage: $0 [-w] \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=; close(JSON) or die; } else { 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-bootstrap.arin.net/bootstrap/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; # · $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/\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;