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