#!/usr/bin/perl
#
# zone_dump.pl version 1.10, 11-16-08
#
# Copyright 2005 - 2008 Michael Robinton <michael@bizsystems.com>
# rc.dnsbls is free software; you can redistribute it and/or 
# modify it under the terms of the GPL software license.
#
use strict;
#use diagnostics;
use Config;
use POSIX qw(nice);
use Compress::Zlib;
use Mail::SpamCannibal::SiteConfig;
use Proc::PidUtil 0.07 qw(
        is_running
        get_script_name
        make_pidfile
        zap_pidfile
);
use File::SafeDO qw(
	doINCLUDE
);


my $CONFIG = new Mail::SpamCannibal::SiteConfig;

# you can override the installation configuration variables by
# editing the configuration file 'config/dnsbls.conf' in the
# SpamCannibal home directory
#
# Set the SpamCannibal home directory if it is not
# what is found in Mail::SpamCannibal::SiteConfig
#
# $CONFIG->{SPAMCANNIBAL_HOME} = '/usr/local/spamcannibal';

# The number of times to retry the zone dump if it fails for some reason
#
my $retry = 3;			# default to try three time at most

###########################################################################
############## NO MORE CONFIGURABLE ITEMS BEYOND THIS POINT ###############
###########################################################################

nice(19) or die "nice failed\n";	# be very nice to other tasks

my $DEBUG = 0;
my $gzip = 0;
my $rbldns= 0;
my $rbldnset = 0;
my $rbldnstset = 0;
my $rbldnscombined = 0;
my $stub = 0;
my $port = 0;
my $now	 = 0;

while(($_ = shift @ARGV) && $_ =~ /^\-[dizrct]/) {
  if ($_ eq '-d') {
    $DEBUG = $_;
  }
  elsif ($_ eq '-r') {
    $rbldns = new Mail::SpamCannibal::ScriptSupport
	unless $rbldns;
    $rbldnstset = 1;
  }
  elsif ($_ eq '-i') {
    $rbldns = new Mail::SpamCannibal::ScriptSupport
	unless $rbldns;
    $rbldnset = 1;
  }
  elsif ($_ eq '-c') {
    $rbldns = new Mail::SpamCannibal::ScriptSupport
	unless $rbldns;
    $rbldnscombined = 1;
  }
  elsif ($_ eq '-z') {
    $gzip = $_;
  }
  elsif ($_ eq '-t') {
    $now = time;
  }
# ignore invalid switches
}

if ($now) {
  print STDERR scalar localtime($now);
  print STDERR "\n";
}

my $destdir = $_;
my $timeout = shift;

die qq|
Syntax:  $0 destination_dir timeout
    or	 $0 -r destination_dir timeout
    or	 $0 -i destination_dir timeout
    or	 $0 -c destination_dir timeout
    or	 $0 -z destination_dir timeout
    or	 $0 -t destination_dir timeout

	-c	cause an rbldns 'combined'
		ip4set file to be written.
		This file include NS A record
		for the DSNBL base zone

 	-i	cause an rbldns ip4set
		file to be written

 deprecated -r	cause an rbldns ip4tset
		file to be written

	-t	print the time in minutes
		to complete the zonedump
		to STDERR

	-z 	gzips the ip4tset output
		file, expect 95% compression

	Directory to write compressed zone file and
	'records' information text file 'bl_records'

	Timeout is the maximum number of minutes
	to wait for 'dnsbls' to complete zone dump,
	recommend 5 to 15

	Currently configured for $retry retries.

	-d switch provides some process trace info

| unless $destdir && $timeout &&
	-d $destdir && -w $destdir &&
	$timeout =~ /\d/ && $timeout !~ /\D/;

$timeout *= 60;

die "USR2 signal not found in perl::Config\n"
	unless  defined $Config{sig_name} && 
		$Config{sig_name} =~ /USR2/;
my $usr2 = 0;
foreach(split(' ',$Config{sig_name})) {
  last if $_ eq 'USR2';
  ++$usr2;
}

my $DNSBLS = doINCLUDE($CONFIG->{SPAMCANNIBAL_HOME} .'/config/dnsbls.conf') 
	or exit 1;

my $dbenv = $DNSBLS->{environment} || $CONFIG->{SPMCNBL_ENVIRONMENT} 
	or die "could not find SpamCannibal database environment\n";

my $zonefile = $DNSBLS->{zonename} .'.in'
	or die "zone name missing from dnsbls.conf\n";
my $zonein = $dbenv .'/'. $zonefile;
unlink $zonein if -e $zonein;		# remove old files hanging around

my $zoneout = $destdir .'/'. $zonefile;

my $dnsblpid;
my $error = '';
my @deadkids;

