#!/usr/bin/perl -w
use strict;
use Symbol;

sub usage{
  my ($conf_fn) = @_;
  print STDOUT <<EoF; 

This little script makes it easy to block all access to
selected sites.  The trick is to program your local DNS
name-server daemon, so that attempts to resolve the IP
address of the execrated sites return no address.

We read in a file (execrated.dat) containing the domain
names of "ad servers" and other undesirable hosts.  You can
obtain a useful list from
http://www.mvps.org/winhelp2002/hosts.txt or elsewhere.
Feel free to edit this file according to your taste.

Also feel free to change the \$confdir variable according to
where the configuration files are stored on your machine.

Principles of operation:

0) In the input file, there should be one host name or
  domain name per line.  Comments (starting with a # mark)
  are ignored.  If any line is in the format of a host file,
  with the numerical IP address 127.0.0.1 in the first
  field, that IP address will be removed.

1) We create a config file called "execrated.conf"
  that will tell your server exactly which
  networks are execrated.  Anything mentioned in
  the input file, and any subdomain thereof, will
  be blocked.

2) You add (by hand) the following line into your
  top-level named.conf file:
	include "$conf_fn";
  so it knows about the aforementioned file.

3) We create a zone file called "execrated.dname" that
  is used to define the DNS lookup results for all
  execrated names.  (They all share this one zone
  file.)  The result will be that the base name
  (e.g. doubleclick.com) will exist but have no IP
  address at all, while any hosts or subdomains
  (e.g. foo.doubleclick.com) will not even exist
  (NXDOMAIN).  Your name server will return these
  results very promptly.
  
  Returning no address at all works better than
  returning some 'special' address such as 127.0.0.1 or
  10.66.66.66, since it does not depend on any
  properties of your local routing table, or on whether
  or not you have servers running on your local host.

4) Each time you run this program, you should signal
  your 'named' process, so that it will reread the
  configuration files.  Perhaps something like:
	killall -1 named 
   Then you should look at the tail of your system 
   logfile (on Debian: /var/log/daemon.log) to make 
   sure the daemon is happy.

Other options:

   -l   print a nicely-alphabetized version of the
	list of execrated domains, suitable for use as
	a new input file.

   -a	('all') do not prune duplicates


EoF

}

## 1) Munge the domain name so that things
## get alphabetized according to basic domain-name first,
## then secondarily the subdomains, properly nested.
## 2) The wrinkle is that you want the TLD to have the
## weakest priority, so that foo.com alphabetizes
## next to foo.net
## 3) Also we make sure foo.com comes _before_ 
## anysubdomain.foo.com
sub rank($){
  my ($host) = @_;
  $host = lc($host);
  my @stuff = reverse split('[.]', $host);
  my $tld = shift(@stuff);
## The 'space' (!not! '.') here is important to 
## implement requirement (3) above:
  return join('.', @stuff) . ' ' . $tld;
}


## Same as above, but without wrinkle (2):
sub prunerank($){
  my ($host) = @_;
  $host = lc($host);
  my @stuff = reverse split('[.]', $host);
  return join('.', @stuff);
}


sub parental($){
  my ($str) = @_;
  $str =~ s'[.]'\.'g;
  return '\.' . $str . '$';
}

## get rid of duplicates, and names that are
## subdomains of others
sub prune{
  my (@hosts) = @_;
  @hosts = sort {prunerank($a) cmp prunerank($b)} @hosts;
  my $prev = 'x x x';
  my $jj = 0;
  my @rslt = ();
  foreach my $host (@hosts) {
    my $patt = parental($prev);
    if ($host ne $prev && !($host =~ m"$patt")) {
      $rslt[$jj++] = $host;
      $prev = $host;
    } else {
      print STDERR "Rejecting '$host' due to previous '$prev'\n";
    }
  }
  return @rslt;
}

main:{

  my $confdir = '/etc/bind';
  my $zone_fn = "$confdir/execrated.dname";
  my $conf_fn = "$confdir/execrated.conf";
  my $dat_fn   = "$confdir/execrated.dat";

  my $listmode = 0;
  my $allmode = 0;

  foreach my $arg (@ARGV) {
    if ($arg eq '-h') {
      usage($conf_fn);
      exit(0);
    } 
    elsif ($arg eq '-a') {
      $allmode++;
    }
    elsif ($arg eq '-l') {
      $listmode++;
    }
    else {
      die "Unrecognized argument '$arg'\n";
      exit(1);
    }
  }

  my $dat_i = Symbol::gensym;
  open ($dat_i, "$dat_fn")
	|| die "Cannot open input file '$dat_fn'\n";

  my @hosts = ();
  my $ii = 0;
  while (my $line = <$dat_i>) {
    chomp $line;
    $line =~ s/[ \t]*#.*//;
    $line =~ s/[ \t]*127.0.0.1[ \t]*//;
    $line =~ s/[*]//;
    $line =~ s/^[.]//;
    if ($line ne '' && $line ne 'localhost') {
      $hosts[$ii++] = lc($line) ;
    }
  }

  close $dat_i;
  if ($allmode) {
    ###
  } else {
    @hosts =  prune(@hosts);
  }

## Sort them into nice-to-the-eye order:
  @hosts = sort {rank($a) cmp rank($b)} @hosts;

  if ($listmode) {
    my $nd = @hosts;
    print STDERR "Writing out $nd domains\n";
    foreach my $host (@hosts) {
      print "$host\n";
    }
    exit(0);
  }


############################################################
## Write the configuration file:
  my $conf_o = Symbol::gensym;
  open ($conf_o, ">$conf_fn")
	|| die "Cannot open file '$conf_fn'\n";

  foreach my $host (@hosts) {
    print $conf_o <<EoF;
zone "$host" { type master; file "$confdir/execrated.dname"; };
EoF
  }
  close $conf_o;

############################################################
## Write the zone file:
  my $zone_o = Symbol::gensym;
  open ($zone_o, ">$zone_fn") 
	|| die "Cannot open file '$zone_fn'\n";

  print $zone_o <<\EoF;
;
; BIND forward lookup for execrated networks
;
$TTL	604800
@	IN	SOA	localhost. root.localhost. (
			      1		; Serial
			 604800		; Refresh
			  86400		; Retry
			2419200		; Expire
			 604800 )	; Negative Cache TTL
;
@	IN	NS	localhost.
EoF
  close $zone_o;

############################################################
}	## end of main program