view release on metacpan or  search on metacpan

lib/BGPmon/CPM/Prefix/Finder.pm  view on Meta::CPAN

    }

    ## figure out if we have expanded a previous prefix that covers this one.
    ## don't do the same range twice
    my $covered = 0;
    my $elligible = 1;
    foreach my $range (@ranges){
      my ($r,$l) = split('/',$range);
      my ($start,$end) = ip_prefix_to_range($r,$l,$version);
      my $binp = ip_iptobin($p,$version);
      my $bstart = ip_iptobin($start,$version);
      my $bend = ip_iptobin($end,$version);
      if(ip_bincomp($binp,'le',$bend) && ip_bincomp($binp,'ge',$bstart)){
        $covered = $range;
        $elligible = 0;
        last;
      }
    }

    my %ipExpanded;
    ## elligible for expansion
    if(!$covered && $elligible){
      %ipExpanded = BGPmon::CPM::Prefix::Finder::expandIP($p);
      if( $ipExpanded{'error'} ){
        $ipExpanded{'msg'} = $ipExpanded{'error'};
        $return_set{$p} = \%ipExpanded;
        next;
      }
      if( defined($ipExpanded{'orghandle'}) 
            && $ipExpanded{'orghandle'} !~ /UNKNOWN/){
        $ipExpanded{'orgid'} = $ipExpanded{'orghandle'};
        my @nets = BGPmon::CPM::Prefix::Finder::orghandle2nets(
                                                      $ipExpanded{'orghandle'});
        my @new_prefixes;
        foreach my $net (@nets){
          push @new_prefixes,
               BGPmon::CPM::Prefix::Finder::inetnum2prefixes($net);
        }
        $ipExpanded{'nets'} = \@new_prefixes;
        push @ranges,@new_prefixes;
        $ipExpanded{'msg'} = "whois $p ($ipExpanded{'orghandle'})";
      }

      my @new_ranges = BGPmon::CPM::Prefix::Finder::inetnum2prefixes(
                                                        $ipExpanded{'inetnum'});
      push @ranges,@new_ranges;
      $ipExpanded{'range'} = \@new_ranges;
    }elsif($covered){
      $ipExpanded{'msg'} = "$p is covered by $covered";
    }else{
      $ipExpanded{'msg'} = "$p is not elligible for expansion";
    }
    $return_set{$p} = \%ipExpanded;
  }
  return %return_set;
}


=head2 expandIP

This subroutine looks into the whois databases and 
Input: ip address
Output: a hash with as many of the following keys as possible
"netname","inetnum","descr","country","orgid","source","netname",
"orgname","orghandle"

=cut
sub expandIP{

  my $ip = shift;
  my %org_info;

  ## step 1: query arin to find the organization (this may be under 
  ##         netname or ??)
  my $ua = LWP::UserAgent->new;
  my $res = $ua->get("http://whois.arin.net/rest/ip/$ip.json",
                     "Content_Type"=>"application/json");
  my $res_struct = decode_json($res->content);
  my $org_handle =  $res_struct->{'net'}->{'orgRef'}->{'@handle'};
  if(!defined($org_handle)){
    $org_handle = "";
    $org_info{'source'} = 'UNKNOWN';
    $org_info{'netname'} = $res_struct->{'net'}->{'name'}->{'$'};
    $org_info{'orgname'} = 'UNKNOWN'; 
    $org_info{'orghandle'} = 'UNKNOWN'; 
    $org_info{'inetnum'} = $res_struct->{'net'}->{'startAddress'}->{'$'} .
                           "-" . $res_struct->{'net'}->{'endAddress'}->{'$'} ;
  }elsif($org_handle =~ /APNIC|AFRINIC|LACNIC|RIPE/ ){
  ## if we have been referred to another RIR search RIPE
  #if(grep /$org_handle/, ("APNIC","AFRINIC","LACNIC","RIPE" )){
    $res = $ua->get("http://apps.db.ripe.net/whois/search?query-string=$ip".
                    "&source=$org_handle&flags=Crl",
                    'Accept'=>'application/json');
    if(!$res->is_success){
      $org_info{'source'} = $org_handle;
      $org_info{'error'} = "whois lookup failed"; 
    }else{
      $res_struct = decode_json($res->content);

      my @attributes;
      if($res_struct->{'whois-resources'}->{'objects'}->{'object'} =~ /HASH/){
        @attributes = @{$res_struct->{'whois-resources'}->{'objects'}->
                        {'object'}->{'attributes'}->{'attribute'}};
      }elsif($res_struct->{'whois-resources'}->{'objects'}->{'object'}
             =~/ARRAY/){
        foreach my $obj(
              @{$res_struct->{'whois-resources'}->{'objects'}->{'object'}}){
          push @attributes, @{$obj->{'attributes'}->{'attribute'}};
        }
      }
      foreach my $att (@attributes){
        if(grep /$att->{'name'}/, 
              ("netname","inetnum","descr","source","country")){
          $org_info{$att->{'name'}} = $att->{'value'};
        }    
        if(grep /$att->{'name'}/, ("remarks")){
          if($att->{'value'} =~ /org-id:\s*(\S+)/){
            $org_info{'orgid'} = $1;
          }
        }