#!/usr/bin/perl

use strict;
use warnings;

use momjian_us;

###

# Check DNS lookups against adult DNS checklist
# Cannot use tcpdump because the reverse IP often does not match
# the forward IP and the filter then does not work

### Packages

use Readonly;
use Sys::Hostname;
use Socket;
use Fcntl qw(:flock :seek);
use Net::DNS;

Readonly my $my_host => quotemeta(hostname);

# uses opendns.com lookups
# https://www.opendns.com/dashboard/settings/1796077/content_filtering
Readonly my @name_servers => qw(208.67.222.222 208.67.220.220);
Readonly my $block_ip => '67.215.65.130';
Readonly my $found_filename => '/u/safetycheck/found';


sub skip_hosts ($)
{
	return shift =~ m/(
		\.in-addr\.arpa |	# can't lookup IP addresses
		\.opendns\.com |	# our own adult lookups
		\.spamhaus\.org |	# spam lookups
		candle\.pha\.pa\.us |	# old hostname
		\.home |		# .home domain
		\b$my_host\b
	)$/xi;
}

# Make regexp of previously accepted web sites
# We use regexp because we want to match the lower part of the hostname
sub load_previously_found_hosts ()
{
	my @hosts;

	open(my $FOUND, '<', $found_filename) or sysdie "Cannot open $found_filename";
	while (<$FOUND>)
	{
		chomp;

		next if (m/^\s*$/);
		push @hosts, quotemeta(reverse($1)) if (m/^.*?:\s+(\S+)\s*$/);
	}
	close($FOUND) or sysdie "Cannot close $found_filename";

	# return regex

	return join('|', @hosts);
}

sub create_email_hosts ()
{
	my %mail_hosts;

	# Email
	# The DNS request might have been for email, so eliminate them.
	# We might have rotated the logs so grab from the previous log as well.
	# Grab only 2.5k lines, for performance.

	my $filename =
	  '(cat /var/log/exim4/mainlog.1 /var/log/exim4/mainlog) | tail -2500';
	open(my $MAILLOG, '-|', $filename) or sysdie "Cannot open pipe $filename";
	while (my $line = <$MAILLOG>)
	{
		chomp $line;
		$line = lc $line;

		# check only incoming hosts
		next if ($line !~ m/<=/);
		next if ($line !~ m/^[^@]*@([^ ]+)/);
		my $host = $1;
		next if (skip_hosts($host));
		$host =~ s/^www\d*\.//;
		$mail_hosts{$host} = 1;
	}
	close($MAILLOG) or sysdie "Cannot close pipe $filename";
	return \%mail_hosts;
}

sub create_dns_hosts ()
{
	my %dns_hosts;

	# Get DNS lookups
	my $scan_filename = '/var/log/safety.log';
	my $daily_filename = '/var/log/safety_daily.log';
	open(my $SCAN_DNS, '<', $scan_filename) or sysdie "Cannot open $scan_filename";
	open(my $DAILY_DNS, '>>', $daily_filename) or sysdie "Cannot open $daily_filename";
	while (<$SCAN_DNS>)
	{
		my @fields = split('[ #]');
		my $source = lc $fields[4];
		my $check  = lc $fields[9];

		# remove www to reduce chance of more entries for this host
		$check =~ s/^www\d*\.//;

		next if (skip_hosts($check));

		my @octets = split('\.', $source);

		# discard DHCP hosts for privacy
		next
		  if (     $source =~ m/^172\.20\.1\./
			&& $octets[3] >= 64
			&& $octets[3] <= 127);

	   # if multiple hosts lookup the same ip, we remember only the last one
		$dns_hosts{$check} = $source;

		# append scan to the daily file
		print $DAILY_DNS $_;
	}

	close($DAILY_DNS) or sysdie "Cannot close $daily_filename";
	close($SCAN_DNS) or sysdie "Cannot close $scan_filename";

	# Truncate file
	open($SCAN_DNS, '>', $scan_filename) or sysdie "Cannot create $scan_filename";
	close($SCAN_DNS) or sysdie "Cannot close $scan_filename";

	return \%dns_hosts;
}

# Add host found on adult list to permanent safe list
sub append_found_host ($$)
{
	my ($host, $source_host) = @_;

	open(my $SAFE, '>>', $found_filename) or sysdie "Cannot open $found_filename";

	print {$SAFE} localtime() . " on $source_host: $host\n";
	close($SAFE) or sysdie "Cannot close $found_filename";
}

sub perform_checks ($$$)
{
	my ($previously_found_hosts, $email_hosts, $dns_hosts) = @_;
	my $last_addition = '';

	my $dns = Net::DNS::Resolver->new(
	  	nameservers => [@name_servers],
	  	recurse     => 1,
		debug       => 0
	);

	# Sort by having shorter URLs appear first, to prevent duplicate additions
	for my $key (sort { (reverse $a) cmp (reverse $b) } keys %$dns_hosts)
	{
		# Don't check/add it a shorter URL was just added
		next if ($last_addition && $key =~ m/\.$last_addition$/);

		# exclude previously found hosts
		# use a regex because it might be key might be longer than the found host
		# reverse to optimize check
		next if ($previously_found_hosts ne "" &&
			reverse($key) =~ m/^(?:$previously_found_hosts)\b/i);

		# exclude email hosts
		next if (defined($email_hosts->{$key}));

		my $source_host =
		  gethostbyaddr(inet_aton($dns_hosts->{$key}), AF_INET);

		if (my $dns_query = $dns->query($key, 'A'))
		{
			foreach my $dns_result ($dns_query->answer)
			{
				if ($dns_result->type eq 'A' &&
				    $dns_result->address eq $block_ip)
				{
					print("$key access from $source_host found on unsafe list.\n");
					append_found_host($key, $source_host);
					$last_addition = quotemeta($key);
					last;
				}
			}
		}
	}
}


#main

# allow only one instance of this script to run
open(my $SELF, '<', "$0") or sysdie "Locking failed";
flock($SELF, LOCK_EX) or sysdie "Locking failed";

my $previously_found_hosts = load_previously_found_hosts;
my $email_hosts = create_email_hosts;
my $dns_hosts = create_dns_hosts;

unlink "/u/safetycheck/disable" if (-f "/u/safetycheck/disable" && 
				   (-M "/u/safetycheck/disable") >= 1/24);
perform_checks($previously_found_hosts, $email_hosts, $dns_hosts)
	if (! -f "/u/safetycheck/disable");

flock($SELF, LOCK_UN);
close($SELF) or sysdie "Locking failed";