1 package FS::domain_record;
4 use vars qw( @ISA $noserial_hack $DEBUG $me );
6 #use FS::Record qw( qsearch qsearchs );
7 use FS::Record qw( qsearchs dbh );
11 @ISA = qw(FS::Record);
14 $me = '[FS::domain_record]';
18 FS::domain_record - Object methods for domain_record records
22 use FS::domain_record;
24 $record = new FS::domain_record \%hash;
25 $record = new FS::domain_record { 'column' => 'value' };
27 $error = $record->insert;
29 $error = $new_record->replace($old_record);
31 $error = $record->delete;
33 $error = $record->check;
37 An FS::domain_record object represents an entry in a DNS zone.
38 FS::domain_record inherits from FS::Record. The following fields are currently
43 =item recnum - primary key
45 =item svcnum - Domain (see L<FS::svc_domain>) of this entry
47 =item reczone - partial (or full) zone for this entry
49 =item recaf - address family for this entry, currently only `IN' is recognized.
51 =item rectype - record type for this entry (A, MX, etc.)
53 =item recdata - data for this entry
55 =item ttl - time to live
65 Creates a new entry. To add the entry to the database, see L<"insert">.
67 Note that this stores the hash reference, not a distinct copy of the hash it
68 points to. You can ask the object for a copy with the I<hash> method.
72 sub table { 'domain_record'; }
76 Adds this record to the database. If there is an error, returns the error,
77 otherwise returns false.
84 local $SIG{HUP} = 'IGNORE';
85 local $SIG{INT} = 'IGNORE';
86 local $SIG{QUIT} = 'IGNORE';
87 local $SIG{TERM} = 'IGNORE';
88 local $SIG{TSTP} = 'IGNORE';
89 local $SIG{PIPE} = 'IGNORE';
91 my $oldAutoCommit = $FS::UID::AutoCommit;
92 local $FS::UID::AutoCommit = 0;
95 if ( $self->rectype eq '_mstr' ) { #delete all other records
96 foreach my $domain_record ( reverse $self->svc_domain->domain_record ) {
97 my $error = $domain_record->delete;
99 $dbh->rollback if $oldAutoCommit;
105 my $error = $self->SUPER::insert;
107 $dbh->rollback if $oldAutoCommit;
111 unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
112 my $error = $self->increment_serial;
114 $dbh->rollback if $oldAutoCommit;
119 my $conf = new FS::Conf;
120 if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) {
121 my $reverse = $self->reverse_record;
122 if ( $reverse && ! $reverse->recnum ) {
123 my $error = $reverse->insert;
125 $dbh->rollback if $oldAutoCommit;
126 return "error adding corresponding reverse-ARPA record: $error";
131 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
139 Delete this record from the database.
146 return "Can't delete a domain record which has a website!"
147 if qsearchs( 'svc_www', { 'recnum' => $self->recnum } );
149 local $SIG{HUP} = 'IGNORE';
150 local $SIG{INT} = 'IGNORE';
151 local $SIG{QUIT} = 'IGNORE';
152 local $SIG{TERM} = 'IGNORE';
153 local $SIG{TSTP} = 'IGNORE';
154 local $SIG{PIPE} = 'IGNORE';
156 my $oldAutoCommit = $FS::UID::AutoCommit;
157 local $FS::UID::AutoCommit = 0;
160 my $error = $self->SUPER::delete;
162 $dbh->rollback if $oldAutoCommit;
166 unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
167 my $error = $self->increment_serial;
169 $dbh->rollback if $oldAutoCommit;
174 my $conf = new FS::Conf;
175 if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) {
176 my $reverse = $self->reverse_record;
177 if ( $reverse && $reverse->recnum && $reverse->recdata eq $self->zone.'.' ){
178 my $error = $reverse->delete;
180 $dbh->rollback if $oldAutoCommit;
181 return "error removing corresponding reverse-ARPA record: $error";
186 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
192 =item replace OLD_RECORD
194 Replaces the OLD_RECORD with this one in the database. If there is an error,
195 returns the error, otherwise returns false.
202 local $SIG{HUP} = 'IGNORE';
203 local $SIG{INT} = 'IGNORE';
204 local $SIG{QUIT} = 'IGNORE';
205 local $SIG{TERM} = 'IGNORE';
206 local $SIG{TSTP} = 'IGNORE';
207 local $SIG{PIPE} = 'IGNORE';
209 my $oldAutoCommit = $FS::UID::AutoCommit;
210 local $FS::UID::AutoCommit = 0;
213 my $error = $self->SUPER::replace(@_);
215 $dbh->rollback if $oldAutoCommit;
219 unless ( $self->rectype eq 'SOA' ) {
220 my $error = $self->increment_serial;
222 $dbh->rollback if $oldAutoCommit;
227 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
235 Checks all fields to make sure this is a valid entry. If there is
236 an error, returns the error, otherwise returns false. Called by the insert
241 # the check method should currently be supplied - FS::Record contains some
242 # data checking routines
248 $self->ut_numbern('recnum')
249 || $self->ut_number('svcnum')
251 return $error if $error;
253 return "Unknown svcnum (in svc_domain)"
254 unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } );
256 my $conf = new FS::Conf;
258 if ( $conf->exists('zone-underscore') ) {
259 $self->reczone =~ /^(@|[a-z0-9_\.\-\*]+)$/i
260 or return "Illegal reczone: ". $self->reczone;
263 $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i
264 or return "Illegal reczone: ". $self->reczone;
268 $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf;
271 $self->ttl =~ /^([0-9]{0,6})$/ or return "Illegal ttl: ". $self->ttl;
274 my %rectypes = map { $_=>1 } ( @{ $self->rectypes }, '_mstr' );
275 return 'Illegal rectype: '. $self->rectype
276 unless exists $rectypes{$self->rectype} && $rectypes{$self->rectype};
278 return "Illegal reczone for ". $self->rectype. ": ". $self->reczone
279 if $self->rectype !~ /^MX$/i && $self->reczone =~ /\*/;
281 if ( $self->rectype eq 'SOA' ) {
282 my $recdata = $self->recdata;
283 $recdata =~ s/\s+/ /g;
284 $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ((\d+|((\d+[WDHMS])+)) ){5}\))$/i
285 or return "Illegal data for SOA record: $recdata";
287 } elsif ( $self->rectype eq 'NS' ) {
288 $self->recdata =~ /^([a-z0-9\.\-]+)$/i
289 or return "Illegal data for NS record: ". $self->recdata;
291 } elsif ( $self->rectype eq 'MX' ) {
292 $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/i
293 or return "Illegal data for MX record: ". $self->recdata;
294 $self->recdata("$1 $2");
295 } elsif ( $self->rectype eq 'A' ) {
296 $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
297 or return "Illegal data for A record: ". $self->recdata;
299 } elsif ( $self->rectype eq 'AAAA' ) {
300 $self->recdata =~ /^([\da-z:]+)$/
301 or return "Illegal data for AAAA record: ". $self->recdata;
303 } elsif ( $self->rectype eq 'PTR' ) {
304 if ( $conf->exists('zone-underscore') ) {
305 $self->recdata =~ /^([a-z0-9_\.\-]+)$/i
306 or return "Illegal data for PTR record: ". $self->recdata;
309 $self->recdata =~ /^([a-z0-9\.\-]+)$/i
310 or return "Illegal data for PTR record: ". $self->recdata;
313 } elsif ( $self->rectype eq 'CNAME' ) {
314 $self->recdata =~ /^([a-z0-9\.\-]+|\@)$/i
315 or return "Illegal data for CNAME record: ". $self->recdata;
317 } elsif ( $self->rectype eq 'TXT' ) {
318 if ( $self->recdata =~ /^((?:\S+)|(?:".+"))$/ ) {
321 $self->recdata('"'. $self->recdata. '"'); #?
323 # or return "Illegal data for TXT record: ". $self->recdata;
324 } elsif ( $self->rectype eq 'SRV' ) {
325 $self->recdata =~ /^(\d+)\s+(\d+)\s+(\d+)\s+([a-z0-9\.\-]+)$/i
326 or return "Illegal data for SRV record: ". $self->recdata;
327 $self->recdata("$1 $2 $3 $4");
328 } elsif ( $self->rectype eq '_mstr' ) {
329 $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
330 or return "Illegal data for _master pseudo-record: ". $self->recdata;
332 warn "$me no specific check for ". $self->rectype. " records yet";
333 $error = $self->ut_text('recdata');
334 return $error if $error;
340 =item increment_serial
344 sub increment_serial {
345 return '' if $noserial_hack;
348 my $soa = qsearchs('domain_record', {
349 svcnum => $self->svcnum,
352 rectype => 'SOA', } )
353 || qsearchs('domain_record', {
354 svcnum => $self->svcnum,
355 reczone => $self->svc_domain->domain.'.',
359 or return "soa record not found; can't increment serial";
361 my $data = $soa->recdata;
362 $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works.
364 my %hash = $soa->hash;
365 $hash{recdata} = $data;
366 my $new = new FS::domain_record \%hash;
372 Returns the domain (see L<FS::svc_domain>) for this record.
378 qsearchs('svc_domain', { svcnum => $self->svcnum } );
383 Returns the canonical zone name.
389 my $zone = $self->reczone; # or die ?
390 if ( $zone =~ /\.$/ ) {
393 my $svc_domain = $self->svc_domain; # or die ?
394 $zone .= '.'. $svc_domain->domain;
402 Returns the corresponding reverse-ARPA record as another FS::domain_record
403 object. If the specific record does not exist in the database but the
404 reverse-ARPA zone itself does, an appropriate new record is created. If no
405 reverse-ARPA zone is available at all, returns false.
407 (You can test whether or not record itself exists in the database or is a new
408 object that might need to be inserted by checking the recnum field)
410 Mostly used by the insert and delete methods - probably should see them for
417 warn "reverse_record called\n" if $DEBUG;
418 #should support classless reverse-ARPA ala rfc2317 too
419 $self->recdata =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/
421 my $domain = "$3.$2.$1.in-addr.arpa";
422 my $ptr_reczone = $4;
423 warn "reverse_record: searching for domain: $domain\n" if $DEBUG;
424 my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } )
426 warn "reverse_record: found domain: $domain\n" if $DEBUG;
428 'svcnum' => $svc_domain->svcnum,
429 'reczone' => $ptr_reczone,
433 qsearchs('domain_record', \%hash )
434 or new FS::domain_record { %hash, 'recdata' => $self->zone.'.' };
441 The data validation doesn't check everything it could. In particular,
442 there is no protection against bad data that passes the regex, duplicate
443 SOA records, forgetting the trailing `.', impossible IP addersses, etc. Of
444 course, it's still better than editing the zone files directly. :)
448 L<FS::Record>, schema.html from the base documentation.