whois(ish) REST for netdot

whois

<%doc>

whois(ish) REST for netdot

Fetch contact information for a given IP address
if ip not found, then closest covering netblock contacts are returned
if direct contacts not found,then parent contacts are returned

install == copy this next to other REST scripts 
(/usr/local/netdot/htdocs/rest/whois)

hillar[ät]aarelaid.net 
Oct 4 2013
ver 0.0.1

</%doc>

<%args>
$user
$manager
$ip       => undef
</%args>

<%init>
use Netdot::REST;
my $rest = Netdot::REST->new(user=>$user, manager=>$manager);
$rest->request($r);
use Apache2::Const -compile => qw(HTTP_UNAUTHORIZED OK NOT_FOUND 
                                  HTTP_BAD_REQUEST HTTP_NOT_ACCEPTABLE);

# Get relevant HTTP headers from request object
my $headers = $rest->{request}->headers_in;

my $logger = Netdot->log->get_logger("Netdot::REST");
$logger->info(sprintf("/rest/whois: %s request with args: %s from %s (%s)", 
                      $rest->{request}->method, 
                      $rest->{request}->args,
                      $rest->{request}->connection->remote_ip, 
                      $headers->{'User-Agent'}
              ));

my %res;
</%init>

<%perl>

if ( $ip ){
  # look for ip 
    my $ipb = Ipblock->search(address=>$ip)->first;
    unless ( $ipb ) {
    	# ip not found, look for closest covering netblock
		$ipb = Ipblock->get_covering_block(address=>$ip);
		unless ( $ipb ) {
			# not found, return no xml only HTTP header 
			Netdot->throw_rest(code=>Apache2::Const::NOT_FOUND, msg=>"$ip not found"); 
		} else {
			$res{match} = 'closest covering block';
			$res{route} = $ipb->get_label; 
		}

    } else {
    	$res{match} = 'direct';
    	$res{route} = $ipb->parent->get_label if $ipb->parent; 
    }
    # is it viewable for current user
    unless ( $manager->can($user, 'view', $ipb) ){
    	$logger->info(sprintf("/rest/whois: user %s not allowed to view ip %s", $user->getUsername(), $ip));
		$rest->throw(code=>Apache2::Const::HTTP_FORBIDDEN, 
		     msg=>"User not allowed to view this IP");
    }

	my %clists;
    # grab usedby and owner id's
    if ( $ipb->used_by && (my $cl = $ipb->used_by->contactlist) ){
		$clists{$cl->id} = $cl;
		$res{used_by} = $ipb->used_by->get_label;
		$res{user_contact_type} = 'direct';
    }     else {
    	#try parent
    	if ( $ipb->parent && $ipb->parent->used_by && (my $cl = $ipb->parent->used_by->contactlist) ){
		$clists{$cl->id} = $cl;
		$res{used_by} = $ipb->parent->used_by->get_label;
		$res{user_contact_type} = 'parent covering block';
    	}
    }
    if ( $ipb->owner && (my $cl = $ipb->owner->contactlist) ){
		$clists{$cl->id} = $cl;
		$res{owned_by} = $ipb->owner->get_label;
		$res{owner_contact_type} = 'direct';

    } else {
    	#try parent
    	if ( $ipb->parent && $ipb->parent->owner && (my $cl = $ipb->parent->owner->contactlist) ){
			$clists{$cl->id} = $cl;
			$res{owned_by} = $ipb->parent->owner->get_label;
			$res{owner_contact_type} = 'parent covering block';
    	} 
    }
	unless ( %clists ) {
			$logger->info(sprintf("/rest/whois: ip %s has no contacts", $ip));
			# no contacts found, return no xml only HTTP header 
			Netdot->throw_rest(code=>Apache2::Const::NOT_FOUND, msg=>"$ip has no contacts"); 
	}
    # get contact's out of contact lists 
    foreach my $cl ( values %clists ){
		$res{contact_list}{$cl->id}{name} = $cl->name;
		foreach my $con ( $cl->contacts ){
		    my $person = $con->person;
		    foreach my $key ( qw(lastname firstname aliases position email 
                                         office cell home pager ) ){
			$res{contact_list}{$cl->id}{contacts}{$con->id}{$key} = $person->$key;
		    }
		    $res{contact_list}{$cl->id}{contacts}{$con->id}{type} = $con->contacttype->name;
		    $res{contact_list}{$cl->id}{contacts}{$con->id}{employer} = $person->entity->name if $person->entity;
		}
    }
}

$m->clear_buffer;
$rest->print_formatted(\%res) if %res;

</%perl>