#!/usr/bin/perl -w

# contact.pl - Find site contact from IP
# Copyright 2001, Dan Pelleg, daniel+hunch@pelleg.org
#
# Released under the BSD license
#
# Use: $0 IP
#

use strict;
use Getopt::Std;
use Socket;

# some debug directives
my($debug_level, 
   $D_CONNECT, $D_PARSE, $D_PARSE2, $D_LOOKUP, $D_STATES, $D_EXTRA)
  = (0, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20);

$debug_level = $D_CONNECT | $D_LOOKUP;

my %opts;

getopts('d:w', \%opts);

$debug_level = $opts{d} if(defined($opts{d}));

my $whois_cmd_mode = 'NORMAL';
if(exists($opts{w})) {
  dbg_print($D_CONNECT, "Using old-style whois command");
  $whois_cmd_mode = 'OLD';
}

my $attacker = shift(@ARGV) or die "Usage: $0 [-d debug-level] [-w] IP";

if($attacker !~ /^[.\d]+$/) {   # not a numeric argument - convert to one
  my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($attacker);
  if(@addrs) {
    $attacker = inet_ntoa($addrs[0]);
  } else {
    print "Cannot find IP for host $attacker\n";
    exit(1);
  }
}

my $contact_email = &find_contact($attacker);
if($contact_email) {
  print "$contact_email\n";
} else {
  print "Could not find contact email\n";
}

sub find_contact {

  my $ip = shift(@_) or die;
  my ($second_lookup_server, $second_lookup_handle) =
      arin_lookup_nonrecursive($ip);

  my ($next_lookup_server, $next_lookup_handle) = ($second_lookup_server, $second_lookup_handle);

  my $nlookups = 0;

  while(defined($next_lookup_server)) {   # if another lookup is needed, go do it
    ($next_lookup_server, $next_lookup_handle) = 
        find_contact_secondary($next_lookup_server, $next_lookup_handle);
    last if($nlookups++ > 3);
  }

  # return no appropriate handle, or original one if none found
  return $next_lookup_server ? $second_lookup_handle : $next_lookup_handle;
}

