#!/usr/bin/perl
#
# Updates a local ClamAV mirror with the lastest updates
# available from the upstream mirror.  If updates area available
# DNS is updated with the changes then notified.
#
# Writtern 2008-08-08 by Scott Quinlan <scott@quinlan.co.nz>
# Copyright (c) 2008 Scott Quinlan <scott@quinlan.co.nz>
#
# Changelog
#
#   v1.1   - scott@quinlan.co.nz - 20081210
#	   * Resolved bug with regex to correctly match
#	     match file version for updates.
#
#   v1.0   - scott@quinlan.co.nz - 20080808
#          * Created script.
#

use strict;
use warnings;

use Socket;
use Net::DNS;

# Define a list of known versions and the upstream spamassassin server
my $updServer		= "current.cvd.clamav.net";
my $mirrorZone		= "quinlan.co.nz";
my $mirrorCNAME		= "clamav";
my $destination		= "/var/www/clamav.quinlan.co.nz/htdocs/";
my @mirrorList		= qw/db.local.clamav.net db.nz.clamav.net/;
my @notifyList		= qw/127.0.0.1/;
my @files		= qw/main daily/;
my %updateInfo		= ();
my %localInfo		= ();
my $updatesAvailable	= 0;
my $localIP4Addr	= '127.0.0.1';
my $updateKeyName	= 'rndc_key';
my $updateKey		= 'insert your private key here';

&main;

sub retrieve_file_version
{
	my ($fileName) = @_;

	return 0 unless (-f sprintf("%s%s", $destination, $fileName));

	my $header = `strings $destination$fileName  | head -n 1`;

	chomp($header);

	# If we cannot match version number within
	# the header of the clamav database then warn
	warn (sprintf("Unable to determine file version for %s%s.", $destination, $fileName)) unless (!$? && $header =~ /^ClamAV\-VDB\:[0-9]{2}\s\S{3}\s[0-9]{4}\s[0-9]{2}\-[0-9]{2}\s[\+|\-][0-9]{4}\:([0-9]+)/i); 

	return $1;
}

sub download
{
	my ($fileName, $overwrite) = @_;

	my ($sec,$min,$hour,$mday,$mon,$year) = localtime(time);

	my $destinationFile = ($overwrite) ? sprintf ("%s%s-%04d%02d%02d", $destination, $fileName, $year+1900, $mon+1, $mday) : sprintf ("%s%s", $destination, $fileName);

	for (my $i=0; $i<@mirrorList+1 && !(-f $destinationFile); $i++)
	{
		# Download daily.cvd from upstream mirrors, try 10 times with a timeout
		# of 60 seconds for each known mirror before giving up
		`wget --tries 10 -T 60 $mirrorList[$i]/$fileName -qO $destinationFile`;

		# There was a problem (404)?
		if ($? && -f $destinationFile)
		{
			unlink $destinationFile;
			next;
		}

		if ($overwrite)
		{
			if (-f sprintf("%s%s", $destination, $fileName))
			{
				unlink(sprintf("%s%s", $destination, $fileName)) or die (sprintf("Unable to remove previous hard link for %s.", $fileName));
			}

			link ($destinationFile, sprintf("%s%s", $destination, $fileName)) or die (sprintf("Unable to create hard link for %s.", $fileName));
 		}

		$updatesAvailable = 1;
	}

	return (-f sprintf ("%s%s", $destination, $fileName));
}

sub main
{
	my $res = new Net::DNS::Resolver;

	die ("Unable resolve TXT record for upstream server.\n") unless (my $query = $res->query($updServer, "TXT"));

	# Retrieve update info from DNS
	foreach my $rr (grep { $_->type eq "TXT"} $query->answer)
	{
		my $release = $rr->rdata;

		if ($release =~ /(([0-9]+\.?)+):([0-9]+):([0-9]+):([0-9]+):([0-9]+):([0-9]+)/)
		{
			$updateInfo{'version'} = $1;
			$updateInfo{'main'} = $3;
			$updateInfo{'daily'} = $4;
			$updateInfo{'timestamp'} = $5;
			$updateInfo{'unknown'} = $6;		# If you know what this is please let me know
			$updateInfo{'f-level'} = $7;
			last;
		}
	}

	die ("Unable to retrieve update information.\n") if (%updateInfo le 0);

	foreach (@files)
	{
		# Download the lastest main database unless different from the local
		warn (sprintf("Unable to download %s.cvd.", $_)) unless ($updateInfo{$_} == retrieve_file_version(sprintf("%s.cvd", $_)) || download (sprintf("%s.cvd", $_), 1));
	}

	# Download the lastest daily update (and any dailies we might be missing, 20 should be enough)
	for (my $i = $updateInfo{'daily'}; $i > $updateInfo{'daily'}-20; $i--)
	{
		warn (sprintf("Unable to download daily update file daily-%d.cdiff", $i)) unless (download (sprintf("daily-%d.cdiff", $i)));
	}

	# Update local DNS with new TXT record only if updates are available
	if ($updatesAvailable)
	{
		my $res = new Net::DNS::Resolver;

		# Set key and key name for authorization
		$res->tsig($updateKeyName, $updateKey);

		# Source address, this is also required for authorization
		$res->srcaddr($localIP4Addr);

		# Update the zone for each namesever
		foreach (@notifyList)
		{
			# Create update packet
			my $update = Net::DNS::Update->new($mirrorZone);

			# We first need to delete all existing TXT records, then
			# create a new record with the updated information
			$update->push("update", rr_del(sprintf("%s.%s TXT", $mirrorCNAME, $mirrorZone)));
			$update->push("update", rr_add(sprintf("%s.%s TXT '%s:%d:%d:%d:%d:%d'", $mirrorCNAME, $mirrorZone, $updateInfo{'version'}, $updateInfo{'main'}, $updateInfo{'daily'}, $updateInfo{'timestamp'}, $updateInfo{'unknown'},  $updateInfo{'f-level'})));

			my $reply = $res->send($update);

			# Did it work?
			warn (sprintf("Update of %s failed (%s).\n", $_, $res->errorstring)) && next if (!$reply);
			warn (sprintf("Update of %s failed ().\n", $_, $res->header->rcode)) && next if ($reply->header->rcode ne 'NOERROR');

			# Excellent, now notify	
			my $packet = new Net::DNS::Packet($mirrorZone, "SOA", "IN");

			warn(sprintf("Unable to create DNS packet for name server notifiy (%s).\n", $_)) && next unless ($packet);

			$packet->header->opcode("NS_NOTIFY_OP");
			$packet->header->rd(0);
			$packet->header->aa(1);

			$res->nameservers($_);

			$reply = $res->send($packet);

			warn (sprintf("Result indicates NOTIFY error for %s.", $_)) unless ($reply);
		}
	}
}

1;