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