FS/FS/svc_www.pm

   1 package FS::svc_www;
   2
   3 use strict;
   4 use vars qw(@ISA $conf $apacheroot $apachemachine $apacheip $nossh_hack );
   5 #use FS::Record qw( qsearch qsearchs );
   6 use FS::Record qw( qsearchs dbh );
   7 use FS::svc_Common;
   8 use FS::cust_svc;
   9 use FS::domain_record;
  10 use FS::svc_acct;
  11 use FS::svc_domain;
  12 use Net::SSH qw(ssh);
  13
  14 @ISA = qw( FS::svc_Common );
  15
  16 #ask FS::UID to run this stuff for us later
  17 $FS::UID::callback{'FS::svc_www'} = sub {
  18   $conf = new FS::Conf;
  19   $apacheroot = $conf->config('apacheroot');
  20   $apachemachine = $conf->config('apachemachine');
  21   $apacheip = $conf->config('apacheip');
  22 };
  23
  24 =head1 NAME
  25
  26 FS::svc_www - Object methods for svc_www records
  27
  28 =head1 SYNOPSIS
  29
  30   use FS::svc_www;
  31
  32   $record = new FS::svc_www \%hash;
  33   $record = new FS::svc_www { 'column' => 'value' };
  34
  35   $error = $record->insert;
  36
  37   $error = $new_record->replace($old_record);
  38
  39   $error = $record->delete;
  40
  41   $error = $record->check;
  42
  43   $error = $record->suspend;
  44
  45   $error = $record->unsuspend;
  46
  47   $error = $record->cancel;
  48
  49 =head1 DESCRIPTION
  50
  51 An FS::svc_www object represents an web virtual host.  FS::svc_www inherits
  52 from FS::svc_Common.  The following fields are currently supported:
  53
  54 =over 4
  55
  56 =item svcnum - primary key
  57
  58 =item recnum - DNS `A' record corresponding to this web virtual host. (see L<FS::domain_record>)
  59
  60 =item usersvc - account (see L<FS::svc_acct>) corresponding to this web virtual host.
  61
  62 =back
  63
  64 =head1 METHODS
  65
  66 =over 4
  67
  68 =item new HASHREF
  69
  70 Creates a new web virtual host.  To add the record to the database, see
  71 L<"insert">.
  72
  73 Note that this stores the hash reference, not a distinct copy of the hash it
  74 points to.  You can ask the object for a copy with the I<hash> method.
  75
  76 =cut
  77
  78 sub table { 'svc_www'; }
  79
  80 =item insert
  81
  82 Adds this record to the database.  If there is an error, returns the error,
  83 otherwise returns false.
  84
  85 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
  86 defined.  An FS::cust_svc record will be created and inserted.
  87
  88 If the configuration values (see L<FS::Conf>) I<apachemachine>, and
  89 I<apacheroot> exist, the command:
  90
  91   mkdir $apacheroot/$zone;
  92   chown $username $apacheroot/$zone;
  93   ln -s $apacheroot/$zone $homedir/$zone
  94
  95 I<$zone> is the DNS A record pointed to by I<recnum>
  96 I<$username> is the username pointed to by I<usersvc>
  97 I<$homedir> is that user's home directory
  98
  99 is executed on I<apachemachine> via ssh.  This behaviour can be surpressed by
 100 setting $FS::svc_www::nossh_hack true.
 101
 102 =cut
 103
 104 sub insert {
 105   my $self = shift;
 106
 107   my $error = $self->check;
 108   return $error if $error;
 109
 110   local $SIG{HUP} = 'IGNORE';
 111   local $SIG{INT} = 'IGNORE';
 112   local $SIG{QUIT} = 'IGNORE';
 113   local $SIG{TERM} = 'IGNORE';
 114   local $SIG{TSTP} = 'IGNORE';
 115   local $SIG{PIPE} = 'IGNORE';
 116
 117   my $oldAutoCommit = $FS::UID::AutoCommit;
 118   local $FS::UID::AutoCommit = 0;
 119   my $dbh = dbh;
 120
 121   #if ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) {
 122   if ( $self->recnum =~ /^([\w\-]+|\@)\.(\d+)$/ ) {
 123     my( $reczone, $domain_svcnum ) = ( $1, $2 );
 124     unless ( $apacheip ) {
 125       $dbh->rollback if $oldAutoCommit;
 126       return "Configuration option apacheip not set; can't autocreate A record";
 127              #"for $reczone". $svc_domain->domain;
 128     }
 129     my $domain_record = new FS::domain_record {
 130       'svcnum'  => $domain_svcnum,
 131       'reczone' => $reczone,
 132       'recaf'   => 'IN',
 133       'rectype' => 'A',
 134       'recdata' => $apacheip,
 135     };
 136     $error = $domain_record->insert;
 137     if ( $error ) {
 138       $dbh->rollback if $oldAutoCommit;
 139       return $error;
 140     }
 141     $self->recnum($domain_record->recnum);
 142   }
 143
 144   $error = $self->SUPER::insert;
 145   if ( $error ) {
 146     $dbh->rollback if $oldAutoCommit;
 147     return $error;
 148   }
 149
 150   my $domain_record = qsearchs('domain_record', { 'recnum' => $self->recnum } );    # or die ?
 151   my $zone = $domain_record->reczone;
 152     # or die ?
 153   unless ( $zone =~ /\.$/ ) {
 154     my $dom_svcnum = $domain_record->svcnum;
 155     my $svc_domain = qsearchs('svc_domain', { 'svcnum' => $dom_svcnum } );
 156       # or die ?
 157     $zone .= $svc_domain->domain;
 158   }
 159
 160   my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
 161     # or die ?
 162   my $username = $svc_acct->username;
 163     # or die ?
 164   my $homedir = $svc_acct->dir;
 165     # or die ?
 166
 167   if ( $apachemachine
 168        && $apacheroot
 169        && $zone
 170        && $username
 171        && $homedir
 172        && ! $nossh_hack
 173   ) {
 174     ssh("root\@$apachemachine",
 175         "mkdir $apacheroot/$zone; ".
 176         "chown $username $apacheroot/$zone; ".
 177         "ln -s $apacheroot/$zone $homedir/$zone"
 178     );
 179   }
 180
 181   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 182   '';
 183 }
 184
 185 =item delete
 186
 187 Delete this record from the database.
 188
 189 =cut
 190
 191 sub delete {
 192   my $self = shift;
 193   my $error;
 194
 195   $error = $self->SUPER::delete;
 196   return $error if $error;
 197
 198   '';
 199 }
 200
 201 =item replace OLD_RECORD
 202
 203 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 204 returns the error, otherwise returns false.
 205
 206 =cut
 207
 208 sub replace {
 209   my ( $new, $old ) = ( shift, shift );
 210   my $error;
 211
 212   $error = $new->SUPER::replace($old);
 213   return $error if $error;
 214
 215   '';
 216 }
 217
 218 =item suspend
 219
 220 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 221
 222 =item unsuspend
 223
 224 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 225
 226 =item cancel
 227
 228 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 229
 230 =item check
 231
 232 Checks all fields to make sure this is a valid web virtual host.  If there is
 233 an error, returns the error, otherwise returns false.  Called by the insert
 234 and repalce methods.
 235
 236 =cut
 237
 238 sub check {
 239   my $self = shift;
 240
 241   my $x = $self->setfixed;
 242   return $x unless ref($x);
 243   #my $part_svc = $x;
 244
 245   my $error =
 246     $self->ut_numbern('svcnum')
 247 #    || $self->ut_number('recnum')
 248     || $self->ut_number('usersvc')
 249   ;
 250   return $error if $error;
 251
 252   if ( $self->recnum =~ /^(\d+)$/ ) {
 253
 254     $self->recnum($1);
 255     return "Unknown recnum: ". $self->recnum
 256       unless qsearchs('domain_record', { 'recnum' => $self->recnum } );
 257
 258   } elsif ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) {
 259
 260     my( $reczone, $domain ) = ( $1, $2 );
 261
 262     my $svc_domain = qsearchs( 'svc_domain', { 'domain' => $domain } )
 263       or return "unknown domain $domain (recnum $1.$2)";
 264
 265     my $domain_record = qsearchs( 'domain_record', {
 266       'reczone' => $reczone,
 267       'svcnum' => $svc_domain->svcnum,
 268     });
 269
 270     if ( $domain_record ) {
 271       $self->recnum($domain_record->recnum);
 272     } else {
 273       #insert will create it
 274       #$self->recnum("$reczone.$domain");
 275       $self->recnum("$reczone.". $svc_domain->svcnum);
 276     }
 277
 278   } else {
 279     return "Illegal recnum: ". $self->recnum;
 280   }
 281
 282   return "Unknown usersvc (svc_acct.svcnum): ". $self->usersvc
 283     unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } );
 284
 285   ''; #no error
 286 }
 287
 288 =back
 289
 290 =head1 BUGS
 291
 292 =head1 SEE ALSO
 293
 294 L<FS::svc_Common>, L<FS::Record>, L<FS::domain_record>, L<FS::cust_svc>,
 295 L<FS::part_svc>, L<FS::cust_pkg>, schema.html from the base documentation.
 296
 297 =cut
 298
 299 1;
 300