nsdbimport: implement import to the database; optionally expand $GENERATE directives

1 files changed, 155 insertions, 48 deletions

diff --git a/nsdbimport/nsdbimport b/nsdbimport/nsdbimport
index a1db672..da6b501 100755
--- a/nsdbimport/nsdbimport
+++ b/nsdbimport/nsdbimport
@@ -17,12 +17,13 @@
 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 DBI;
 
 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 
@@ -31,14 +32,17 @@ 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 $dry_run;
 my $bind_directory;
 my $bind_config;
+my $dbd;
+my $generate_seen;
 
 sub error {
     my $msg = shift;
     local %_ = @_;
     print STDERR "$progname: " if defined($progname);
     print STDERR "$_{prefix}: " if defined($_{prefix});
@@ -57,16 +61,17 @@ sub abend {
     exit $code;
 }
 
 my %config;
 
 sub readconfig {
-    my $file = shift;
+    my ($file, $kw) = @_;
     open(my $fd, "<", $file)
 	or abend(EX_UNAVAILABLE, "can't open configuration file $file: $!");
     my $line;
+    my $err;
     while (<$fd>) {
 	++$line;
 	chomp;
 	if (/\\$/) {
 	    chop;
 	    $_ .= <$fd>;
@@ -81,24 +86,30 @@ sub readconfig {
 	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;
-	# }
-	
+	unless (exists($kw->{$k})) {
+	    error("$file:$line: unknown keyword $k");
+	    ++$err;
+	    next;
+	}
 	$config{$k} = $v;
     }
     close $fd;
+    exit(EX_CONFIG) if $err;
     abend(EX_CONFIG, "rr-query is not defined in $file")
 	unless defined($config{'rr-query'});
 }
 
+sub istrue {
+    my $s = shift;
+    return $s =~ /^([1yt])|(yes)|(true)|(enable)$/i;
+}
+
 # ###################
 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, '-|',
@@ -119,37 +130,49 @@ sub parse_named_conf {
 	    $files{$ref->{file}} = $name;
 	}
     }
     return %files;
 }
 # ###################
+my $rx_class = array_to_regexp('IN', 'HS', 'CH');
+my @rrtypes = ('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');
+my $rx_rr = array_to_regexp(@rrtypes);
+
+# ###################
 sub replvar {
     my ($rec, $var, $opt) = @_;
     my %option;
     if (defined($opt)) {
 	foreach my $x (split /,/, $opt) {
-	    if ($x =~ /([?+\.-@])(.*)/) {
+	    if ($x =~ /([?+\.@-])(.*)/) {
 		$option{$1} = $2;
 	    }
 	}
     }
 
-    my $val = $rec->{$var};
+    my $val = $rec->{$var} || '';
     
-    if (!defined($val)) {
+    if ($val eq '') {
 	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 ne '') {
 	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 =~ /\.$/;
@@ -157,23 +180,68 @@ sub replvar {
     }
     return $val;
 }
 	
 sub query_expand {
     my ($q, $rec) = @_;
-    $q =~ s/\$\{([\w_-]+)(?::(.+))?\}/replvar($rec, $1, $2)/gex;
+    $q =~ s/\$\{([\w_-]+)(?::(.+?))?\}/replvar($rec, $1, $2)/gex;
     debug(2, "$rec->{locus}: $q");
     return $q;
 }
 
+sub sql_query {
+    my ($tmpl, $rec) = @_;
+    my $q = query_expand($tmpl, $rec);
+    unless ($dry_run) {
+	$dbd->do($q)
+	    or abend(EX_UNAVAILABLE, $dbd->errstr."\nFailed query: $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 format_part {
+    my ($i, $xhs, $xwid, $xtyp, $loc) = @_;
+    my $ctr;
+
+    if ($xtyp =~ /^[doxX]$/) {
+	$ctr = sprintf($xwid > 0 ? "%0${xwid}$xtyp" : "%$xtyp", $i);
+    } elsif ($xtyp =~ /[nN]/) {
+	my $f = $xtyp eq 'n' ? '%x' : '%X';
+	my @a = reverse(split(//, sprintf("%x", $i)));
+	unshift @a, '0' while (($#a+1) < $xwid);
+	$ctr = join('.', @a);
+    } else {
+	error("invalid type $xtyp in \$GENERATE", prefix => $loc);
+    }
+    $xhs =~ s/\$/$ctr/;
+    return $xhs;
+}
+
 sub generate {
-    my ($expr, $origin, $file, $line) = @_;
-    # FIXME
+    my ($expr, $origin, $ttl, $file, $line) = @_;
+    my $p = '([^\s\{]+)(?:\{(\d+)(?:(?:,(\d+))(?:,([doxXnN])))\})?';
+    if ($expr =~ /(\d+)-(\d+)(?:\/(\d+))?\s+$p\s+($rx_rr)\s+$p/) {
+	my ($start,$stop,$step,
+	    $lhs,$loff,$lwid,$ltyp,
+	    $rr,
+	    $rhs,$roff,$rwid,$rtyp) = ($1, $2, $3 || 1,
+				       $4, $5 || 0, $6 || 0, $7 || 'd',
+				       $8,
+				       $9, $10 || 0, $11 || 0, $12 || 'd');
+	for (my $i = $start; $i <= $stop; $i += $step) {
+	    import_record({origin => $origin,
+			   locus => "$file:$line",
+			   ttl => $ttl,
+			   rr => $rr,
+			   label => format_part($i + $loff,$lhs,$lwid,$ltyp),
+			   data => format_part($i + $roff,$rhs,$rwid,$rtyp)});
+	}
+    }
 }
 
 # ###################
 my $rxt = '[\dshdwmy]+';
 sub insert_soa {
     my ($rec, $tmpl) = @_;
@@ -182,40 +250,37 @@ sub insert_soa {
 	$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
+	sql_query($tmpl, $rec);
     } 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
+	sql_query($tmpl, $rec);
     } 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
+    sql_query($tmpl || $config{'rr-query'}, $rec);
 }
 
 # ###################
 sub parsetime {
     my ($s, $loc) = @_;
     my $t = 0;
@@ -253,29 +318,29 @@ sub parsetime {
 	    return undef;
 	}
     }
     return $t;
 }
 
-my $rx_class = array_to_regexp('IN', 'HS', 'CH');
+sub import_record {
+    my $rec = shift;
+    my $kw = lc($rec->{rr}).'-query';
 
-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');
+    if (defined($rrfun{$rec->{rr}}) and defined($config{$kw})) {
+	&{$rrfun{$rec->{rr}}}($rec, $config{$kw});
+    } else {
+	insert_rr($rec, $config{$kw});
+    }
+}
 
 sub zimport {
     my ($file, $origin) = @_;
 
     $file = "$bind_directory/$file"
 	if $file !~ m#^/# and defined($bind_directory);
-
+    debug(1, "processing file $file, origin $origin");
     open(my $fd, "<", $file)
 	or abend(EX_NOINPUT, "can't open input file $file: $!");
     my $line;
     my $ttl = 86400; # FIXME
     while (<$fd>) {
 	++$line;
@@ -290,13 +355,19 @@ sub zimport {
 	    $origin = $1;
 	} elsif (/^\$INCLUDE\s+([^\s]+)\s+(.+)$/) {
 	    zimport($1, $2);
 	} elsif (/^\$INCLUDE\s+(.+)/) {
 	    zimport($1, $origin);
 	} elsif (/^\$GENERATE\s+(.+)/) {
-	    generate($1, $origin, $file, $line);
+	    if (istrue($config{generate})) {
+		generate($1, $origin, $ttl, $file, $line);
+	    } else {
+		error('$GENERATE ignored',
+		      prefix => "$file:$line: warning");
+		$generate_seen = 1;
+	    }
 	} 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;
@@ -305,30 +376,22 @@ sub zimport {
 		    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});
-	    }
+	    import_record({origin => $origin,
+			   label => $1,
+			   ttl => parsetime($2, "$file:$line") || $ttl,
+			   rr => $rr,
+			   data => $4,
+			   locus => "$file:$line"});
 	    
 	    if ($rr eq 'SOA') {
-		$origin = $record{label} unless $record{label} eq '@';
+		$origin = $1 unless $1 eq '@';
 	    }
 	}
     }
     close $fd;
 }
 
@@ -347,25 +410,66 @@ GetOptions("h" => sub {
 		    pod2usage(-exitstatus => EX_OK, -verbose => 0);
 	   },
 	   "directory|C=s" => \$bind_directory,
 	   "from-config=s" => \$bind_config,
 	   "origin=s" => \$origin,
 	   "debug|d+" => \$debug,
+	   "dry-run|n" => \$dry_run,
 	   "config|c=s" => \$conffile) or exit(EX_USAGE);
-	   
+
+++$debug if $dry_run;
+
 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;
+my %kw = ('database' => 1,
+	  'host' => 1,
+	  'port' => 1,
+	  'db-params' => 1,
+	  'user' => 1,
+	  'password' => 1,
+	  'db-default-file' => 1,
+	  'generate' => 1,
+	  'rr-query' => 1);
+
+foreach my $rr (@rrtypes) {
+    $kw{lc($rr).'-query'} = 1;
+}
+
+readconfig($conffile, \%kw);
+
+debug(1, "connecting to the database");
+
+my $arg = "";
+$arg .= ":database=$config{database}" if defined $config{database};
+$arg .= ":host=$config{host}" if defined $config{host};
+$arg .= ":port=$config{port}" if defined $config{port};
+$arg .= ":$config{'db-params'}" if defined $config{'db-params'};
+$arg .= ":;mysql_read_default_file=$config{'db-default-file'}"
+    if defined $config{'db-default-file'};
+
+if (!$arg
+    or (!defined($config{user}) and !defined($config{'db-default-file'}))) {
+    my $my_cnf = "$ENV{HOME}/.my.cnf";
+    if (-r $my_cnf) {
+        debug(1, "using mysql option file $my_cnf");
+        $arg .= ";mysql_read_default_file=$my_cnf";
+    }
+}
+$arg = 'DBI:mysql'.$arg;
+
+$dbd = DBI->connect($arg, $config{user}, $config{password},
+		    { PrintError => 0, AutoCommit => 1})
+    or exit(EX_UNAVAILABLE);
 
 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);
@@ -374,7 +478,10 @@ if (defined($bind_config)) {
     abend(EX_USAGE, "no input files") unless $#ARGV >= 0;
     foreach my $arg (@ARGV) {
 	zimport($arg, $origin);
     }	  
 }
 
-      
+error('set generate=yes to enable processing of $GENERATE directives')
+    if ($generate_seen);
+
+$dbd->disconnect;