#!/usr/bin/perl

# Script to automatically build sa-update tarballs for SARE rulesets
# Daryl C. W. O'Shea, DOS Technologies
# August 1, 2006



# The Plan:
#
#	- get http://www.rulesemporium.com/rules/ index
#	- parse cf filenames and associated dates
#	- lookup filenames in database for an assigned file number
#	  - authomatically assign a new number for new files
#	- build a tarball for every combination of the (updated) files
#	- create GPG .asc files and SHA1 .sha files for each tarball
#	- update the version number of the updated tarballs in DNS
#	  (use includes in Bind)


use strict;
use LWP::UserAgent;
use DBI;
use IO::Zlib;
use Archive::Tar;


# lots of relative paths from ...
chdir("/home/dos/sare-sa-updates/");


# clear the named reload script that root runs periodically
open (NAMED, ">named-reload.sh");
print NAMED "#!/bin/bash\n";
close NAMED;

my $ua = new LWP::UserAgent;

# set a reasonable timeout
$ua->timeout(30);


my $request = new HTTP::Request('GET', 'http://www.rulesemporium.com/rules/');
#my $request = new HTTP::Request('GET', 'http://209.177.149.122/rules/');

my $response = $ua->simple_request($request);

#print $response->status_line, "\n";

die "rules/ index query failed ".$response->status_line."\n" unless $response->is_success;


# parse out the cf files and their dates
# TODO: this won't catch a file updated twice in the same second

my %ruleset_dates = ();
my $content = $response->content;

my %months = (	"Jan" => "01", "Feb" => "02", "Mar" => "03", "Apr" => "04",
		"May" => "05", "Jun" => "06", "Jul" => "07", "Aug" => "08",
		"Sep" => "09", "Oct" => "10", "Nov" => "11", "Dec" => "12" );

while ($content =~ /<img src.*href=\"(.*?.cf)\">\1<\/a>\s+(\S+ \S+)/g) {
  my $ruleset = $1;
  my $date = $2;

  $date =~ /^(\d{2})-([A-Za-z]{3})-(\d{4}) (\d{2}):(\d{2})$/;
  $ruleset_dates{$ruleset} = "$3$months{$2}$1$4$5";

#  print $ruleset_dates{$ruleset}, "\t", $ruleset, "\n";
}


# check to see if the ruleset is in our database
# get its last update time if it is
# add the ruleset if it isn't
# (we determine what rulesets to grab here

my @rulesets_to_update = ();
my %ruleset_versions = ();

my $dbh = DBI->connect("DBI:mysql:sa-update:localhost", "dos", "envc63Dq",
			{'PrintError' => 1});

my $sql = "SELECT date_last_update, number_updates FROM sare WHERE ruleset = ?";
my $sths = $dbh->prepare_cached($sql);

$sql = "INSERT INTO sare (ruleset, date_last_update, date_first_update, 
	number_updates) VALUES (?, 0, ?, 0)";
my $sthi = $dbh->prepare_cached($sql);

while (my ($ruleset, $date) = each (%ruleset_dates)) {
  my $date_last_update = 0;

  # select ruleset from database
  # TODO: use date not epoch seconds
  my $rc = $sths->execute($ruleset);

  unless ($rc) {
    # TODO: clean up database handles
    die "\$rc not defined for query of: $ruleset";
  }

  if ($rc == 1) {
    ($date_last_update, $ruleset_versions{$ruleset}) = $sths->fetchrow_array();
  }
  elsif ($rc == 0) {
    # insert if non-existent
    my $rc = $sthi->execute($ruleset, time());
    mkdir "channels/$ruleset" or die "failed to mkdir channels/$ruleset";
    mkdir "rulesets/$ruleset" or die "Failed to mkdir rulesets/$ruleset";

    open(MIRRORS, ">channels/$ruleset/MIRRORED.BY") or die "can not open channels/$ruleset/MIRRORED.BY for write";
    print MIRRORS "http://daryl.dostech.ca/sa-update/sare/$ruleset/\n";
    print MIRRORS "http://updates.sa-update.com/sare/$ruleset/\n";
    close MIRRORS;

    $ruleset_versions{$ruleset} = 0;

    unless ($rc) {
      # TODO: clean up database handles
      die "\$rc not defined for insert of: $ruleset";
    }
    unless ($rc == 1) {
      # TODO: clean up database handles
      die "\$rc of $rc not valid";
    }
  }
  else {
    # TODO: clean up database handles
    die "\$rc of $rc not valid";
  }


  if ($date > $date_last_update) {
    print "added to update list: $ruleset\n";
    push @rulesets_to_update, $ruleset;
    $ruleset_versions{$ruleset}++;
  }
}

$sths->finish();


# since the SARE rules/ index only lists date stamps with minute accuracy we
# have to wait a minute here (after getting the index and determining there
# are updates to download) in case a file gets updated more than once in the
# same minute to avoid downloading earlier versions, and missing later
# versions, in the same minute
sleep 62 if scalar @rulesets_to_update;


# download rulesets (use wget)
# update date in database for each ruleset

my $sql = "UPDATE sare SET date_last_update = ?, number_updates = number_updates + 1 WHERE ruleset = ?";
my $sth = $dbh->prepare_cached($sql);

