emailBL code

[Adam Katz]

Jeff Moss wrote:
> This is not to suggest that I ever understood the part about using
> half-length MD5.

No need.  I'm using full-length hashes now, plus the SURBL/chmod style
IP addresses.  I must have lost the email I was composing on the topic,
but it's fully propagated by now.  I've attached my code.

Note that the code still supports the old truncated string.  I'll rip
that out soon.  Also note that I'm not an advanced perl coder (almost
all of my perl scripts start as POSIX shell scripts, including this one)
... so while I'm happy to get *suggestions*, I'm not so eager for the
insults and hash words this list tends to give instead.

#!/usr/bin/perl
## Generates bind data with the data from the anti-phishing-email-reply project.
## Usage:  emailbl [SUBDOMAIN] DOMAIN
##   Example:  emailbl emailbl khopesh.com
## emailbl v0.6 Copyright (C) 2009 by Adam Katz <scriptsATkhopiscom>, AGPL v3+

use warnings;
use strict;
use Digest::MD5 "md5_hex";
use LWP::Simple "get";

my $subdomain = $ARGV[0];
my $domain = $ARGV[1];
if ($domain !~ /./) { $domain = $subdomain; $subdomain = ''; }
else { $domain = "$subdomain.$domain"; }
$subdomain = "." . $subdomain;

# six lines for this? ... $dummy_last_seen=`TZ=UTC date +%Y%m%d`
my @date = gmtime(time);
my $dummy_last_seen = $date[5]+1900;
if ($date[4] < 10) { $dummy_last_seen .= 0; }
$dummy_last_seen .= $date[4]+0; # adding to zero in case it's already padded
if ($date[3] < 10) { $dummy_last_seen .= 0; }
$dummy_last_seen .= $date[3]+0; # adding to zero in case it's already padded

my $list = "phishing_reply_addresses";
my $bindconf = "emailbl.db";

open(LIST, ">", $list) or die $!;
print LIST <<EOF;
te...@example.com,ABCD,$dummy_last_seen
te...@emailbl.khopesh.com,ABCD,$dummy_last_seen
hidd...@example.com,ABCDZ,$dummy_last_seen
hidd...@emailbl.khopesh.com,ABCDZ,$dummy_last_seen

EOF

# TODO: use subversion!
my $antiphishing_url = 
"http://anti-phishing-email-reply.googlecode.com/svn/trunk/phishing_reply_addresses";;
print LIST get($antiphishing_url); # saved for debug purposes

close(LIST);

open(BIND, ">", $bindconf) or die $!;

print BIND "; $domain BIND named, " . gmtime() . " (UTC) from\n";
print BIND "; $antiphishing_url\n\n";

print BIND "; SPF record (just in case)\n";
my $spf = $subdomain;
$spf =~ s/^\.//;
if (!$spf) { $spf = "@"; }
print BIND "$spf\tIN\tTXT\t\"v=spf1 -all\"\n\n";

# more test points - "hidden" and "test" can be used as if hashes of themselves.
print BIND "hidden.hash$subdomain       IN\tTXT\t\"\...@hidden\@\"\n";
print BIND "test.hash$subdomain IN      TXT     \"te...@$domain\"\n";
foreach ("2.0.0.127","hidden.example.com","test.$domain","test.example.com") {
  print BIND "$_$subdomain      IN      TXT     $dummy_last_seen\n";
  print BIND "$_$subdomain      IN      A       127.0.0.15\n";
  #for (my $t=1; $t<5; $t++) {
  #  print BIND "$_$subdomain   IN      A       127.0.0.$t\n";
  #}
}

print BIND "\n\n";

open(LIST, $list) or die $!;
while(<LIST>) {
  next if (!/^[^#@,]...@[^#@,]+,[A-DZ]+,[0-9]{8}\s*$/);
  chomp;

  my ($hash, $usr, $email, $ans, $start, $ustart, $type_list, $last_seen);
  $hash = $email = $start = $type_list = $last_seen = $_;

  $ans = "; " . $_ . "\n"; # copy original as a comment

  $hash =~ s/@.*//;
  $hash =~ tr [A-Z] [a-z];
  $usr = $hash;
  #$hash = substr(Digest::MD5::md5_hex($hash),16); # 2nd 16 of 32 chars
  $hash = Digest::MD5::md5_hex($hash);   # 1:3.2e11 collisions vs 1:190 above
  $usr =~ s/^([...@+]{1,16})[...@]*@.*/$1/;  # truncate to 16 characters
  $usr =~ s/^[^a-z0-9]+|[^a-z0-9]+$//g;  # fix leading/trailing chars
  $usr =~ s/[^-a-z.0-9]/-/g;             # fix illegal chars

  $email =~ s/,.*//;
  $email = "$hash.hash$subdomain\tIN\tTXT\t\"$email\"\n";

  $start =~ s/^...@]+@([^,]+),.*/$hash.$1$subdomain\tIN/;
  $ustart = $start;
  $ustart =~ s/$hash/$usr/;

  $type_list =~ s/.*,([A-IZ]+),.*/$1/;
  if ($type_list =~ /Z/) {
    $email =~ s/\t".*"/\t"\...@hidden\@"/; # hide the email address
    $type_list =~ s/Z//g;
  }
  $type_list =~ s/(?=.)/+/g;
  $type_list =~ tr [ABCD] [1248]; # this needs rewriting when we get an E!
  $type_list = eval 0 . $type_list;
  $type_list = "\tA\t127.0.0.$type_list\n";
  $type_list = $start . $type_list . $ustart . $type_list;
  #my @types = split(/(?=.)/, $type_list);

  $last_seen =~ s/^.*,([0-9]+)\s*$/$start\tTXT\t$1\n/;

  $ans .= $email . $last_seen;
  $last_seen =~ s/$hash/$usr/;
  $ans .= $last_seen . $type_list;

  #foreach (@types) {
  #  $ans .= $start . "\tA\t127.0.0." . $_ . "\n";
  #  $ans .= $ustart . "\tA\t127.0.0." . $_ . "\n";
  #}
  print BIND $ans;
}
close(LIST);

close(BIND);