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
   9 @ISA = qw(FS::Record);
  10
  11 =head1 NAME
  12
  13 FS::domain_record - Object methods for domain_record records
  14
  15 =head1 SYNOPSIS
  16
  17   use FS::domain_record;
  18
  19   $record = new FS::domain_record \%hash;
  20   $record = new FS::domain_record { 'column' => 'value' };
  21
  22   $error = $record->insert;
  23
  24   $error = $new_record->replace($old_record);
  25
  26   $error = $record->delete;
  27
  28   $error = $record->check;
  29
  30 =head1 DESCRIPTION
  31
  32 An FS::domain_record object represents an entry in a DNS zone.
  33 FS::domain_record inherits from FS::Record.  The following fields are currently
  34 supported:
  35
  36 =over 4
  37
  38 =item recnum - primary key
  39
  40 =item svcnum - Domain (see L<FS::svc_domain>) of this entry
  41
  42 =item reczone - partial (or full) zone for this entry
  43
  44 =item recaf - address family for this entry, currently only `IN' is recognized.
  45
  46 =item rectype - record type for this entry (A, MX, etc.)
  47
  48 =item recdata - data for this entry
  49
  50 =back
  51
  52 =head1 METHODS
  53
  54 =over 4
  55
  56 =item new HASHREF
  57
  58 Creates a new entry.  To add the example to the database, see L<"insert">.
  59
  60 Note that this stores the hash reference, not a distinct copy of the hash it
  61 points to.  You can ask the object for a copy with the I<hash> method.
  62
  63 =cut
  64
  65 sub table { 'domain_record'; }
  66
  67 =item insert
  68
  69 Adds this record to the database.  If there is an error, returns the error,
  70 otherwise returns false.
  71
  72 =cut
  73
  74 sub insert {
  75   my $self = shift;
  76
  77   local $SIG{HUP} = 'IGNORE';
  78   local $SIG{INT} = 'IGNORE';
  79   local $SIG{QUIT} = 'IGNORE';
  80   local $SIG{TERM} = 'IGNORE';
  81   local $SIG{TSTP} = 'IGNORE';
  82   local $SIG{PIPE} = 'IGNORE';
  83
  84   my $oldAutoCommit = $FS::UID::AutoCommit;
  85   local $FS::UID::AutoCommit = 0;
  86   my $dbh = dbh;
  87
  88   if ( $self->rectype eq '_mstr' ) { #delete all other records
  89     foreach my $domain_record ( reverse $self->svc_domain->domain_record ) {
  90       my $error = $domain_record->delete;
  91       if ( $error ) {
  92         $dbh->rollback if $oldAutoCommit;
  93         return $error;
  94       }
  95     }
  96   }
  97
  98   my $error = $self->SUPER::insert;
  99   if ( $error ) {
 100     $dbh->rollback if $oldAutoCommit;
 101     return $error;
 102   }
 103
 104   unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
 105     my $error = $self->increment_serial;
 106     if ( $error ) {
 107       $dbh->rollback if $oldAutoCommit;
 108       return $error;
 109     }
 110   }
 111
 112   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 113
 114   '';
 115
 116 }
 117
 118 =item delete
 119
 120 Delete this record from the database.
 121
 122 =cut
 123
 124 sub delete {
 125   my $self = shift;
 126
 127   local $SIG{HUP} = 'IGNORE';
 128   local $SIG{INT} = 'IGNORE';
 129   local $SIG{QUIT} = 'IGNORE';
 130   local $SIG{TERM} = 'IGNORE';
 131   local $SIG{TSTP} = 'IGNORE';
 132   local $SIG{PIPE} = 'IGNORE';
 133
 134   my $oldAutoCommit = $FS::UID::AutoCommit;
 135   local $FS::UID::AutoCommit = 0;
 136   my $dbh = dbh;
 137
 138   my $error = $self->SUPER::delete;
 139   if ( $error ) {
 140     $dbh->rollback if $oldAutoCommit;
 141     return $error;
 142   }
 143
 144   unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
 145     my $error = $self->increment_serial;
 146     if ( $error ) {
 147       $dbh->rollback if $oldAutoCommit;
 148       return $error;
 149     }
 150   }
 151
 152   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 153
 154   '';
 155
 156 }
 157
 158 =item replace OLD_RECORD
 159
 160 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 161 returns the error, otherwise returns false.
 162
 163 =cut
 164
 165 sub replace {
 166   my $self = shift;
 167
 168   local $SIG{HUP} = 'IGNORE';
 169   local $SIG{INT} = 'IGNORE';
 170   local $SIG{QUIT} = 'IGNORE';
 171   local $SIG{TERM} = 'IGNORE';
 172   local $SIG{TSTP} = 'IGNORE';
 173   local $SIG{PIPE} = 'IGNORE';
 174
 175   my $oldAutoCommit = $FS::UID::AutoCommit;
 176   local $FS::UID::AutoCommit = 0;
 177   my $dbh = dbh;
 178
 179   my $error = $self->SUPER::replace(@_);
 180   if ( $error ) {
 181     $dbh->rollback if $oldAutoCommit;
 182     return $error;
 183   }
 184
 185   unless ( $self->rectype eq 'SOA' ) {
 186     my $error = $self->increment_serial;
 187     if ( $error ) {
 188       $dbh->rollback if $oldAutoCommit;
 189       return $error;
 190     }
 191   }
 192
 193   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 194
 195   '';
 196
 197 }
 198
 199 =item check
 200
 201 Checks all fields to make sure this is a valid example.  If there is
 202 an error, returns the error, otherwise returns false.  Called by the insert
 203 and replace methods.
 204
 205 =cut
 206
 207 # the check method should currently be supplied - FS::Record contains some
 208 # data checking routines
 209
 210 sub check {
 211   my $self = shift;
 212
 213   my $error =
 214     $self->ut_numbern('recnum')
 215     || $self->ut_number('svcnum')
 216   ;
 217   return $error if $error;
 218
 219   return "Unknown svcnum (in svc_domain)"
 220     unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } );
 221
 222   $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i
 223     or return "Illegal reczone: ". $self->reczone;
 224   $self->reczone($1);
 225
 226   $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf;
 227   $self->recaf($1);
 228
 229   $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|_mstr)$/
 230     or return "Illegal rectype (only SOA NS MX A PTR CNAME recognized): ".
 231               $self->rectype;
 232   $self->rectype($1);
 233
 234   return "Illegal reczone for ". $self->rectype. ": ". $self->reczone
 235     if $self->rectype !~ /^MX$/i && $self->reczone =~ /\*/;
 236
 237   if ( $self->rectype eq 'SOA' ) {
 238     my $recdata = $self->recdata;
 239     $recdata =~ s/\s+/ /g;
 240     $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/i
 241       or return "Illegal data for SOA record: $recdata";
 242     $self->recdata($1);
 243   } elsif ( $self->rectype eq 'NS' ) {
 244     $self->recdata =~ /^([a-z0-9\.\-]+)$/i
 245       or return "Illegal data for NS record: ". $self->recdata;
 246     $self->recdata($1);
 247   } elsif ( $self->rectype eq 'MX' ) {
 248     $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/i
 249       or return "Illegal data for MX record: ". $self->recdata;
 250     $self->recdata("$1 $2");
 251   } elsif ( $self->rectype eq 'A' ) {
 252     $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
 253       or return "Illegal data for A record: ". $self->recdata;
 254     $self->recdata($1);
 255   } elsif ( $self->rectype eq 'PTR' ) {
 256     $self->recdata =~ /^([a-z0-9\.\-]+)$/i
 257       or return "Illegal data for PTR record: ". $self->recdata;
 258     $self->recdata($1);
 259   } elsif ( $self->rectype eq 'CNAME' ) {
 260     $self->recdata =~ /^([a-z0-9\.\-]+)$/i
 261       or return "Illegal data for CNAME record: ". $self->recdata;
 262     $self->recdata($1);
 263   } elsif ( $self->rectype eq '_mstr' ) {
 264     $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
 265       or return "Illegal data for _master pseudo-record: ". $self->recdata;
 266   } else {
 267     die "ack!";
 268   }
 269
 270   ''; #no error
 271 }
 272
 273 =item increment_serial
 274
 275 =cut
 276
 277 sub increment_serial {
 278   return '' if $noserial_hack;
 279   my $self = shift;
 280
 281   my $soa = qsearchs('domain_record', {
 282     svcnum  => $self->svcnum,
 283     reczone => '@', #or full domain ?
 284     recaf   => 'IN',
 285     rectype => 'SOA',
 286   } ) or return "soa record not found; can't increment serial";
 287
 288   my $data = $soa->recdata;
 289   $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works.
 290
 291   my %hash = $soa->hash;
 292   $hash{recdata} = $data;
 293   my $new = new FS::domain_record \%hash;
 294   $new->replace($soa);
 295 }
 296
 297 =item svc_domain
 298
 299 Returns the domain (see L<FS::svc_domain) for this record.
 300
 301 =cut
 302
 303 sub svc_domain {
 304   my $self = shift;
 305   qsearchs('svc_domain', { svcnum => $self->svcnum } );
 306 }
 307
 308 =back
 309
 310 =head1 VERSION
 311
 312 $Id: domain_record.pm,v 1.9 2002-05-23 13:00:08 ivan Exp $
 313
 314 =head1 BUGS
 315
 316 The data validation doesn't check everything it could.  In particular,
 317 there is no protection against bad data that passes the regex, duplicate
 318 SOA records, forgetting the trailing `.', impossible IP addersses, etc.  Of
 319 course, it's still better than editing the zone files directly.  :)
 320
 321 =head1 SEE ALSO
 322
 323 L<FS::Record>, schema.html from the base documentation.
 324
 325 =cut
 326
 327 1;
 328