sub find_contact_secondary {
  my ($db, $orig_handle) = @_;
  my $contact_handle;
  # map db to whois server
  my %whois_srvs = (
                    'RIPE' => 'whois.ripe.net',
                    'APNIC' => 'whois.apnic.net',
                    'KRNIC' => 'whois.krnic.net',
                    'VERIO' => 'rwhois.verio.net',
                    'BR' => 'whois.nic.br',
                    'LACNIC' => 'whois.lacnic.net',
                   );

  if($db eq 'ARIN') {
    return arin_lookup_nonrecursive($orig_handle);
  }

  my $whois_server = $whois_srvs{$db} or die("Can't find DB: $db");

  my $next_lookup_server;

  my @contacts;                 # list of refs to hashes, each a possible contact
  my $contact;                  # contact to look for

  # contact WHOIS for reverse lookup
  dbg_print($D_CONNECT, "Connecting to $whois_server, handle $orig_handle");
  open(WHOIS, whois_cmd($whois_server, $orig_handle)) or die ("Can't run whois");
  my %attr;                     # stores key/value pairs
  my $state = 'begin';
  my $locate;                   # handle to look for


  # set the handle to look for
  my $handle_key='nic-hdl';

  if($db eq 'BR') {             # special case
    $handle_key='nic-hdl-br';
  }


  while(<WHOIS>) {
    chop;
    dbg_print($D_PARSE, $_);
    next if($state eq 'begin' && /^\[.*\]$/); # server name shown in some whois clients' output
    if(/(^%)|(^\# English)/i) {                  # comment line
      if($state eq 'begin') {
        $state = 'saw_comment';
        dbg_print($D_STATES, "state -> $state");
      }
      next;
    }
    if(/^\s*$/) {               # empty line
      if($state eq 'saw_comment') { # first empty line - preamble is over
        $state = 'search';        # start reading
        dbg_print($D_STATES, "state -> $state");
        next;
      }
      if($state eq 'search') {  # first "real" paragraph seen
        $state = 'locate';      # find a handle for a contact
        dbg_print($D_STATES, "state -> $state");
        $contact = $attr{'tech-c'} or die("No tech-c record!"); # find tech contact's handle
        dbg_print($D_LOOKUP, "in search of " . join(',', split("\n", $contact)));
      } else {                  # we're in the locate state
        if(defined($attr{$handle_key})) {        # is this someone we're looking for?
          if(grep(/^$attr{$handle_key}$/, split("\n", $contact))) {
            # yes! store in list of possible contacts
            dbg_print($D_LOOKUP, "found details for $attr{$handle_key}");
            push(@contacts, { %attr } );
          }
        }
        %attr = ();             # empty  the attribute list
      }
      next;
    }
    # an informative line
    if(/refer to the (\w+) Whois (DB|Database)/i) {
      $next_lookup_server = $1;
      dbg_print($D_LOOKUP, "need a secondary lookup: $next_lookup_server");
      next;
    }
    if(/at whois.registro.br and at http:\/\/whois.nic.br/i) {
      $next_lookup_server = "BR";
      dbg_print($D_LOOKUP, "need a secondary lookup: $next_lookup_server");
      next;
    }
    if(/^\[ Technical Contact Information \]\s*$/i) {
      dbg_print($D_PARSE2, "special hack for tech contact");
      $attr{'nic-hdl'} = "$db-special-tech-c";
      next;
    }

    if(/^\s*(\w+([\- ]\w+)*)\s*:\s*(.*)/) { # parse key/value
      my ($key, $val) = (lc($1), $3);
      dbg_print($D_PARSE2, "got $key=$val");
      if(defined($attr{$key})) { # append if something already defined (multi-line/multi-value field)
        $attr{$key} .= "\n$val";
      } else {
        $attr{$key} = "$val";
      }
      if($db eq 'KRNIC' && $key =~ /(IP Address)|(Technical Contact Information )/i) {
        dbg_print($D_PARSE2, "special hack for org info");
        $attr{'tech-c'} = "$db-special-tech-c";
        next;
      }
    } else {
      # list of weird lines that can be ignored
      next if($state ne 'locate'); # not in mode that requires to understand the lines
      next if($db eq 'KRNIC' && /^\[ /); # KRNIC paragraph headers
      warn("cannot parse line $_");
    }
  }
  close(WHOIS);

  # enumerate contacts
  for my $cont (@contacts) {
    next unless(defined($cont->{'e-mail'}));
    my $sanitized_contact = (split(' ', $cont->{'e-mail'}))[0];
    dbg_print($D_LOOKUP, "possible contact: $sanitized_contact");
    if(!defined($contact_handle)) {        # first contact we have? use it
      $contact_handle = $sanitized_contact;
      dbg_print($D_LOOKUP, "using first hit $contact_handle");
    } else {
      # decide if to use previous contact or current one
      # try to see if security/abuse keywords appear anywhere for this contact
      my $prefer_current = 0;
      $prefer_current = 1 if(defined($cont->{'person'}) && ($cont->{'person'} =~ /(security)|(abuse)/i));
      $prefer_current = 1 if(defined($cont->{'e-mail'}) && ($cont->{'e-mail'} =~ /(security)|(abuse)/i));
      if($prefer_current) {
        dbg_print($D_LOOKUP, "Preferring " . $cont->{'e-mail'} . " over $contact_handle (keyword)");
        $contact_handle = $cont->{'e-mail'}
      } else {
        dbg_print($D_LOOKUP, "Not liking " . $cont->{'e-mail'} . ", keeping $contact_handle");
      }
    }
  }

  return $next_lookup_server ? ($next_lookup_server, $orig_handle) : (undef, $contact_handle);
}

sub arin_lookup_nonrecursive {
  my $handle = shift(@_);
  my $second_lookup_server;  # undefined if not needed

  my $found_handle;

  my $possible_handle;
  my $possible_email;
  my $comment = "";

  # contact ARIN for reverse lookup
  dbg_print($D_CONNECT, "Connecting to ARIN, handle $handle");
  open(ARIN, whois_cmd('whois.arin.net', $handle)) or die ("Can't run whois");
  my $state = 'search';
  while(<ARIN>) {
    chop;
    dbg_print($D_PARSE, $_);
    if($state eq 'saw_coord') { # should have email in this line
      if(/\s+([\w\-\.\+]+)\@(\w[\w\-\.]*)\s*$/) {
        $possible_email = "$1\@$2";
        dbg_print($D_PARSE, "found possible email $possible_email");
        $state = 'done';
        next;
      }
    }
    if(/^\s*Coordinator:\s*$/) { # expect email in next line
      $state = 'saw_coord';
      dbg_print($D_STATES, "state -> $state");
      next;
    }
    if(/^\s*OrgAbuseEmail:\s*([\w\-\.\+]+)\@(\w[\w\-\.]*)\s*$/) { # OrgAbuseEmail record
      $possible_email = "$1\@$2";       # overwrite an existing email, if there
      dbg_print($D_PARSE, "found possible email $possible_email");
      $state = 'done';
      next;
    }
    if(/^\s*TechEmail:\s*([\w\-\.\+]+)\@(\w[\w\-\.]*)\s*$/) { # TechEmail record
      if(!defined($possible_email)) { # don't overwrite previous info
        $possible_email = "$1\@$2";
        dbg_print($D_PARSE, "found possible email $possible_email");
        $state = 'done';
      }
      next;
    }

    # collect comment lines
    if(/^comment:\s*(.*)/i) {
      $comment .= " $1";
      next;
    }

    if(/^\s+(.*)/) {
      $comment .= " $1";
      next;
    }

    if(/.*\(([^\)]+)\)/) {        # keep track of stuff in parenthesis (prefer last pair of parens)
      $possible_handle = $1;
      dbg_print($D_LOOKUP, "possible handle: $possible_handle");
    }
  }
  close(ARIN);

  # see if the comment redirects us to another server

  if ($comment =~ /has been transferred to (\w+) for administrative/i) {
    $second_lookup_server = $1;
  }
  if ($comment =~ /found in the (\w+) database/) {
    $second_lookup_server = $1;
  }
  if ($comment =~ /the (\w+) database at whois/) {
    $second_lookup_server = $1;
  }
  if ($comment =~ /has been delegated to (\w+)/) {
    $second_lookup_server = $1;
  }
  if ($comment =~ /refer to the (\w+) Whois Database/i) {
    $second_lookup_server = $1;
  }
  if ($comment =~ /This IP address range is under (\w+) responsibility/i) {
    $second_lookup_server = $1;
  }
  if ($comment =~ /^Korea Telecom/i) {
    $second_lookup_server = 'KRNIC';
  }
  if ($comment =~ /^Comite Gestor da Internet no Brasil/i) {
    $second_lookup_server = 'BR';
  }
  if ($comment =~ /^\s*Asia Pacific Network Information Centre\s*$/i) {
    $second_lookup_server = 'APNIC';
  }

  if($second_lookup_server) {   # if a secondary lookup needed, do not use the email found
    dbg_print($D_LOOKUP, "need a secondary lookup: $second_lookup_server");
    $found_handle = $handle;
  } elsif(defined($possible_handle) && !defined($possible_email)) { # a secondary handle for an ARIN handle needed
    $second_lookup_server = 'ARIN';
    $found_handle = $possible_handle;
  } elsif(defined($possible_email)) {
    $found_handle = $possible_email;
  } else {
    $found_handle = $handle;
  }

  return($second_lookup_server, $found_handle);
}

sub dbg_print
{
	my($level, $msg) = @_;
	if($level & $debug_level) {
		print STDERR "$msg\n";
	}
}

sub whois_cmd {
  my($server, $handle) = @_;
  if($whois_cmd_mode eq 'OLD') {
    return "/usr/bin/whois $handle\@$server |"; # RH5
  } else {
    return "/usr/bin/whois -h $server $handle |"; # FreeBSD, RH7
  }
}