diff options
author | cvs2git <cvs2git> | 2004-04-07 09:08:35 +0000 |
---|---|---|
committer | cvs2git <cvs2git> | 2004-04-07 09:08:35 +0000 |
commit | 022491d9d2723ca4d7d0718cdb1fd67e7652428e (patch) | |
tree | fc1e50c0d78ecc401ef2214a6a11ee07242be0f8 /FS/FS/domain_record.pm | |
parent | 35effa1bf4ac902547615c816960bbc8db8e7256 (diff) |
This commit was manufactured by cvs2svn to create tag 'NET_WHOIS_RAW_0_31'.NET_WHOIS_RAW_0_31
Diffstat (limited to 'FS/FS/domain_record.pm')
-rw-r--r-- | FS/FS/domain_record.pm | 351 |
1 files changed, 0 insertions, 351 deletions
diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm deleted file mode 100644 index ea0c48d4f..000000000 --- a/FS/FS/domain_record.pm +++ /dev/null @@ -1,351 +0,0 @@ -package FS::domain_record; - -use strict; -use vars qw( @ISA $noserial_hack ); -#use FS::Record qw( qsearch qsearchs ); -use FS::Record qw( qsearchs dbh ); -use FS::svc_domain; -use FS::svc_www; - -@ISA = qw(FS::Record); - -=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 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<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; - } - } - - $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; - } - } - - $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 => '@', #or full 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; -} - -=back - -=head1 VERSION - -$Id: domain_record.pm,v 1.16 2003-08-05 00:20:43 khoff Exp $ - -=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; - |