parent
0dc7cdea82
commit
e6da9f192e
@ -1,52 +1,180 @@
|
||||
package zonefile;
|
||||
use v5.14;
|
||||
use Net::DNS::RR;
|
||||
use Net::DNS::ZoneFile;
|
||||
use Moo;
|
||||
use DNS::ZoneParse;
|
||||
use utf8;
|
||||
use URI;
|
||||
use Data::Dumper;
|
||||
|
||||
has zone => qw/is rw/ ;
|
||||
has [ qw/domain/ ] => qw/ is ro required 1/;
|
||||
has [ qw/zonefile/ ] => qw/ is rw required 1/;
|
||||
|
||||
# Simple functions to manipulate lists of Net::DNS::RR
|
||||
|
||||
sub rr_array_del {
|
||||
my ($zones, $rr) = @_;
|
||||
my @z = grep { $_->plain ne $rr->plain } @$zones;
|
||||
[ @z ]
|
||||
}
|
||||
|
||||
sub rr_array_add {
|
||||
my ($zone, $rr) = @_;
|
||||
my @already_present = grep { $_->plain eq $rr->plain } @$zone;
|
||||
push @$zone, $rr unless @already_present;
|
||||
$zone
|
||||
}
|
||||
|
||||
sub rr_array_new_serial {
|
||||
my $zones = shift;
|
||||
|
||||
for(@{$zones}) {
|
||||
if($_->type =~ /SOA/) {
|
||||
my $serial = $_->serial;
|
||||
$_->serial($serial + 1);
|
||||
}
|
||||
}
|
||||
|
||||
$zones
|
||||
}
|
||||
|
||||
sub rr_array_serial {
|
||||
my $zones = shift;
|
||||
|
||||
for(@{$zones}) {
|
||||
if($_->type =~ /SOA/) {
|
||||
return $_->serial;
|
||||
}
|
||||
}
|
||||
|
||||
die "Impossible to get the zone serial."
|
||||
}
|
||||
|
||||
sub rr_array_dump {
|
||||
my $zone = shift;
|
||||
my $dump = '';
|
||||
|
||||
# write the SOA record first
|
||||
for(@{$zone}) {
|
||||
if($_->type =~ /SOA/i) {
|
||||
$dump .= $_->string . "\n";
|
||||
}
|
||||
}
|
||||
|
||||
for(@{$zone}) {
|
||||
if($_->type !~ /SOA/i) {
|
||||
$dump .= $_->string . "\n";
|
||||
}
|
||||
}
|
||||
|
||||
$dump
|
||||
}
|
||||
|
||||
|
||||
sub BUILD {
|
||||
my ($self) = @_;
|
||||
|
||||
my $filename = $$self{zonefile};
|
||||
if($filename =~ "://")
|
||||
{
|
||||
my $fileuri = URI->new($filename);
|
||||
$filename = $fileuri->path;
|
||||
}
|
||||
my $path = $$self{zonefile};
|
||||
|
||||
$$self{zone} = DNS::ZoneParse->new($filename, $$self{domain});
|
||||
# zonefile is the filename
|
||||
if($$self{zonefile} =~ "://") {
|
||||
my $fileuri = URI->new($$self{zonefile});
|
||||
$path = $fileuri->path;
|
||||
}
|
||||
|
||||
my $zonefile = Net::DNS::ZoneFile->new( $path );
|
||||
my @zone = $zonefile->read;
|
||||
$$self{zone} = [ @zone ];
|
||||
}
|
||||
|
||||
sub new_serial {
|
||||
my $self = shift;
|
||||
$self->zone->new_serial();
|
||||
$$self{zone} = rr_array_new_serial $$self{zone}
|
||||
}
|
||||
|
||||
sub origin {
|
||||
sub dump {
|
||||
my $self = shift;
|
||||
$self->zone->origin();
|
||||
rr_array_dump $$self{zone}
|
||||
}
|
||||
|
||||
sub output {
|
||||
my $self = shift;
|
||||
$self->zone->output();
|
||||
sub serial {
|
||||
my ($self, $rr) = @_;
|
||||
rr_array_serial $$self{zone}
|
||||
}
|
||||
|
||||
sub dump {
|
||||
my $self = shift;
|
||||
$self->zone->dump();
|
||||
# remove a raw line that represents the RR
|
||||
sub rr_del_raw {
|
||||
my ($self, $rrline) = @_;
|
||||
my $rr = Net::DNS::RR->new($rrline);
|
||||
$self->rr_del($rr)
|
||||
}
|
||||
|
||||
sub rr_del {
|
||||
my ($self, $rr) = @_;
|
||||
$$self{zone} = rr_array_del $$self{zone}, $rr
|
||||
}
|
||||
|
||||
# add a raw line that represents the RR
|
||||
sub rr_add_raw {
|
||||
my ($self, $rrline) = @_;
|
||||
my $rr = Net::DNS::RR->new($rrline);
|
||||
$self->rr_add($rr)
|
||||
}
|
||||
|
||||
sub rr_add {
|
||||
my ($self, $rr) = @_;
|
||||
$$self{zone} = rr_array_add $$self{zone}, $rr
|
||||
}
|
||||
|
||||
sub rr_mod {
|
||||
my ($self, $rrline_old, $rrline_new) = @_;
|
||||
$self->rr_del_raw($rrline_old);
|
||||
$self->rr_add_raw($rrline_new);
|
||||
}
|
||||
|
||||
# better encapsulation
|
||||
sub a { my $self = shift; $self->zone->a }
|
||||
sub aaaa { my $self = shift; $self->zone->aaaa }
|
||||
sub cname { my $self = shift; $self->zone->cname }
|
||||
sub ns { my $self = shift; $self->zone->ns }
|
||||
sub mx { my $self = shift; $self->zone->mx }
|
||||
sub ptr { my $self = shift; $self->zone->ptr }
|
||||
sub txt { my $self = shift; $self->zone->txt } # TODO TEST THIS
|
||||
|
||||
sub rr_array_to_array {
|
||||
my ($self) = shift;
|
||||
my $rr_list;
|
||||
|
||||
for(@{$$self{zone}}) {
|
||||
|
||||
my @list = split / /, $_->plain;
|
||||
|
||||
my $rr;
|
||||
$$rr{name} = $list[0];
|
||||
$$rr{ttl} = $list[1];
|
||||
$$rr{class} = $list[2];
|
||||
$$rr{type} = $list[3];
|
||||
|
||||
if($list[3] =~ /SOA/) {
|
||||
$$rr{ns} = $list[4];
|
||||
$$rr{postmaster} = $list[5];
|
||||
$$rr{serial} = $list[6];
|
||||
$$rr{refresh} = $list[7];
|
||||
$$rr{retry} = $list[8];
|
||||
$$rr{expire} = $list[9];
|
||||
$$rr{minimum} = $list[10];
|
||||
}
|
||||
elsif($list[3] =~ /^(A(AAA)?|CNAME|NS)$/) {
|
||||
$$rr{rdata} = $list[4];
|
||||
}
|
||||
elsif($list[3] =~ /^MX$/) {
|
||||
$$rr{priority} = $list[4];
|
||||
$$rr{rdata} = $list[5];
|
||||
}
|
||||
elsif($list[3] =~ /^TXT$/) {
|
||||
$$rr{rdata} = $_->rdstring;
|
||||
}
|
||||
else {
|
||||
die "This RR is not available : " . $_->plain;
|
||||
}
|
||||
|
||||
push @$rr_list, $rr;
|
||||
|
||||
}
|
||||
|
||||
$rr_list
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
@ -0,0 +1,18 @@
|
||||
use Test::More;
|
||||
use Modern::Perl;
|
||||
use lib 'lib';
|
||||
use util ':all';
|
||||
use zonefile;
|
||||
|
||||
chdir 'lib'; # TODO hack at 2am
|
||||
|
||||
#map {
|
||||
# ok
|
||||
# ( ( is_domain_name $_ ), "is '$_' a domain name" )
|
||||
#} qw( foo.bar bar localhost. localhost );
|
||||
#
|
||||
#done_testing;
|
||||
|
||||
my $zf = zonefile->new( zonefile => "../t/zonefile.txt" );
|
||||
$zf->new_serial();
|
||||
print $zf->dump();
|
||||
@ -0,0 +1,17 @@
|
||||
$ORIGIN example.com. ; designates the start of this zone file in the namespace
|
||||
$TTL 1h ; default expiration time of all resource records without their own TTL value
|
||||
example.com. IN SOA ns.example.com. username.example.com. ( 2007120710 1d 2h 4w 1h )
|
||||
example.com. IN NS ns ; ns.example.com is a nameserver for example.com
|
||||
example.com. IN NS ns.somewhere.example. ; ns.somewhere.example is a backup nameserver for example.com
|
||||
example.com. IN MX 10 mail.example.com. ; mail.example.com is the mailserver for example.com
|
||||
@ IN MX 20 mail2.example.com. ; equivalent to above line, "@" represents zone origin
|
||||
@ IN MX 50 mail3 ; equivalent to above line, but using a relative host name
|
||||
example.com. IN A 192.0.2.1 ; IPv4 address for example.com
|
||||
IN AAAA 2001:db8:10::1 ; IPv6 address for example.com
|
||||
ns IN A 192.0.2.2 ; IPv4 address for ns.example.com
|
||||
IN AAAA 2001:db8:10::2 ; IPv6 address for ns.example.com
|
||||
www IN CNAME example.com. ; www.example.com is an alias for example.com
|
||||
wwwtest IN CNAME www ; wwwtest.example.com is another alias for www.example.com
|
||||
mail IN A 192.0.2.3 ; IPv4 address for mail.example.com
|
||||
mail2 IN A 192.0.2.4 ; IPv4 address for mail2.example.com
|
||||
mail3 IN A 192.0.2.5 ; IPv4 address for mail3.example.com
|
||||
Loading…
Reference in new issue