#!/usr/bin/perl -w
#-*-perl-*-

require 5;
use strict;

use Rcs;
use File::Basename;

#
# Set to '1' to DEBUG!
#
my $DEBUG1 = 1;
my $DEBUG2 = 0;

#
# strip the pathname from the name of the program
#
$0 =~ s!.*/!!;

#####################################################################
#
# Start of configurable parameters
#
#####################################################################
#
# where the RCS commands live
Rcs->bindir('/usr/bin');

my $conf    = "/etc/bind/named.conf.local";
my $rndc     = "/usr/sbin/rndc";
my $rndc_key = '/etc/bind/rndc.key';
my $default_editor = '/usr/bin/jed';
my $checkzone = '/usr/sbin/named-checkzone';

#
# To get this working with 'view' comment out the next two lines
#
die "Usage: $0 <domain>\n" unless $#ARGV == 0;
my $view = '';    
#
# and comment in the next two lines
# (Not tested in this version)
#
#die "Usage: $0 <view> <domain>\n" unless $#ARGV == 1;
#my $view = lc (shift @ARGV);
#
# end of 'view' changes
#
#####################################################################
#
# End of configurable parameters
#
#####################################################################

my $domain = lc (shift @ARGV);

# declare these subroutines in advance
sub domain2zone ($);
sub masterzone2file (@);

my $zone = domain2zone($domain);
$DEBUG1 && print "Domain: $domain ==> $zone\n";
my $file = masterzone2file($view, $zone);
$DEBUG1 && print "Zone: $zone ==> $file\n";

my $basename = basename ($file, '');
my $dirname = dirname ($file);

# change to the working file directory
chdir ($dirname) or die "Can't chdir to '$dirname'\n";

# Initialise the RCS structures
my $obj = Rcs->new;
$obj->file($basename);

my $rcsfile = $obj->rcsdir . '/' . $obj->arcfile;

# if the RCS directory doesn't exist, make it
mkdir ( $obj->rcsdir) unless ( -d $obj->rcsdir );

# move existing RCS file into an RCS directory
if ( -e $obj->arcfile ) {
    rename ($obj->arcfile, $rcsfile);
}

unless ( -e $rcsfile ) {
    # we need an RCS file from somewhere
    $obj->rcs('-i', "-t-Created using '$0'");
    # if the working file exists check it in
    if ( -e $basename ) {
	print "Checking in '$basename'\n";
	$obj->ci('-u', "-mChecked in using '$0'");
    }
}

# check to see if the working file has been changed
if ( -e $basename ) {
    my $changed = $obj->rcsdiff;
    if ($changed) {
	die "'$file' is out of sync with its latest RCS version.\nUse 'rcs -l $file; ci -u $file'\n";
    }
}

$DEBUG2 && print "Checkout: $!basename\n";
$obj->co('-l') || die "Failed to lock zone file: $basename\n";

# if the editor crashes, restore the original file
$SIG{INT}=$SIG{QUIT}=$SIG{TERM}= \&save_me;

$DEBUG2 && print "Edit: $basename\n";
edit($basename);

my @diff_output;
if ((@diff_output = $obj->rcsdiff)) {
    if ($DEBUG1) {
	print "\nChanges:\n---\n";
	foreach my $line (@diff_output) {
	    chomp ($line);
	    print "$line\n";
	}
	print "---\n";
    }
    
    $DEBUG2 && print "Update Serial: $basename\n";
    updateserial($basename);
    
    $DEBUG2 && print "Check In: $basename\n";
    $obj->ci('-u', "-mModified using '$0'");

    $DEBUG2 && print "Running named-checkzone: $zone $file\n";
    if (checkzone ($zone, $file)) {
	$DEBUG2 && print "Ndc reload: $zone\n";
	ndcreload($zone);
    } else {
	$DEBUG2 && print "'$zone' NOT reloaded\n";
	print "ERROR: Re-run '$0 $zone' and fix NOW!\n"
    }
} else {
    $DEBUG2 && print "Check In: $basename\n";
    $obj->ci('-u', "-mModified using '$0'");
}

exit 0;

#
# Subroutines used in script
#
sub save_me {
    # Signal handler: only installed after checking out a file, 
    # to try and check the file back in.
    printf("Abandoning changes and reverting to previous version\n");
    my($result) = $obj->co('-u', '-f');
    exit(1);
}

sub edit {
    my $file = shift;
    my $editor = $ENV{'EDITOR'} ||= $default_editor;

    $DEBUG2 && print "\tEditor: $editor\n";
    my $editresult = system $editor, $file;
    if ($editresult) {
	save_me("[Child killed]");
    }
    return ($editresult == 0);
}

sub domain2zone ($) {
    my $domain = shift;

    die "domain $domain contains invalid characters\n" 
	if ($domain !~ /^[a-z0-9\.\-]+$/);
    $domain =~ s/\.$//;
    my @parts = split('\.', $domain);
    my $zone = $domain;
    if ($zone =~ /ip6\.int$/ || $zone =~ /ip6\.arpa$/) {
	return $zone;
    }
    if (@parts == 1) {	
	$zone = "$parts[0].in-addr.arpa" if classA_IP(@parts);
    } elsif (@parts == 2) {
	$zone = "$parts[1].$parts[0].in-addr.arpa" if classB_IP(@parts);
    } elsif (@parts == 3 || @parts == 4) {
	$zone = "$parts[2].$parts[1].$parts[0].in-addr.arpa" 
	    if (($zone !~ /in-addr\.arpa$/) && classC_IP(@parts));
    } elsif (@parts > 4 && ($zone !~ /in-addr\.arpa$/) && classC_IP(@parts)) {
	die "Invalid IP: Too many octets\n";
    }

    return $zone;
}

