1 package FS::domain_record;
4 use vars qw( @ISA $noserial_hack );
5 #use FS::Record qw( qsearch qsearchs );
6 use FS::Record qw( qsearchs dbh );
10 @ISA = qw(FS::Record);
14 FS::domain_record - Object methods for domain_record records
18 use FS::domain_record;
20 $record = new FS::domain_record \%hash;
21 $record = new FS::domain_record { 'column' => 'value' };
23 $error = $record->insert;
25 $error = $new_record->replace($old_record);
27 $error = $record->delete;
29 $error = $record->check;
33 An FS::domain_record object represents an entry in a DNS zone.
34 FS::domain_record inherits from FS::Record. The following fields are currently
39 =item recnum - primary key
41 =item svcnum - Domain (see L<FS::svc_domain>) of this entry
43 =item reczone - partial (or full) zone for this entry
45 =item recaf - address family for this entry, currently only `IN' is recognized.
47 =item rectype - record type for this entry (A, MX, etc.)
49 =item recdata - data for this entry
59 Creates a new entry. To add the example to the database, see L<"insert">.
61 Note that this stores the hash reference, not a distinct copy of the hash it
62 points to. You can ask the object for a copy with the I<hash> method.
66 sub table { 'domain_record'; }
70 Adds this record to the database. If there is an error, returns the error,
71 otherwise returns false.
78 local $SIG{HUP} = 'IGNORE';
79 local $SIG{INT} = 'IGNORE';
80 local $SIG{QUIT} = 'IGNORE';
81 local $SIG{TERM} = 'IGNORE';
82 local $SIG{TSTP} = 'IGNORE';
83 local $SIG{PIPE} = 'IGNORE';
85 my $oldAutoCommit = $FS::UID::AutoCommit;
86 local $FS::UID::AutoCommit = 0;
89 if ( $self->rectype eq '_mstr' ) { #delete all other records
90 foreach my $domain_record ( reverse $self->svc_domain->domain_record ) {
91 my $error = $domain_record->delete;
93 $dbh->rollback if $oldAutoCommit;
99 my $error = $self->SUPER::insert;
101 $dbh->rollback if $oldAutoCommit;
105 unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
106 my $error = $self->increment_serial;
108 $dbh->rollback if $oldAutoCommit;
113 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
121 Delete this record from the database.
128 return "Can't delete a domain record which has a website!"
129 if qsearchs( 'svc_www', { 'recnum' => $self->recnum } );
131 local $SIG{HUP} = 'IGNORE';
132 local $SIG{INT} = 'IGNORE';
133 local $SIG{QUIT} = 'IGNORE';
134 local $SIG{TERM} = 'IGNORE';
135 local $SIG{TSTP} = 'IGNORE';
136 local $SIG{PIPE} = 'IGNORE';
138 my $oldAutoCommit = $FS::UID::AutoCommit;
139 local $FS::UID::AutoCommit = 0;
142 my $error = $self->SUPER::delete;
144 $dbh->rollback if $oldAutoCommit;
148 unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
149 my $error = $self->increment_serial;
151 $dbh->rollback if $oldAutoCommit;
156 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
162 =item replace OLD_RECORD
164 Replaces the OLD_RECORD with this one in the database. If there is an error,
165 returns the error, otherwise returns false.
172 local $SIG{HUP} = 'IGNORE';
173 local $SIG{INT} = 'IGNORE';
174 local $SIG{QUIT} = 'IGNORE';
175 local $SIG{TERM} = 'IGNORE';
176 local $SIG{TSTP} = 'IGNORE';
177 local $SIG{PIPE} = 'IGNORE';
179 my $oldAutoCommit = $FS::UID::AutoCommit;
180 local $FS::UID::AutoCommit = 0;
183 my $error = $self->SUPER::replace(@_);
185 $dbh->rollback if $oldAutoCommit;
189 unless ( $self->rectype eq 'SOA' ) {
190 my $error = $self->increment_serial;
192 $dbh->rollback if $oldAutoCommit;
197 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
205 Checks all fields to make sure this is a valid example. If there is
206 an error, returns the error, otherwise returns false. Called by the insert
211 # the check method should currently be supplied - FS::Record contains some
212 # data checking routines
218 $self->ut_numbern('recnum')
219 || $self->ut_number('svcnum')
221 return $error if $error;
223 return "Unknown svcnum (in svc_domain)"
224 unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } );
226 $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i
227 or return "Illegal reczone: ". $self->reczone;
230 $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf;
233 $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|_mstr)$/
234 or return "Illegal rectype (only SOA NS MX A PTR CNAME recognized): ".
238 return "Illegal reczone for ". $self->rectype. ": ". $self->reczone
239 if $self->rectype !~ /^MX$/i && $self->reczone =~ /\*/;
241 if ( $self->rectype eq 'SOA' ) {
242 my $recdata = $self->recdata;
243 $recdata =~ s/\s+/ /g;
244 $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ((\d+|((\d+[WDHMS])+)) ){5}\))$/i
245 or return "Illegal data for SOA record: $recdata";
247 } elsif ( $self->rectype eq 'NS' ) {
248 $self->recdata =~ /^([a-z0-9\.\-]+)$/i
249 or return "Illegal data for NS record: ". $self->recdata;
251 } elsif ( $self->rectype eq 'MX' ) {
252 $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/i
253 or return "Illegal data for MX record: ". $self->recdata;
254 $self->recdata("$1 $2");
255 } elsif ( $self->rectype eq 'A' ) {
256 $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
257 or return "Illegal data for A record: ". $self->recdata;
259 } elsif ( $self->rectype eq 'PTR' ) {
260 $self->recdata =~ /^([a-z0-9\.\-]+)$/i
261 or return "Illegal data for PTR record: ". $self->recdata;
263 } elsif ( $self->rectype eq 'CNAME' ) {
264 $self->recdata =~ /^([a-z0-9\.\-]+|\@)$/i
265 or return "Illegal data for CNAME record: ". $self->recdata;
267 } elsif ( $self->rectype eq '_mstr' ) {
268 $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
269 or return "Illegal data for _master pseudo-record: ". $self->recdata;
277 =item increment_serial
281 sub increment_serial {
282 return '' if $noserial_hack;
285 my $soa = qsearchs('domain_record', {
286 svcnum => $self->svcnum,
287 reczone => '@', #or full domain ?
290 } ) or return "soa record not found; can't increment serial";
292 my $data = $soa->recdata;
293 $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works.
295 my %hash = $soa->hash;
296 $hash{recdata} = $data;
297 my $new = new FS::domain_record \%hash;
303 Returns the domain (see L<FS::svc_domain>) for this record.
309 qsearchs('svc_domain', { svcnum => $self->svcnum } );
314 Returns the canonical zone name.
320 my $zone = $self->reczone; # or die ?
321 if ( $zone =~ /\.$/ ) {
324 my $svc_domain = $self->svc_domain; # or die ?
325 $zone .= '.'. $svc_domain->domain;
335 $Id: domain_record.pm,v 1.16 2003-08-05 00:20:43 khoff Exp $
339 The data validation doesn't check everything it could. In particular,
340 there is no protection against bad data that passes the regex, duplicate
341 SOA records, forgetting the trailing `.', impossible IP addersses, etc. Of
342 course, it's still better than editing the zone files directly. :)
346 L<FS::Record>, schema.html from the base documentation.