#!/usr/bin/perl

# $Id$
# Public Domain

use strict;
use warnings;

use Carp;
use DBI;
use DBD::SQLite;
use Getopt::Std;
use MIME::Lite;
use Net::Ping;
use POSIX;

my %opts;
my $optsok = getopts("d:t:T:C:iho", \%opts);
my $domain;

my $timeout = ($opts{'t'}) ?
	$opts{'t'} :
	5;

if ($opts{'d'}) {
	$domain = $opts{'d'};
} else  {
	&Usage;
	exit;
}

if ($opts{'i'}) {
	&Init;
	exit;
}

if ($opts{'h'}) {
	&Usage;
	exit;
}


if ($< != 0) {
	print STDERR "netmonitor.pl must be run as root. Exiting...\n\n";
	exit;
}

if (not -f $domain.".db") {
	print STDERR "Database doesn't exist for this domain, you should run netmonitor.pl -i. Exiting...\n\n";
	exit;
}

my %RelevantServers=( "A.ROOT-SERVERS.NET"=>1, "B.ROOT-SERVERS.NET"=>1, "C.ROOT-SERVERS.NET"=>1,
			"D.ROOT-SERVERS.NET"=>1, "E.ROOT-SERVERS.NET"=>1, "F.ROOT-SERVERS.NET"=>1,
			"G.ROOT-SERVERS.NET"=>1, "H.ROOT-SERVERS.NET"=>1, "I.ROOT-SERVERS.NET"=>1,
			"J.ROOT-SERVERS.NET"=>1, "K.ROOT-SERVERS.NET"=>1, "L.ROOT-SERVERS.NET"=>1,
			"M.ROOT-SERVERS.NET"=>1,
			"dns1.go-now.at"=>1,"dns2.go-now.at"=>1,"dns4.go-now.at"=>1,"91.112.11.214"=>1,"ns1.maisum.net"=>1,"ns2.maisum.net"=>1
			);

my %ResponsibleServers=("dns1.go-now.at"=>1,"dns2.go-now.at"=>1,"dns4.go-now.at"=>1,"91.112.11.214"=>1,"ns1.maisum.net"=>1,"ns2.maisum.net"=>1);

my $AlertHappened=0;


open HTML,">report.html";


&HtmlHeader;
&AddRootservers;
&CheckRelevantServers;
&CheckWhois;
&CheckNS;
&CheckMX;
if ($opts{'o'}) { &CheckOCSP; }
&Mail;
&Reports;


# check if all root servers are available for $domain


sub AddRootservers
{
	my @rootservers;
	Info("\nAdding Rootservers...");
	my $dbh = DbConnect();
	my $all = $dbh->selectall_arrayref("SELECT id,name FROM rootservers");

	foreach my $row (@$all) {
		my ($id, $name) = @$row;
                $RelevantServers{$name}=1;
	}

}