sub classA_IP {
    my $oct = shift;

    return (isoct($oct) && ($oct&0x80) == 0x00);
}

sub classB_IP {
    my $oct = shift;

    return (isoct($oct) && ($oct&0xc0) == 0x80 || classA_IP($oct));
}

sub classC_IP {
    my $oct = shift;

    return (isoct($oct) && ($oct&0xe0) == 0xc0 || classB_IP($oct));
}

sub isoct {
    my $oct = shift;

    return ($oct =~ /^\d+$/ && $oct < 256 && $oct >= 0);
}

sub masterzone2file (@) {
    my $view = shift;
    my $zone = shift;
    my $zoneinfo = findzone($view, $zone);
    die "No zone matching: $zone\n" unless $zoneinfo;
    die "$zone is a secondary zone - make changes to the primary zone\n" 
        if $$zoneinfo{'type'} eq 'slave';
    return $$zoneinfo{'file'};
}

sub findzone (@) {
    my $view = shift;
    my $zone = shift;
    my $zoneinfo;
    my $foundview = 0;

    open CONF, $conf || die "Failed to open $conf\n";
    while(defined($zoneinfo = getnextzone(\*CONF))) {
	$DEBUG2 && print "VIEW: $view $$zoneinfo{'view'}\n";
	if ($$zoneinfo{'view'} eq $view) {
	    $foundview = 1;
	} elsif ($$zoneinfo{'view'} ne '' && $$zoneinfo{'view'} ne $view) {
	    $foundview = 0;
	}
	$DEBUG2 && print "ZONE: $zone $$zoneinfo{'name'}\n";
	if ($foundview && $$zoneinfo{'name'} eq $zone) {
		close CONF;
		return $zoneinfo;
        } 
    }
    return undef;
}

sub getnextzone {
    my $fh = shift;
    my $view;
    my $zone;
    my %zone;

    $zone{'view'} = '';

    while(<$fh>) {
	chomp;
	s|//.*$||g;

	if (!$view && /view\s*"(.*?)"\s*{/) {
	    $zone{'view'} = lc $1;
	    $DEBUG2 && print "\t$zone{'view'}\n";
	    $view = 1;
	}
	if (!$zone && /zone\s*"(.*?)"\s*{/) {
	    $zone{'name'} = lc $1;
	    $DEBUG2 && print "\t$zone{'name'}\n";
	    $zone = 1;
	} elsif ($zone) {
	    if (/type\s*(\S+);/) {
		$zone{'type'} = $1;
		$DEBUG2 && print "\t\tType: $zone{'type'}\n";
	    } elsif (/file\s*"(.*?)"/) {
		$zone{'file'} = "$1" if ($zone{'type'} eq 'master');
		$zone{'file'} = "$1" if ($zone{'type'} eq 'slave');
		$DEBUG2 && print "\t\tFile: $zone{'file'}\n";
	    } elsif (/masters\s*{(.*)}/) {
		$zone{'masters'} = [ split(/\s+/, $1) ];
		$DEBUG2 && print("\t\tMasters: ", join(', ', @{$zone{'masters'}}), "\n");
	    } elsif (/};/) {
		$DEBUG2 && print "\tEND: $zone{'name'}\n";
		last;
	    }
	}
    }

    return $zone ? \%zone : undef;
}


sub updateserial {
    my $file = shift;
    
    open ZONE, "$file" || do {
	warn "Failed to open zone file: $file\n";
	return;
    };

    open NEWZONE, ">$file.$$" || do {
	warn "Failed to open new zone file: $file.$$\n";
	return;
    };

    local $/ = ")";
    my $soa = <ZONE>;
    $DEBUG2 && print "\tOld SOA: $soa\n";
    $soa =~ /\(\s*(\d+)/;
    my $oserial = $1;
    $DEBUG1 && print "Old Serial: $oserial\n";

    my ($yyyy,$mm,$dd) = (localtime(time))[5,4,3];
    $yyyy += 1900;
    $mm++;
    my $nserial = sprintf "%04d%02d%02d00", $yyyy, $mm, $dd;
    $nserial++ until ($oserial < $nserial);
    $DEBUG1 && print "New Serial: $nserial\n";

    $soa =~ s/(\(\s*)(\d+)/$1$nserial/;
    $DEBUG2 && print "\tNew SOA: $soa\n";
    print NEWZONE $soa;
    undef $/;
    print NEWZONE <ZONE>;

    close ZONE;
    close NEWZONE;
    rename "$file.$$", "$file";
}

sub ndcreload {
    my $zone = shift;

    system $rndc, '-k', $rndc_key, 'reload', $zone, 'in', $view;
    return ($? == 0);
}

sub checkzone {
    my $zone = shift;
    my $file = shift;
    
    system $checkzone, $zone, $file;
    return ($? == 0);
}