#
# IPtoLL
#
# Robert Olson
# olson@mcs.anl.gov
# Argonne National Laboratory
# September, 1996
#
# Please keep this heading attached to the file it heads.
#

package IPtoLL;

use strict;
use vars qw($VERSION);

$VERSION = '0.02';

require IO;
use Socket;
require DBI;
require DBQuery;
require FileHandle;
require IPtoLL::Config;
require CircularList;

sub new
{
    my($class) = @_;
    my($self);

    $self = {
	dbh => undef,
	drh => undef,
    };
    $self->{drh} = DBI->install_driver($IPtoLL::DBDriver);
    defined($self->{drh}) or
	die "Cannot install DBI driver $IPtoLL::DBDriver\n";
    
    $self->{dbh} = $self->{drh}->connect($IPtoLL::DBServerHost,
					 $IPtoLL::DBName);
    defined($self->{dbh}) or
	die "Cannot open database $IPtoLL::DBName on server $IPtoLL::DBServerHost\n";

    bless($self, $class);

    $self->init_internic_names();
    
    return $self;
}

#
# Lookup the internic addresses...
#
sub init_internic_names
{
    my($self) = @_;
    my($name,$aliases,$addrtype,$length,@addrs, @dotted, $addr);

    ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname('rs.internic.net');
    for $addr (@addrs)
    {
	push(@dotted, join(".", unpack("C4", $addr)));
    }
#    print "Internic: @dotted\n";
    $self->{internic_addrs} = new CircularList(@dotted);
    $self->{internic_addr} = $self->{internic_addrs}->next();
}

#
# Get a socket to talk to whois
#
sub get_internic_socket
{
    my($self) = @_;
    my($sock, $addr);
    my($starting_addr);

    $starting_addr = $self->{internic_addr};

    while (1)
    {
	$sock = IO::Socket::INET->new(PeerAddr => $self->{internic_addr},
				      PeerPort => 43,
				      Proto => 'tcp');
	last if $sock;

	print "connect to $self->{internic_addr} failed\n";

	#
	# Failed; try the next internic addr.
	#
	$self->{internic_addr} = $self->{internic_addrs}->next();

	#
	# If we wrap all the way around, bail.
	#
	if ($self->{internic_addr} eq $starting_addr)
	{
	    die "Cannot contact any of the internic addresses\n";
	}
	sleep 1;
    }
    $sock->autoflush(1);
    return $sock;
}

sub dbh
{
    my($self) = @_;
    return $self->{dbh};
}

sub hostname_to_location
{
    my($self, $hostname) = @_;
    my($city, $state, $lat, $lon);

    ($city, $state) = $self->hostname_to_city($hostname);
    if (!$city)
    {
	return ();
    }

    ($lat, $lon) = $self->city_to_location($city, $state);

    if ($lat)
    {
	return ($lat, $lon);
    }
    else
    {
	return ();
    }
}

=head2 ($city, $state) = $obj->hostname_to_city($hostname)

Look up hostname in the database, returning its city and state.
We first do lookups on successively shorter suffixes of hostname,
in an attempt to look up based on the domain for the host. If those
fails, call hostname_to_city_from_internic to do the internic lookup
and db update.

=cut

sub hostname_to_city
{
    my($self, $hostname) = @_;
    my(@suffixes, $country, $city, $state);

    #
    # Check for IP addr
    #
    if ($hostname =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
    {
	my($addr, $name);
	$addr = pack("C4", $1, $2, $3, $4);
	($name) = gethostbyaddr($addr, AF_INET);
	if ($name)
	{
#	    print "mapped $hostname to $name\n";
	    $hostname = $name;
	}
	else
	{
	    return ();
	}
    }

    @suffixes = $self->hostname_suffixes($hostname);
    ($city, $state, $country) = $self->lookup_hostname_suffixes(@suffixes);

    if ($city)
    {
#	print "foudn in db\n";
	return ($city, $state);
    }

    #
    # Nope, not there. Delegate the responsibility to the internic code.
    #
    ($city, $state) = $self->internic_lookup_domain_list(@suffixes);
    if ($city)
    {
	#
	# Bingo, found it. 
	#
	return($city, $state);
    }
    #
    # Sorry...
    #
    return ();
}

sub internic_lookup_domain_list
{
    my($self, @suffixes) = @_;
    my($city, $state);
    my($domain);

    for $domain (@suffixes)
    {
	($city, $state) = $self->internic_lookup_domain($domain);
	if ($city)
	{
	    #
	    # Found it. Insert into db, and return.
	    #
	    my $now = time;
	    print "Inserting $domain $city $state\n";
	    $self->query("insert into DOMAIN values ('$domain', '$city', '$state', NULL, $now)");
	    return ($city, $state);
	}
    }
    return ();
}

sub internic_lookup_domain
{
    my($self, $domain, $recursing) = @_;
    my($tries);

    #
    # Never try to look up a toplevel domain
    #
    return () unless $domain =~ /\./;

    $tries = 0;
    while (1)
    {
	my($sock, $rc, $city, $state, $val);
	
	$sock = $self->get_internic_socket();
	$sock or die "cannot create internic socket: $!\n";
	print $sock "$domain\r\n";
	($rc, $val) = $self->parse_internic_output($sock);
	$sock->close();

#	print "Lookup of $domain returns $rc $val\n";
	
	if ($rc eq 'success')
	{
	    return @$val;
	}
	elsif ($rc eq 'not_found')
	{
	    return ();
	}
	elsif ($rc eq 'load_too_high' and $tries++ < 3)
	{
	    sleep 3;
	}
	elsif ($rc eq 'also_try')
	{
	    if (!$recursing)
	    {
		my($try, $val2);
		for $try (@$val)
		{
#		print "Also trying $try\n";
		    ($city, $state) = $self->internic_lookup_domain("!$try", 1);
		    if ($city)
		    {
			return ($city, $state);
		    }
		}
	    }
	    return ();
	}
	else
	{
	    die "invalid return code $rc";
	}
    }
}

sub parse_internic_output
{
    my($self, $sock) = @_;
    my($city, $state, @alternates, $allow_alternates);
    
    while (<$sock>)
    {
	if (/([a-zA-Z]+)\.?(\s?[a-zA-Z]+\s?[a-zA-Z]+),\s+([A-Z]+)\.?\s+[0-9]+/) 
	{
	    $city = $1.$2;
	    $state = $3;	
	    return ('success', [lc($city), lc($state)]);
	}

	if (/\(([^)]+-DOM)\)/)
    	{
	    push(@alternates, $1);
	    next;
    	}
        elsif (/To single out/)
	{
	    $allow_alternates = 1;
	}
        elsif (/No match for/)
	{
	    return ("not_found");
	}
        elsif (/Sorry, the system load is temporarily too heavy/)
	{
	    return ("load_too_high");
	}
    }
    if (@alternates && $allow_alternates)
    {
	return ("also_try", [@alternates]);
    }
    else
    {
	return ("not_found");
    }
}

