view release on metacpan or  search on metacpan

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

  Input: Array of IP addresses
  Output: Hash of Prefixes

=cut
sub expandWhois{

  ## get the list of prefixes to expand
  my @prefixes = @_;

  my %return_set;
  my @ranges;

  ## perform the expansion for each prefix
  foreach my $p (@prefixes){

    ## if it is formatted as /32 or /128 remove it
    if($p =~ /\/(\d+)/){
      if($1 == 32 || $1 == 128){
        $p =~ s/\/(\d+)//;
      }
    }
    my $version;
    if(ip_is_ipv4($p)){
      $version = 4;
    }elsif(ip_is_ipv6($p)){
      $version = 6;
    }else{
      $return_set{$p}{'msg'} = 'Unable to verify as IPv4 or v6';
      next;
    }

    ## 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;
          }
        }
        
      }
    }
  ## get the data about the organization out of the original structure
  }else{
    $org_info{'source'} = 'ARIN';
    $org_info{'netname'} = $res_struct->{'net'}->{'name'}->{'$'};
    $org_info{'orgname'} = $res_struct->{'net'}->{'orgRef'}->{'@name'};
    $org_info{'orghandle'} = $res_struct->{'net'}->{'orgRef'}->{'@handle'};
    $org_info{'inetnum'} = $res_struct->{'net'}->{'startAddress'}->{'$'} .
                           "-" . $res_struct->{'net'}->{'endAddress'}->{'$'} ;

  }
  return %org_info;
}

=head2 inetnum2prefixes

This subroutine expands an inetnum into a list of prefixes that cover the space.

Input: inetnum
Output: array of prefixes

=cut
sub inetnum2prefixes{

  my $inetnum = shift;
  my ($start,$end) = split /-/,$inetnum;
  my @prefixes;
  $start =~ s/\s*//g;
  $end =~ s/\s*//g;

  my $version = 0;
  if(ip_is_ipv4($start) && ip_is_ipv4($end)){
    $version = 4;
  }elsif(ip_is_ipv6($start) && ip_is_ipv6($end)){
    $version = 6;
  }else{
    return @prefixes;
  }
  my $sbin = ip_iptobin($start,$version);
  my $ebin = ip_iptobin($end,$version);
  if(!defined($sbin) || !defined($ebin)){
    return @prefixes;
  }
  return ip_range_to_prefix($sbin,$ebin,$version);
}

=head2 netname2prefixes

This subroutine expands a netname to a list of prefixes

Input: source and netname
Output: array of prefixes

=cut
sub netname2prefixes{
  my $source = shift;