path: root/nsdbimport/nsdbimport

#! /usr/bin/perl
# Copyright (C) 2014 Sergey Poznyakoff <gray@gnu.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

use strict;
use Getopt::Long qw(:config gnu_getopt no_ignore_case);
use File::Basename;
use Pod::Usage;
use Pod::Man;
use String::Regexp;

use constant EX_OK           => 0;
use constant EX_USAGE        => 64;    # command line usage error
use constant EX_DATAERR      => 65;    # data format error
use constant EX_NOINPUT      => 66;    # cannot open input file
use constant EX_UNAVAILABLE  => 69;    # service unavailable 
use constant EX_SOFTWARE     => 70;    # internal software error (not used yet)
use constant EX_OSFILE       => 72;    # critical OS file missing
use constant EX_CANTCREAT    => 73;    # can't create (user) output file
use constant EX_CONFIG       => 78;    # configuration error 

my $progname = basename($0);      # This script name;
my $progdescr = "converts BIND zone files to SQL database";
my $debug;
my $bind_directory;
my $bind_config;

sub error {
    my $msg = shift;
    local %_ = @_;
    print STDERR "$progname: " if defined($progname);
    print STDERR "$_{prefix}: " if defined($_{prefix});
    print STDERR "$msg\n"
}

sub debug {
    my $l = shift;
    error(join(' ',@_), prefix => 'DEBUG') if $debug >= $l;
}

sub abend {
    my $code = shift;
    print STDERR "$progname: " if defined($progname);
    print STDERR "@_\n";
    exit $code;
}

my %config;

sub readconfig {
    my $file = shift;
    open(my $fd, "<", $file)
	or abend(EX_UNAVAILABLE, "can't open configuration file $file: $!");
    my $line;
    while (<$fd>) {
	++$line;
	chomp;
	if (/\\$/) {
	    chop;
	    $_ .= <$fd>;
	    redo;
	}
	
	s/^\s+//;
	s/\s+$//;
	s/#.*//;
	next if ($_ eq "");

	unless (/([\w_-]+)\s*=\s*(.*)/) {
	    error("$file:$line: malformed line");
	    next;
	}
	my ($k,$v) = ($1, $2);

	# unless (exists($config{$k})) {
	#     error("$file:$line: unknown keyword $k");
	#     next;
	# }
	
	$config{$k} = $v;
    }
    close $fd;
    abend(EX_CONFIG, "rr-query is not defined in $file")
	unless defined($config{'rr-query'});
}

# ###################
sub parse_named_conf {
    my %zone;
    abend(EX_OSFILE, "$bind_config doesn't exist or is unreadable")
	unless -f $bind_config and -r $bind_config;
    open(my $fd, '-|',
	 "cfpeek --parser=bind $bind_config")
	or die "can't run cfpeek: $!";
    while (<$fd>) {
	if (/^\.options\.directory:\s+(.+)/) {
	    $bind_directory = $1;
	} elsif (/^\.zone="([^"]+)"\.((?:type)|(?:file)):\s+(.+)/) {
	    $zone{$1}->{$2} = $3;
	}
    }
    close $fd;
    my %files;
    while (my ($name, $ref) = each %zone) {
	if ($ref->{type} eq 'master' and defined($ref->{file})) {
	    debug(1, "register zone $name, file $ref->{file}");
	    $files{$ref->{file}} = $name;
	}
    }
    return %files;
}
# ###################
sub replvar {
    my ($rec, $var, $opt) = @_;
    my %option;
    if (defined($opt)) {
	foreach my $x (split /,/, $opt) {
	    if ($x =~ /([?+\.-@])(.*)/) {
		$option{$1} = $2;
	    }
	}
    }

    my $val = $rec->{$var};
    
    if (!defined($val)) {
	if (defined($option{'-'})) {
	    $val = $option{'-'};
	} elsif (defined($option{'?'})) {
	    my $text = $option{'?'} || "$var not defined";
	    error($text, prefix => $rec->{locus});
	}
    } elsif (defined($option{'+'})) {
	$val = $option{'+'};
    }

    if (defined($val)) {
	if ($val eq '@' and defined($option{'@'})) {
	    $val = $option{'@'} || $rec->{origin};
	    $val .= '.' unless $val =~ /\.$/;
	} elsif (defined($option{'.'}) and $val !~ /\.$/) {
	    $val .= '.' . ($option{'.'} || $rec->{origin});
	    $val .= '.' unless $val =~ /\.$/;
	}
    }
    return $val;
}
	
