line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
# Parse::DNS::Zone - DNS Zone File Parser |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Copyright (c) 2009-2011, 2013, 2015 - Olof Johansson |
5
|
|
|
|
|
|
|
# All rights reserved. |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# This program is free software; you can redistribute it and/or |
8
|
|
|
|
|
|
|
# modify it under the same terms as Perl itself. |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=pod |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Parse::DNS::Zone - DNS Zone File Parser |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 SYNOPSIS |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
use Parse::DNS::Zone; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $pdz = Parse::DNS::Zone->new( |
21
|
|
|
|
|
|
|
zonefile=>'db.example', |
22
|
|
|
|
|
|
|
origin=>'example.org.', |
23
|
|
|
|
|
|
|
); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
my $a_rr = $pdz->get_rdata(name=>'foo', rr=>'A'); |
26
|
|
|
|
|
|
|
my $mx_rr = $pdz->get_rdata(name=>'@', rr=>'MX'); # Get the origin's MX |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# Getting SOA values |
29
|
|
|
|
|
|
|
my $mname = $pdz->get_mname(); |
30
|
|
|
|
|
|
|
my $rname = $pdz->get_rname(); |
31
|
|
|
|
|
|
|
my $serial = $pdz->get_serial(); |
32
|
|
|
|
|
|
|
# ... etc ... |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=head1 DESCRIPTION |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
B parses a zonefile, used to define a DNS Zone |
37
|
|
|
|
|
|
|
and gives you the information therein, via an object oriented |
38
|
|
|
|
|
|
|
interface. Parse::DNS::Zone doesn't validate rrdata, except for |
39
|
|
|
|
|
|
|
SOA, and is used to 1) validate the basic structure of the file |
40
|
|
|
|
|
|
|
and 2) extract rdata so you can parse it and validate it yourself. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
Parse::DNS::Zone supports the zone file format as described in |
43
|
|
|
|
|
|
|
RFC 1034: |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=over 4 |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=item * $INCLUDE |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=item * $ORIGIN |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=item * $TTL (as described in RFC 2308) |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=back |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
Parse::DNS::Zone does not support $GENERATE in this version. |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=cut |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
package Parse::DNS::Zone; |
60
|
|
|
|
|
|
|
our $VERSION = '0.5'; |
61
|
3
|
|
|
3
|
|
52657
|
use warnings; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
90
|
|
62
|
3
|
|
|
3
|
|
11
|
use strict; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
75
|
|
63
|
3
|
|
|
3
|
|
11
|
use File::Basename; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
251
|
|
64
|
3
|
|
|
3
|
|
12
|
use File::Spec; |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
49
|
|
65
|
3
|
|
|
3
|
|
11
|
use Carp; |
|
3
|
|
|
|
|
3
|
|
|
3
|
|
|
|
|
6970
|
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head2 Parse::DNS::Zone->new( ARGS ) |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=over 4 |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=item B |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=over 4 |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=item * B |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
Origin |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=back |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
And additionally, exactly one of the following: |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=over 4 |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=item * B |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Path to the zonefile being parsed |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=item * B |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
The zone, as a string. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=back |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=item B |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=over 4 |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=item * B |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
If set to a true value, the parser will whine and die if |
104
|
|
|
|
|
|
|
the zonefile doesn't contain a SOA record. (Default: yes) |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=item * B |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
Specify a basepath, from which included relative zonefiles |
109
|
|
|
|
|
|
|
should be available. If used with the B parameter, |
110
|
|
|
|
|
|
|
this defaults to the directory in which the zonefile is in. |
111
|
|
|
|
|
|
|
For $INCLUDEs to work when passing the zone in as a string, |
112
|
|
|
|
|
|
|
this needs to be specified. |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=item * B |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
If set to a true value, the parser will append the origin |
117
|
|
|
|
|
|
|
to all unqualified domain names (in certain record types, |
118
|
|
|
|
|
|
|
currently: CNAME, MX, NS, AFSDB, PTR). If some record |
119
|
|
|
|
|
|
|
types are missing from this list, please report that as a |
120
|
|
|
|
|
|
|
bug. (Default: no) |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
This feature do run the risk of becoming stale if new |
123
|
|
|
|
|
|
|
record types are introduced. But if you run into problems, |
124
|
|
|
|
|
|
|
don't hesitate to report it! |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=back |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
=back |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=cut |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
sub new { |
133
|
5
|
|
|
5
|
1
|
154
|
my $class = shift; |
134
|
5
|
|
|
|
|
21
|
my $self = { |
135
|
|
|
|
|
|
|
require_soa => 1, |
136
|
|
|
|
|
|
|
append_origin => 0, |
137
|
|
|
|
|
|
|
@_ |
138
|
|
|
|
|
|
|
}; |
139
|
|
|
|
|
|
|
|
140
|
5
|
100
|
66
|
|
|
27
|
if (not defined $self->{zonestr} and defined $self->{zonefile}) { |
141
|
4
|
|
|
|
|
11
|
$self->{zonestr} = _load_zonefile($self->{zonefile}); |
142
|
|
|
|
|
|
|
} |
143
|
5
|
50
|
|
|
|
17
|
if (not defined $self->{zonestr}) { |
144
|
0
|
|
|
|
|
0
|
croak("You need to specify either zonestr or zonefile"); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
# default basepath is dirname($zonefile) |
148
|
5
|
100
|
|
|
|
13
|
if (not exists $self->{basepath}) { |
149
|
4
|
50
|
|
|
|
189
|
$self->{basepath} = dirname($self->{zonefile}) if |
150
|
|
|
|
|
|
|
defined $self->{zonefile}; |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# append trailing . |
154
|
5
|
50
|
|
|
|
22
|
$self->{origin} .= '.' if($self->{origin}=~/[^[^\.]$/); |
155
|
5
|
|
|
|
|
11
|
bless($self, $class); |
156
|
|
|
|
|
|
|
|
157
|
5
|
|
|
|
|
13
|
_parse($self); |
158
|
|
|
|
|
|
|
|
159
|
5
|
50
|
33
|
|
|
35
|
if($self->{require_soa} && |
160
|
|
|
|
|
|
|
(!exists $self->{zone}{$self->{origin}}{soa})) { |
161
|
0
|
|
|
|
|
0
|
croak("No SOA in zonefile"); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
5
|
|
|
|
|
10
|
_parse_soa($self); |
165
|
|
|
|
|
|
|
|
166
|
5
|
|
|
|
|
17
|
return $self; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=head1 METHODS |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head2 General |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=head3 $pdz->get_rdata(name=>$name, rr=>$rr, n=>$n, field=>$field) |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
Is used to get the data associated with a specific name and rr |
176
|
|
|
|
|
|
|
type. The $name can be as the name appears in the zonefile, or a |
177
|
|
|
|
|
|
|
fqdn (with trailing .) as long as it is tracked by the zonefile. |
178
|
|
|
|
|
|
|
If the n argument is specified, the n:th RR in the RRset is |
179
|
|
|
|
|
|
|
returned. Otherwise, you'll get a complete list of the RRset if |
180
|
|
|
|
|
|
|
you're in list context, or the first RR if you're in scalar |
181
|
|
|
|
|
|
|
context. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
The $field is the particular component of the resource record to |
184
|
|
|
|
|
|
|
return. It defaults to 'val', which is the actual value of the |
185
|
|
|
|
|
|
|
record. Other possibilities are 'class' (e.g. "IN") and 'ttl'. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=cut |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub get_rdata { |
190
|
31
|
|
|
31
|
1
|
358
|
my $self = shift; |
191
|
31
|
|
|
|
|
81
|
my $h = { |
192
|
|
|
|
|
|
|
field=>'rdata', |
193
|
|
|
|
|
|
|
@_, |
194
|
|
|
|
|
|
|
}; |
195
|
|
|
|
|
|
|
|
196
|
31
|
|
|
|
|
35
|
my ($name, $rr, $field, $n) = @{$h}{qw(name rr field n)}; |
|
31
|
|
|
|
|
60
|
|
197
|
|
|
|
|
|
|
|
198
|
31
|
|
|
|
|
60
|
$name=~s/^\@$/$self->{origin}/g; |
199
|
31
|
|
|
|
|
37
|
$name=~s/\.\@\./\.$self->{origin}/g; |
200
|
31
|
|
|
|
|
29
|
$name=~s/\.\@$/\.$self->{origin}/g; |
201
|
31
|
|
|
|
|
28
|
$name=~s/\@\.$/\.$self->{origin}/g; |
202
|
31
|
100
|
100
|
|
|
128
|
$name .= ".$self->{origin}" if(($name ne $self->{origin}) && |
203
|
|
|
|
|
|
|
(!($name=~/\.$/))); |
204
|
|
|
|
|
|
|
|
205
|
31
|
100
|
|
|
|
63
|
return $self->{zone}{lc $name}{lc $rr}{lc $field}[$n] if defined $n; |
206
|
29
|
100
|
|
|
|
45
|
return @{$self->{zone}{lc $name}{lc $rr}{lc $field}} if wantarray; |
|
1
|
|
|
|
|
7
|
|
207
|
28
|
|
|
|
|
146
|
return $self->{zone}{lc $name}{lc $rr}{lc $field}[0]; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=head3 $pdz->exists($name) |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
Returns a true value if the name exists, and false otherwise. |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=cut |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub exists { |
217
|
7
|
|
|
7
|
1
|
9
|
my $self = shift; |
218
|
7
|
|
|
|
|
7
|
my $name = shift; |
219
|
|
|
|
|
|
|
|
220
|
7
|
|
|
|
|
8
|
$name=~s/^\@$/$self->{origin}/g; |
221
|
7
|
|
|
|
|
8
|
$name=~s/\.\@\./\.$self->{origin}/g; |
222
|
7
|
|
|
|
|
6
|
$name=~s/\.\@$/\.$self->{origin}/g; |
223
|
7
|
|
|
|
|
7
|
$name=~s/\@\.$/\.$self->{origin}/g; |
224
|
7
|
100
|
66
|
|
|
45
|
$name .= ".$self->{origin}" if(($name ne $self->{origin}) && |
225
|
|
|
|
|
|
|
(!($name=~/\.$/))); |
226
|
|
|
|
|
|
|
|
227
|
7
|
|
|
|
|
27
|
return exists $self->{zone}{lc $name}; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head3 $pdz->get_rrs($name) |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Returns a list with all RR types for a specific name |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=cut |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub get_rrs { |
237
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
238
|
1
|
|
|
|
|
1
|
my $name = shift; |
239
|
1
|
|
|
|
|
1
|
my @rrs; |
240
|
|
|
|
|
|
|
|
241
|
1
|
|
|
|
|
2
|
$name=~s/^\@$/$self->{origin}/g; |
242
|
1
|
|
|
|
|
2
|
$name=~s/\.\@\./\.$self->{origin}/g; |
243
|
1
|
|
|
|
|
2
|
$name=~s/\.\@$/\.$self->{origin}/g; |
244
|
1
|
|
|
|
|
1
|
$name=~s/\@\.$/\.$self->{origin}/g; |
245
|
1
|
50
|
33
|
|
|
31
|
$name .= ".$self->{origin}" if(($name ne $self->{origin}) && |
246
|
|
|
|
|
|
|
(!($name=~/\.$/))); |
247
|
|
|
|
|
|
|
|
248
|
1
|
|
|
|
|
1
|
foreach my $k (keys %{$self->{zone}{lc $name}}) { |
|
1
|
|
|
|
|
5
|
|
249
|
2
|
|
|
|
|
7
|
push @rrs, $k; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
1
|
|
|
|
|
3
|
return @rrs; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head3 $pdz->get_dupes(name=>$name, rr=>$rr) |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Returns how many RRs of a given type is defined for $name. For a simple |
258
|
|
|
|
|
|
|
setup with a single RR for $name, this will return 1. If you have some |
259
|
|
|
|
|
|
|
kind of load balancing or other scheme using multiple RRs of the same |
260
|
|
|
|
|
|
|
type this sub will return the number of "dupes". |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=cut |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
sub get_dupes { |
265
|
4
|
|
|
4
|
1
|
8
|
my $self = shift; |
266
|
4
|
|
|
|
|
9
|
my $h = { |
267
|
|
|
|
|
|
|
@_, |
268
|
|
|
|
|
|
|
}; |
269
|
|
|
|
|
|
|
|
270
|
4
|
|
|
|
|
6
|
my $name = $h->{name}; |
271
|
4
|
|
|
|
|
5
|
my $rr = $h->{rr}; |
272
|
|
|
|
|
|
|
|
273
|
4
|
|
|
|
|
16
|
$name=~s/^\@$/$self->{origin}/g; |
274
|
4
|
|
|
|
|
6
|
$name=~s/\.\@\./\.$self->{origin}/g; |
275
|
4
|
|
|
|
|
5
|
$name=~s/\.\@$/\.$self->{origin}/g; |
276
|
4
|
|
|
|
|
5
|
$name=~s/\@\.$/\.$self->{origin}/g; |
277
|
4
|
100
|
66
|
|
|
17
|
$name .= ".$self->{origin}" if(($name ne $self->{origin}) && |
278
|
|
|
|
|
|
|
(!($name=~/\.$/))); |
279
|
|
|
|
|
|
|
|
280
|
4
|
|
|
|
|
8
|
return int(@{$self->{zone}{lc $name}{lc $rr}{rdata}}); |
|
4
|
|
|
|
|
25
|
|
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=head3 $pdz->get_names( ) |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
Returns a list with all names specified in the zone |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=cut |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
sub get_names { |
290
|
3
|
|
|
3
|
1
|
7
|
my $self = shift; |
291
|
3
|
|
|
|
|
4
|
my @names; |
292
|
|
|
|
|
|
|
|
293
|
3
|
|
|
|
|
3
|
foreach my $n (keys %{$self->{zone}}) { |
|
3
|
|
|
|
|
13
|
|
294
|
45
|
|
|
|
|
41
|
push @names, $n; |
295
|
|
|
|
|
|
|
} |
296
|
|
|
|
|
|
|
|
297
|
3
|
|
|
|
|
17
|
return @names; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=head2 SOA |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=head3 $pdz->get_mname( ) |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
Returns the MNAME part of the SOA. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=cut |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub get_mname { |
309
|
1
|
|
|
1
|
1
|
254
|
my $self = shift; |
310
|
1
|
|
|
|
|
5
|
return $self->{soa}{mname}; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=head3 $pdz->get_rname( parse=>{0,1} ) |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
Return the RNAME part of the SOA. If parse is set to a value |
316
|
|
|
|
|
|
|
other than 0, the value will be interpreted to show an |
317
|
|
|
|
|
|
|
emailaddress. (default: 0) |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=cut |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub get_rname { |
322
|
2
|
|
|
2
|
1
|
3
|
my $self = shift; |
323
|
2
|
|
|
|
|
5
|
my %p = ( |
324
|
|
|
|
|
|
|
parse=>0, |
325
|
|
|
|
|
|
|
@_ |
326
|
|
|
|
|
|
|
); |
327
|
|
|
|
|
|
|
|
328
|
2
|
|
|
|
|
4
|
my $ret = $self->{soa}{rname}; |
329
|
2
|
100
|
|
|
|
6
|
if($p{parse}) { |
330
|
1
|
|
|
|
|
5
|
my ($user,$host)=$self->{soa}{rname}=~/^([^\.]+)\.(.*)$/; |
331
|
1
|
|
|
|
|
3
|
$ret = "$user\@$host"; |
332
|
|
|
|
|
|
|
} |
333
|
|
|
|
|
|
|
|
334
|
2
|
|
|
|
|
7
|
return $ret; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=head3 $pdz->get_serial( ) |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
Return the SERIAL value of a SOA. |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=cut |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
sub get_serial { |
344
|
1
|
|
|
1
|
1
|
282
|
my $self = shift; |
345
|
1
|
|
|
|
|
6
|
return $self->{soa}{serial}; |
346
|
|
|
|
|
|
|
} |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
=head3 $pdz->get_refresh( ) |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
Return the REFRESH value of a SOA |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
=cut |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
sub get_refresh { |
355
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
356
|
1
|
|
|
|
|
5
|
return $self->{soa}{refresh}; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=head3 $pdz->get_retry( ) |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Return the RETRY value of a SOA |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
=cut |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
sub get_retry { |
366
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
367
|
1
|
|
|
|
|
5
|
return $self->{soa}{retry}; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=head3 $pdz->get_expire( ) |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
Return the EXPIRE value of a SOA |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
=cut |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
sub get_expire { |
377
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
378
|
1
|
|
|
|
|
5
|
return $self->{soa}{expire}; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=head3 $pdz->get_minimum( ) |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
Return the MINIMUM value of a SOA |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
=cut |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
sub get_minimum { |
388
|
1
|
|
|
1
|
1
|
2
|
my $self = shift; |
389
|
1
|
|
|
|
|
4
|
return $self->{soa}{minimum}; |
390
|
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# Is used to populate the zone hash used internally. |
393
|
|
|
|
|
|
|
sub _parse { |
394
|
5
|
|
|
5
|
|
7
|
my $self = shift; |
395
|
|
|
|
|
|
|
|
396
|
5
|
|
|
|
|
24
|
my %zone = $self->_parse_zone( |
397
|
|
|
|
|
|
|
zonestr => $self->{zonestr}, |
398
|
|
|
|
|
|
|
origin => $self->{origin}, |
399
|
|
|
|
|
|
|
); |
400
|
|
|
|
|
|
|
|
401
|
5
|
|
|
|
|
10
|
undef $self->{zone}; |
402
|
5
|
|
|
|
|
39
|
$self->{zone}={%zone}; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
sub _load_zonefile { |
406
|
8
|
|
|
8
|
|
19
|
my $file = shift; |
407
|
8
|
50
|
|
|
|
222
|
open(my $zonefh, $file) or croak("Could not open $file: $!"); |
408
|
8
|
|
|
|
|
12
|
return do { local $/; <$zonefh> }; # slurp |
|
8
|
|
|
|
|
27
|
|
|
8
|
|
|
|
|
185
|
|
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# Is used internally to parse a zone from a filename. will do some |
412
|
|
|
|
|
|
|
# recursion for the $include, so a procedural implementation is needed |
413
|
|
|
|
|
|
|
sub _parse_zone { |
414
|
9
|
|
|
9
|
|
10
|
my $self = shift; |
415
|
|
|
|
|
|
|
# $def_class and $def_ttl are only given when called for included zones |
416
|
9
|
|
|
|
|
28
|
my %opts = @_; |
417
|
|
|
|
|
|
|
|
418
|
9
|
|
33
|
|
|
18
|
my $origin = $opts{origin} // $self->{origin}; |
419
|
|
|
|
|
|
|
|
420
|
9
|
|
|
|
|
11
|
my $zonestr = $opts{zonestr}; |
421
|
9
|
100
|
66
|
|
|
35
|
if (not defined $zonestr and exists $opts{zonefile}) { |
422
|
4
|
|
|
|
|
9
|
$zonestr = _load_zonefile($opts{zonefile}); |
423
|
|
|
|
|
|
|
} |
424
|
|
|
|
|
|
|
|
425
|
9
|
|
|
|
|
9
|
my ($def_class, $def_ttl); |
426
|
9
|
100
|
|
|
|
18
|
if ($opts{included}) { |
427
|
4
|
|
|
|
|
6
|
($def_class, $def_ttl) = @{\%opts}{qw(default_class default_ttl)}; |
|
4
|
|
|
|
|
12
|
|
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
} |
430
|
9
|
|
|
|
|
13
|
my $zonepath = $self->{basepath}; |
431
|
|
|
|
|
|
|
|
432
|
9
|
|
|
|
|
7
|
my $mrow; |
433
|
|
|
|
|
|
|
my $prev; |
434
|
0
|
|
|
|
|
0
|
my %zone; |
435
|
|
|
|
|
|
|
|
436
|
9
|
|
|
|
|
25
|
my $zentry = qr/^ |
437
|
|
|
|
|
|
|
(\S+)\s+ # name |
438
|
|
|
|
|
|
|
( |
439
|
|
|
|
|
|
|
(?: (?: IN | CH | HS ) \s+ \d+ \s+ ) | |
440
|
|
|
|
|
|
|
(?: \d+ \s+ (?: IN | CH | HS ) \s+ ) | |
441
|
|
|
|
|
|
|
(?: (?: IN | CH | HS ) \s+ ) | |
442
|
|
|
|
|
|
|
(?: \d+ \s+ ) | |
443
|
|
|
|
|
|
|
)? # or |
444
|
|
|
|
|
|
|
(\S+)\s+ # type |
445
|
|
|
|
|
|
|
(.*) # rdata |
446
|
|
|
|
|
|
|
$/ix; |
447
|
|
|
|
|
|
|
|
448
|
9
|
|
|
|
|
57
|
for (split /\n/, $zonestr) { |
449
|
174
|
|
|
|
|
146
|
chomp; |
450
|
174
|
|
|
|
|
191
|
s/;.*$//; |
451
|
174
|
100
|
|
|
|
380
|
next if /^\s*$/; |
452
|
136
|
|
|
|
|
394
|
s/\s+/ /g; |
453
|
|
|
|
|
|
|
|
454
|
136
|
|
|
|
|
176
|
s/^\@ /$origin /g; |
455
|
136
|
|
|
|
|
118
|
s/ \@ / $origin /g; |
456
|
136
|
|
|
|
|
110
|
s/ \@$/ $origin/g; |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
# handles mutlirow entries, with () |
459
|
136
|
100
|
|
|
|
610
|
if($mrow) { |
|
|
100
|
|
|
|
|
|
460
|
25
|
|
|
|
|
52
|
$mrow.=$_; |
461
|
|
|
|
|
|
|
|
462
|
25
|
100
|
|
|
|
47
|
next if(! /\)/); |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
# End of multirow |
465
|
5
|
|
|
|
|
19
|
$mrow=~s/[\(\)]//g; |
466
|
5
|
|
|
|
|
8
|
$mrow=~s/\n//mg; |
467
|
5
|
|
|
|
|
26
|
$mrow=~s/\s+/ /g; |
468
|
5
|
|
|
|
|
6
|
$mrow .= "\n"; |
469
|
|
|
|
|
|
|
|
470
|
5
|
|
|
|
|
6
|
$_ = $mrow; |
471
|
5
|
|
|
|
|
22
|
undef $mrow; |
472
|
|
|
|
|
|
|
} elsif(/^.*\([^\)]*$/) { |
473
|
|
|
|
|
|
|
# Start of multirow |
474
|
5
|
|
|
|
|
8
|
$mrow.=$_; |
475
|
5
|
|
|
|
|
6
|
next; |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
|
478
|
111
|
100
|
|
|
|
157
|
if(/^ /) { |
479
|
4
|
|
|
|
|
8
|
s/^/$prev/; |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
111
|
50
|
|
|
|
168
|
$origin = $1, next if(/^\$ORIGIN ([\w\-\.]+)\s*$/i); |
483
|
111
|
100
|
|
|
|
170
|
$def_ttl = $1, next if(/^\$TTL (\d+)\s*$/i); |
484
|
107
|
100
|
|
|
|
162
|
if(/^\$INCLUDE (\S+)(?: (\S+))?\s*(?:;.*)?$/i) { |
485
|
4
|
50
|
|
|
|
13
|
my $subo=defined $2?$2:$origin; |
486
|
|
|
|
|
|
|
|
487
|
4
|
|
|
|
|
9
|
my $zfile = $1; |
488
|
4
|
50
|
|
|
|
9
|
if($1 !~ m/^\//) { |
489
|
4
|
|
|
|
|
70
|
$zfile = File::Spec->catfile($zonepath, $zfile); |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
4
|
|
|
|
|
22
|
my %subz = $self->_parse_zone( |
493
|
|
|
|
|
|
|
zonefile => $zfile, |
494
|
|
|
|
|
|
|
included => 1, |
495
|
|
|
|
|
|
|
origin => $subo, |
496
|
|
|
|
|
|
|
default_class => $def_class, |
497
|
|
|
|
|
|
|
default_ttl => $def_ttl, |
498
|
|
|
|
|
|
|
); |
499
|
|
|
|
|
|
|
|
500
|
4
|
|
|
|
|
8
|
foreach my $k (keys %subz) { |
501
|
4
|
|
|
|
|
8
|
$zone{$k}=$subz{$k}; |
502
|
|
|
|
|
|
|
} |
503
|
4
|
|
|
|
|
8
|
next; |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
|
506
|
103
|
|
|
|
|
584
|
my($name,$ttlclass,$type,$rdata) = /$zentry/; |
507
|
|
|
|
|
|
|
|
508
|
103
|
|
|
|
|
101
|
my($ttl, $class); |
509
|
103
|
50
|
|
|
|
612
|
if(defined $ttlclass) { |
510
|
103
|
|
|
|
|
124
|
($ttl) = $ttlclass=~/(\d+)/o; |
511
|
103
|
|
|
|
|
122
|
($class) = $ttlclass=~/(CH|IN|HS)/io; |
512
|
|
|
|
|
|
|
|
513
|
103
|
|
|
|
|
110
|
$ttlclass=~s/\d+//; |
514
|
103
|
|
|
|
|
105
|
$ttlclass=~s/(?:CH|IN|HS)//; |
515
|
103
|
|
|
|
|
93
|
$ttlclass=~s/\s//g; |
516
|
103
|
50
|
|
|
|
158
|
if($ttlclass) { |
517
|
0
|
|
|
|
|
0
|
carp "bad rr: $_ (ttlclass: $ttlclass)"; |
518
|
0
|
|
|
|
|
0
|
next; |
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
103
|
100
|
|
|
|
130
|
$ttl = defined $ttl ? $ttl : $def_ttl; |
523
|
103
|
100
|
|
|
|
112
|
$class = defined $class ? $class : $def_class; |
524
|
103
|
|
|
|
|
75
|
$def_class = $class; |
525
|
|
|
|
|
|
|
|
526
|
103
|
50
|
33
|
|
|
299
|
next if (!$name || !$type || !$rdata); |
|
|
|
33
|
|
|
|
|
527
|
|
|
|
|
|
|
|
528
|
103
|
50
|
|
|
|
132
|
if(not defined $def_class) { |
529
|
0
|
|
|
|
|
0
|
carp("no class is set"); |
530
|
0
|
|
|
|
|
0
|
next; |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
|
533
|
103
|
50
|
|
|
|
134
|
if(not defined $ttl) { |
534
|
0
|
|
|
|
|
0
|
carp("no ttl is set"); |
535
|
0
|
|
|
|
|
0
|
next; |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
|
538
|
103
|
|
|
|
|
80
|
$prev=$name; |
539
|
103
|
|
|
|
|
126
|
$name = _fqdnize($name, $origin); |
540
|
|
|
|
|
|
|
|
541
|
103
|
100
|
100
|
|
|
283
|
if($self->{append_origin} and |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
542
|
|
|
|
|
|
|
$type =~ /^(?:cname|afsdb|mx|ns)$/i and |
543
|
|
|
|
|
|
|
$rdata ne $origin and $rdata !~ /\.$/) { |
544
|
3
|
|
|
|
|
4
|
$rdata.=".$origin"; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
103
|
|
|
|
|
93
|
push(@{$zone{lc $name}{lc $type}{rdata}}, $rdata); |
|
103
|
|
|
|
|
330
|
|
548
|
103
|
|
|
|
|
81
|
push(@{$zone{lc $name}{lc $type}{ttl}}, $ttl); |
|
103
|
|
|
|
|
186
|
|
549
|
103
|
|
|
|
|
67
|
push(@{$zone{lc $name}{lc $type}{class}}, $class); |
|
103
|
|
|
|
|
208
|
|
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
|
552
|
9
|
|
|
|
|
79
|
return %zone; |
553
|
|
|
|
|
|
|
} |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
sub _fqdnize { |
556
|
109
|
|
|
109
|
|
1790
|
my ($name, $origin) = @_; |
557
|
|
|
|
|
|
|
|
558
|
109
|
|
100
|
|
|
158
|
$origin //= '.'; |
559
|
109
|
100
|
|
|
|
243
|
$origin .= '.' unless $origin =~ /\.$/; |
560
|
|
|
|
|
|
|
|
561
|
109
|
100
|
|
|
|
202
|
return $name if $name =~ /\.$/; |
562
|
79
|
100
|
|
|
|
119
|
return "$name." if $origin eq '.'; |
563
|
78
|
|
|
|
|
134
|
return "$name.$origin"; |
564
|
|
|
|
|
|
|
} |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
# Is used to parse the SOA and build the soa hash as used |
567
|
|
|
|
|
|
|
# internally.. |
568
|
|
|
|
|
|
|
sub _parse_soa { |
569
|
5
|
|
|
5
|
|
6
|
my $self = shift; |
570
|
5
|
|
|
|
|
17
|
my $soa_rd = get_rdata($self, (name=>"$self->{origin}", rr=>'SOA')); |
571
|
5
|
|
|
|
|
31
|
my($mname,$rname,$serial,$refresh,$retry,$expire,$minimum)= |
572
|
|
|
|
|
|
|
$soa_rd=~/^(\S+) (\S+) (\d+) (\d+) (\d+) (\d+) (\d+)\s*$/; |
573
|
|
|
|
|
|
|
|
574
|
5
|
|
|
|
|
15
|
$self->{soa}{mname}=$mname; |
575
|
5
|
|
|
|
|
9
|
$self->{soa}{rname}=$rname; |
576
|
5
|
|
|
|
|
6
|
$self->{soa}{serial}=$serial; |
577
|
5
|
|
|
|
|
7
|
$self->{soa}{refresh}=$refresh; |
578
|
5
|
|
|
|
|
6
|
$self->{soa}{retry}=$retry; |
579
|
5
|
|
|
|
|
6
|
$self->{soa}{expire}=$expire; |
580
|
5
|
|
|
|
|
10
|
$self->{soa}{minimum}=$minimum; |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
1; |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
=head1 SEE ALSO |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
RFC 1034, RFC 1035, Bind Administrator's Guide |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=head1 AVAILABILITY |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
Latest stable version is available on CPAN. Current development |
592
|
|
|
|
|
|
|
version is available on https://github.com/olof/Parse-DNS-Zone. |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
=head1 COPYRIGHT |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
Copyright (c) 2009-2011, 2013, 2015 - Olof Johansson |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
All rights reserved. |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or |
601
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
=cut |