1package Net::DNS::RR::SOA;
2
3use strict;
4use warnings;
5our $VERSION = (qw$Id: SOA.pm 1819 2020-10-19 08:07:24Z willem $)[2];
6
7use base qw(Net::DNS::RR);
8
9
10=head1 NAME
11
12Net::DNS::RR::SOA - DNS SOA resource record
13
14=cut
15
16use integer;
17
18use Net::DNS::DomainName;
19use Net::DNS::Mailbox;
20
21
22sub _decode_rdata {			## decode rdata from wire-format octet string
23	my $self = shift;
24	my ( $data, $offset, @opaque ) = @_;
25
26	( $self->{mname}, $offset ) = Net::DNS::DomainName1035->decode(@_);
27	( $self->{rname}, $offset ) = Net::DNS::Mailbox1035->decode( $data, $offset, @opaque );
28	@{$self}{qw(serial refresh retry expire minimum)} = unpack "\@$offset N5", $$data;
29	return;
30}
31
32
33sub _encode_rdata {			## encode rdata as wire-format octet string
34	my $self = shift;
35	my ( $offset, @opaque ) = @_;
36
37	my $rname = $self->{rname};
38	my $rdata = $self->{mname}->encode(@_);
39	$rdata .= $rname->encode( $offset + length($rdata), @opaque );
40	$rdata .= pack 'N5', $self->serial, @{$self}{qw(refresh retry expire minimum)};
41	return $rdata;
42}
43
44
45sub _format_rdata {			## format rdata portion of RR string.
46	my $self = shift;
47
48	my $mname  = $self->{mname}->string;
49	my $rname  = $self->{rname}->string;
50	my $serial = $self->serial;
51	my $spacer = length "$serial" > 7 ? "" : "\t";
52	return ($mname, $rname,
53		join( "\n\t\t\t\t",
54			"\t\t\t$serial$spacer\t;serial", "$self->{refresh}\t\t;refresh",
55			"$self->{retry}\t\t;retry",	 "$self->{expire}\t\t;expire",
56			"$self->{minimum}\t\t;minimum\n" ) );
57}
58
59
60sub _parse_rdata {			## populate RR from rdata in argument list
61	my $self = shift;
62
63	$self->mname(shift);
64	$self->rname(shift);
65	$self->serial(shift);
66	for (qw(refresh retry expire minimum)) {
67		$self->$_( Net::DNS::RR::ttl( {}, shift ) ) if scalar @_;
68	}
69	return;
70}
71
72
73sub _defaults {				## specify RR attribute default values
74	my $self = shift;
75
76	$self->_parse_rdata(qw(. . 0 4h 1h 3w 1h));
77	delete $self->{serial};
78	return;
79}
80
81
82sub mname {
83	my $self = shift;
84
85	$self->{mname} = Net::DNS::DomainName1035->new(shift) if scalar @_;
86	return $self->{mname} ? $self->{mname}->name : undef;
87}
88
89
90sub rname {
91	my $self = shift;
92
93	$self->{rname} = Net::DNS::Mailbox1035->new(shift) if scalar @_;
94	return $self->{rname} ? $self->{rname}->address : undef;
95}
96
97
98sub serial {
99	my $self = shift;
100
101	return $self->{serial} || 0 unless scalar @_;		# current/default value
102
103	my $value = shift;					# replace if in sequence
104	return $self->{serial} = ( $value & 0xFFFFFFFF ) if _ordered( $self->{serial}, $value );
105
106	# unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished
107	my $serial = 0xFFFFFFFF & ( $self->{serial} || 0 );
108	return $self->{serial} = 0x80000000 if $serial == 0x7FFFFFFF;	 # wrap
109	return $self->{serial} = 0x00000000 if $serial == 0xFFFFFFFF;	 # wrap
110	return $self->{serial} = $serial + 1;			# increment
111}
112
113
114sub refresh {
115	my $self = shift;
116
117	$self->{refresh} = 0 + shift if scalar @_;
118	return $self->{refresh} || 0;
119}
120
121
122sub retry {
123	my $self = shift;
124
125	$self->{retry} = 0 + shift if scalar @_;
126	return $self->{retry} || 0;
127}
128
129
130sub expire {
131	my $self = shift;
132
133	$self->{expire} = 0 + shift if scalar @_;
134	return $self->{expire} || 0;
135}
136
137
138sub minimum {
139	my $self = shift;
140
141	$self->{minimum} = 0 + shift if scalar @_;
142	return $self->{minimum} || 0;
143}
144
145
146########################################
147
148sub _ordered() {			## irreflexive 32-bit partial ordering
149	use integer;
150	my ( $n1, $n2 ) = @_;
151
152	return 0 unless defined $n2;				# ( any, undef )
153	return 1 unless defined $n1;				# ( undef, any )
154
155	# unwise to assume 64-bit arithmetic, or that 32-bit integer overflow goes unpunished
156	if ( $n2 < 0 ) {					# fold, leaving $n2 non-negative
157		$n1 = ( $n1 & 0xFFFFFFFF ) ^ 0x80000000;	# -2**31 <= $n1 < 2**32
158		$n2 = ( $n2 & 0x7FFFFFFF );			#  0	 <= $n2 < 2**31
159	}
160
161	return $n1 < $n2 ? ( $n1 > ( $n2 - 0x80000000 ) ) : ( $n2 < ( $n1 - 0x80000000 ) );
162}
163
164
1651;
166__END__
167
168
169=head1 SYNOPSIS
170
171    use Net::DNS;
172    $rr = Net::DNS::RR->new('name SOA mname rname 0 14400 3600 1814400 3600');
173
174=head1 DESCRIPTION
175
176Class for DNS Start of Authority (SOA) resource records.
177
178=head1 METHODS
179
180The available methods are those inherited from the base class augmented
181by the type-specific methods defined in this package.
182
183Use of undocumented package features or direct access to internal data
184structures is discouraged and could result in program termination or
185other unpredictable behaviour.
186
187
188=head2 mname
189
190    $mname = $rr->mname;
191    $rr->mname( $mname );
192
193The domain name of the name server that was the
194original or primary source of data for this zone.
195
196=head2 rname
197
198    $rname = $rr->rname;
199    $rr->rname( $rname );
200
201The mailbox which identifies the person responsible
202for maintaining this zone.
203
204=head2 serial
205
206    $serial = $rr->serial;
207    $serial = $rr->serial(value);
208
209Unsigned 32 bit version number of the original copy of the zone.
210Zone transfers preserve this value.
211
212RFC1982 defines a strict (irreflexive) partial ordering for zone
213serial numbers. The serial number will be incremented unless the
214replacement value argument satisfies the ordering constraint.
215
216=head2 refresh
217
218    $refresh = $rr->refresh;
219    $rr->refresh( $refresh );
220
221A 32 bit time interval before the zone should be refreshed.
222
223=head2 retry
224
225    $retry = $rr->retry;
226    $rr->retry( $retry );
227
228A 32 bit time interval that should elapse before a
229failed refresh should be retried.
230
231=head2 expire
232
233    $expire = $rr->expire;
234    $rr->expire( $expire );
235
236A 32 bit time value that specifies the upper limit on
237the time interval that can elapse before the zone is no
238longer authoritative.
239
240=head2 minimum
241
242    $minimum = $rr->minimum;
243    $rr->minimum( $minimum );
244
245The unsigned 32 bit minimum TTL field that should be
246exported with any RR from this zone.
247
248=head1 Zone Serial Number Management
249
250The internal logic of the serial() method offers support for several
251widely used zone serial numbering policies.
252
253=head2 Strictly Sequential
254
255    $successor = $soa->serial( SEQUENTIAL );
256
257The existing serial number is incremented modulo 2**32 because the
258value returned by the auxilliary SEQUENTIAL() function can never
259satisfy the serial number ordering constraint.
260
261=head2 Date Encoded
262
263    $successor = $soa->serial( YYYYMMDDxx );
264
265The 32 bit value returned by the auxilliary YYYYMMDDxx() function will
266be used if it satisfies the ordering constraint, otherwise the serial
267number will be incremented as above.
268
269Serial number increments must be limited to 100 per day for the date
270information to remain useful.
271
272=head2 Time Encoded
273
274    $successor = $soa->serial( UNIXTIME );
275
276The 32 bit value returned by the auxilliary UNIXTIME() function will
277used if it satisfies the ordering constraint, otherwise the existing
278serial number will be incremented as above.
279
280
281=head1 COPYRIGHT
282
283Copyright (c)1997 Michael Fuhr.
284
285Portions Copyright (c)2003 Chris Reinhardt.
286
287Portions Copyright (c)2010,2012 Dick Franks.
288
289All rights reserved.
290
291Package template (c)2009,2012 O.M.Kolkman and R.W.Franks.
292
293
294=head1 LICENSE
295
296Permission to use, copy, modify, and distribute this software and its
297documentation for any purpose and without fee is hereby granted, provided
298that the above copyright notice appear in all copies and that both that
299copyright notice and this permission notice appear in supporting
300documentation, and that the name of the author not be used in advertising
301or publicity pertaining to distribution of the software without specific
302prior written permission.
303
304THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
305IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
306FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
307THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
308LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
309FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
310DEALINGS IN THE SOFTWARE.
311
312
313=head1 SEE ALSO
314
315L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1035 Section 3.3.13, RFC1982
316
317=cut
318