X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_domain.pm;h=157f9e0cae6b69d4f6c0243be1e0885504d1270c;hp=0d71b27754c6c51d7c4bb053c3615e81af45848a;hb=633c48448d9468690b7ad77eb6ff7c660a286658;hpb=89d15555270a63ab09116107f3dc327e86d831c5 diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 0d71b2775..157f9e0ca 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -1,19 +1,17 @@ package FS::svc_domain; use strict; -use vars qw( @ISA $whois_hack $conf $smtpmachine +use vars qw( @ISA $whois_hack $conf @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine - $soarefresh $soaretry $qshellmachine $nossh_hack + $soarefresh $soaretry ); use Carp; -use Mail::Internet 1.44; -use Mail::Header; use Date::Format; -use Net::Whois 1.0; -use Net::SSH; +#use Net::Whois::Raw; use FS::Record qw(fields qsearch qsearchs dbh); use FS::Conf; use FS::svc_Common; +use FS::svc_Parent_Mixin; use FS::cust_svc; use FS::svc_acct; use FS::cust_pkg; @@ -21,14 +19,12 @@ use FS::cust_main; use FS::domain_record; use FS::queue; -@ISA = qw( FS::svc_Common ); +@ISA = qw( FS::svc_Parent_Mixin FS::svc_Common ); #ask FS::UID to run this stuff for us later $FS::UID::callback{'FS::domain'} = sub { $conf = new FS::Conf; - $smtpmachine = $conf->config('smtpmachine'); - @defaultrecords = $conf->config('defaultrecords'); $soadefaultttl = $conf->config('soadefaultttl'); $soaemail = $conf->config('soaemail'); @@ -37,9 +33,6 @@ $FS::UID::callback{'FS::domain'} = sub { $soarefresh = $conf->config('soarefresh'); $soaretry = $conf->config('soaretry'); - $qshellmachine = $conf->exists('qmailmachines') - ? $conf->config('shellmachine') - : ''; }; =head1 NAME @@ -80,6 +73,20 @@ FS::svc_Common. The following fields are currently supported: =item catchall - optional svcnum of an svc_acct record, designating an email catchall account. +=item suffix - + +=item parent_svcnum - + +=item registrarnum - Registrar (see L) + +=item registrarkey - Registrar key or password for this domain + +=item setup_date - UNIX timestamp + +=item renewal_interval - Number of days before expiration date to start renewal + +=item expiration_date - UNIX timestamp + =back =head1 METHODS @@ -92,9 +99,38 @@ Creates a new domain. To add the domain to the database, see L<"insert">. =cut +sub table_info { + { + 'name' => 'Domain', + 'sorts' => 'domain', + 'display_weight' => 20, + 'cancel_weight' => 60, + 'fields' => { + 'domain' => 'Domain', + }, + }; +} + sub table { 'svc_domain'; } -=item insert +sub search_sql { + my($class, $string) = @_; + $class->search_sql_field('domain', $string); +} + + +=item label + +Returns the domain. + +=cut + +sub label { + my $self = shift; + $self->domain; +} + +=item insert [ , OPTION => VALUE ... ] Adds this domain to the database. If there is an error, returns the error, otherwise returns false. @@ -120,20 +156,11 @@ If any records are defined in the I configuration file, appropriate records are added to the domain_record table (see L). -If a machine is defined in the I configuration value, the -I configuration file exists, and the I field points -to an an account with a home directory (see L), the command: - - [ -e $dir/.qmail-$qdomain-defualt ] || { - touch $dir/.qmail-$qdomain-default; - chown $uid:$gid $dir/.qmail-$qdomain-default; - } - -is executed on shellmachine via ssh (see L). -This behaviour can be supressed by setting $FS::svc_domain::nossh_hack true. +Currently available options are: I -a machine is defined -in the +If I is set (to a scalar jobnum or an array reference of +jobnums), all provisioning jobs will have a dependancy on the supplied +jobnum(s) (they will not run until the specific job(s) complete(s)). =cut @@ -158,24 +185,13 @@ sub insert { return "Domain in use (here)" if qsearchs( 'svc_domain', { 'domain' => $self->domain } ); - my $whois = $self->whois; - if ( $self->action eq "N" && ! $whois_hack && $whois ) { - $dbh->rollback if $oldAutoCommit; - return "Domain in use (see whois)"; - } - if ( $self->action eq "M" && ! $whois ) { - $dbh->rollback if $oldAutoCommit; - return "Domain not found (see whois)"; - } - $error = $self->SUPER::insert; + $error = $self->SUPER::insert(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } - $self->submit_internic unless $whois_hack; - if ( $soamachine ) { my $soa = new FS::domain_record { 'svcnum' => $self->svcnum, @@ -211,28 +227,6 @@ sub insert { $dbh->commit or die $dbh->errstr if $oldAutoCommit; - if ( $qshellmachine && $self->catchall && ! $nossh_hack ) { - - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } ) - or warn "WARNING: inserted unknown catchall: ". $self->catchall; - if ( $svc_acct && $svc_acct->dir ) { - my $qdomain = $self->domain; - $qdomain =~ s/\./:/g; #see manpage for 'dot-qmail': EXTENSION ADDRESSES - my ( $uid, $gid, $dir ) = ( - $svc_acct->uid, - $svc_acct->gid, - $svc_acct->dir, - ); - - my $queue = new FS::queue { - 'svcnum' => $self->svcnum, - 'job' => 'Net::SSH::ssh_cmd', - }; - $error = $queue->insert("root\@$qshellmachine", "[ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }" ); - - } - } - ''; #no error } @@ -269,7 +263,11 @@ sub delete { my $error = $domain_record->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "can't delete DNS entry: ". + join(' ', map $domain_record->$_(), + qw( reczone recaf rectype recdata ) + ). + ":$error"; } } @@ -292,9 +290,14 @@ returns the error, otherwise returns false. sub replace { my ( $new, $old ) = ( shift, shift ); + # We absolutely have to have an old vs. new record to make this work. + $old = $new->replace_old unless defined($old); + return "Can't change domain - reorder." if $old->getfield('domain') ne $new->getfield('domain'); + # Better to do it here than to force the caller to remember that svc_domain is weird. + $new->setfield(action => 'M'); my $error = $new->SUPER::replace($old); return $error if $error; } @@ -350,42 +353,33 @@ sub check { my($recref) = $self->hashref; - unless ( $whois_hack ) { - unless ( $self->email ) { #find out an email address - my @svc_acct; - foreach ( qsearch( 'cust_svc', { 'pkgnum' => $pkgnum } ) ) { - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $_->svcnum } ); - push @svc_acct, $svc_acct if $svc_acct; - } - - if ( scalar(@svc_acct) == 0 ) { - return "Must order an account in package ". $pkgnum. " first"; - } elsif ( scalar(@svc_acct) > 1 ) { - return "More than one account in package ". $pkgnum. ": specify admin contact email"; - } else { - $self->email($svc_acct[0]->email ); - } - } - } - #if ( $recref->{domain} =~ /^([\w\-\.]{1,22})\.(com|net|org|edu)$/ ) { - if ( $recref->{domain} =~ /^([\w\-]{1,22})\.(com|net|org|edu)$/ ) { + if ( $recref->{domain} =~ /^([\w\-]{1,63})\.(com|net|org|edu|tv|info|biz)$/ ) { $recref->{domain} = "$1.$2"; + $recref->{suffix} ||= $2; # hmmmmmmmm. - } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)$/ ) { - $recref->{domain} = $1; + } elsif ( $whois_hack && $recref->{domain} =~ /^([\w\-\.]+)\.(\w+)$/ ) { + $recref->{domain} = "$1.$2"; + # need to match a list of suffixes - no guarantee they're top-level.. } else { return "Illegal domain ". $recref->{domain}. " (or unknown registry - try \$whois_hack)"; } - $recref->{action} =~ /^(M|N)$/ or return "Illegal action"; - $recref->{action} = $1; - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } ); - return "Unknown catchall" unless $svc_acct || ! $recref->{catchall}; + if ( $recref->{catchall} ne '' ) { + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } ); + return "Unknown catchall" unless $svc_acct; + } - $self->ut_textn('purpose'); + $self->ut_alphan('suffix') + or $self->ut_foreign_keyn('registrarnum', 'registrar', 'registrarnum') + or $self->ut_textn('registrarkey') + or $self->ut_numbern('setup_date') + or $self->ut_numbern('renewal_interval') + or $self->ut_numbern('expiration_date') + or $self->ut_textn('purpose') + or $self->SUPER::check; } @@ -397,11 +391,13 @@ sub domain_record { my $self = shift; my %order = ( - SOA => 1, - NS => 2, - MX => 3, - CNAME => 4, - A => 5, + 'SOA' => 1, + 'NS' => 2, + 'MX' => 3, + 'CNAME' => 4, + 'A' => 5, + 'TXT' => 6, + 'PTR' => 7, ); sort { $order{$a->rectype} <=> $order{$b->rectype} } @@ -409,17 +405,27 @@ sub domain_record { } +sub catchall_svc_acct { + my $self = shift; + if ( $self->catchall ) { + qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } ); + } else { + ''; + } +} + =item whois -Returns the Net::Whois::Domain object (see L) for this domain, or -undef if the domain is not found in whois. +# Returns the Net::Whois::Domain object (see L) for this domain, or +# undef if the domain is not found in whois. (If $FS::svc_domain::whois_hack is true, returns that in all cases instead.) =cut sub whois { - $whois_hack or new Net::Whois::Domain $_[0]->domain; + #$whois_hack or new Net::Whois::Domain $_[0]->domain; + #$whois_hack or die "whois_hack not set...\n"; } =item _whois @@ -447,8 +453,6 @@ sub submit_internic { =head1 BUGS -All BIND/DNS fields should be included (and exported). - Delete doesn't send a registration template. All registries should be supported. @@ -460,9 +464,8 @@ The $recref stuff in sub check should be cleaned up. =head1 SEE ALSO L, L, L, L, -L, L, L, L, -L, schema.html from the base documentation, config.html from the -base documentation. +L, L, L, schema.html from the base +documentation, config.html from the base documentation. =cut