#my $i = 0;
my @updated_rulesets = ();
foreach my $ruleset (@rulesets_to_update) {
  #$i++;  last if $i == 3;
  print "fetching ruleset: $ruleset\n";

  my $request = new HTTP::Request('GET', "http://www.rulesemporium.com/rules/$ruleset");
  my $response = $ua->simple_request($request);
  print $response->status_line, "\n";

  die "rules/$ruleset query failed" unless $response->is_success;

  open (RULESET, ">rulesets/$ruleset/$ruleset_dates{$ruleset}.cf") or die "can not open $ruleset for writing";
  print RULESET $response->content;
  close RULESET;

  my $rc = $sth->execute($ruleset_dates{$ruleset}, $ruleset);

  unless ($rc) {
    # TODO: clean up database handles
    die "\$rc not defined for query of: $ruleset";
  }
  push @updated_rulesets, $ruleset;

}


# build tarballs, sign them, etc
foreach my $ruleset (@updated_rulesets) {
  print "creating archive: channels/$ruleset.tar.gz\n";
  chdir("rulesets/$ruleset/");
  Archive::Tar->create_archive("../../channels/$ruleset/$ruleset_dates{$ruleset}.tar.gz",9,"$ruleset_dates{$ruleset}.cf");
  chdir("../../");

  print "creating sha1sum: channels/$ruleset.tar.gz\n";
  system("/usr/bin/sha1sum channels/$ruleset/$ruleset_dates{$ruleset}.tar.gz > channels/$ruleset/$ruleset_dates{$ruleset}.tar.gz.sha1");

  print "signing archive: channels/$ruleset.tar.gz\n";
  system("/usr/bin/gpg -bas channels/$ruleset/$ruleset_dates{$ruleset}.tar.gz");
}


# if there are no updated rulesets we're done
unless (scalar @updated_rulesets) {
  exit 1;
}


# update DNS
#1.1.3.updates.spamassassin.org. 3600 IN TXT     "428423"

my $time = time();

open (DNS, ">sare.sa-update.dostech.net.zone") or die "can not open DNS zone file for writing";
open (CHANNEL, ">sare-sa-update-channels.txt") or die "can not open channel file for writing";

print DNS <<EOF;
\$TTL 1d
sare.sa-update.dostech.net.	IN SOA  ns6.dostech.net. admin.dostech.ca. (
				$time ; serial
				900        ; refresh (15 minutes)
				600        ; retry (10 minutes)
				1209600    ; expire (14 days)
				3600       ; minimum (1 hour)
				)

			IN	NS	ns5.dostech.net.
			IN	NS	ns6.dostech.net.
			IN	NS	ns7.dostech.net.

			IN	RP	spamassassin.dostech.ca. .

\$TTL 1h

EOF

# default channel always needs to be updated!
my $time_string = scalar localtime();
print CHANNEL <<EOF;
#########################################################################
#
# Automatically generated list of sa-update channels for SARE rulesets
#
# Generated at: $time_string
#
# Channel how-to located at:
#	http://daryl.dostech.ca/sa-update/sare/sare-sa-update-howto.txt
#
# Channel GPG key located at:
#	http://daryl.dostech.ca/sa-update/sare/GPG.KEY
#
# Contact: Daryl C. W. O'Shea <spamassassin\@dostech.ca>
#
#########################################################################

# Default channel provided by the Apache SpamAssassin project.
# You must update it at least once if you want to use sa-update

updates.spamassassin.org


# SARE ruleset channels.
# Please note, not all rulesets are for all versions of SpamAssassin.
# Please check the SARE website at http://www.rulesemporium.com/rules.htm
# to see what rulesets apply to your installed version of SpamAssassin.

# NOTE: As of August 13th 2006 the 70_sare_whitelist_spf.cf ruleset is
#	broken upstream so that channel will currently fail to update.

EOF


my $sql = "SELECT ruleset, date_last_update FROM sare WHERE number_updates > 0";
my $sth = $dbh->prepare_cached($sql);

my $rc = $sth->execute();

unless ($rc) {
  # TODO: clean up database handles
  die "\$rc not defined for query of: zone files update";
}

my @channel_lines = ();
while (my @row = $sth->fetchrow_array()) {
  print DNS "*.$row[0]\tIN TXT\t\"$row[1]\"\n";
  print DNS "mirrors.$row[0]\tIN TXT\t\"http://daryl.dostech.ca/sa-update/sare/$row[0]/MIRRORED.BY\"\n";
  print DNS "$row[0]\tIN RP spamassassin.dostech.ca. .\n\n";

  push @channel_lines, "#$row[0].sare.sa-update.dostech.net\n";

  # TODO: delete this?  it is only needed to create missing files for alrady present channels
  open(MIRRORS, ">channels/$row[0]/MIRRORED.BY") or die "can not open channels/$row[0]/MIRRORED.BY for write";
  print MIRRORS "http://daryl.dostech.ca/sa-update/sare/$row[0]/\n";
  print MIRRORS "http://updates.sa-update.com/sare/$row[0]/\n";
  close MIRRORS;

}
$sth->finish();

close DNS;

foreach my $line (sort @channel_lines) {
  print CHANNEL $line;
}
close CHANNEL;

# add to the script root runs periodically to reload named
open (NAMED, ">>named-reload.sh");
print NAMED <<EOF;
/sbin/service named reload
echo "#!/bin/bash" > /home/dos/sare-sa-updates/named-reload.sh

EOF
close NAMED;

exit 0; 
