FS/FS/domain_record.pm

   1 package FS::domain_record;
   2
   3 use strict;
   4 use vars qw( @ISA $noserial_hack );
   5 #use FS::Record qw( qsearch qsearchs );
   6 use FS::Record qw( qsearchs dbh );
   7 use FS::svc_domain;
   8 use FS::svc_www;
   9
  10 @ISA = qw(FS::Record);
  11
  12 =head1 NAME
  13
  14 FS::domain_record - Object methods for domain_record records
  15
  16 =head1 SYNOPSIS
  17
  18   use FS::domain_record;
  19
  20   $record = new FS::domain_record \%hash;
  21   $record = new FS::domain_record { 'column' => 'value' };
  22
  23   $error = $record->insert;
  24
  25   $error = $new_record->replace($old_record);
  26
  27   $error = $record->delete;
  28
  29   $error = $record->check;
  30
  31 =head1 DESCRIPTION
  32
  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
  35 supported:
  36
  37 =over 4
  38
  39 =item recnum - primary key
  40
  41 =item svcnum - Domain (see L<FS::svc_domain>) of this entry
  42
  43 =item reczone - partial (or full) zone for this entry
  44
  45 =item recaf - address family for this entry, currently only `IN' is recognized.
  46
  47 =item rectype - record type for this entry (A, MX, etc.)
  48
  49 =item recdata - data for this entry
  50
  51 =back
  52
  53 =head1 METHODS
  54
  55 =over 4
  56
  57 =item new HASHREF
  58
  59 Creates a new entry.  To add the example to the database, see L<"insert">.
  60
  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.
  63
  64 =cut
  65
  66 sub table { 'domain_record'; }
  67
  68 =item insert
  69
  70 Adds this record to the database.  If there is an error, returns the error,
  71 otherwise returns false.
  72
  73 =cut
  74
  75 sub insert {
  76   my $self = shift;
  77
  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';
  84
  85   my $oldAutoCommit = $FS::UID::AutoCommit;
  86   local $FS::UID::AutoCommit = 0;
  87   my $dbh = dbh;
  88
  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;
  92       if ( $error ) {
  93         $dbh->rollback if $oldAutoCommit;
  94         return $error;
  95       }
  96     }
  97   }
  98
  99   my $error = $self->SUPER::insert;
 100   if ( $error ) {
 101     $dbh->rollback if $oldAutoCommit;
 102     return $error;
 103   }
 104
 105   unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
 106     my $error = $self->increment_serial;
 107     if ( $error ) {
 108       $dbh->rollback if $oldAutoCommit;
 109       return $error;
 110     }
 111   }
 112
 113   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 114
 115   '';
 116
 117 }
 118
 119 =item delete
 120
 121 Delete this record from the database.
 122
 123 =cut
 124
 125 sub delete {
 126   my $self = shift;
 127
 128   return "Can't delete a domain record which has a website!"
 129     if qsearchs( 'svc_www', { 'recnum' => $self->recnum } );
 130
 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';
 137
 138   my $oldAutoCommit = $FS::UID::AutoCommit;
 139   local $FS::UID::AutoCommit = 0;
 140   my $dbh = dbh;
 141
 142   my $error = $self->SUPER::delete;
 143   if ( $error ) {
 144     $dbh->rollback if $oldAutoCommit;
 145     return $error;
 146   }
 147
 148   unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
 149     my $error = $self->increment_serial;
 150     if ( $error ) {
 151       $dbh->rollback if $oldAutoCommit;
 152       return $error;
 153     }
 154   }
 155
 156   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 157
 158   '';
 159
 160 }
 161
 162 =item replace OLD_RECORD
 163
 164 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 165 returns the error, otherwise returns false.
 166
 167 =cut
 168
 169 sub replace {
 170   my $self = shift;
 171
 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';
 178
 179   my $oldAutoCommit = $FS::UID::AutoCommit;
 180   local $FS::UID::AutoCommit = 0;
 181   my $dbh = dbh;
 182
 183   my $error = $self->SUPER::replace(@_);
 184   if ( $error ) {
 185     $dbh->rollback if $oldAutoCommit;
 186     return $error;
 187   }
 188
 189   unless ( $self->rectype eq 'SOA' ) {
 190     my $error = $self->increment_serial;
 191     if ( $error ) {
 192       $dbh->rollback if $oldAutoCommit;
 193       return $error;
 194     }
 195   }
 196
 197   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 198
 199   '';
 200
 201 }
 202
 203 =item check
 204
 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
 207 and replace methods.
 208
 209 =cut
 210
 211 # the check method should currently be supplied - FS::Record contains some
 212 # data checking routines
 213
 214 sub check {
 215   my $self = shift;
 216
 217   my $error =
 218     $self->ut_numbern('recnum')
 219     || $self->ut_number('svcnum')
 220   ;
 221   return $error if $error;
 222
 223   return "Unknown svcnum (in svc_domain)"
 224     unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } );
 225
 226   $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i
 227     or return "Illegal reczone: ". $self->reczone;
 228   $self->reczone($1);
 229
 230   $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf;
 231   $self->recaf($1);
 232
 233   $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|_mstr)$/
 234     or return "Illegal rectype (only SOA NS MX A PTR CNAME recognized): ".
 235               $self->rectype;
 236   $self->rectype($1);
 237
 238   return "Illegal reczone for ". $self->rectype. ": ". $self->reczone
 239     if $self->rectype !~ /^MX$/i && $self->reczone =~ /\*/;
 240
 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";
 246     $self->recdata($1);
 247   } elsif ( $self->rectype eq 'NS' ) {
 248     $self->recdata =~ /^([a-z0-9\.\-]+)$/i
 249       or return "Illegal data for NS record: ". $self->recdata;
 250     $self->recdata($1);
 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;
 258     $self->recdata($1);
 259   } elsif ( $self->rectype eq 'PTR' ) {
 260     $self->recdata =~ /^([a-z0-9\.\-]+)$/i
 261       or return "Illegal data for PTR record: ". $self->recdata;
 262     $self->recdata($1);
 263   } elsif ( $self->rectype eq 'CNAME' ) {
 264     $self->recdata =~ /^([a-z0-9\.\-]+|\@)$/i
 265       or return "Illegal data for CNAME record: ". $self->recdata;
 266     $self->recdata($1);
 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;
 270   } else {
 271     die "ack!";
 272   }
 273
 274   ''; #no error
 275 }
 276
 277 =item increment_serial
 278
 279 =cut
 280
 281 sub increment_serial {
 282   return '' if $noserial_hack;
 283   my $self = shift;
 284
 285   my $soa = qsearchs('domain_record', {
 286     svcnum  => $self->svcnum,
 287     reczone => '@', #or full domain ?
 288     recaf   => 'IN',
 289     rectype => 'SOA',
 290   } ) or return "soa record not found; can't increment serial";
 291
 292   my $data = $soa->recdata;
 293   $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works.
 294
 295   my %hash = $soa->hash;
 296   $hash{recdata} = $data;
 297   my $new = new FS::domain_record \%hash;
 298   $new->replace($soa);
 299 }
 300
 301 =item svc_domain
 302
 303 Returns the domain (see L<FS::svc_domain>) for this record.
 304
 305 =cut
 306
 307 sub svc_domain {
 308   my $self = shift;
 309   qsearchs('svc_domain', { svcnum => $self->svcnum } );
 310 }
 311
 312 =item zone
 313
 314 Returns the canonical zone name.
 315
 316 =cut
 317
 318 sub zone {
 319   my $self = shift;
 320   my $zone = $self->reczone; # or die ?
 321   if ( $zone =~ /\.$/ ) {
 322     $zone =~ s/\.$//;
 323   } else {
 324     my $svc_domain = $self->svc_domain; # or die ?
 325     $zone .= '.'. $svc_domain->domain;
 326     $zone =~ s/^\@\.//;
 327   }
 328   $zone;
 329 }
 330
 331 =back
 332
 333 =head1 VERSION
 334
 335 $Id: domain_record.pm,v 1.15 2003-04-29 18:28:50 khoff Exp $
 336
 337 =head1 BUGS
 338
 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.  :)
 343
 344 =head1 SEE ALSO
 345
 346 L<FS::Record>, schema.html from the base documentation.
 347
 348 =cut
 349
 350 1;
 351