#!/usr/bin/perl -w

use strict;

=head1 NAME

 domains.cgi - summarize domain status

=head1 DESCRIPTION

Does a merger of these sources of information:

  local database of domain names and some info (such as comments)
  whois
  DNS

For each domain show:

registrant/contacts
registrar/account
DNS/account
web/account
email/account

=head1 TODO

specify what name servers to use (or always use authoritative ones and compare to local cache and to some other)
    ala http://www.netleader.com.au/projects/dnscheck/download/dnscheck-1.1.tar.gz

also query table "domainassoc" for aliases -- and automatically determine
   what kind of alias: CNAME, A, url redirect, frame.

pull out dns config using subdomain list if axfr fails (like dnsenum and dnsdigger, possibly multiple threads)

offer to run dnsdoctor

show:
    email aliases
    special apache config
    
warn about ones about to expire

sort by expiration date

filtering

status: fix up for alias/redirect, expired, etc.
    (list subdomains here too)

popup of email aliases
popup of mailing lists

popup for:
    whois details
    IP details
    NS details

account links
link to live web site
link to any mailing lists

highlight expired/taken and don't show as much. 

group by domain group

figure out better way to identify web host

=head1 Schema

  status # could be: live, alias/dns, alias/redirect, alias/frame, parked, expired/taken, expired/available


=cut

use CGI qw(:standard);
use Data::Dumper;

use FindBin;
use lib $FindBin::Bin;
use lib '/group/discerning.com/public_html/hacks/sysadmin/';
require sysadmindb;
use WhoisNGNGNG;

################################################################
my $DEBUG = 0;
sub debug {
    print "DEBUG: ", @_, "\n" if $DEBUG;
}

sub warning {
    print "WARNING: ", @_, "\n";
}

################################################################

sub get_registrar_isp {
    my ($registrar_name) = @_;
    return undef unless $registrar_name;

    # get first word, and convert to lower case
    my ($rn) = ($registrar_name =~ m/^\s*([a-z\-0-9]+)/i);
    $rn = lc($rn);
    
    my $isp = db_get_hash("SELECT * FROM isp WHERE registrar_names LIKE '%$rn%'");
    # die "can't find isp '$registrar_name'" if !$isp && $rn =~ m/namecheap/;
    return $isp;
}

# the orgname from arin/ripe/etc.
sub get_netname_isp {
    my ($netname_org) = @_;
    my ($name1) = ($netname_org =~ m/^([a-z0-9]+)/i);
    return undef unless $name1;
    $name1 = lc($name1);
    my $isp = db_get_hash("SELECT * FROM isp WHERE isp_id LIKE '%$name1%'");
    return $isp;
}

sub get_server_isp {
    my ($server_name) = @_;
    return undef unless $server_name;

    # get just top part of domain
    my $dn = primary_domain($server_name);
    $dn = lc($dn);

    my $isp = db_get_hash("SELECT * FROM isp WHERE servers LIKE '%$dn%'"); 
    return $isp if $isp;

    my $follow = ip_to_name(name_to_ip($server_name));
    if ($follow && $follow ne $server_name) {
	debug "trying name '$follow' instead of '$server_name'";
	return get_server_isp($follow);
    }
    return undef;
}

sub get_isp_account {
    my ($isp, $dn, $account_id) = @_;
    my $isp_id = $isp->{isp_id};
    my $rows = db_get_hashes("SELECT * FROM ispaccount WHERE isp_id = '$isp_id' AND (account_id = '$account_id' OR account_id = '')");
    unless ($rows && @$rows) {
	warning("no ispaccount rows for isp '$isp_id' account '$account_id'");
	return undef;
    }
    return $rows->[0] if @$rows == 1;
    my $re = quotemeta($dn);
    for (@$rows) {
	return $_ if $_->{domains} =~ m/$re/;
    }
    warning("none of the ", scalar(@$rows), " accounts for '$isp_id' account '$account_id' matched domain '$dn'");
    return undef;
}

# do a DNS reverse ip to name lookup
# this may fail
sub ip_to_name {
    my ($ipaddr) = @_;
    return '' unless $ipaddr;
    my $name = '';
    my $cmd = "dig +short -x $ipaddr";
    my @dig_lines = `$cmd`;
    debug("command '$cmd' = '@dig_lines'\n");
    for(@dig_lines) {
	chomp;
	# take just PTR, not CNAME
	next if m/arpa/;
	$name = $_, last;
    }
    debug("ip_to_name($ipaddr)='$name'");
    return $name;
}

