X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fdomain_record.pm;h=6513abf2527c61c514947f4902bdcfbbd0ded255;hb=ee27da6c4fdef689b9c32e9e84a7aa94648e2298;hp=7b67f666d7f7bd67b1ed6f58a60011cc258fabd9;hpb=02f0f4ce6f01b9f6d67c44b8884320e6204a95a1;p=freeside.git diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm deleted file mode 100644 index 7b67f666d..000000000 --- a/FS/FS/domain_record.pm +++ /dev/null @@ -1,417 +0,0 @@ -package FS::domain_record; - -use strict; -use vars qw( @ISA $noserial_hack $DEBUG ); -use FS::Conf; -#use FS::Record qw( qsearch qsearchs ); -use FS::Record qw( qsearchs dbh ); -use FS::svc_domain; -use FS::svc_www; - -@ISA = qw(FS::Record); - -$DEBUG = 0; - -=head1 NAME - -FS::domain_record - Object methods for domain_record records - -=head1 SYNOPSIS - - use FS::domain_record; - - $record = new FS::domain_record \%hash; - $record = new FS::domain_record { 'column' => 'value' }; - - $error = $record->insert; - - $error = $new_record->replace($old_record); - - $error = $record->delete; - - $error = $record->check; - -=head1 DESCRIPTION - -An FS::domain_record object represents an entry in a DNS zone. -FS::domain_record inherits from FS::Record. The following fields are currently -supported: - -=over 4 - -=item recnum - primary key - -=item svcnum - Domain (see L) of this entry - -=item reczone - partial (or full) zone for this entry - -=item recaf - address family for this entry, currently only `IN' is recognized. - -=item rectype - record type for this entry (A, MX, etc.) - -=item recdata - data for this entry - -=back - -=head1 METHODS - -=over 4 - -=item new HASHREF - -Creates a new entry. To add the example to the database, see L<"insert">. - -Note that this stores the hash reference, not a distinct copy of the hash it -points to. You can ask the object for a copy with the I method. - -=cut - -sub table { 'domain_record'; } - -=item insert - -Adds this record to the database. If there is an error, returns the error, -otherwise returns false. - -=cut - -sub insert { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - if ( $self->rectype eq '_mstr' ) { #delete all other records - foreach my $domain_record ( reverse $self->svc_domain->domain_record ) { - my $error = $domain_record->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } - - my $error = $self->SUPER::insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) { - my $error = $self->increment_serial; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my $conf = new FS::Conf; - if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) { - my $reverse = $self->reverse_record; - if ( $reverse && ! $reverse->recnum ) { - my $error = $reverse->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error adding corresponding reverse-ARPA record: $error"; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item delete - -Delete this record from the database. - -=cut - -sub delete { - my $self = shift; - - return "Can't delete a domain record which has a website!" - if qsearchs( 'svc_www', { 'recnum' => $self->recnum } ); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) { - my $error = $self->increment_serial; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - my $conf = new FS::Conf; - if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) { - my $reverse = $self->reverse_record; - if ( $reverse && $reverse->recnum && $reverse->recdata eq $self->zone.'.' ){ - my $error = $reverse->delete; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "error removing corresponding reverse-ARPA record: $error"; - } - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item replace OLD_RECORD - -Replaces the OLD_RECORD with this one in the database. If there is an error, -returns the error, otherwise returns false. - -=cut - -sub replace { - my $self = shift; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - my $error = $self->SUPER::replace(@_); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - unless ( $self->rectype eq 'SOA' ) { - my $error = $self->increment_serial; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - ''; - -} - -=item check - -Checks all fields to make sure this is a valid example. If there is -an error, returns the error, otherwise returns false. Called by the insert -and replace methods. - -=cut - -# the check method should currently be supplied - FS::Record contains some -# data checking routines - -sub check { - my $self = shift; - - my $error = - $self->ut_numbern('recnum') - || $self->ut_number('svcnum') - ; - return $error if $error; - - return "Unknown svcnum (in svc_domain)" - unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } ); - - $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i - or return "Illegal reczone: ". $self->reczone; - $self->reczone($1); - - $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf; - $self->recaf($1); - - $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|_mstr)$/ - or return "Illegal rectype (only SOA NS MX A PTR CNAME recognized): ". - $self->rectype; - $self->rectype($1); - - return "Illegal reczone for ". $self->rectype. ": ". $self->reczone - if $self->rectype !~ /^MX$/i && $self->reczone =~ /\*/; - - if ( $self->rectype eq 'SOA' ) { - my $recdata = $self->recdata; - $recdata =~ s/\s+/ /g; - $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ((\d+|((\d+[WDHMS])+)) ){5}\))$/i - or return "Illegal data for SOA record: $recdata"; - $self->recdata($1); - } elsif ( $self->rectype eq 'NS' ) { - $self->recdata =~ /^([a-z0-9\.\-]+)$/i - or return "Illegal data for NS record: ". $self->recdata; - $self->recdata($1); - } elsif ( $self->rectype eq 'MX' ) { - $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/i - or return "Illegal data for MX record: ". $self->recdata; - $self->recdata("$1 $2"); - } elsif ( $self->rectype eq 'A' ) { - $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/ - or return "Illegal data for A record: ". $self->recdata; - $self->recdata($1); - } elsif ( $self->rectype eq 'PTR' ) { - $self->recdata =~ /^([a-z0-9\.\-]+)$/i - or return "Illegal data for PTR record: ". $self->recdata; - $self->recdata($1); - } elsif ( $self->rectype eq 'CNAME' ) { - $self->recdata =~ /^([a-z0-9\.\-]+|\@)$/i - or return "Illegal data for CNAME record: ". $self->recdata; - $self->recdata($1); - } elsif ( $self->rectype eq '_mstr' ) { - $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/ - or return "Illegal data for _master pseudo-record: ". $self->recdata; - } else { - die "ack!"; - } - - $self->SUPER::check; -} - -=item increment_serial - -=cut - -sub increment_serial { - return '' if $noserial_hack; - my $self = shift; - - my $soa = qsearchs('domain_record', { - svcnum => $self->svcnum, - reczone => '@', - recaf => 'IN', - rectype => 'SOA', } ) - || qsearchs('domain_record', { - svcnum => $self->svcnum, - reczone => $self->svc_domain->domain.'.', - recaf => 'IN', - rectype => 'SOA', - } ) - or return "soa record not found; can't increment serial"; - - my $data = $soa->recdata; - $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works. - - my %hash = $soa->hash; - $hash{recdata} = $data; - my $new = new FS::domain_record \%hash; - $new->replace($soa); -} - -=item svc_domain - -Returns the domain (see L) for this record. - -=cut - -sub svc_domain { - my $self = shift; - qsearchs('svc_domain', { svcnum => $self->svcnum } ); -} - -=item zone - -Returns the canonical zone name. - -=cut - -sub zone { - my $self = shift; - my $zone = $self->reczone; # or die ? - if ( $zone =~ /\.$/ ) { - $zone =~ s/\.$//; - } else { - my $svc_domain = $self->svc_domain; # or die ? - $zone .= '.'. $svc_domain->domain; - $zone =~ s/^\@\.//; - } - $zone; -} - -=item reverse_record - -Returns the corresponding reverse-ARPA record as another FS::domain_record -object. If the specific record does not exist in the database but the -reverse-ARPA zone itself does, an appropriate new record is created. If no -reverse-ARPA zone is available at all, returns false. - -(You can test whether or not record itself exists in the database or is a new -object that might need to be inserted by checking the recnum field) - -Mostly used by the insert and delete methods - probably should see them for -examples. - -=cut - -sub reverse_record { - my $self = shift; - warn "reverse_record called\n" if $DEBUG; - #should support classless reverse-ARPA ala rfc2317 too - $self->recdata =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ - or return ''; - my $domain = "$3.$2.$1.in-addr.arpa"; - my $ptr_reczone = $4; - warn "reverse_record: searching for domain: $domain\n" if $DEBUG; - my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) - or return ''; - warn "reverse_record: found domain: $domain\n" if $DEBUG; - my %hash = ( - 'svcnum' => $svc_domain->svcnum, - 'reczone' => $ptr_reczone, - 'recaf' => 'IN', - 'rectype' => 'PTR', - ); - qsearchs('domain_record', \%hash ) - or new FS::domain_record { %hash, 'recdata' => $self->zone.'.' }; -} - -=back - -=head1 BUGS - -The data validation doesn't check everything it could. In particular, -there is no protection against bad data that passes the regex, duplicate -SOA records, forgetting the trailing `.', impossible IP addersses, etc. Of -course, it's still better than editing the zone files directly. :) - -=head1 SEE ALSO - -L, schema.html from the base documentation. - -=cut - -1; -