sub query_expand {
    my ($q, $rec) = @_;
    $q =~ s/\$\{([\w_-]+)(?::(.+))?\}/replvar($rec, $1, $2)/gex;
    debug(2, "$rec->{locus}: $q");
    return $q;
}

# generate($expr, $origin, $file, $line);
# $GENERATE start-stop[/step] lhs[{offset[,width[,type]]}] rr-type rhs[{offset[,width[,type]]}]
# http://www.zytrax.com/books/dns/ch8/generate.html
sub generate {
    my ($expr, $origin, $file, $line) = @_;
    # FIXME
}

# ###################
my $rxt = '[\dshdwmy]+';
sub insert_soa {
    my ($rec, $tmpl) = @_;
    if ($rec->{data} =~ /^([^\s]+)\s+([^\s]+)\s+\(\s*($rxt)\s+($rxt)\s+($rxt)\s+($rxt)\s+($rxt)\s*\)$/i) {
	$rec->{ns} = $1;
	$rec->{resp_person} = $2;
	$rec->{serial} = $3;
	$rec->{refresh} = parsetime($4, $rec->{origin});
	$rec->{retry} = parsetime($5, $rec->{origin});
	$rec->{expire} = parsetime($6, $rec->{origin});
	$rec->{minimum} = parsetime($7, $rec->{origin});
	my $q = query_expand($tmpl, $rec);
	# FIXME: SQL
    } else {
	error("malformed SOA: '$rec->{data}'",
	      prefix => "warning: $rec->{locus}");
    }
}
    
sub insert_mx {
    my ($rec, $tmpl) = @_;
    if ($rec->{data} =~ /^(\d+)\s+(.+)$/) {
	$rec->{mx_priority} = $1;
	$rec->{mx} = $2;
	my $q = query_expand($tmpl, $rec);
	# FIXME: SQL
    } else {
	error("malformed MX: '$rec->{data}'",
	      prefix => "warning: $rec->{locus}");
    }
}

my %rrfun = (SOA => \&insert_soa,
	     MX => \&insert_mx);

sub insert_rr {
    my ($rec, $tmpl) = @_;
    my $q = query_expand($tmpl || $config{'rr-query'}, $rec);
    # FIXME: SQL
}

# ###################
sub parsetime {
    my ($s, $loc) = @_;
    my $t = 0;
    if ($s =~ /^\d+$/) {
	$t = $s;
    } else {
	my @keyord = ('s', 1,
		      'm', 60,
		      'h', 3600,
		      'd', 86400,
		      'w', 7*86400,
		      'm', 31*86400,
		      'y', 365*86400);
	if ($s =~ s/(\d+)$//) {
	    $t = $1;
	    shift @keyord;
	    shift @keyord;
	}	    
      OUTER:
	while (1) {
	    my $i = 0;
	    my $set = join('', map { ++$i % 2 ? $_ : () }  @keyord);
	    last if $set eq '';
	    last unless $s =~ s/(\d+)([$set])$//i;
	    my $k = lc $2;
	    while (shift(@keyord) ne $k) {
		shift(@keyord);
		last OUTER if $#keyord == -1;
	    }
	    $t += $1 * shift(@keyord);
	}
	unless ($s eq '')  {
	    my $p = "warning: $loc" if $loc;
	    error("time specification error near $s", prefix => $p);
	    return undef;
	}
    }
    return $t;
}

my $rx_class = array_to_regexp('IN', 'HS', 'CH');

