equal
deleted
inserted
replaced
14 our @EXPORT_OK = (); |
14 our @EXPORT_OK = (); |
15 |
15 |
16 |
16 |
17 # the sort order for the records of the same label |
17 # the sort order for the records of the same label |
18 my %ORDER = map { state $n = 0; $_ => ++$n } qw(SOA NS TXT MX A AAAA SSHFP); |
18 my %ORDER = map { state $n = 0; $_ => ++$n } qw(SOA NS TXT MX A AAAA SSHFP); |
|
19 |
|
20 sub h2ttl(_); |
19 |
21 |
20 # input $arg - hash with options |
22 # input $arg - hash with options |
21 # $data - a long string with the zone data |
23 # $data - a long string with the zone data |
22 sub parse { |
24 sub parse { |
23 my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH'; |
25 my %arg = %{ pop @_ } if ref $_[-1] eq 'HASH'; |
67 ); |
69 ); |
68 next if $rrset{rrtype} ~~ $arg{-skip}; |
70 next if $rrset{rrtype} ~~ $arg{-skip}; |
69 |
71 |
70 if ($rrset{rrtype} eq 'SOA') { |
72 if ($rrset{rrtype} eq 'SOA') { |
71 next if $soa_seen++; |
73 next if $soa_seen++; |
72 $rrset{data} =~ s/\s+/ /g; # squeeze spaces |
|
73 } |
74 } |
74 |
75 |
75 # label ergänzen, wenn nicht FQDN |
76 # label ergänzen, wenn nicht FQDN |
76 $rrset{label} .= ".$origin" |
77 $rrset{label} .= ".$origin" |
77 unless substr($rrset{label}, -1) eq '.'; |
78 unless substr($rrset{label}, -1) eq '.'; |
79 given ($rrset{rrtype}) { |
80 given ($rrset{rrtype}) { |
80 |
81 |
81 # origin steht im SOA |
82 # origin steht im SOA |
82 when ('SOA') { |
83 when ('SOA') { |
83 $origin = $rrset{label}; |
84 $origin = $rrset{label}; |
84 |
85 my ($primary, $hostmaster, $serial, $refresh, $retry, $expire, $minttl) |
85 # fix the nameserver name |
86 = split ' ', $rrset{data}; |
86 $rrset{data} =~ s{^(\S+[^.])(?=\s)}{$1.$origin}; |
87 |
87 |
88 $_ .= ".$origin" |
88 # fix the hostmaster address |
89 foreach grep !/\.$/ => $primary, $hostmaster; |
89 $rrset{data} =~ s{^\S+\s+\K(\S+[^.])(?=\s)}{$1.$origin}; |
90 |
|
91 $rrset{data} = join ' ', |
|
92 $primary, $hostmaster, $serial, map { h2ttl } $refresh, $retry, $expire, $minttl; |
90 } |
93 } |
91 |
94 |
92 # bei einigen RRs müssen wir die Daten korrigieren |
95 # bei einigen RRs müssen wir die Daten korrigieren |
93 when ([qw/CNAME MX NS PTR SOA/]) { |
96 when ([qw/CNAME MX NS PTR SOA/]) { |
94 $rrset{data} =~ s/\@/$origin/g; |
97 $rrset{data} =~ s/\@/$origin/g; |
122 } |
125 } |
123 |
126 |
124 return join '', @out; |
127 return join '', @out; |
125 } |
128 } |
126 |
129 |
127 sub h2ttl { |
130 sub h2ttl(_) { |
128 my $ttl = shift; |
131 my $ttl = shift; |
129 my $out; |
132 my $out; |
130 my %factor = ( |
133 my %factor = ( |
131 w => 604800, |
134 w => 604800, |
132 d => 86400, |
135 d => 86400, |