metazone

#!/usr/bin/perl
#
# SPDX-License-Identifier: 0BSD OR MIT-0

use warnings;
use strict;
use re 'eval';

use File::Temp qw(tempfile);
use Getopt::Std;

sub wail { warn "metazone: @_\n"; }
sub fail { wail @_; exit 2; }
sub fale { fail "@_: $!" }

# for named-compilezone
$ENV{PATH} .= ":/sbin:/usr/sbin:/usr/local/sbin";
my $compilezone = 'named-compilezone -i local -k warn -n warn -o -';

sub usage {
    print STDERR <<EOF;
usage:	metazone [options] <zone> [serial [server]]
	metazone [options] <zone> named.zones.*
options:
  -d                  debugging mode
  -f [file]           read/write metazone from/to file
  -n                  do not reconfigure named
  [serial [server]]   generate config files from metazone
  named.zones.*       generate metazone from config files
EOF
    exit 2;
}
my %opt;
usage unless getopts '-df:n', \%opt;
exec "perldoc -F $0" if $opt{h};
usage if @ARGV < 1;

our $quiet = $opt{d} ? '' : '2>/dev/null';

our $metazone = shift;

our $server = 'localhost';

if ((@ARGV == 1 or @ARGV == 2) and $ARGV[0] =~ m{^\d+$}) {
	$server = $ARGV[1] if defined $ARGV[1];
	@ARGV = ();
}

sub slurp {
    my $f = shift;
    open my $h, '<', $f or fale "open $f";
    undef $/;
    return <$h>;
}

my $format_version = 44;

my $reserved = sprintf '^(%s)$', join '|',
	qw(allow-query allow-transfer also-notify in-view masters
	   server-addresses server-names servers view zones);

# metazone to named.conf

$metazone =~ s{[.]?$}{.};
our $zonere = quotemeta $metazone;
our $label = qr{(?:[^;.\\\s]|\\.)+};
our $hostname = qr{(?:[A-Za-z0-9](?:[A-Za-z0-9-]*[A-Za-z0-9])?[.])+};
our $rname = qr{$label\.$hostname};
our $soare = qr{^$zonere\s+\d+\s+IN\s+SOA\s+$hostname\s+$rname
		\s+\d+\s+(\d+\s+\d+\s+\d+\s+(\d+)\n)$}x;
our $txtre = qr{^(?<zone>(?:$label\.)+)(?<view>$label)\.$zonere
		\s+\d+\s+IN\s+TXT\s+(?<txt>.*)}x;

sub unquote {
	my $rdata = shift;
	$rdata =~ s{"((?:[^"\\]|\\.)*)"\s*}{$1}g;
	$rdata =~ s{\\(00(?<n>\d)|0(?<n>\d\d)|(?<n>\d\d\d))}{chr $+{n}}ge;
	$rdata =~ s{\\(.)}{$1}g;
	return $rdata;
}

sub checkzone {
    my $soa = shift;
    fail "missing SOA record" unless defined $soa and $soa =~ $soare;
    my $fv = $1;
    fail "mismatched format version: $fv != $format_version"
	unless $fv == $format_version;
    return @_;
}