sub CheckRelevantServers
{
	Info("\nCheckRelevantServers");
	my $done=0;
	my $dbh = DbConnect();

	while(!$done)
	{
		$done=1;

		foreach my $curserver (keys %RelevantServers)
		{
			if($RelevantServers{$curserver}==2)
			{
				next;
			}
			else
			{
	                        $done=0;
			}
			$RelevantServers{$curserver}=2;

			Info("Checking SOA of $domain on $curserver");
			my @zone_unsorted = `dig -t SOA $domain \@$curserver`;
			#print @zone_unsorted;
			my @zone_sorted   = sort @zone_unsorted;

			# we compare each rootserver answer with the previous record
			my $entries = $dbh->selectall_arrayref("SELECT name,lastcheck FROM rootservers WHERE name='".$curserver."'");

			my ($name,$lastcheck);

			foreach my $row2 (@$entries)
			{
				#Info("1 line found");
				($name, $lastcheck) = @$row2;
			}
	
			my $buf="";
                        my $NumberNS=0;
			foreach (@zone_sorted)
			{
				if(m/IN\s+NS\s+([\w.-]+)/)
				{
					$NumberNS++;
					my $sn=lc $1; $sn=~s/\.$//;
					if(!defined($RelevantServers{$sn}))
					{
						#Info("Adding $sn to the serverlist");
						$RelevantServers{$sn}=1;
					}
				}
				#print "-$_-\n";

				# remove comments / blank lines
				next if m/\;+.*/;
				next if m/^\s*$/;

				$buf .= $_;
			}
                        if(!$NumberNS)
			{
				$ResponsibleServers{lc $curserver}=1;
				print "RESPONSIBLE DNS SERVER: $curserver\n";
			}

			# no previous record
			if (not defined($lastcheck))
			{
				$dbh->do("INSERT INTO rootservers VALUES (NULL, '$curserver', '$buf')");
				#$dbh->do("UPDATE rootservers SET lastcheck='".$buf."' WHERE name='".$curserver."'");
			}
	
			# compare
			else
			{
				# differs
				chomp $buf; chomp $lastcheck;
				if ($buf ne $lastcheck)
				{
					
					&Alert($dbh, "[NOK]\t\tOutput of ".$curserver." is\n\t\t\t\t-".$buf."-\n\t\t\t\tinstead of\n\t\t\t\t-".$lastcheck."-");
					$dbh->do("UPDATE rootservers SET lastcheck='".$buf."' WHERE name='".$curserver."'");
				} else
				{
					&Log($dbh, "[OK]\tOutput of ".$curserver." is unchanged.");
				}
			}
		}
	}

	&DbCommit($dbh);
	&DbDisconnect($dbh);
}


# get the nameservers of the domain via whois

