X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fdomain_record.pm;h=37cc6c9e83baeea26a99f12d2fffec56622bd100;hp=743f43c562baf9b4e18e136ce44dc1a550ecfe65;hb=3ef62a0570055da710328937e7f65dbb2c027c62;hpb=09a19f9ad1cc89c96b672e1f17af1099f7b3e2a1 diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index 743f43c56..37cc6c9e8 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -1,10 +1,11 @@ package FS::domain_record; use strict; -use vars qw( @ISA ); +use vars qw( @ISA $noserial_hack ); #use FS::Record qw( qsearch qsearchs ); -use FS::Record qw( qsearchs ); +use FS::Record qw( qsearchs dbh ); use FS::svc_domain; +use FS::svc_www; @ISA = qw(FS::Record); @@ -71,12 +72,93 @@ 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, @@ -84,6 +166,40 @@ 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 @@ -107,30 +223,33 @@ sub check { return "Unknown svcnum (in svc_domain)" unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } ); - $self->reczone =~ /^(@|[a-z0-9\.\-]+)$/ + $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)$/ + $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+ ){5}\))$/ + $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/i or return "Illegal data for SOA record: $recdata"; $self->recdata($1); } elsif ( $self->rectype eq 'NS' ) { - $self->recdata =~ /^([a-z0-9\.\-]+)$/ + $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\.\-]+)$/ + $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' ) { @@ -138,13 +257,16 @@ sub check { or return "Illegal data for A record: ". $self->recdata; $self->recdata($1); } elsif ( $self->rectype eq 'PTR' ) { - $self->recdata =~ /^([a-z0-9\.\-]+)$/ + $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\.\-]+)$/ + $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!"; } @@ -152,11 +274,46 @@ sub check { ''; #no error } +=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) for this record. + +=cut + +sub svc_domain { + my $self = shift; + qsearchs('svc_domain', { svcnum => $self->svcnum } ); +} + =back =head1 VERSION -$Id: domain_record.pm,v 1.2 2001-05-18 14:08:55 ivan Exp $ +$Id: domain_record.pm,v 1.11 2002-06-23 19:16:45 ivan Exp $ =head1 BUGS @@ -169,16 +326,6 @@ course, it's still better than editing the zone files directly. :) L, schema.html from the base documentation. -=head1 HISTORY - -$Log: domain_record.pm,v $ -Revision 1.2 2001-05-18 14:08:55 ivan -tyop - -Revision 1.1 2000/02/03 05:16:52 ivan -beginning of DNS and Apache support - - =cut 1;