1 package FS::domain_record;
4 use vars qw( @ISA $noserial_hack $DEBUG );
6 #use FS::Record qw( qsearch qsearchs );
7 use FS::Record qw( qsearchs dbh );
11 @ISA = qw(FS::Record);
17 FS::domain_record - Object methods for domain_record records
21 use FS::domain_record;
23 $record = new FS::domain_record \%hash;
24 $record = new FS::domain_record { 'column' => 'value' };
26 $error = $record->insert;
28 $error = $new_record->replace($old_record);
30 $error = $record->delete;
32 $error = $record->check;
36 An FS::domain_record object represents an entry in a DNS zone.
37 FS::domain_record inherits from FS::Record. The following fields are currently
42 =item recnum - primary key
44 =item svcnum - Domain (see L<FS::svc_domain>) of this entry
46 =item reczone - partial (or full) zone for this entry
48 =item recaf - address family for this entry, currently only `IN' is recognized.
50 =item rectype - record type for this entry (A, MX, etc.)
52 =item recdata - data for this entry
62 Creates a new entry. To add the entry to the database, see L<"insert">.
64 Note that this stores the hash reference, not a distinct copy of the hash it
65 points to. You can ask the object for a copy with the I<hash> method.
69 sub table { 'domain_record'; }
73 Adds this record to the database. If there is an error, returns the error,
74 otherwise returns false.
81 local $SIG{HUP} = 'IGNORE';
82 local $SIG{INT} = 'IGNORE';
83 local $SIG{QUIT} = 'IGNORE';
84 local $SIG{TERM} = 'IGNORE';
85 local $SIG{TSTP} = 'IGNORE';
86 local $SIG{PIPE} = 'IGNORE';
88 my $oldAutoCommit = $FS::UID::AutoCommit;
89 local $FS::UID::AutoCommit = 0;
92 if ( $self->rectype eq '_mstr' ) { #delete all other records
93 foreach my $domain_record ( reverse $self->svc_domain->domain_record ) {
94 my $error = $domain_record->delete;
96 $dbh->rollback if $oldAutoCommit;
102 my $error = $self->SUPER::insert;
104 $dbh->rollback if $oldAutoCommit;
108 unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
109 my $error = $self->increment_serial;
111 $dbh->rollback if $oldAutoCommit;
116 my $conf = new FS::Conf;
117 if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) {
118 my $reverse = $self->reverse_record;
119 if ( $reverse && ! $reverse->recnum ) {
120 my $error = $reverse->insert;
122 $dbh->rollback if $oldAutoCommit;
123 return "error adding corresponding reverse-ARPA record: $error";
128 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
136 Delete this record from the database.
143 return "Can't delete a domain record which has a website!"
144 if qsearchs( 'svc_www', { 'recnum' => $self->recnum } );
146 local $SIG{HUP} = 'IGNORE';
147 local $SIG{INT} = 'IGNORE';
148 local $SIG{QUIT} = 'IGNORE';
149 local $SIG{TERM} = 'IGNORE';
150 local $SIG{TSTP} = 'IGNORE';
151 local $SIG{PIPE} = 'IGNORE';
153 my $oldAutoCommit = $FS::UID::AutoCommit;
154 local $FS::UID::AutoCommit = 0;
157 my $error = $self->SUPER::delete;
159 $dbh->rollback if $oldAutoCommit;
163 unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
164 my $error = $self->increment_serial;
166 $dbh->rollback if $oldAutoCommit;
171 my $conf = new FS::Conf;
172 if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) {
173 my $reverse = $self->reverse_record;
174 if ( $reverse && $reverse->recnum && $reverse->recdata eq $self->zone.'.' ){
175 my $error = $reverse->delete;
177 $dbh->rollback if $oldAutoCommit;
178 return "error removing corresponding reverse-ARPA record: $error";
183 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
189 =item replace OLD_RECORD
191 Replaces the OLD_RECORD with this one in the database. If there is an error,
192 returns the error, otherwise returns false.
199 local $SIG{HUP} = 'IGNORE';
200 local $SIG{INT} = 'IGNORE';
201 local $SIG{QUIT} = 'IGNORE';
202 local $SIG{TERM} = 'IGNORE';
203 local $SIG{TSTP} = 'IGNORE';
204 local $SIG{PIPE} = 'IGNORE';
206 my $oldAutoCommit = $FS::UID::AutoCommit;
207 local $FS::UID::AutoCommit = 0;
210 my $error = $self->SUPER::replace(@_);
212 $dbh->rollback if $oldAutoCommit;
216 unless ( $self->rectype eq 'SOA' ) {
217 my $error = $self->increment_serial;
219 $dbh->rollback if $oldAutoCommit;
224 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
232 Checks all fields to make sure this is a valid entry. If there is
233 an error, returns the error, otherwise returns false. Called by the insert
238 # the check method should currently be supplied - FS::Record contains some
239 # data checking routines
245 $self->ut_numbern('recnum')
246 || $self->ut_number('svcnum')
248 return $error if $error;
250 return "Unknown svcnum (in svc_domain)"
251 unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } );
253 my $conf = new FS::Conf;
255 if ( $conf->exists('zone-underscore') ) {
256 $self->reczone =~ /^(@|[a-z0-9_\.\-\*]+)$/i
257 or return "Illegal reczone: ". $self->reczone;
260 $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i
261 or return "Illegal reczone: ". $self->reczone;
265 $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf;
268 $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|TXT|_mstr)$/
269 or return "Illegal rectype (only SOA NS MX A PTR CNAME TXT recognized): ".
273 return "Illegal reczone for ". $self->rectype. ": ". $self->reczone
274 if $self->rectype !~ /^MX$/i && $self->reczone =~ /\*/;
276 if ( $self->rectype eq 'SOA' ) {
277 my $recdata = $self->recdata;
278 $recdata =~ s/\s+/ /g;
279 $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ((\d+|((\d+[WDHMS])+)) ){5}\))$/i
280 or return "Illegal data for SOA record: $recdata";
282 } elsif ( $self->rectype eq 'NS' ) {
283 $self->recdata =~ /^([a-z0-9\.\-]+)$/i
284 or return "Illegal data for NS record: ". $self->recdata;
286 } elsif ( $self->rectype eq 'MX' ) {
287 $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/i
288 or return "Illegal data for MX record: ". $self->recdata;
289 $self->recdata("$1 $2");
290 } elsif ( $self->rectype eq 'A' ) {
291 $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
292 or return "Illegal data for A record: ". $self->recdata;
294 } elsif ( $self->rectype eq 'PTR' ) {
295 if ( $conf->exists('zone-underscore') ) {
296 $self->recdata =~ /^([a-z0-9_\.\-]+)$/i
297 or return "Illegal data for PTR record: ". $self->recdata;
300 $self->recdata =~ /^([a-z0-9\.\-]+)$/i
301 or return "Illegal data for PTR record: ". $self->recdata;
304 } elsif ( $self->rectype eq 'CNAME' ) {
305 $self->recdata =~ /^([a-z0-9\.\-]+|\@)$/i
306 or return "Illegal data for CNAME record: ". $self->recdata;
308 } elsif ( $self->rectype eq 'TXT' ) {
309 if ( $self->recdata =~ /^((?:\S+)|(?:".+"))$/ ) {
312 $self->recdata('"'. $self->recdata. '"'); #?
314 # or return "Illegal data for TXT record: ". $self->recdata;
315 } elsif ( $self->rectype eq '_mstr' ) {
316 $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
317 or return "Illegal data for _master pseudo-record: ". $self->recdata;
325 =item increment_serial
329 sub increment_serial {
330 return '' if $noserial_hack;
333 my $soa = qsearchs('domain_record', {
334 svcnum => $self->svcnum,
337 rectype => 'SOA', } )
338 || qsearchs('domain_record', {
339 svcnum => $self->svcnum,
340 reczone => $self->svc_domain->domain.'.',
344 or return "soa record not found; can't increment serial";
346 my $data = $soa->recdata;
347 $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works.
349 my %hash = $soa->hash;
350 $hash{recdata} = $data;
351 my $new = new FS::domain_record \%hash;
357 Returns the domain (see L<FS::svc_domain>) for this record.
363 qsearchs('svc_domain', { svcnum => $self->svcnum } );
368 Returns the canonical zone name.
374 my $zone = $self->reczone; # or die ?
375 if ( $zone =~ /\.$/ ) {
378 my $svc_domain = $self->svc_domain; # or die ?
379 $zone .= '.'. $svc_domain->domain;
387 Returns the corresponding reverse-ARPA record as another FS::domain_record
388 object. If the specific record does not exist in the database but the
389 reverse-ARPA zone itself does, an appropriate new record is created. If no
390 reverse-ARPA zone is available at all, returns false.
392 (You can test whether or not record itself exists in the database or is a new
393 object that might need to be inserted by checking the recnum field)
395 Mostly used by the insert and delete methods - probably should see them for
402 warn "reverse_record called\n" if $DEBUG;
403 #should support classless reverse-ARPA ala rfc2317 too
404 $self->recdata =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/
406 my $domain = "$3.$2.$1.in-addr.arpa";
407 my $ptr_reczone = $4;
408 warn "reverse_record: searching for domain: $domain\n" if $DEBUG;
409 my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
411 warn "reverse_record: found domain: $domain\n" if $DEBUG;
413 'svcnum' => $svc_domain->svcnum,
414 'reczone' => $ptr_reczone,
418 qsearchs('domain_record', \%hash )
419 or new FS::domain_record { %hash, 'recdata' => $self->zone.'.' };
425 #http://en.wikipedia.org/wiki/List_of_DNS_record_types
426 #DHCID? other things?
428 [ qw(A AAAA CNAME MX NS PTR SPF SRV TXT), #most common types
429 #qw(DNAME), #uncommon types
430 qw(DLV DNSKEY DS NSEC NSEC3 NSEC3PARAM RRSIG), #DNSSEC types
438 The data validation doesn't check everything it could. In particular,
439 there is no protection against bad data that passes the regex, duplicate
440 SOA records, forgetting the trailing `.', impossible IP addersses, etc. Of
441 course, it's still better than editing the zone files directly. :)
445 L<FS::Record>, schema.html from the base documentation.