sub CheckWhois
{
	Info("\nCheckWhois ...");
	my $dbh = DbConnect();

	my @whois = `whois -h whois.publicinterestregistry.net $domain`;

	#print @whois;
	my @ns_unsorted;


	foreach (@whois) {
		if (m/^Name\sServer\:(\S.+)/) {
			push(@ns_unsorted, $1);
			$ResponsibleServers{lc $1}=1;

		}
		if (m/Expiration Date:\d+-\w+-(\d+) \d+:\d+:\d+ \w+/) #13-Sep-2010 06:30:48 UTC
		{
			my $curyear=strftime("%Y",localtime);
			if($curyear eq $1)
			{
				Alert($dbh,"Domain $domain will expire this year!");
			}
		} 
	}

	my @ns_sorted = sort @ns_unsorted;

	# let's check if the list of NS has changed                                

	my $all = $dbh->selectall_arrayref("SELECT id,name FROM ns");

	my @nsrecords_unsorted;

	# first check, no NS recorded

	if (! $all->[0])
	{
		Info("First Check, no previous NS records yet");
		foreach (@ns_sorted)
		{
			$_=lc $_; s/\.$//;
			#Info("DNS Server $_ aus dem Whois übernommen");
			$dbh->do("INSERT INTO ns VALUES (NULL, '$_', NULL)");
		}
	}
	else
	{
		#Info("Followup Check, let´s see the difference");
		foreach my $row (@$all) {
			my ($id, $name) = @$row;
			push(@nsrecords_unsorted, $name);
			print "Entry: $name\n";
		}

		my @nsrecords_sorted = sort @nsrecords_unsorted;
		my $error;

		for my $i (0..$#nsrecords_sorted)
		{
			chomp($ns_sorted[$i]);
			chomp($nsrecords_sorted[$i]);
			if ($ns_sorted[$i] ne $nsrecords_sorted[$i])
			{
				$error .= "\n\t\t\t\t".$ns_sorted[$i]."\n\t\t\t\tinstead of\t\t\t\t".$nsrecords_sorted[$i];
			}
		}

		if ($error)
		{
			&Alert($dbh, "[NOK]\tThe NS list in the whois has changed: ".$error);

			# store the new list of NS
			my $j = 0;

			my $all2 = $dbh->selectall_arrayref("SELECT id,name FROM ns");

			foreach my $row2 (@$all2) {
				my ($id2, $name2) = @$row2;
				$dbh->do("UPDATE ns SET name='".$ns_sorted[$j]."' WHERE id='".$id2."'");
			}
		} else {
			&Log($dbh, "[OK]\tThe NS list in the whois is unchanged.");
		}
	}

	&DbCommit($dbh);
	&DbDisconnect($dbh);
}


# check each NS zone

sub CheckNS
{
	Info("\nCheckNS ...");
	my $dbh = DbConnect();

	my $nAXFR=0;
	my %zrecord=();
	my %ignore=();

	foreach my $ns (keys %ResponsibleServers)
	{
		print "Checking $ns\n";
     		my $all = $dbh->selectall_arrayref("SELECT name,zone FROM ns where name='$ns'");
		
		my ($ns2, $recorded_zone) = @$all[0];
		my $answer;

		#Info("Checking Zone on -$ns-");	
	
		my $status = (Ping($ns, $timeout) == 1) ;
		if($status)
		{
			&Log($dbh, "[OK]\t".$ns.": is online.");
		}
		else
		{ 
			&Warning($dbh, "[NOK]\t".$ns.": is offline (ICMP).");
			$ignore{$ns}=1;
		}

		my @zone_unsorted = `dig -t AXFR $domain \@$ns`;
		my @zone_sorted = sort @zone_unsorted;

		# to search the pattern "Transfer failed" and to store
		my $zone_string = join('', @zone_sorted);

                &Log($dbh, "[OK]\t ".$#zone_sorted." Fields loaded");


		# remove comments / blank lines / SOA
		my @zone_filtered;
                my $zonefound=0;

		for my $i (0..$#zone_sorted)
		{
			next if $zone_sorted[$i] =~ m/\;+.*/;
			next if $zone_sorted[$i] =~ m/.*SOA.*/;

			$zonefound++;

			# to avoid diffs with spaces/tabs
			$zone_sorted[$i] =~ s/\t/    /g;

			if($zone_sorted[$i] =~m/^(\S+)\s/)
			{
				$zrecord{lc $1}=1;
				#Info($dbh,"AXFR Entry found: $1");
			}
		}

		if (($zone_string =~ m/.*Transfer failed.*/g) || $zonefound==0)
		{
			&Warning($dbh, "[OK]\t".$ns.": AXFR failed.");
			next;
		} else {
			$nAXFR++;
			&Log($dbh, "[OK]\t".$ns.": AXFR done.");
		}

	}

	if(!$nAXFR)
	{
		Alert($dbh,"No AXFR Servers found! Please reconfigure at least one server to allow AXFR from this IP address.");
	}	


	foreach my $record (sort keys %zrecord)
	{
		Info("\n$record:");
		my $val=undef;
		my $err=0;
		my %answer=();
		my $oneanswer="";

		foreach my $ns (sort keys %ResponsibleServers)
		{
			next if($ignore{$ns});
			my @answer = `dig -t ANY +short $record \@$ns`; 
                        #$answer=~s/\n//sg;
			sort @answer;
                        my $answer=join "", @answer;
			$answer{$answer}->{$ns}=1;
			#Info("$ns says $answer");
			if(defined($val))
			{
				if($val ne $answer)
				{
					$err++;
				}
			}
			else
			{
				$val=$answer;
			}
		}
		if($err)
		{
			Alert($dbh,"Inconsistent DNS:");
                        my $prevvs=0;
                        my $msg="";
			foreach my $val (keys %answer)
			{
				if($prevvs)
				{
					$msg.=" vs. ";
					Alert($dbh,$msg);
					$msg="";
				}
				$msg.= "   $val (";
				my $prevc=0;
				foreach (keys %{$answer{$val}})
				{
					$msg.="," if($prevc);
					$msg.= "$_";
					$prevc=1;
				}
				$msg.= ")";
				$prevvs=1;
			} 
			Alert($dbh,$msg);
		}
		else
		{
			Log($dbh,"[OK] Record in Sync: $oneanswer");
		}
	}

	if(0)
	{
		my @zone_filtered=();
		my $recorded_zone="";
		my $ns="";
		my $zone_string="";
		if (@zone_filtered)
		{
			# we compare
			if ($recorded_zone)
			{
				my @zone_recorded = split('\n', $recorded_zone);

				my $error = "";

				for my $i (0..$#zone_filtered)
				{
					if (chomp($zone_recorded[$i]) ne chomp($zone_filtered[$i]))
					{
						# last-line bug
						next if ($zone_recorded[$i] eq $zone_filtered[$i]);

						$error = "\n\t\t\t\t".$zone_filtered[$i]."\n\t\t\t\tinstead of\n\t\t\t\t".$zone_recorded[$i];
					}
				}

				if ($error)
				{
					&Alert($dbh, "[NOK]\tZone records have changed on ".$ns.":".$error);
					$dbh->do("UPDATE ns SET zone='".$zone_string."' WHERE name='".$ns."'");
				} else {
					&Log($dbh, "[OK]\tZone records are unchanged on ".$ns.".");
				}
			}

			# we insert
			else
			{
				$dbh->do("UPDATE ns SET zone='".$zone_string."' WHERE name='".$ns."'");
			}
		}


		# check that each NS are indicating the same "A"
		our @results;

		my @output = `dig -t A $domain \$ns`;

		for (my $i=0; $i<$#output; $i++)
		{
			if ($output[$i] =~ m/ANSWER SECTION/)
			{
				my $entry = $output[$i+1];
				chomp($entry);

				# only store the returned IP address
				$entry =~ m/([0-9.]+)$/;

				push(@results, $1);
			}
		}


		for (my $j=0; $j < $#results; $j++)
		{
			next if ($j == 0);

			if ($results[$j] ne $results[0])
			{
				&Alert($dbh, "[NOK]\t\"A\" record of $domain is different on ".$ns.".");
			}

			else
			{
				&Log($dbh, "[OK]\t\"A\" record of $domain is the same on ".$ns.".");
			}
		}
	}

	&DbCommit($dbh);
	&DbDisconnect($dbh);
}


# test availability of each MX

sub CheckMX
{
	Info("\nChecking MX record ...");
	my $dbh = DbConnect();

	my @mxlist = `host -t MX $domain`;

	foreach my $mx (@mxlist)
	{
		$mx =~ m/.*is handled by\s(\d+)\s(.*)\./;

		my $name = $2;
		my $pri  = $1;

		my $status = (Ping($name, $timeout) == 1) ?
			&Log($dbh, "[OK]\tMX ".$name." (".$pri."): is online") :
			&Alert($dbh, "[NOK]\tMX ".$name." (".$pri."): is offline");
	}

	&DbCommit($dbh);
	&DbDisconnect($dbh);
}


# check that OCSP responder is working

sub CheckOCSP
{
	my @ocspservers=("ocsp.$domain","213.154.225.237","ocsp.test1.cacert.at","91.112.11.210","ocsp.openvalidation.org");

	my $dbh = DbConnect();

	foreach my $responder (@ocspservers)
	{
		if (Ping($responder, $timeout) != 1)
		{
			&Alert($dbh, "[NOK]\t".$responder.": is offline.");
		}
	
		else
		{
			&Log($dbh, "[OK]\t".$responder.": is online.");
	
			my $test1 = `openssl ocsp -CAfile ca.bundle -url http://$responder/ -issuer class1.crt -cert OCSP-1.crt -text 2>&1 > /dev/null`;
			Info($dbh,$test1);
	
			if ($test1 =~ m/Response verify OK/)
			{
				&Log($dbh, "[OK]\t".$responder.": answer is OK for OCSP-1.crt issued by class1.crt.");
			}
			elsif ($test1 =~ m/\: unknown/)
			{
				&Alert($dbh, "[NOK]\t".$responder.": replying -unknown- for OCSP-1.crt issued by class1.crt");
			}
			else
			{
				&Alert($dbh, "[NOK]\t".$responder.": answer is NOK for OCSP-1.crt issued by class1.crt");
			}
	
			my $test2 = `openssl ocsp -CAfile ca.bundle -url http://$responder/ -issuer class1.crt -cert class3.crt -text 2>&1 > /dev/null`;
			Info($dbh,$test2);

			if ($test2 =~ m/Response verify OK/)
			{
				&Log($dbh, "[OK]\t".$responder.": answer is OK for class3.crt issued by class1.crt.");
			}
			elsif ($test2 =~ m/\: unknown/)
			{
				&Alert($dbh, "[NOK]\t".$responder.": replying -unknown- for class3.crt issued by class1.crt");
			}
			else
			{
				&Alert($dbh, "[NOK]\t".$responder.": answer is NOK for class3.crt issued by class1.crt");
			}
		}
	}
	&DbCommit($dbh);
	&DbDisconnect($dbh);

}	
	
# check availability of a host

sub Ping
{
	my $host = shift;
	my $timeout = shift;

	my $p = Net::Ping->new("icmp");

	my ($ret, $duration, $ip) = $p->ping($host, $timeout);
	$p->close();

	return $ret;
}


# connect to the database

sub DbConnect
{
	my $dbh = DBI->connect("dbi:SQLite:".$domain.".db", "", "",
						{
							RaiseError => 1,
							AutoCommit => 0
						}
	);

	return $dbh;
}


# disconnect from the database

sub DbDisconnect
{
	my $dbh = shift;
	$dbh->disconnect;
}


# commit the database changes

sub DbCommit
{
	my $dbh = shift;
	$dbh->commit;

	if ($@) {
		&DbRollback($dbh);
	}
}


# rollback the database changes

sub DbRollback
{
	my $dbh = shift;
	$dbh->rollback;
}


# init $domain database

sub Init
{
	if (-f $domain.".db") {  
		print STDERR "Database exists, you have to delete it first. Exiting...\n\n";
		exit;
	}

	my $dbh = &DbConnect;

	# create contacts
	$dbh->do("CREATE TABLE contacts (id INTEGER PRIMARY KEY, field, email)");
	#$dbh->do("INSERT INTO contacts VALUES (NULL, 'To', 'aanriot".'@'."atlantilde.com')");
	$dbh->do("INSERT INTO contacts VALUES (NULL, 'To', 'pg".'@'."futureware.at')");

	# create root servers

	$dbh->do("CREATE TABLE rootservers (id INTEGER PRIMARY KEY, name UNIQUE, lastcheck)");

	#foreach (@list)
	#{
	#	$dbh->do("INSERT INTO rootservers VALUES (NULL, '$_', NULL)");
	#}

	# create the table to store NS list
	$dbh->do("CREATE TABLE ns (id INTEGER PRIMARY KEY, name, zone)");

	# create tables to store logs and alerts
	$dbh->do("CREATE TABLE logs   (id INTEGER PRIMARY KEY, time, text)");
	$dbh->do("CREATE TABLE alerts (id INTEGER PRIMARY KEY, time, text)");

	&DbCommit($dbh);
	&DbDisconnect($dbh);
}


# write logs / alerts into the database

sub Info($)
{
	print "$_[0]\n";
        print HTML "<div class=\"info\">$_[0]</div>\n";
}

sub Log
{
	my ($dbh, $text) = @_;

	my $newtime = time;
	print "$text\n";

        if ($text =~ m/\[OK\]/)
        {
          print HTML "<div class=\"ok\">$text</div>\n";
        }
        else
        {
          print HTML "<div class=\"log\">$text</div>\n";
        }

	$dbh->do("INSERT INTO logs VALUES (NULL, '$newtime', '$text')");
}

sub Warning
{
	my ($dbh, $text) = @_;

	my $newtime = time;
	print "$text\n";

        print HTML "<div class=\"warning\">$text</div>\n";

	$dbh->do("INSERT INTO logs VALUES (NULL, '$newtime', '$text')");
}
sub Alert
{
	my ($dbh, $text) = @_;

	my $newtime = time;
	print "$text\n";
        print HTML "<div class=\"alert\">$text</div>\n";

	$AlertHappened=1;

	$dbh->do("INSERT INTO alerts VALUES (NULL, '$newtime', '$text')");
}


# mail alerts

sub Mail
{
	my $Subject = "Hourly reports";
	my $body = "Hourly reports from netmonitor.pl:\n\n";

	my $dbh = &DbConnect;	

	my $all = $dbh->selectall_arrayref("SELECT time,text FROM alerts");

	foreach my $row (@$all)
	{
		my ($time, $text) = @$row;

		if (time - $time <= 3600)
		{
			my ($ss, $mm, $hh, $day, $month, $year, $zone) = localtime($time);
			$year += 1900;

			my $date_string = $year."/".$month."/".$day." - ".$hh.":".$mm;

			$body .= $date_string."\t".$text."\n";
		}
	}

	if (@$all != 0)
	{
		# To field
		my $To;
		my $all2 = $dbh->selectall_arrayref("SELECT id,email FROM contacts WHERE field='To'");
		foreach my $row2 (@$all2) {
			my ($id, $email) = @$row2;
			$To .= $email.", ";
		}

		# Cc field
		my $Cc;
		my $all3 = $dbh->selectall_arrayref("SELECT id,email FROM contacts WHERE field='Cc'");
		foreach my $row3 (@$all3) {
			my ($id, $email) = @$row3;
			$Cc .= $email.", ";
		}

		my $msg = MIME::Lite->new(
							  To      => $To,
							  Cc      => $Cc,
							  Subject => "NetMonitor alert",
							  Type    => 'text/plain',
							  Data    => $body
							  );
		$msg->send();
	}

	&DbDisconnect($dbh);
}


# generate reports for the web interface

sub HtmlHeader
{
  my $timestamp = strftime("%Y/%m/%d - %H:%M:%S",localtime(time));

  print HTML "<html>\n<head><title>NetMonitor Report $timestamp</title>\n";
  print HTML '<link rel="stylesheet" type="text/css" href="report.css">'."\n";
  print HTML "</head>\n<body bgcolor=\"#ffffff\"><font size=\"-2\">";
}

sub Reports
{
    my $dbh = &DbConnect;

	my $all1 = $dbh->selectall_arrayref("SELECT time,text FROM logs");
	my $buf1;

	if (@$all1 != 0)
	{
		foreach my $row1 (@$all1)
		{
			my ($time, $text) = @$row1;
			$buf1 .= $time."\t".$text."\n";
		}

		open(LOG, ">".$domain.".log");
		print LOG $buf1;
		close(LOG);
	}

	my $all2 = $dbh->selectall_arrayref("SELECT time,text FROM alerts");
	my $buf2;

	if (@$all2 != 0)
	{
		foreach my $row2 (@$all2)
		{
			my ($time, $text) = @$row2;

			next if ($text =~ m/AXFR/);

			my $now = strftime("%Y/%m/%d - %H:%M:%S",localtime(time));
			$buf2 .= $now."\t\t".$text."\n";
		}

		open(ALERTS, ">".$domain.".alerts");
		print ALERTS $buf2;
		close(ALERTS);
	}

	&DbDisconnect($dbh);
}


# display help

sub Usage # to use the program
{
	print STDERR <<EOH;

Usage:  perl netmonitor.pl [-dtTCioh] domain.tld

    -d : domain to check
    -t : timeout to use  [default: 5]
    -T : 'To' field to use for mail reports
    -C : 'CC' field to use for mail reports
    -i : initialize the SQLite3 database
    -o : perform OCSP checks
    -h : this help

EOH
}