sub name_to_ip {
    my ($dn) = @_;
    my $a = '';
    my $cmd = "dig +short A $dn";
    my @dig_a = `$cmd`;
    debug("command '$cmd' = '",@dig_a,"'");
    for(@dig_a) {
	chomp;
	$a = $_, last if m/^[\d \.]*$/;
    }
    # take last line in case of alias (just want A, not CNAME)
    # $a =~ s/.*\n(.*)\n/$1/;
    debug("name_to_ip($dn)='",$a,"'");
    return $a;
}

sub ip_to_netname {
    my ($ipaddr) = @_;
    my $arin_whois = get_command_cached("whois $ipaddr");
    my $arin_net_name = '';
    if (0) {}

    # try ripe netblock format first, as it also has some ARIN format stuff
    elsif ($arin_whois =~ m/^netname: *(.*)/m) {
	$arin_net_name = $1;
	# note this assumes that the first descr corresponds to the netname section
	$arin_net_name .= " ($1)" if $arin_whois =~ m/^descr: *(.*)/m;
    }

    # try arin netblock format
    elsif ($arin_whois =~ m/^OrgName: *(.*)/m) {
	$arin_net_name = $1;
	$arin_net_name .= "/$1" if $arin_whois =~ m,CIDR: *.*/(\d+),;
    }

    # try AS list format; take last line that has a NET handle.
    elsif ($arin_whois =~ m/\(NET-[\d\-]+\)/) {
	my @lines = ($arin_whois =~ m/^(.*\(NET-[\d\-]+\))/gm);
	debug("popping last of arin lines: '@lines' our of output '$arin_whois'");
	$arin_net_name = pop(@lines);
	chomp($arin_net_name);
	if ($arin_net_name =~ m/(.*) ([A-Z\-\d]+\-)(\d+) \((NET-.*)\)/) {
	    my ($bus_name, $net_name, $net_size, $net_handle) = ($1, $2, $3, $4);
	    $arin_net_name = "$bus_name/$net_size";
	}
    }
    debug("ip_to_netname($ipaddr) = '$arin_net_name'");
    return $arin_net_name;
}

sub isp_html {
    my ($isp, $dn, $account_id) = @_;
    return '' unless $isp;
    my $isp_name = $isp->{isp_name} || die "bad isp: ", Dumper($isp);
    my $isp_account = get_isp_account($isp, $dn, $account_id);
    my $account_user_name = $isp_account ? $isp_account->{user_name} : undef;
    my $h = $isp_name;
    $h .= " (account '$account_user_name')" if $account_user_name;
    return $h;
}

sub isp_server_html {
    my ($server_name, $dn, $account_id) = @_;
    return '' unless $server_name;
    my $isp = get_server_isp($server_name);
    if ($isp) {
	return isp_html($isp, $dn, $account_id);
    }
    else {
	return "(unknown server '$server_name')";
    }
}

sub primary_domain {
    my ($dn) = @_;
    # remove any trailing period.
    $dn =~ s/\.$//;
    my @parts = split(/\./, $dn);
    my $tld = pop @parts;
    my $subd = pop @parts;
    my $primary = lc("$subd.$tld");
    return $primary;
}

# lookup MX records for domain.
# then primary domain out of first one.
sub get_mx_info {
    my ($dn) = @_;

    my @dig_lines = `dig +short MX $dn`;
    return {} unless @dig_lines;

    my @mx_lines = @dig_lines;
    chomp(@mx_lines);
    debug('mx_lines=', Dumper([@mx_lines]));

    my $first = $mx_lines[0];
    # remove priority from first
    $first =~ s/^\d+ //;

    return {mx_lines => [@mx_lines], first_mx => $first}; 
}

# sometimes includes MX, sometimes not?
sub get_dig_any {
    my ($ns, $dn) = @_;
    my @lines = get_command_cached("dig +noall +answer ANY $dn \@$ns");
    chomp(@lines);
    return @lines;
}

sub get_axfr {
    my ($ns, $dn) = @_;
    # +short omits all but the last column, which is useless for AXFR
    my @lines = get_command_cached("dig AXFR $dn \@$ns");
    chomp(@lines);
    my @comments = grep {$_ =~ m/\S/ && $_ =~ m/^\s*;/} @lines;
    my @real = grep {$_ =~ m/\S/ && $_ !~ m/^\s*;/} @lines;
    return @real ? @real : @comments;
}

