X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_www.pm;h=6415a301243be770d392e8737c9a8e2a22992eae;hb=1126f78d0ff7708ade671422d3e6ceae3411241e;hp=bb765b193f705e99d157c6a2c1bffb133a601aa3;hpb=051f66ab072bfbb2a074f656b9886ccbc47287ed;p=freeside.git diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm index bb765b193..6415a3012 100644 --- a/FS/FS/svc_www.pm +++ b/FS/FS/svc_www.pm @@ -1,14 +1,15 @@ package FS::svc_www; use strict; -use vars qw(@ISA $conf $apacheroot $apachemachine $nossh_hack ); +use vars qw(@ISA $conf $apacheroot $apachemachine $apacheip $nossh_hack ); #use FS::Record qw( qsearch qsearchs ); -use FS::Record qw( qsearchs ); +use FS::Record qw( qsearchs dbh ); use FS::svc_Common; use FS::cust_svc; use FS::domain_record; use FS::svc_acct; -use FS::SSH qw(ssh); +use FS::svc_domain; +use Net::SSH qw(ssh); @ISA = qw( FS::svc_Common ); @@ -17,6 +18,7 @@ $FS::UID::callback{'FS::svc_www'} = sub { $conf = new FS::Conf; $apacheroot = $conf->config('apacheroot'); $apachemachine = $conf->config('apachemachine'); + $apacheip = $conf->config('apacheip'); }; =head1 NAME @@ -53,7 +55,7 @@ from FS::svc_Common. The following fields are currently supported: =item svcnum - primary key -=item recnum - DNS `A' record corresponding to this web virtual host. (see L) =item usersvc - account (see L) corresponding to this web virtual host. @@ -101,11 +103,50 @@ setting $FS::svc_www::nossh_hack true. sub insert { my $self = shift; - my $error; - $error = $self->SUPER::insert; + my $error = $self->check; return $error if $error; + 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->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) { + if ( $self->recnum =~ /^([\w\-]+|\@)\.(\d+)$/ ) { + my( $reczone, $domain_svcnum ) = ( $1, $2 ); + unless ( $apacheip ) { + $dbh->rollback if $oldAutoCommit; + return "Configuration option apacheip not set; can't autocreate A record"; + #"for $reczone". $svc_domain->domain; + } + my $domain_record = new FS::domain_record { + 'svcnum' => $domain_svcnum, + 'reczone' => $reczone, + 'recaf' => 'IN', + 'rectype' => 'A', + 'recdata' => $apacheip, + }; + $error = $domain_record->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $self->recnum($domain_record->recnum); + } + + $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + my $domain_record = qsearchs('domain_record', { 'recnum' => $self->recnum } ); # or die ? my $zone = $domain_record->reczone; # or die ? @@ -113,7 +154,7 @@ sub insert { my $dom_svcnum = $domain_record->svcnum; my $svc_domain = qsearchs('svc_domain', { 'svcnum' => $dom_svcnum } ); # or die ? - $zone .= $svc_domain->domain; + $zone .= '.'. $svc_domain->domain; } my $svc_acct = qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); @@ -137,6 +178,7 @@ sub insert { ); } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -187,7 +229,7 @@ Called by the cancel method of FS::cust_pkg (see L). =item check -Checks all fields to make sure this is a valid example. If there is +Checks all fields to make sure this is a valid web virtual host. If there is an error, returns the error, otherwise returns false. Called by the insert and repalce methods. @@ -198,17 +240,44 @@ sub check { my $x = $self->setfixed; return $x unless ref($x); - my $part_svc = $x; + #my $part_svc = $x; my $error = $self->ut_numbern('svcnum') - || $self->ut_number('recnum') +# || $self->ut_number('recnum') || $self->ut_number('usersvc') ; return $error if $error; - return "Unknown recnum: ". $self->recnum - unless qsearchs('domain_record', { 'recnum' => $self->recnum } ); + if ( $self->recnum =~ /^(\d+)$/ ) { + + $self->recnum($1); + return "Unknown recnum: ". $self->recnum + unless qsearchs('domain_record', { 'recnum' => $self->recnum } ); + + } elsif ( $self->recnum =~ /^([\w\-]+|\@)\.(([\w\.\-]+\.)+\w+)$/ ) { + + my( $reczone, $domain ) = ( $1, $2 ); + + my $svc_domain = qsearchs( 'svc_domain', { 'domain' => $domain } ) + or return "unknown domain $domain (recnum $1.$2)"; + + my $domain_record = qsearchs( 'domain_record', { + 'reczone' => $reczone, + 'svcnum' => $svc_domain->svcnum, + }); + + if ( $domain_record ) { + $self->recnum($domain_record->recnum); + } else { + #insert will create it + #$self->recnum("$reczone.$domain"); + $self->recnum("$reczone.". $svc_domain->svcnum); + } + + } else { + return "Illegal recnum: ". $self->recnum; + } return "Unknown usersvc (svc_acct.svcnum): ". $self->usersvc unless qsearchs('svc_acct', { 'svcnum' => $self->usersvc } ); @@ -218,10 +287,6 @@ sub check { =back -=head1 VERSION - -$Id: svc_www.pm,v 1.2 2000-03-01 08:13:59 ivan Exp $ - =head1 BUGS =head1 SEE ALSO @@ -229,16 +294,6 @@ $Id: svc_www.pm,v 1.2 2000-03-01 08:13:59 ivan Exp $ L, L, L, L, L, L, schema.html from the base documentation. -=head1 HISTORY - -$Log: svc_www.pm,v $ -Revision 1.2 2000-03-01 08:13:59 ivan -compilation bugfixes - -Revision 1.1 2000/02/03 05:16:52 ivan -beginning of DNS and Apache support - - =cut 1;