#!/usr/bin/perl
#
# This script yanks the DNS-BH domains.txt file and processes it so that it
# is suitable to use with MaraDNS.  It creates wildcarded A records and a
# 'dummy' MX record for the domain and cunningly tags on a TXT records so
# you can make a DNS query to see *why* the domain was blacklisted without
# having to actually consult the original domains.txt file.
#
# To use, add to your /etc/maradns/mararc file:
# =====
#  # following all gleaned from:
#  # http://www.maradns.org/tutorial/recursive.html#custom
#  csv2 = {}
#  # you MUST use 'example.com.', do NOT change!
#  csv2["example.com."] = "db.blacklist"
#
#  # do not use 'bind_address' but instead (or '0.0.0.0'):
#  ipv4_bind_addresses = "127.0.0.1,a.b.c.d,w.x.y.z"
# =====
#
# The 'db.blacklist' file the script produces should be placed in /etc/maradns
#
# Best way to run this is to put in a file '/etc/cron.d/dns-chores'
# =====
# # Every two hours check for updates
# 15 0-23/2       * * *   root    test -x /usr/local/bin/create-blacklist && /usr/local/bin/create-blacklist && /etc/init.d/maradns restart > /dev/null
# =====
#
# Alexander Clouter <alex@digriz.org.uk> - Copyright 2008
#  - released under the GNU General Public License (GPL) version 2
#
# Sponsored by The School of Oriental and African Studies, UK
#
use strict;
use warnings;

use LWP;

use Data::Dumper;

use constant SRC	=> 'http://www.malwaredomains.com/files/domains.txt';
use constant LOCAL_SRC	=> '/etc/maradns/domains.txt';
use constant BLACKLIST	=> '/etc/maradns/db.blacklist';

# replace the following with your honeypot FQDN alternatively just 'localhost'
my @HONEY_IP		=  ( '1.2.3.4' );
my $HONEY_FQDN		=  'honeypot.example.com';

# optional trims (if it appears in the line, skip entry)
#my @trims		= (
#		'exploit_ani',
#		'naver.com',
#);

my $req = HTTP::Request->new;
$req->method('GET');
$req->uri(SRC);
$req->header(Accept => 'text/plain');

my $m = (stat(LOCAL_SRC))[9];
if ( -f LOCAL_SRC ) {
  my $mod = scalar gmtime($m);
  $mod =~ s/^(\w+) (.*)$/$1, $2/;
  $req->header('If-Modified-Since' => $mod);
}

my $ua = LWP::UserAgent->new;
$ua->agent('MaraDNS-DNSBH-Conv/0.1');
my $response = $ua->request($req, LOCAL_SRC);

if ( $response->code == 304
	&& -f BLACKLIST && $m <= (stat(BLACKLIST))[9] ) {
  #print STDERR "domain blacklist is already up to date\n";
  exit 1;
}

unless ( $response->code == 200 || $response->code == 304 ) {
  print STDERR 'there was an error (' . $response->code . ') when fetching file: ' . $response->message . "\n";
  exit -1;
}

my %domains;

local *IN;
open IN, '< ' . LOCAL_SRC;
while ( my $line = <IN> ) {
  # tab, space and newline (line feed) are the only permitted non-printable's
  # otherwise we only want ASCII thank you
  if ( $line =~ /[\x00-\x08\x0b-\x1f\x80-\xff]/ ) {
    print STDERR "unprintable characters on line $....removing guff\n";
    $line =~ s/[\x00-\x08\x0b-\x1f\x80-\xff]//g;
  }

  next if ( $line =~ /^\s*#/ );

  $line =~ s/^\s*(.*?)\s*$/$1/;

  # filter 'false positives' for now
#  next if ( scalar grep { index($line, $_) != -1 } @trims );

  my ( $domain, $reason ) = split /\s+/, $line, 2;
    $domain = lc $domain;

  # this we can fix
  if ( substr($domain, 0, 1) eq '.' || substr($domain, -1) eq '.' ) {
    print "mangled domain ('$domain'), trimming fullstops\n";
    $domain =~ s/^\.*(.*?)\.*$/$1/;
  }

  # http://www.ietf.org/mail-archive/web/netmod/current/msg00399.html
  # amended to permit '_' in the hostname and single character bits
  unless ( $domain =~ /^(([a-z0-9][\w\-]*)?[\w]\.)*[a-z0-9][a-z0-9\-]*[a-z0-9]$/ ) {
    print "invalid domain ('$domain'), skipping\n";
    next;
  }

  ## fixup's in the reason
  # 'www.bleedingthreats.net/forum/viewtopic.php?forum=11    showtopic=98'
  $reason =~ s/(.*?\?.*?)\t+(?=.*?\=.*?)/$1&/g;

  # the reason area is free text so we need to escape it and what not
  # FIXME: others need adding as I come across them
  $reason =~  s/#/'\\x23'/g;
  $reason =~ s/\|/'\\x7c'/g;
  $reason =~  s/~/'\\x7e'/g;

  $reason =~ s/\t/ : /g;

  $domains{$domain} = $reason;
}
close IN;

open OUT, '> ' . BLACKLIST;
foreach my $domain ( keys %domains ) {
  foreach my $ip ( @HONEY_IP ) {
    print OUT <<EOF;
$domain.	A $ip ~
*.$domain.	A $ip ~
EOF
  }

  print OUT <<EOF;
$domain.	MX 0 $HONEY_FQDN. ~
*.$domain.	MX 0 $HONEY_FQDN. ~
$domain.	TXT 'dnshijack : ${\$domains{$domain}}' ~

EOF
}
close OUT;

exit 0;