sub lookup_hostname_suffixes
{
    my($self, @suffixes) = @_;
    my($q, $h);
    
    for $h (@suffixes)
    {
	my($s, $e);
	$q = $self->query("select city, state, country from DOMAIN where domain = '$h'");
	if ($q)
	{
#	    print "Found $h in db\n";
	    return ($q->item(0,0), $q->item(0,1), $q->item(0,2)); 
	}
    }
    return ();
}

sub hostname_suffixes
{
    my($self, $hostname) = @_;
    my(@parts, $i, $h, @r);

    @parts = split(/\./, $hostname);

    $h = pop(@parts);
    @r = ($h);
    while (@parts)
    {
	$h = pop(@parts) . '.' . $h;
	unshift(@r, $h);
    }
    return @r;
}

=head2 $obj->initialize_usmap($map_file)

Initialize the database from the data in $map_file.

=cut    
    

sub initialize_usmap
{
    my($self, $map_file) = @_;
    my($fh);
    my($state, $latdeg, $latmin, $latsec, $dir, $junk);
    my($londeg, $lonmin, $lonsec, $lat, $lon, $city, $state);
    my($start, $end, $n_cities, $elap, $avg);
    
    $fh = new FileHandle("<$map_file") or
	die "Cannot open map file $map_file: $!\n";

    $start = time;
    $n_cities = 0;
    while (<$fh>)
    {
	print if ($n_cities % 1000) == 0;
	chop;

	$city = substr($_, 0, 21);
	$city =~ s/\s+$//;
#	$city =~ s/^\s+//;
	$city =~ s/'/\\'/g;

	substr($_, 0, 21) = '';
	($state, $latdeg, $latmin, $latsec, $dir, $junk, $londeg, $lonmin,
	 $lonsec) =  split(/ /);
	$lat = $latdeg + $latmin/60.0 + $latsec/3600.0;
	$lon = -($londeg + $lonmin/60.0 + $lonsec/3600.0);

	#
	# Canonicalize to lower case
	#
	$city = lc($city);
	$state = lc($state);

#	print "have $city $state $lat $lon\n";
	$self->insert_city($city, $state, $lat, $lon);
	$n_cities++;
#	last if $n_cities > 100;
    }
    $end = time;
    $fh->close();
    $elap = $end - $start;
    $avg = 1000.0 * $elap / $n_cities;
    printf "Inserted $n_cities records in $elap seconds; %5.2f ms/insert\n",
	   $avg;
    
}

=head2 ($latitude, $longitude) = $obj->city_to_location($city, $state)

Look up city & state in the database, returning its latitude and longitude, or
the empty list if it not present.

=cut

sub city_to_location
{
    my($self, $city, $state) = @_;
    my($q);
    
    $city = lc($city);
    $state = lc($state);

    $q = $self->query("select latitude, longitude from US_CITY where city = '$city' and state = '$state'");
    if ($q)
    {
	return ($q->item(0, 0), $q->item(0, 1));
    }
    else
    {
	return ();
    }
}

sub insert_city
{
    my($self, $city, $state, $lat, $lon) = @_;
    my($r);

    #
    # Optional: check to see if the city is already there
    #
#    $r = $self->query("select * from US_CITY where city = '$city' and state = '$state'");

    if (!$r)
    {
	#
	# It's not, so go ahead & insert.
	#
	$self->query("insert into US_CITY values ('$city', '$state', $lat, $lon)");
    }
    else
    {
	warn "Location for $city $state already in place\n";
    }
}

#
# Make a query against the db, and return a DBQuery object
#
sub query
{
    my($self, $query, @vars) = @_;
    my($q, @rows, $result, @a);

#    print "query: $query\n";
    $result = $self->dbh->do($query);


    if (!defined($result))
    {
	print "query failure: $DBI::errstr\n";
	return undef;
    }

    while (@a = $result->fetchrow)
    {
#	print "got @a\n";
	push(@rows, [@a]);
    }

    if (@rows)
    {
	$q = DBQuery->new($query, \@vars, \@rows);
    }
    else
    {
	$q = undef;
    }
    return $q;
}


1;

__END__
