FS/FS/domain_record.pm

   1 package FS::domain_record;
   2
   3 use strict;
   4 use vars qw( @ISA );
   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   my $error = $self->SUPER::insert;
  89   if ( $error ) {
  90     $dbh->rollback if $oldAutoCommit;
  91     return $error;
  92   }
  93
  94   unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
  95     my $error = $self->increment_serial;
  96     if ( $error ) {
  97       $dbh->rollback if $oldAutoCommit;
  98       return $error;
  99     }
 100   }
 101
 102   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 103
 104   '';
 105
 106 }
 107
 108 =item delete
 109
 110 Delete this record from the database.
 111
 112 =cut
 113
 114 sub delete {
 115   my $self = shift;
 116
 117   local $SIG{HUP} = 'IGNORE';
 118   local $SIG{INT} = 'IGNORE';
 119   local $SIG{QUIT} = 'IGNORE';
 120   local $SIG{TERM} = 'IGNORE';
 121   local $SIG{TSTP} = 'IGNORE';
 122   local $SIG{PIPE} = 'IGNORE';
 123
 124   my $oldAutoCommit = $FS::UID::AutoCommit;
 125   local $FS::UID::AutoCommit = 0;
 126   my $dbh = dbh;
 127
 128   my $error = $self->SUPER::delete;
 129   if ( $error ) {
 130     $dbh->rollback if $oldAutoCommit;
 131     return $error;
 132   }
 133
 134   unless ( $self->rectype =~ /^(SOA|_mstr)$/ ) {
 135     my $error = $self->increment_serial;
 136     if ( $error ) {
 137       $dbh->rollback if $oldAutoCommit;
 138       return $error;
 139     }
 140   }
 141
 142   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 143
 144   '';
 145
 146 }
 147
 148 =item replace OLD_RECORD
 149
 150 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 151 returns the error, otherwise returns false.
 152
 153 =cut
 154
 155 sub replace {
 156   my $self = shift;
 157
 158   local $SIG{HUP} = 'IGNORE';
 159   local $SIG{INT} = 'IGNORE';
 160   local $SIG{QUIT} = 'IGNORE';
 161   local $SIG{TERM} = 'IGNORE';
 162   local $SIG{TSTP} = 'IGNORE';
 163   local $SIG{PIPE} = 'IGNORE';
 164
 165   my $oldAutoCommit = $FS::UID::AutoCommit;
 166   local $FS::UID::AutoCommit = 0;
 167   my $dbh = dbh;
 168
 169   my $error = $self->SUPER::replace(@_);
 170   if ( $error ) {
 171     $dbh->rollback if $oldAutoCommit;
 172     return $error;
 173   }
 174
 175   unless ( $self->rectype eq 'SOA' ) {
 176     my $error = $self->increment_serial;
 177     if ( $error ) {
 178       $dbh->rollback if $oldAutoCommit;
 179       return $error;
 180     }
 181   }
 182
 183   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 184
 185   '';
 186
 187 }
 188
 189 =item check
 190
 191 Checks all fields to make sure this is a valid example.  If there is
 192 an error, returns the error, otherwise returns false.  Called by the insert
 193 and replace methods.
 194
 195 =cut
 196
 197 # the check method should currently be supplied - FS::Record contains some
 198 # data checking routines
 199
 200 sub check {
 201   my $self = shift;
 202
 203   my $error =
 204     $self->ut_numbern('recnum')
 205     || $self->ut_number('svcnum')
 206   ;
 207   return $error if $error;
 208
 209   return "Unknown svcnum (in svc_domain)"
 210     unless qsearchs('svc_domain', { 'svcnum' => $self->svcnum } );
 211
 212   $self->reczone =~ /^(@|[a-z0-9\.\-\*]+)$/i
 213     or return "Illegal reczone: ". $self->reczone;
 214   $self->reczone($1);
 215
 216   $self->recaf =~ /^(IN)$/ or return "Illegal recaf: ". $self->recaf;
 217   $self->recaf($1);
 218
 219   $self->rectype =~ /^(SOA|NS|MX|A|PTR|CNAME|_mstr)$/
 220     or return "Illegal rectype (only SOA NS MX A PTR CNAME recognized): ".
 221               $self->rectype;
 222   $self->rectype($1);
 223
 224   return "Illegal reczone for ". $self->rectype. ": ". $self->reczone
 225     if $self->rectype !~ /^MX$/i && $self->reczone =~ /\*/;
 226
 227   if ( $self->rectype eq 'SOA' ) {
 228     my $recdata = $self->recdata;
 229     $recdata =~ s/\s+/ /g;
 230     $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/i
 231       or return "Illegal data for SOA record: $recdata";
 232     $self->recdata($1);
 233   } elsif ( $self->rectype eq 'NS' ) {
 234     $self->recdata =~ /^([a-z0-9\.\-]+)$/i
 235       or return "Illegal data for NS record: ". $self->recdata;
 236     $self->recdata($1);
 237   } elsif ( $self->rectype eq 'MX' ) {
 238     $self->recdata =~ /^(\d+)\s+([a-z0-9\.\-]+)$/i
 239       or return "Illegal data for MX record: ". $self->recdata;
 240     $self->recdata("$1 $2");
 241   } elsif ( $self->rectype eq 'A' ) {
 242     $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
 243       or return "Illegal data for A record: ". $self->recdata;
 244     $self->recdata($1);
 245   } elsif ( $self->rectype eq 'PTR' ) {
 246     $self->recdata =~ /^([a-z0-9\.\-]+)$/i
 247       or return "Illegal data for PTR record: ". $self->recdata;
 248     $self->recdata($1);
 249   } elsif ( $self->rectype eq 'CNAME' ) {
 250     $self->recdata =~ /^([a-z0-9\.\-]+)$/i
 251       or return "Illegal data for CNAME record: ". $self->recdata;
 252     $self->recdata($1);
 253   } elsif ( $self->rectype eq '_mstr' ) {
 254     $self->recdata =~ /^((\d{1,3}\.){3}\d{1,3})$/
 255       or return "Illegal data for _master pseudo-record: ". $self->recdata;
 256   } else {
 257     die "ack!";
 258   }
 259
 260   ''; #no error
 261 }
 262
 263 =item increment_serial
 264
 265 =cut
 266
 267 sub increment_serial {
 268   my $self = shift;
 269
 270   my $soa = qsearchs('domain_record', {
 271     svcnum  => $self->svcnum,
 272     reczone => '@', #or full domain ?
 273     recaf   => 'IN',
 274     rectype => 'SOA',
 275   } ) or return "soa record not found; can't increment serial";
 276
 277   my $data = $soa->recdata;
 278   $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works.
 279
 280   my %hash = $soa->hash;
 281   $hash{recdata} = $data;
 282   my $new = new FS::domain_record \%hash;
 283   $new->replace($soa);
 284 }
 285
 286 =back
 287
 288 =head1 VERSION
 289
 290 $Id: domain_record.pm,v 1.8 2002-05-22 18:44:01 ivan Exp $
 291
 292 =head1 BUGS
 293
 294 The data validation doesn't check everything it could.  In particular,
 295 there is no protection against bad data that passes the regex, duplicate
 296 SOA records, forgetting the trailing `.', impossible IP addersses, etc.  Of
 297 course, it's still better than editing the zone files directly.  :)
 298
 299 =head1 SEE ALSO
 300
 301 L<FS::Record>, schema.html from the base documentation.
 302
 303 =cut
 304
 305 1;
 306