use Net::DNS::Resolver;
sub get_dn {
    my ($dn, $ns) = @_;
    my $res = Net::DNS::Resolver->new();
    $res->nameservers($ns) if $ns;
    $res->tcp_timeout(7);
    $res->udp_timeout(5);
    $res->retry(2);
    $res->retrans(3);

    # my $p = $res->search($dn); print $p->answer() if $p;
    my $packet = $res->query($dn, 'ANY');
    if (!$packet) {
	# might be 'NXDOMAIN'
	# warning("DNS errorstring($dn)=", $res->errorstring());
	return ();
    }
    my @answers = ();
    foreach my $rr ($packet->answer()) {
	    # $rr->address(), $rr->type(), $rr->string()
	push(@answers, $rr->string());
    }
    return @answers;
}


################################################################

use Cache::File;
our $CACHE_DIR = '/tmp/domains_cgi_cache';

mkdir($CACHE_DIR) unless -d $CACHE_DIR;
our $CACHE = Cache::File->new(
			      # only helps with the .db files
			      # the external tied files are not done this way
			      cache_umask => '000',
				    cache_root => $CACHE_DIR, 
			      # without a unit, it is an epoch
				    default_expires => '3600 sec',
			      lock_level => Cache::File::LOCK_LOCAL
				    # load_callback => sub {WhoisNGNGNG::get_whois($_[0]->key());},
				    );

die "bad" unless $CACHE->cache_umask() eq '000';

sub get_whois_cached {
    my ($dn) = @_;
    my $entry = $CACHE->entry($dn);
    my $whois;
    if ($entry->exists()) {
	# warning("whois cached: $dn");
	$whois = $entry->thaw();
	$whois = undef unless %$whois;
    }
    else {
	warning("whois not cached: $dn");
	$whois = WhoisNGNGNG::get_whois($dn);
	$entry->freeze(defined($whois) ? $whois : {});
    }
    return $whois;
}

sub get_command_cached {
    my ($cmd) = @_;
    my $entry = $CACHE->entry($cmd);
    my $lines;
    if ($entry->exists()) {
	# warning("command cached: $cmd");
	$lines = $entry->thaw();
	if (!$lines) {
	    warning("thawed value is undefined");
	}
    }
    if (!defined($lines)) {
	warning("command not cached: $cmd");
	$lines = [`$cmd`];
	$entry->freeze($lines);
    }
    return wantarray ? @$lines : join('',@$lines);
}

################################################################

my $ACCOUNT_ID;

my @DISPLAYCOLS = qw(Domain Registration Web Email DNS);

# see dnsdigger/names.txt and dnsenum/dns.txt
#our @SUBDOMAINS = qw(beta demo dev dns download email ftp help images lists list mail ns pop pop3 qa smtp test www);
our @SUBDOMAINS = qw(lists www);

sub testme {
    my $ns = 'ns13.zoneedit.com';
    my @answers = get_dn('discerning.com', 'ns1.easydns.com');
    print Dumper([@answers]);
    my @answers2 = get_dn('lists.uhurumovement.org', 'ns13.zoneedit.com');
    print Dumper([@answers2]);
}

sub check_local {
    my @dirs = `ls -d /group/*.{net,org,com} 2>/dev/null`;
    chomp(@dirs);
    for(@dirs) {
	s,/group/,,;
	warning("no domain in db for local hosting dir '$_'") unless db_get_hash("SELECT * FROM domains WHERE domainname = '$_'");
    }
}
    