my $rx_rr = array_to_regexp('A', 'AAAA', 'A6', 'AFSDB',
			    'CNAME', 'DNAME', 'DNSKEY', 'DS',
			    'EUI48', 'EUI64', 'HINFO', 'ISDN',
			    'KEY', 'LOC', 'MX', 'NAPTR',
			    'NS', 'NSEC', 'NXT', 'NXT',
			    'PTR', 'RP', 'RRSIG', 'RT',
			    'SIG', 'SOA', 'SPF', 'SRV',
			    'TXT', 'WKS', 'X25');

sub zimport {
    my ($file, $origin) = @_;

    $file = "$bind_directory/$file"
	if $file !~ m#^/# and defined($bind_directory);

    open(my $fd, "<", $file)
	or abend(EX_NOINPUT, "can't open input file $file: $!");
    my $line;
    my $ttl = 86400; # FIXME
    while (<$fd>) {
	++$line;
	chomp;
	s/^\s+//;
	s/\s+$//;
	s/;.*//;
	next if ($_ eq "");
	if (/^\$TTL\s+(.+?)\s*$/) {
	    $ttl = parsetime($1);
	} elsif (/^\$ORIGIN\s+(.+)/) {
	    $origin = $1;
	} elsif (/^\$INCLUDE\s+([^\s]+)\s+(.+)$/) {
	    zimport($1, $2);
	} elsif (/^\$INCLUDE\s+(.+)/) {
	    zimport($1, $origin);
	} elsif (/^\$GENERATE\s+(.+)/) {
	    generate($1, $origin, $file, $line);
	} elsif (/^\$/) {
	    error("ignoring unrecognized directive",
		  prefix => "$file:$line: warning");
    	         # LABEL TTL CLASS RR DATA
	} elsif (/(?:(@|[^\s]+)\s+)?(?:([\dwdhms]+)\s+)?(?:$rx_class\s+)?($rx_rr)\s+(.*)/i) {
	    my $rr = uc $3;
	    if ($rr eq 'SOA') {
		unless (/\)$/) {
		    my $s = <$fd>;
		    $s =~ s/;.*//;
		    $_ .= $s;
		    redo;
		}
	    }
	    
	    my %record = (origin => $origin,
			  label => $1,
			  ttl => parsetime($2, "$file:$line") || $ttl,
			  rr => $rr,
			  data => $4,
			  locus => "$file:$line");

	    my $kw = lc($rr).'-query';

	    if (defined($rrfun{$rr}) and defined($config{$kw})) {
		&{$rrfun{$rr}}(\%record, $config{$kw});
	    } else {
		insert_rr(\%record, $config{$kw});
	    }
	    
	    if ($rr eq 'SOA') {
		$origin = $record{label} unless $record{label} eq '@';
	    }
	}
    }
    close $fd;
}

# ###################
my $conffile;
my $origin;

GetOptions("h" => sub {
		    pod2usage(-message => "$progname: $progdescr",
			      -exitstatus => 0);
	   },
	   "help" => sub {
		    pod2usage(-exitstatus => EX_OK, -verbose => 2);
	   },
	   "usage" => sub {
		    pod2usage(-exitstatus => EX_OK, -verbose => 0);
	   },
	   "directory|C=s" => \$bind_directory,
	   "from-config=s" => \$bind_config,
	   "origin=s" => \$origin,
	   "debug|d+" => \$debug,
	   "config|c=s" => \$conffile) or exit(EX_USAGE);
	   
unless (defined($conffile)) {
    ($conffile) = grep { -e $_ } (
	'.nsdbimport.conf',
	"$ENV{HOME}/.nsdbimport.conf",
	'etc/.nsdbimport.conf');
}

abend(EX_USAGE, "no configuration file; please use the --config option")
    unless defined $conffile;

readconfig $conffile;

if (defined($bind_config)) {
    abend(EX_USAGE, "extra input files") if $#ARGV >= 0;
    my %files = parse_named_conf;
    while (my ($file, $origin) = each %files) {
	zimport($file, $origin);
    }
} else {
    abend(EX_USAGE, "no input files") unless $#ARGV >= 0;
    foreach my $arg (@ARGV) {
	zimport($arg, $origin);
    }	  
}