6 use Smart::Comments; |
6 use Smart::Comments; |
7 use Digest::SHA qw(sha512_hex); |
7 use Digest::SHA qw(sha512_hex); |
8 |
8 |
9 sub parse { |
9 sub parse { |
10 my $file = shift; |
10 my $file = shift; |
11 my @lines = split /\n/, do { |
11 my @lines = split /\n/, do { |
12 local $/ = undef; |
12 local $/ = undef; |
13 local @ARGV = $file; |
13 local @ARGV = $file; |
14 <>; |
14 <>; |
15 }; |
15 }; |
16 |
16 |
17 my @zone; |
17 my @zone; |
18 my ($origin, $ttl, $last_label, $soa_seen); |
18 my ($origin, $ttl, $last_label, $soa_seen); |
19 |
19 |
20 foreach (@lines) { |
20 foreach (@lines) { |
21 s{;.*$}{}; |
21 s{;.*$}{}; |
22 given ($_) { |
22 given ($_) { |
23 when (m{^\s*\$ORIGIN\s+(\S+)}) { $origin = $1 } |
23 when (m{^\s*\$ORIGIN\s+(\S+)}) { $origin = $1 } |
24 when (m{^\s*\$TTL\s+(\S+)}) { $ttl = $1 } |
24 when (m{^\s*\$TTL\s+(\S+)}) { $ttl = $1 } |
25 when ( |
25 when ( |
26 m{^(?<label>\S+)? |
26 m{^(?<label>\S+)? |
27 \s+(?<ttl>\S+(?=\s+))? |
27 \s+(?<ttl>\S+(?=\s+))? |
28 \s+(?:(?:IN|ANY)\s+)?(?<rrtype>\S+(?=\s+)) |
28 \s+(?:(?:IN|ANY)\s+)?(?<rrtype>\S+(?=\s+)) |
29 \s+(?<data>.*) |
29 \s+(?<data>.*) |
30 }x |
30 }x |
31 ) |
31 ) |
32 { |
32 { |
33 my %rrset = ( |
33 my %rrset = ( |
34 label => $last_label = defined $+{label} |
34 label => $last_label = |
35 ? $+{label} eq '@' ? $origin : $+{label} |
35 defined $+{label} |
36 : $last_label, |
36 ? $+{label} eq '@' |
37 ttl => h2ttl($+{ttl} // $ttl), |
37 ? $origin |
38 rrtype => uc $+{rrtype}, |
38 : $+{label} |
39 data => $+{data}, |
39 : $last_label, |
40 ); |
40 ttl => h2ttl($+{ttl} // $ttl), |
|
41 rrtype => uc $+{rrtype}, |
|
42 data => $+{data}, |
|
43 ); |
41 |
44 |
42 if ($rrset{rrtype} eq 'SOA') { |
45 if ($rrset{rrtype} eq 'SOA') { |
43 next if $soa_seen; |
46 next if $soa_seen; |
44 $soa_seen = 1; |
47 $soa_seen = 1; |
45 } |
48 } |
46 |
49 |
|
50 # label ergänzen, wenn nicht FQDN |
|
51 $rrset{label} .= ".$origin" |
|
52 unless substr($rrset{label}, -1) eq '.'; |
47 |
53 |
|
54 given ($rrset{rrtype}) { |
48 |
55 |
49 # label ergänzen, wenn nicht FQDN |
56 # origin steht im SOA |
50 $rrset{label} .= ".$origin" unless substr($rrset{label}, -1) eq '.'; |
57 when ('SOA') { |
|
58 $origin = $rrset{label}; |
51 |
59 |
52 given ($rrset{rrtype}) { |
60 # fix the nameserver name |
53 # origin steht im SOA |
61 $rrset{data} =~ s{^(\S+[^.])(?=\s)}{$1.$origin}; |
54 when('SOA') { |
62 |
55 $origin = $rrset{label}; |
63 # fix the hostmaster address |
56 # fix the nameserver name |
64 $rrset{data} =~ s{^\S+\s+\K(\S+[^.])(?=\s)}{$1.$origin}; |
57 $rrset{data} =~ s{^(\S+[^.])(?=\s)}{$1.$origin}; |
65 } |
58 # fix the hostmaster address |
66 |
59 $rrset{data} =~ s{^\S+\s+\K(\S+[^.])(?=\s)}{$1.$origin}; |
67 # bei einigen RRs müssen wir die Daten korrigieren |
60 } |
68 when ([qw/MX NS PTR/]) { |
61 # bei einigen RRs müssen wir die Daten korrigieren |
69 $rrset{data} .= ".$origin" |
62 when ([qw/MX NS PTR/]) { |
70 unless substr($rrset{data}, -1) eq '.'; |
63 $rrset{data} .= ".$origin" unless substr($rrset{data}, -1) eq '.'; |
71 } |
64 } |
72 } |
65 } |
73 my $id = sha512_hex(sort %rrset); |
66 my $id = sha512_hex(sort %rrset); |
74 push @zone, { id => $id, rrset => \%rrset }; |
67 push @zone, {id => $id, rrset => \%rrset}; |
|
68 } |
75 } |
69 } |
76 } |
70 } |
77 } |
71 |
78 |
72 # list of { |
79 # list of { |
73 # id => $id, |
80 # id => $id, |
74 # rrset => { label => …, ttl => …, rrtype => …, data => … } |
81 # rrset => { label => …, ttl => …, rrtype => …, data => … } |
75 # } |
82 # } |
76 return @zone; |
83 return @zone; |
77 } |
84 } |
78 |
85 |
79 sub ttl2h { |
86 sub ttl2h { |
80 my $seconds = shift; |
87 my $seconds = shift; |
81 my @out; |
88 my @out; |
82 my @units = ( [w => 604800], [d => 86400], [h => 3600], [m => 60], [s => 1]); |
89 my @units = ([w => 604800], [d => 86400], [h => 3600], [m => 60], [s => 1]); |
83 |
90 |
84 foreach (@units) { |
91 foreach (@units) { |
85 my $x = int($seconds / $_->[1]); |
92 my $x = int($seconds / $_->[1]); |
86 push @out, "$x$_->[0]" if $x; |
93 push @out, "$x$_->[0]" if $x; |
87 $seconds %= $_->[1] or last; |
94 $seconds %= $_->[1] or last; |
88 } |
95 } |
89 |
96 |
90 return join '', @out; |
97 return join '', @out; |
91 } |
98 } |
92 |
99 |
93 sub h2ttl { |
100 sub h2ttl { |
94 my $ttl = shift; |
101 my $ttl = shift; |
95 my $out; |
102 my $out; |
96 my %factor = ( |
103 my %factor = ( |
97 w => 604800, |
104 w => 604800, |
98 d => 86400, |
105 d => 86400, |
99 h => 3600, |
106 h => 3600, |
100 m => 60, |
107 m => 60, |
101 s => 1, |
108 s => 1, |
102 ); |
109 ); |
103 |
110 |
104 while ($ttl =~ m{(\d+)([wdhms])}g) { |
111 while ($ttl =~ m{(\d+)([wdhms])}g) { |
105 $out += $1 * $factor{$2}; |
112 $out += $1 * $factor{$2}; |
106 } |
113 } |
107 |
114 |
108 return $out // $ttl; |
115 return $out // $ttl; |
109 } |
116 } |
110 |
117 |
111 sub nice { |
118 sub nice { |
|
119 |
112 # get a list of { id => $id, rrset => \%rrset } |
120 # get a list of { id => $id, rrset => \%rrset } |
113 my @zone = |
121 my @zone = |
114 sort { length $a->{label} <=> length $b->{label} or $a->{label} |
122 sort { |
115 cmp $b->{label}} map { $_->{rrset} } @_; |
123 length $a->{label} <=> length $b->{label} |
|
124 or $a->{label} |
|
125 cmp $b->{label} |
|
126 } map { $_->{rrset} } @_; |
116 |
127 |
117 my @out; |
128 my @out; |
118 my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label}; |
129 my $origin = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{label}; |
119 my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl}; |
130 my $ttl = (grep { $_->{rrtype} eq 'SOA' } @zone)[0]->{ttl}; |
120 my $l1 = (sort map { index $_->{label}, '.' } @zone)[-1]; |
131 my $l1 = (sort map { index $_->{label}, '.' } @zone)[-1]; |
121 my $l2 = (sort map { length $_->{rrtype} } @zone)[-1]; |
132 my $l2 = (sort map { length $_->{rrtype} } @zone)[-1]; |
122 push @out, "\$ORIGIN $origin", |
133 push @out, "\$ORIGIN $origin", "\$TTL " . ttl2h($ttl); |
123 "\$TTL " . ttl2h($ttl); |
|
124 |
134 |
125 my $print = sub { |
135 my $print = sub { |
126 my %r = %{+shift}; |
136 my %r = %{ +shift }; |
127 state $last_label;; |
137 state $last_label; |
128 |
138 |
129 $r{label} = '@' if $r{label} eq $origin; |
139 $r{label} = '@' if $r{label} eq $origin; |
130 $r{label} =~ s{\.\Q$origin\E$}{}; |
140 $r{label} =~ s{\.\Q$origin\E$}{}; |
131 $r{data} =~ s{\.\Q$origin\E$}{} if $r{rrtype} ~~ [qw(MX SOA PTR)]; |
141 $r{data} =~ s{\.\Q$origin\E$}{} if $r{rrtype} ~~ [qw(MX SOA PTR)]; |
132 $r{ttl} = $r{ttl} == $ttl ? '' : ttl2h($r{ttl}); |
142 $r{ttl} = $r{ttl} == $ttl ? '' : ttl2h($r{ttl}); |
133 $r{label} = do { |
143 $r{label} = do { |
134 if (defined $last_label and $r{label} eq $last_label) { '' } |
144 if (defined $last_label and $r{label} eq $last_label) { '' } |
135 else { $last_label = $r{label} } |
145 else { $last_label = $r{label} } |
136 }; |
146 }; |
137 |
147 |
138 return sprintf '%-*s %6s %-*s %s', |
148 return sprintf '%-*s %6s %-*s %s', |
139 $l1 => $r{label}, $r{ttl}, $l2 => $r{rrtype}, $r{data}; |
149 $l1 => $r{label}, |
|
150 $r{ttl}, |
|
151 $l2 => $r{rrtype}, |
|
152 $r{data}; |
140 }; |
153 }; |
141 push @out, $print->($_) foreach @zone; |
154 push @out, $print->($_) foreach @zone; |
142 return join "\n", @out; |
155 return join "\n", @out; |
143 } |
156 } |
144 |
157 |