sub main {

    $WhoisNGNGNG::WARN_NOT_FOUND = 0;

    # fetch domain objects from our local db
    my $sql = "SELECT * from domains" .  ($ACCOUNT_ID ? " where account_id = '$ACCOUNT_ID'" : '');
    my $domain_objects = db_get_hashes($sql);

    my $alias_domains = db_get_hashes("SELECT * from domainassoc");
    for my $a (@$alias_domains) {
	my $dn = $a->{domainname};
	my $other = $a->{otherdomain};
	my ($matching) = grep {$_->{domainname} eq $other} @$domain_objects;
	if (!$matching) {
	    warning("no such referenced domain '$other' for alias domain '$dn'");
	}
	else {
	    # warning("pushing alias '$dn' to referenced '$other'");
	    my $fake_dnobj = {domainname => $dn, account_id => $matching->{account_id}, orgshort => $matching->{orgshort}, status => $a->{assoc}}; 
	    push(@$domain_objects, $fake_dnobj);
	}
    }

    # my $pagestyle = "td, p {white-space: no-wrap}";
    my $pagestyle = '';
    print header, start_html(-title => "Domains Report", -style => {code => $pagestyle} );
    print '<table border="1">';
    print Tr(th([@DISPLAYCOLS]));
    for my $dnobj (@$domain_objects) {
	for my $prop (qw(domainname orgshort account_id)) {die "record missing property '$prop': ", Dumper($dnobj) unless $dnobj->{$prop}}

	my $account_id = $dnobj->{account_id};

	# fetch whois data
	my $dn = $dnobj->{domainname};

	my $whois = get_whois_cached($dn);

	my @tds = ();
	for my $col (@DISPLAYCOLS) {
	    # my $handler = $col->{handler}; my $html = &$handler($dnobj, $whois);
	    my $html;
	    if ($col eq 'Domain') {
		my $comments = $dnobj->{comment}||'';
		$comments = "<div style='white-space: normal; border: 1px solid red'>$comments</div>" if $comments;
		$html = join("<br>\n", 
			     'Domain: ' .$dn, 
			     'Nickname: ' . $dnobj->{orgshort}, 
			     'Fullname: ' . ($dnobj->{orglong}||''),
			     'Status: ' . ($dnobj->{status}||'live'),
			     'Comments: ' . $comments,
			     );
	    }
	    elsif (!$whois) {
	    }
	    elsif ($col eq 'Registration') {
		my $registrar_name = $whois->contact_name('Registrar');
		my $isp = get_registrar_isp($registrar_name);
		$html = join("<br>\n",
				 'ISP: ' . ($isp ? isp_html($isp, $dn, $account_id) : "unknown '$registrar_name'"), 
				 'Registrant: ' . $whois->contact_name('Registrant'),
				 'Administrative: ' . $whois->contact_name('Administrative'),
				 'Technical: ' . $whois->contact_name('Technical'),
				 'Created Date: ' . $whois->{CreatedDate},
				 'Expiration Date: ' . $whois->{ExpirationDate},
			     );
	    }

	    elsif ($col eq 'Web') {
# ways to get info about a web host:
#    traceroute
#    dig -x N.N.N.N   (reverse ip to name)
#    whois N.N.N.N    (arin net name of ip))
#    http://N.N.N.N

		# assuming shared hosting, do a name to ip to name to determine web host
		my $ip = name_to_ip("www.$dn");
		my $reverse_name = ip_to_name($ip);
	        my $netname = ip_to_netname($ip);

		my $isp_html = '';
		# use reversed name if it came back and with something different (vhosting)
		if ($reverse_name && lc($reverse_name) ne lc($dn) && lc($reverse_name) ne lc("www.$dn")) {
		    $isp_html = isp_server_html($reverse_name, $dn, $account_id);
		}
		elsif ($netname) {
		    my $isp = get_netname_isp($netname);
		    $isp_html = isp_html($isp, $dn, $account_id);
		}
		my @lines = ('ISP: ' . $isp_html,
			     'WWW IP: ' . $ip,
			     'WWW Reverse Name: ' . $reverse_name,
			     'ARIN Net: ' . $netname,
			     );

		$html = join("<br>\n", @lines);
	    }

	    elsif ($col eq 'Email') {
		my $mx_info = get_mx_info($dn);
		my $first_mx_server = $mx_info->{first_mx};
		my $mx_lines = $mx_info->{mx_lines} || [];
		$html = join("<br>\n",
			     'ISP: ' . isp_server_html($first_mx_server, $dn, $account_id),
			     'MX Records: ' . "<pre>" . join("\n", @$mx_lines) . "</pre>",
			     );
	    }

	    elsif ($col eq 'DNS') {
		# look up name servers from whois
		my $ns = $whois ? $whois->name_servers() : undef;
		if ($ns && @$ns) {
		    my $first_ns = $ns->[0];
		    $html = join("<br>\n",
				 'ISP: ' . isp_server_html($first_ns, $dn, $account_id),
				 'Whois Name Servers: ' . '<pre>' . join("\n", @$ns) . '</pre>',
				 'Dig ANY: ' . '<pre>' . join("\n", get_dig_any($first_ns, $dn)) . '</pre>',
				 'Subdomains: ' . '<pre>' . join("\n", map {get_dn("$_.$dn")} @SUBDOMAINS) . '</pre>',
				 'AXFR: ' . '<pre>' . join("\n", get_axfr($first_ns, $dn)) . '</pre>',
			     );		    
		}
	    }
	    $html ||= '';
	    my $wrap = 0;
	    my $style = $wrap ? '' : 'white-space: nowrap';
	    push(@tds, "\n    " . td({valign => 'top', style => $style}, $html));
	}
	print Tr(@tds), "\n";
    }
    print '</table>';
    print end_html;
}

#check_local();
main();