my $try = 'try';
RETRY:
foreach(1..$retry) {
  print STDERR "$try #$_  $error\n" if $DEBUG;
  $try = 'retry';
  $error = '';
  unless ($dnsblpid = is_running($dbenv .'/dnsbls.pid')) {
    $error = "'dnsbls' not running\n";
    sleep 120;			# give dbwatch a chance to restart stuff
    next RETRY;			# it checks every minute
  }
  kill $usr2, $dnsblpid;	# start the zone dump
  my $timer = $timeout -1;
  my $childf = '';		# child pid filename

  print STDERR "dump $zoneout to $destdir, timeout $timeout seconds\n" if $DEBUG;

  WAIT:
  foreach(1..120) {		# allow 120 seconds for task to start, then abort
    opendir(D,$dbenv) or die "failed to open database environment\n";
    @_ = grep(/dnsbls\.\d+\.pid/,readdir(D));
    closedir D;
    foreach my $kid (@_) {
      last WAIT unless grep(/$kid/,@deadkids);
    }
    $timer -= 1;
  print STDERR '.' if $DEBUG;
    sleep 1;
  }
  print STDERR "\n" if $DEBUG;
  foreach my $kid (@_) {		# there should not be more than one item alive
    next if grep(/$kid/,@deadkids);	# don't check dead kids
    print STDERR "check if $kid is alive\n" if $DEBUG;
    $childf = $dbenv .'/'. $kid;	# unless the system is not config'd right
    last if is_running($childf);
    $childf = '';
  }
  unless ($childf) {
    @deadkids = @_;
    $error = "dnsbls child not found\n";
    next RETRY;
  }
  $error = '';

  print STDERR "$childf running\ntimer = $timer  " if $DEBUG;

  while($timer > 0) {		# wait for child completion
    $timer -= 5;
    sleep 5;
    print STDERR "$timer " if $DEBUG;
    last unless is_running($childf);
  }
  print STDERR "\n" if $DEBUG;
  unless ($timer > 0) {
    $error .= "timeout waiting for zone dump to complete\n";
    next RETRY;
  }
  unless (-e $zonein && -r $zonein) {
    $error .= "'dnsbls' failed to create $zonein\n";
    next RETRY;
  }
  last;
}
die $error if $error;

##### have a zone file, get the record count 
my $interim;
if ($now) {
  $interim = time;
  print STDERR "zone creation   ", (int(($interim - $now)/60)), " minutes\n";
  print STDERR scalar localtime($interim);
  print STDERR "\n";
}


open(IN,$zonein)
	or die "failed to open new zonefile\n";

my $records = '<!-- no record count found -->'."\n";

while(<IN>) {
  last unless $_ =~ /^;/;		# punt if not a header line
  if ($_ =~ /(\d+)\s+A\s+records/) {
    $records = "contains $1 A records\n";
    last;
  }
}
seek(IN,0,0);				# rewind for zip operation

if ($gzip) {
  $gzip = gzopen($zoneout .'.gz.tmp','wb')
	or die "could not open gzip zonefile\n";
}
if ($rbldnstset) {
  open(RBLt,'>'. $zoneout .'.rbl.tmp')
	or die "could not open output rbldns ip4tset file\n";
}
if ($rbldnset) {
  open(RBLs,'>'. $zoneout .'.ip4set.rbl.tmp')
	or die "could not open output rbldns ip4set file\n";
}
if ($rbldnscombined) {
  open(RBLc,'>'. $zoneout .'.cmb.rbl.tmp');
  print RBLc $rbldns->rbldns_combined('ip4set');
}
if ($gzip || $rbldns) {
  while(<IN>) {
    if($gzip) {
      $gzip->gzwrite($_)
	or die "error writing gzip file: $gzerrno\n";
    }
    if ($rbldns) {
      my $line = $rbldns->dns2rblz($_);
      next unless $line;
      print RBLt $line if $rbldnstset;
      if ($rbldnset || $rbldnscombined) {
	$line = $rbldns->rbldns_compress($line);
	print RBLs $line if $rbldnset;
	print RBLc $line if $rbldnscombined;
      }
    }
  }
  if ($gzip) {
    $gzip->gzclose;
    rename $zoneout .'.gz.tmp', $zoneout .'.gz';	# atomic move
  }
  if ($rbldnstset) {
    print RBLt $rbldns->rbldnst_done();
    close RBLt;
    rename $zoneout .'.rbl.tmp', $zoneout .'.rbl';	# atomic move
  }
  if ($rbldnset) {
    print RBLs $rbldns->rbldns_done();
    close RBLs;
    rename $zoneout .'.ip4set.rbl.tmp', $zoneout .'.ip4set.rbl';
  }
  if ($rbldnscombined) {
    print RBLc $rbldns->rbldns_done(), $rbldns->rbldns_address();
    close RBLc;
    rename $zoneout .'.cmb.rbl.tmp', $zoneout .'.cmb.rbl';
  }
}

unless ($gzip || $destdir eq $dbenv) {
  seek(IN,0,0);			# rewind for copy operation
  open(OUT,'>'. $zoneout .'.tmp')
	or die "could not open output zonefile\n";
  while(<IN>) {
    print OUT $_;			# copy file to new destination
  }
  close OUT;
  rename $zoneout .'.tmp', $zoneout;	# atomic move
}

close IN;

unlink $zonein if ($gzip || $destdir ne $dbenv) && -e $zonein;

open(OUT,'>'. $destdir .'/bl_records.tmp')
	or die "could not open bl_records file\n";
print OUT $records;
close OUT;
rename $destdir .'/bl_records.tmp', $destdir .'/bl_records';

if ($now) {
  print STDERR "file conversion ",(int((time - $interim)/60)), " minutes\n";
  print STDERR scalar localtime();
  print STDERR "\nzone dump took  ", (int((time - $now)/60)), " minutes\n";
}

exit 0;