summaryrefslogtreecommitdiff
path: root/FS/FS/domain_record.pm
diff options
context:
space:
mode:
Diffstat (limited to 'FS/FS/domain_record.pm')
-rw-r--r--FS/FS/domain_record.pm438
1 files changed, 438 insertions, 0 deletions
diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm
new file mode 100644
index 0000000..6513abf
--- /dev/null
+++ b/FS/FS/domain_record.pm
@@ -0,0 +1,438 @@
+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<FS::svc_domain>) 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 entry 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<hash> 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 entry. 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 } );
+
+ my $conf = new FS::Conf;
+
+ if ( $conf->exists('zone-underscore') ) {
+ $self->reczone =~ /^(@|[a-z0-9_\.\-\*]+)$/i
+ or return "Illegal reczone: ". $self->reczone;
+ $self->reczone($1);
+ } else {
+ $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|TXT|_mstr)$/
+ or return "Illegal rectype (only SOA NS MX A PTR CNAME TXT 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' ) {
+ if ( $conf->exists('zone-underscore') ) {
+ $self->recdata =~ /^([a-z0-9_\.\-]+)$/i
+ or return "Illegal data for PTR record: ". $self->recdata;
+ $self->recdata($1);
+ } else {
+ $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 'TXT' ) {
+ if ( $self->recdata =~ /^((?:\S+)|(?:".+"))$/ ) {
+ $self->recdata($1);
+ } else {
+ $self->recdata('"'. $self->recdata. '"'); #?
+ }
+ # or return "Illegal data for TXT record: ". $self->recdata;
+ } 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<FS::svc_domain>) 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<FS::Record>, schema.html from the base documentation.
+
+=cut
+
+1;
+
generated by cgit v1.1 at 2024-06-01 23:54:28 +0000