# DNS::ZoneParse
# Parse and Manipulate DNS Zonefiles
# Version 0.95
# CVS: $Id: ZoneParse.pm,v 1.5 2004/10/24 16:55:01 simonflack Exp $
package DNS::ZoneParse;
use 5.005;
use Storable 'dclone';
use POSIX 'strftime';
use vars qw($VERSION);
use strict;
use Carp;
$VERSION = '0.95';
my (%dns_id, %dns_soa, %dns_ns, %dns_a, %dns_cname, %dns_mx,
%dns_txt, %dns_ptr, %dns_a4, %dns_last_name);
sub new {
my $class = shift;
my $self = bless [], $class;
$self->_initialize();
$self->_load_file(@_) if @_;
return $self;
}
sub DESTROY {
my $self = shift;
delete $dns_soa {$self}; delete $dns_ns {$self};
delete $dns_a {$self}; delete $dns_cname {$self};
delete $dns_mx {$self}; delete $dns_txt {$self};
delete $dns_ptr {$self}; delete $dns_a4 {$self};
delete $dns_id {$self}; delete $dns_last_name {$self};
}
sub AUTOLOAD {
my $self = shift;
(my $method = $DNS::ZoneParse::AUTOLOAD) =~ s/.*:://;
my $rv = $method eq 'soa' ? $dns_soa {$self}
: $method eq 'ns' ? $dns_ns {$self}
: $method eq 'a' ? $dns_a {$self}
: $method eq 'cname' ? $dns_cname {$self}
: $method eq 'mx' ? $dns_mx {$self}
: $method eq 'txt' ? $dns_txt {$self}
: $method eq 'ptr' ? $dns_ptr {$self}
: $method eq 'aaaa' ? $dns_a4 {$self}
: $method eq 'zonefile' ? $dns_id {$self}->{ZoneFile}
: $method eq 'origin' ? $dns_id {$self}->{Origin}
: undef;
croak "Invalid method called: $method" unless defined $rv;
return $rv;
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Public OO Methods
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub dump {
# returns a HOH for use with XML modules, etc
my $self = shift;
return dclone({
SOA => $dns_soa {$self}, AAAA => $dns_a4 {$self},
A => $dns_a {$self}, NS => $dns_ns {$self},
CNAME => $dns_cname {$self}, MX => $dns_mx {$self},
PTR => $dns_ptr {$self}, TXT => $dns_txt {$self},
});
}
sub new_serial {
my $self = shift;
my $incriment = shift || 0;
my $soa = $dns_soa{$self};
if ($incriment > 0) {
$soa->{serial} += $incriment;
} else {
my $newserial = strftime("%Y%m%d%H", localtime(time));
$soa->{serial} = ($newserial > $soa->{serial}) ? $newserial
: $soa->{serial} + 1;
}
return $soa->{serial};
}
sub output {
my $self = shift;
my @quick_classes = qw(A AAAA CNAME PTR);
my $zone_ttl = $dns_soa{$self}{ttl} ? "\$TTL $dns_soa{$self}{ttl}" : '';
my $output = "";
$output .= <<ZONEHEADER;
;
; Database file $dns_id{$self}->{ZoneFile} for $dns_id{$self}->{Origin} zone.
; Zone version: $dns_soa{$self}->{serial}
;
$zone_ttl
$dns_soa{$self}->{origin} $dns_soa{$self}->{ttl} IN SOA $dns_soa{$self}->{primary} $dns_soa{$self}->{email} (
$dns_soa{$self}->{serial} ; serial number
$dns_soa{$self}->{refresh} ; refresh
$dns_soa{$self}->{retry} ; retry
$dns_soa{$self}->{expire} ; expire
$dns_soa{$self}->{minimumTTL} ; minimum TTL
)
;
; Zone NS Records
;
ZONEHEADER
foreach (@{$dns_ns{$self}}) {
next unless defined;
$output .= "$_->{name} $_->{ttl} $_->{class} NS $_->{host}\n";
}
$output .= "\n\;\n\; Zone MX Records\n\;\n\n";
foreach (@{$dns_mx{$self}}) {
next unless defined;
$output .= "$_->{name} $_->{ttl} $_->{class} MX $_->{priority} "
." $_->{host}\n";
}
$output .= "\n\;\n\; Zone Records\n\;\n\n";
foreach (@{$dns_a{$self}}) {
next unless defined;
$output .= "$_->{name} $_->{ttl} $_->{class} A $_->{host}\n";
}
foreach (@{$dns_cname{$self}}) {
next unless defined;
$output .= "$_->{name} $_->{ttl} $_->{class} CNAME $_->{host}\n";
}
foreach (@{$dns_a4{$self}}) {
next unless defined;
$output .= "$_->{name} $_->{ttl} $_->{class} AAAA $_->{host}\n";
}
foreach (@{$dns_txt{$self}}) {
next unless defined;
$output .= qq[$_->{name} $_->{ttl} $_->{class} TXT "$_->{text}"\n]
}
foreach (@{$dns_ptr{$self}}) {
next unless defined;
$output .= "$_->{name} $_->{ttl} $_->{class} PTR $_->{host}\n";
}
return $output;
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Private Methods
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub _initialize {
my $self = shift;
$dns_id {$self} = {}; $dns_soa {$self} = {};
$dns_ns {$self} = []; $dns_a {$self} = [];
$dns_cname {$self} = []; $dns_mx {$self} = [];
$dns_txt {$self} = []; $dns_ptr {$self} = [];
$dns_a4 {$self} = []; $dns_last_name{$self} = '@';
return 1;
}
sub _load_file {
my ($self, $zonefile, $origin) = @_;
my $zone_contents;
if(ref($zonefile) eq "SCALAR") {
$zone_contents = $$zonefile;
} else {
local *inZONE;
if (open(inZONE, "$zonefile")) {
$zone_contents = do {local $/; <inZONE>};
close(inZONE);
} else {
croak qq[DNS::ZoneParse Could not open input file: "$zonefile":$!]
}
}
if ($self->_parse( $zonefile, $zone_contents, $origin )) { return 1; }
}
sub _parse {
my ($self, $zonefile, $contents, $origin) = @_;
$self->_initialize();
my $chars = qr/[a-z\-\.0-9]+/i;
$contents =~ /Database file ($chars)( dns)? for ($chars) zone/si;
$dns_id{$self} = $self -> _massage({
ZoneFile => $1 || $zonefile,
Origin => $3 || $origin,
});
my $records = $self->_clean_records($contents);
my $valid_name = qr/[\@a-z_\-\.0-9\*]+/i;
my $valid_ip6 = qr/[\@a-z_\-\.0-9\*:]+/i;
my $rr_class = qr/\b(?:IN|HS|CH)\b/i;
my $rr_type = qr/\b(?:NS|A|CNAME)\b/i;
my $rr_ttl = qr/(?:\d+[wdhms]?)+/i;
my $ttl_cls = qr/(?:($rr_ttl)\s)?(?:($rr_class)\s)?/;
my $last_name = $dns_id {$self} -> {Origin} || '@';
foreach (@$records) {
TRACE ("parsing line <$_>");
if (/^($valid_name)? \s* # host
$ttl_cls # ttl & class
($rr_type) \s # record type
($valid_name) # record data
/ix) {
my ($name, $ttl, $class, $type, $host) = ($1, $2, $3, $4, $5);
my $dns_thing = uc $type eq 'NS' ? $dns_ns{$self}
: uc $type eq 'A' ? $dns_a{$self} : $dns_cname{$self};
push @$dns_thing,
$self -> _massage({name => $name, class=> $class,
host => $host, ttl => $ttl});
}
elsif (/^($valid_name)? \s*
$ttl_cls
AAAA \s
($valid_ip6)
/x)
{
my ($name, $ttl, $class, $host) = ($1, $2, $3, $4);
push @{$dns_a4{$self}},
$self -> _massage({name => $name, class=> $class,
host => $host, ttl => $ttl})
}
elsif (/^($valid_name)? \s*
$ttl_cls
MX \s
(\d+) \s
($valid_name)
/ix)
{
# host ttl class mx pri dest
my ($name, $ttl, $class, $pri, $host) = ($1, $2, $3, $4, $5);
push @{$dns_mx{$self}},
$self -> _massage({ name => $name, priority => $pri,
host => $host, ttl => $ttl,
class => $class})
}
elsif (/^($valid_name) \s+
$ttl_cls
SOA \s+
($valid_name) \s+
($valid_name) \s*
\(?\s*
($rr_ttl) \s+
($rr_ttl) \s+
($rr_ttl) \s+
($rr_ttl) \s+
($rr_ttl) \s*
\)?
/ix)
{
# SOA record
my $ttl = $dns_soa{$self}->{ttl} || $2 || '';
$dns_soa{$self} =
$self -> _massage({ origin => $1, ttl => $ttl, primary => $4,
email => $5, serial => $6, refresh => $7,
retry => $8, expire => $9,
minimumTTL => $10 });
}
elsif (/^($valid_name)? \s*
$ttl_cls
PTR \s+
($valid_name)
/ix)
{
# PTR
push @{$dns_ptr{$self}},
$self -> _massage({ name => $1, class => $3, ttl => $2,
host => $4 });
}
elsif (/($valid_name)? \s $ttl_cls TXT \s \"([^\"]*)\"/ix)
{
push @{$dns_txt{$self}},
$self -> _massage({ name => $1, ttl => $2, class => $3,
text=> $4});
}
elsif (/\$TTL\s+($rr_ttl)/i) {
$dns_soa{$self}->{ttl} = $1;
}
else {
carp "Unparseable line\n $_\n";
}
}
return 1;
}
sub _clean_records {
my $self = shift;
my ($zone) = shift;
$zone =~ s<\;.*$> <>mg; # Remove comments
$zone =~ s<^\s*$> <>mg; # Remove empty lines
$zone =~ s<$/+> <$/>g; # Remove multiple carriage returns
$zone =~ s<[ \t]+>< >g; # Collapse whitespace, turn TABs to spaces
# Concatenate everything split over multiple lines i.e. elements surrounded
# by parentheses can be split over multiple lines. See RFC 1035 section 5.1
$zone =~ s{(\([^\)]*?\))}{_concatenate($1)}egs;
# Split into multiple records, and kick out empty lines
my @records = grep !/^$/, split (m|$/|, $zone);
return \@records;
}
sub _concatenate {
my $text_in_parenth= shift;
$text_in_parenth=~ s{\s*$/\s*}{ }g;
return $text_in_parenth;
}
sub _massage {
my $self = shift;
my $record = shift;
my $last_name = \$dns_last_name {$self};
foreach (keys %$record) {
$record->{$_} = "" unless defined $record->{$_};
$record->{$_} = uc $record->{$_} if $_ eq 'class';
}
return $record unless exists $record->{name};
if (length $record->{name}) {
$$last_name = $record->{name};
} else {
TRACE("Record has no name, using last name");
$record->{name} = $$last_name;
}
DUMP("Record parsed", $record);
return $record;
}
sub TRACE {0 && print @_, $/}
sub DUMP {0 && require Data::Dumper && TRACE(shift, Data::Dumper::Dumper(@_))}
1;
__END__
=head1 NAME
DNS::ZoneParse - Parse and manipulate DNS Zone Files.
=head1 SYNOPSIS
use DNS::ZoneParse;
my $zonefile = DNS::ZoneParse->new("/path/to/dns/zonefile.db", $origin);
# Get a reference to the MX records
my $mx = $zonefile->mx;
# Change the first mailserver on the list
$mx->[0] = { host => 'mail.localhost.com',
priority => 10,
name => '@' };
# update the serial number
$zonefile->new_serial();
# write the new zone file to disk
open NEWZONE, ">/path/to/dns/zonefile.db" or die "error";
print NEWZONE $zonefile->output();
close NEWZONE;
=head1 INSTALLATION
perl Makefile.PL
make
make test
make install
Win32 users substitute "make" with "nmake" or equivalent.
nmake is available at http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
=head1 DESCRIPTION
This module will parse a Zone File and put all the Resource Records (RRs)
into an anonymous hash structure. At the moment, the following types of
RRs are supported: SOA, NS, MX, A, CNAME, TXT, PTR. It could be useful for
maintaining DNS zones, or for transferring DNS zones to other servers. If
you want to generate an XML-friendly version of your zone files, it is
easy to use XML::Simple with this module once you have parsed the zonefile.
DNS::ZoneParse scans the DNS zonefile - removes comments and seperates
the file into its constituent records. It then parses each record and
stores the records internally. See below for information on the accessor
methods.
=head2 METHODS
=over 4
=item new
This creates the DNS::ZoneParse Object and loads the zonefile
Example:
my $zonefile = DNS::ZoneParse->new("/path/to/zonefile.db");
You can also initialise the object with the contents of a file:
my $zonefile = DNS::ZoneParse->new( \$zone_contents );
You can pass a second, optional parameter to the constructor to supply an
C<$origin> if none can be found in the zone file.
my $zonefile = DNS::ZoneParse->new( \$zone_contents, $origin );
=item a(), cname(), mx(), ns(), ptr()
These methods return references to the resource records. For example:
my $mx = $zonefile->mx;
Returns the mx records in an array reference.
A, CNAME, NS, MX and PTR records have the following properties:
'ttl', 'class', 'host', 'name'
MX records also have a 'priority' property.
=item soa()
Returns a hash reference with the following properties:
'serial', 'origin', 'primary', 'refresh', 'retry', 'ttl', 'minimumTTL',
'email', 'expire'
=item dump
Returns a copy of the datastructute that stores all the resource records. This
might be useful if you want to quickly transform the data into another format,
such as XML.
=item new_serial
C<new_serial()> incriments the Zone serial number. It will generate a
date-based serial number. Or you can pass a positive number to add to the
current serial number.
Examples:
$zonefile->new_serial(); # generates a new serial number based on date:
# YYYYmmddHH format, incriments current serial
# by 1 if the new serial is still smaller
$zonefile->new_serial(50); # adds 50 to the original serial number
=item output
C<output()> returns the new zonefile output as a string. If you wish your
output formatted differently, you can pass the output of C<dump()> to your
favourite templating module.
=back
=head2 EXAMPLES
This script will print the A records in a zone file, add a new A record for the
name "new" and then return the zone file.
use strict;
use DNS::ZoneParse;
my $zonefile = DNS::ZoneParse->new("/path/to/zonefile.db");
print "Current A Records\n";
my $a_records = $zonefile->a();
foreach my $record (@$a_records) {
print "$record->{name} resolves at $record->{host}\n";
}
push (@$a_records, { name => 'new', class => 'IN',
host => '127.0.0.1', ttl => '' });
$zonefile->new_serial();
my $newfile = $zonefile->output();
This script will convert a DNS Zonefile to an XML file using XML::Simple.
use strict;
use DNS::ZoneParse;
use XML::Simple;
my $zonefile = DNS::ZoneParse->new("/path/to/zonefile.db");
my $new_xml = XMLout($zonefile->dump,
noattr => 1,
suppressempty => 1,
rootname => $zonefile->origin);
=head1 CHANGES
see F<Changes>
=head1 API
The DNS::ZoneParse API may change in future versions. At present, the parsing
is not as strict as it should be and support for C<$ORIGIN> and C<$TTL> is
quite basic. It would also be nice to support the C<INCLUDE>
statement. Furthermore, parsing large zonefiles with thousands of records can
use lots of memory - some people have requested a callback interface.
=head1 BUGS
I can squash more bugs with your help. Please let me know if you spot something
that doesn't work as expected.
You can report bugs via the CPAN RT:
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DNS-ZoneParse>
If possible, please provide a diff against F<t/dns-zoneparse.t> and
F<t/test-zone.db> that demonstrates the bug(s).
=head1 SEE ALSO
Other modules with similar functionality:
Net::DNS::ZoneParser, Net::DNS::ZoneFile, DNS::ZoneFile
=head1 AUTHOR
Simon Flack
=head1 LICENSE
DNS::ZoneParse is free software which you can redistribute and/or modify under
the same terms as Perl itself.
=cut