sub axfrzone {
    my $zone = shift;
    my $master = shift;
    if ($master) {
	    wail "loading zone $zone via AXFR from $master" unless $quiet;
	    $master =~ s{^(.*)#(\d+)$}{-p $2 \@$1} or $master = '@'.$master;
    } else {
	    wail "loading zone $zone via AXFR" unless $quiet;
	    $master = '';
    }
    return checkzone qx{dig $master +noadditional axfr $zone |
                        $compilezone $zone /dev/stdin $quiet};
}

sub loadzone {
    my ($zone,$file) = @_;
    wail "loading zone $zone from file $file" unless $quiet;
    return checkzone qx{$compilezone -j $zone '$file' $quiet};
}

sub metazone {
    my %conf;
    for (@_) {
	    $conf{$+{view}}{$+{zone}} = unquote $+{txt}
		if m{$txtre}o;
    }
    my %rename;
    for my $view (sort keys %conf) {
	    if ($view =~ $reserved) {
		    wail "$view: skipping reserved subdomain";
		    next;
	    }
	    my $conf = "# automatically updated by metazone - DO NOT EDIT\n";
	    $conf .= "# view $view generated from $metazone\n";
	    for my $zone (sort keys %{$conf{$view}}) {
		    $conf .= "zone \"$zone\" $conf{$view}{$zone}\n";
	    }
	    my $fn = "named.zones.$view";
	    next if -f $fn and $conf eq slurp $fn;
	    my ($fh,$tn) = tempfile "$fn.XXXXXXXX", UNLINK => 1;
	    print $fh $conf;
	    close $fh or fale "write $fn";
	    $rename{$tn} = $fn;
    }
    while (my ($tn,$fn) = each %rename) {
	    rename $tn, $fn or fale "rename $tn";
    }
    if (%rename and not $opt{n}) {
	    # XXX syslog
	    wail "reconfiguring named" unless $quiet;
	    return system 'rndc reconfig';
    } else {
	    return 0;
    }
}

if (@ARGV == 0) {
	if ($opt{f}) {
		exit metazone loadzone $metazone, $opt{f};
	} else {
		exit metazone axfrzone $metazone, $server;
	}
}

# named.conf to metazone

our $com89_re = qr{ /\*.*?\*/ }sx;
our $com99_re = qr{ //.*\n }x;
our $comsh_re = qr{ \#.*\n }x;
our $s_re = qr{ ( $com89_re | $com99_re | $comsh_re | \s+ )+ }x;
our $string_re = qr{ " (?: [^"\\] | \\. )* " }x;
our $atom_re   = qr{ [0-9A-Za-z!:._/-]+ }x;
our $stuff_re  = qr{ $string_re | $atom_re
		   | (??{$::block_re}) | $s_re | ;
		   }x;
our $block_re = qr{ { (?: $stuff_re )+ } }x;
our $zone_re = qr{ $s_re? zone $s_re (?<zone>$string_re|$atom_re)
		   (?: $s_re (?i:in|"in") )? $s_re?
		   (?<conf>$block_re $s_re? ;) }x;

sub loadconf {
	my $f = shift;
	my $ctxt = slurp $f;
	my %conf;
	while ($ctxt =~ s{^$zone_re}{}o) {
		my $conf = $+{conf};
		my $zone = unquote $+{zone};
		$zone =~ s{[.]*$}{};
		$conf{$zone} = $conf;
	}
	return \%conf if $ctxt =~ s{^$s_re?$}{}o;
	$ctxt =~ s{\n}{ }g;
	$ctxt =~ s{^(.{60}).*}{$1...} if length $ctxt >= 60;
	fail "$f: could not parse \"$ctxt\"";
}

sub quote {
	my $rdata = shift;
	$rdata =~ s{([\\"])}{\\$1}g;
	$rdata =~ s{(.+)}{\t"$1"}g;
	$rdata =~ s{"\n}{\\010"\n}g;
	$rdata =~ s{\n*$}{};
	return $rdata;
}

my %conf;
for my $fn (@ARGV) {
	usage unless $fn =~ m{^named\.zones\.(.*)$};
	$conf{$1} = loadconf $fn;
}

if ($opt{f}) {
	open STDOUT, '>', $opt{f}
	    or fale "open > $opt{f}";
}

# XXX configurable?
my $time = time;
print <<EOF;
\$ORIGIN $metazone
\$TTL 1h
@	SOA	localhost. hostmaster.localhost. (
		$time 1h 1h 1w $format_version )
	NS	localhost.
EOF

for my $view (sort keys %conf) {
	if ($view =~ $reserved) {
		wail "$view: skipping reserved subdomain";
		next;
	}
	print "\$ORIGIN $view.$metazone\n";
	for my $zone (sort keys %{$conf{$view}}) {
		printf "%s	TXT ( %s )\n",
		    $zone, quote $conf{$view}{$zone};
	}
}

exit;