#!/usr/bin/perl -w # # bind_to_djb.pl v0.1 (released 01/22/2001) # # (c) 2001 Abraham A Ingersoll , License: GPL # # Expects user to specifiy zone and zone file name as arguments # Dumps out tinydns-data translation on STDOUT # # v0.1 only supports record types SOA, NS, MX, A and CNAME # # I welcome bugfixes, suggestions, support for added RR types, etc # use strict; my $PARSE_DEBUG = 0; unless ($ARGV[0]) { print "usage: $0 [zone] < bind-data-format > tinydns-format\n"; exit; } my $zone = pop(@ARGV); my $multiline = 0; my (@rrs, $ttl, @unknown_types, $prev_record); while(<>) { chomp; my $ret = &parse_line($_, \@rrs, \$ttl, \$zone, \$multiline, $prev_record); unless ($multiline || $ret) { # if multiline or ret true, we don't have a complete record to print yet.. my $rr = pop(@rrs); #print "ml = $multiline, ret = $ret, rr->rr_data = $rr->{rr_data}, rr->domain = $rr->{domain}\n"; if ($rr->{type} =~ /SOA/i) { print "Z", $rr->{domain}, ":", $rr->{prim}, ":", $rr->{email}, ":", $rr->{serial}, ":", $rr->{refresh}, ":", $rr->{retry}, ":", $rr->{expire}, ":", $rr->{ttl}, ":\n"; } elsif ($rr->{'type'} =~ /NS/i) { print ".", $rr->{domain}, "::", $rr->{rr_data}, ":", $rr->{opt_ttl}, ":\n"; } elsif ($rr->{'type'} =~ /CNAME/i) { print "C", $rr->{domain}, ":", $rr->{rr_data}, ":", $rr->{opt_ttl}, ":\n"; } elsif ($rr->{type} =~ /A/i) { print "+", $rr->{domain}, ":", $rr->{rr_data}, ":", $rr->{opt_ttl}, ":\n"; } elsif ($rr->{type} =~ /MX/i) { print "@", $rr->{domain}, ":", $rr->{rr_data}, ":", $rr->{weight}, ":", $rr->{opt_ttl}, ":\n"; } else { push(@unknown_types, $_); } $prev_record = $rr; } } sub parse_line { my($line, $rrs, $ttl, $origin, $multiline, $prev_record) = @_; if ($line =~ /^\;/) { return 1; } # skip comments if ($line =~ /^\s+$/ || $line =~ /^$/) { return 1; } # skip blank lines if ($line =~ /([\S\s]*)\;/) { $line = $1; } # skip text after comment in middle of line if ($line =~ /(.*)\s+$/) { $line = $1; } # remove trailing whitespace (after nuking mid-line comment) if ($line =~ /\$ORIGIN\s([0-9a-z\-.]+)/i) { $$origin = $1; print "l = \"$line\"\n$$origin found\n" if $PARSE_DEBUG; return 1; } #origin def, could be anywhere if ($line =~ /\$TTL\s([0-9]+)/) { $$ttl = $1; print "l = \"$line\"\n$$ttl found\n" if $PARSE_DEBUG; return 1; } my %rr; $line =~ s/[\s]{2,}/ /g; print "l = \"$line\" ($$multiline)\n" if $PARSE_DEBUG; my(@row) = split(/\s/,$line); if ($$multiline == 1) { # if previous records exist, see if exactly previous was multi-line my $prev_rr = pop(@$rrs); foreach my $field (@row) { if ($field) { &scan_rr($field,$prev_rr,$origin,$multiline,$ttl); } } if ($prev_rr->{'domain'} eq "_prev_record_") { #my $blah = pop(@$rrs); $prev_rr->{'domain'} = $prev_record->{'domain'}; #push(@$rrs,$blah); } push(@$rrs,$prev_rr); } else { foreach my $field (@row) { &scan_rr($field,\%rr,$origin,$multiline,$ttl); } if ($rr{'domain'} eq "_prev_record_") { #my $blah = pop(@$rrs); $rr{'domain'} = $prev_record->{'domain'}; #push(@$rrs,$blah); } push(@$rrs, \%rr); } return 0; } sub scan_rr { my ($field, $hash, $origin, $multiline, $ttl) = @_; print "f=$field:\n" if $PARSE_DEBUG; if ($field =~ /^\s*$/) { $hash->{domain} = "_prev_record_"; print " blank, so default\n" if $PARSE_DEBUG; return; } if (!$hash->{domain} && ($field =~ /([a-z0-9\-\.\@]+)/i)) { print "1 = $1 .. \n" if $PARSE_DEBUG; $hash->{domain} = check_absolute($1,$origin); print " ($hash->{domain}) domain\n" if $PARSE_DEBUG; return; } if ((!$hash->{opt_ttl} && !$hash->{type}) && ($field =~ /([0-9]+)([MHDWmhdw]{1,1}|.*)/)) { if ($2) { $hash->{opt_ttl} = &do_ttl_math($1,$2); } else { $hash->{opt_ttl} = "$1"; } print " ($1$2) opt_ttl\n" if $PARSE_DEBUG; return; } if (!$hash->{opt_class} && ($field =~ /(IN)/i) && !($hash->{type})) { $hash->{opt_class} = $1; print " opt_clas\n" if $PARSE_DEBUG; if (!($hash->{opt_ttl})) { $hash->{opt_ttl} = $$ttl; } return; } if (!$hash->{type} && ($field =~ /([A-Z]+)/i)) { # this could be a MUCH MORE specifc list of all record types .. A, CNAME, MX, HINFO, etc) $hash->{type} = $1; print " type\n" if $PARSE_DEBUG; if (!($hash->{opt_ttl})) { $hash->{opt_ttl} = $$ttl; } return; } if ($hash->{type} =~ /MX/i) { &scan_mx_rr($field,$hash,$origin); return; } elsif ($hash->{type} =~ /SOA/i) { &scan_soa_rr($field,$hash,$origin,$multiline,$ttl); return; } elsif (($hash->{type} =~ /CNAME/i) || ($hash->{type} =~ /PTR/i)) { &scan_other($field,$hash,$origin); return; } if (!$hash->{rr_data} && ($field =~ /(\S+)/)) { # uhh .. lots of possabilities here $hash->{rr_data} = $1; print " rr_data\n" if $PARSE_DEBUG; return; } print " unrecognized RR value\n" if $PARSE_DEBUG; } sub scan_mx_rr { my ($field, $hash, $origin) = @_; if (!$hash->{weight} && $field =~ /([0-9]{1,5})/) { $hash->{weight} = $1; print " weight\n" if $PARSE_DEBUG; return; } if (!$hash->{rr_data} && $field =~ /([0-9a-z\.\-]+)/i) { $hash->{rr_data} = check_absolute($1,$origin); print " mx_rr_data\n" if $PARSE_DEBUG; return; } print " unrecognized MX RR value\n" if $PARSE_DEBUG; } sub scan_other { my ($field, $hash, $origin) = @_; if (!$hash->{rr_data} && $field =~ /([0-9a-z\.\-\@]+)/i) { $hash->{rr_data} = check_absolute($1,$origin); print " mx_rr_data\n" if $PARSE_DEBUG; return; } print "unrecognized [other] RR value encountered in scan_other!" if $PARSE_DEBUG; } sub check_absolute { my ($rr_data, $origin) = @_; if (!($rr_data =~ /\.$/) && !($rr_data =~ /\@/)) { print " not absolute, appending origin \n" if $PARSE_DEBUG; return($rr_data . "." . $$origin); } elsif ($rr_data =~ /\@/) { # assume @ = origin, as currently defined in the zone file return($$origin); } else { return($rr_data); } } sub do_ttl_math { my ($base, $char) = @_; if ($char =~ /W/i) { return $base * 604800; } elsif ($char =~ /D/i) { return $base * 86400; } elsif ($char =~ /H/i) { return $base * 3600; } elsif ($char =~ /M/i) { return $base * 600; } else { print "ack, unrecognized TTL multiplier -- $char!!!\n" if $PARSE_DEBUG; return $base; } } sub scan_soa_rr { my ($field, $hash, $origin, $multiline, $ttl) = @_; print "f=\"$field\":\n" if $PARSE_DEBUG; if (!$hash->{prim} && ($field =~ /([a-z0-9\-.]+)/i)) { $hash->{prim} = check_absolute($1,$origin); print " prim\n" if $PARSE_DEBUG; return; } if (!$hash->{email} && ($field =~ /([a-z0-9\-\.]+)/i)) { $hash->{email} = check_absolute($1,$origin); print " email\n" if $PARSE_DEBUG; return; } if (!$hash->{open_paren} && ($field =~ /(\()/)) { $hash->{open_paren} = $1; print " open_paren\n" if $PARSE_DEBUG; $$multiline = 1; return; } if (!$hash->{ml_space} && ($field =~ /(\s+)/)) { $hash->{ml_space} = $1; print " multiline space\n" if $PARSE_DEBUG; return; } if (!$hash->{serial} && ($field =~ /([0-9]+)/)) { ##TODO extend to support D W H M syntax $hash->{serial} = $1; print " serial\n" if $PARSE_DEBUG; return; } if (!$hash->{refresh} && ($field =~ /([0-9]+)([MHDWmhdw]{1,1}|.*)/)) { if ($2) { $hash->{refresh} = &do_ttl_math($1,$2); } else { $hash->{refresh} = "$1"; } print " ($1$2) refresh\n" if $PARSE_DEBUG; return; } if (!$hash->{retry} && ($field =~ /([0-9]+)([MHDWmhdw]{1,1}|.*)/)) { if ($2) { $hash->{retry} = &do_ttl_math($1,$2); } else { $hash->{retry} = "$1"; } print " ($1$2) retry\n" if $PARSE_DEBUG; return; } if (!$hash->{expire} && ($field =~ /([0-9]+)([MHDWmhdw]{1,1}|.*)/)) { if ($2) { $hash->{expire} = &do_ttl_math($1,$2); } else { $hash->{expire} = "$1"; } print " ($1$2) expire\n" if $PARSE_DEBUG; return; } if (!$hash->{ttl} && ($field =~ /(\d+)([MHDWmhdw]{1,1}|.*)/)) { print "1 = $1, 2 = $2\n" if $PARSE_DEBUG; ## TODO -- a TTL) messes this up. Need to search for it here or fix the above regex if ($2) { #my $ttl1 = $1; my $ttl2 = $2; #print "ttl1 = $ttl1 ttl2 = $ttl2\n"; #if ($ttl2 =~ /\)/) { $hash->{ttl} = &do_ttl_math($1,$2); #} } else { $hash->{ttl} = $1; } print " ($1 $2) ttl\n" if $PARSE_DEBUG; if ($field =~ /(\))/) { #sometimes TTLs are like yea -- x x x x x) with no space $hash->{close_paren} = $1; $$multiline = 0; } if (!($$ttl)) { # if no default $TTL statement, use the SOA ttl as default $$ttl = $hash->{ttl}; print "\$TTL or previous default not found, using SOA value $hash->{ttl}\n" if $PARSE_DEBUG; } return; } if (!$hash->{close_paren} && ($field =~ /(\))/)) { $hash->{close_paren} = $1; print " close_paren\n" if $PARSE_DEBUG; $$multiline = 0; return; } print " unrecognized SOA RR value\n" if $PARSE_DEBUG; }