X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fsvc_domain.pm;h=2a24da427ac5c9b18a61f3ec3c324799ac37e02b;hp=e1e4eb8b5a8f5350f3c1252cb376d7dcddef0bb2;hb=7a8c7b6f64ac14d555d866f93300e64c47b74a98;hpb=051f66ab072bfbb2a074f656b9886ccbc47287ed diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index e1e4eb8b5..2a24da427 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -1,53 +1,33 @@ package FS::svc_domain; use strict; -use vars qw( @ISA $whois_hack $conf $mydomain $smtpmachine - $tech_contact $from $to @nameservers @nameserver_ips @template - @mxmachines @nsmachines $soadefaultttl $soaemail $soaexpire $soamachine +use vars qw( @ISA $whois_hack $conf + @defaultrecords $soadefaultttl $soaemail $soaexpire $soamachine $soarefresh $soaretry ); use Carp; -use Mail::Internet; -use Mail::Header; +use Scalar::Util qw( blessed ); use Date::Format; -use Net::Whois 1.0; -use FS::Record qw(fields qsearch qsearchs); +#use Net::Whois::Raw; +use Net::Domain::TLD qw(tld_exists); +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; 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; - $mydomain = $conf->config('domain'); - $smtpmachine = $conf->config('smtpmachine'); - - my($internic)="/registries/internic"; - $tech_contact = $conf->config("$internic/tech_contact"); - $from = $conf->config("$internic/from"); - $to = $conf->config("$internic/to"); - my(@ns) = $conf->config("$internic/nameservers"); - @nameservers=map { - /^\s*\d+\.\d+\.\d+\.\d+\s+([^\s]+)\s*$/ - or die "Illegal line in $internic/nameservers"; - $1; - } @ns; - @nameserver_ips=map { - /^\s*(\d+\.\d+\.\d+\.\d+)\s+([^\s]+)\s*$/ - or die "Illegal line in $internic/nameservers!"; - $1; - } @ns; - @template = map { $_. "\n" } $conf->config("$internic/template"); - - @mxmachines = $conf->config('mxmachines'); - @nsmachines = $conf->config('nsmachines'); + @defaultrecords = $conf->config('defaultrecords'); $soadefaultttl = $conf->config('soadefaultttl'); $soaemail = $conf->config('soaemail'); $soaexpire = $conf->config('soaexpire'); @@ -93,6 +73,24 @@ FS::svc_Common. The following fields are currently supported: =item domain +=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 + +=item max_accounts + =back =head1 METHODS @@ -105,9 +103,236 @@ 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', + 'parent_svcnum' => { + label => 'Parent domain / Communigate administrator domain', + type => 'select', + select_table => 'svc_domain', + select_key => 'svcnum', + select_label => 'domain', + disable_inventory => 1, + disable_select => 1, + }, + 'max_accounts' => { label => 'Maximum number of accounts', + 'disable_inventory' => 1, + }, + 'cgp_aliases' => { + label => 'Communigate aliases', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'cgp_accessmodes' => { + label => 'Communigate enabled services', + type => 'communigate_pro-accessmodes', + disable_inventory => 1, + disable_select => 1, + }, + + 'acct_def_cgp_accessmodes' => { + label => 'Acct. default Communigate enabled services', + type => 'communigate_pro-accessmodes', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_password_selfchange' => { label => 'Acct. default Password modification', + type => 'checkbox', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_password_recover' => { label => 'Acct. default Password recovery', + type => 'checkbox', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_cgp_deletemode' => { + label => 'Acct. default Communigate message delete method', + type => 'select', + select_list => [ 'Move To Trash', 'Immediately', 'Mark' ], + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_cgp_emptytrash' => { + label => 'Acct. default Communigate on logout remove trash', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_quota' => { + label => 'Acct. default Quota', #Mail storage limit + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_file_quota'=> { + label => 'Acct. default File storage limit', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_file_maxnum'=> { + label => 'Acct. default Number of files limit', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_file_maxsize'=> { + label => 'Acct. default File size limit', + type => 'text', + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_cgp_rulesallowed' => { + label => 'Acct. default Allowed mail rules', + type => 'select', + select_list => [ '', 'No', 'Filter Only', 'All But Exec', 'Any' ], + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_cgp_rpopallowed' => { + label => 'Acct. default RPOP modifications', + type => 'checkbox', + }, + 'acct_def_cgp_mailtoall' => { + label => 'Acct. default Accepts mail to "all"', + type => 'checkbox', + }, + 'acct_def_cgp_addmailtrailer' => { + label => 'Acct. default Add trailer to sent mail', + type => 'checkbox', + }, + 'trailer' => { + label => 'Mail trailer', + type => 'textarea', + }, + 'acct_def_cgp_language' => { + label => 'Acct. default language', + type => 'select', + select_list => [ '', qw( English Arabic Chinese Dutch French German Hebrew Italian Japanese Portuguese Russian Slovak Spanish Thai ) ], + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_cgp_timezone' => { + label => 'Acct. default time zone', + type => 'select', + select_list => [ '', + 'HostOS', + '(+0100) Algeria/Congo', + '(+0200) Egypt/South Africa', + '(+0300) Saudi Arabia', + '(+0400) Oman', + '(+0500) Pakistan', + '(+0600) Bangladesh', + '(+0700) Thailand/Vietnam', + '(+0800) China/Malaysia', + '(+0900) Japan/Korea', + '(+1000) Queensland', + '(+1100) Micronesia', + '(+1200) Fiji', + '(+1300) Tonga/Kiribati', + '(+1400) Christmas Islands', + '(-0100) Azores/Cape Verde', + '(-0200) Fernando de Noronha', + '(-0300) Argentina/Uruguay', + '(-0400) Venezuela/Guyana', + '(-0500) Haiti/Peru', + '(-0600) Central America', + '(-0700) Arisona', + '(-0800) Adamstown', + '(-0900) Marquesas Islands', + '(-1000) Hawaii/Tahiti', + '(-1100) Samoa', + 'Asia/Afghanistan', + 'Asia/India', + 'Asia/Iran', + 'Asia/Iraq', + 'Asia/Israel', + 'Asia/Jordan', + 'Asia/Lebanon', + 'Asia/Syria', + 'Australia/Adelaide', + 'Australia/East', + 'Australia/NorthernTerritory', + 'Europe/Central', + 'Europe/Eastern', + 'Europe/Moscow', + 'Europe/Western', + 'GMT (+0000)', + 'Newfoundland', + 'NewZealand/Auckland', + 'NorthAmerica/Alaska', + 'NorthAmerica/Atlantic', + 'NorthAmerica/Central', + 'NorthAmerica/Eastern', + 'NorthAmerica/Mountain', + 'NorthAmerica/Pacific', + 'Russia/Ekaterinburg', + 'Russia/Irkutsk', + 'Russia/Kamchatka', + 'Russia/Krasnoyarsk', + 'Russia/Magadan', + 'Russia/Novosibirsk', + 'Russia/Vladivostok', + 'Russia/Yakutsk', + 'SouthAmerica/Brasil', + 'SouthAmerica/Chile', + 'SouthAmerica/Paraguay', + ], + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_cgp_skinname' => { + label => 'Acct. default layout', + type => 'select', + select_list => [ '', '***', 'GoldFleece', 'Skin2' ], + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_cgp_prontoskinname' => { + label => 'Acct. default Pronto style', + type => 'select', + select_list => [ '', 'Pronto', 'Pronto-darkflame', 'Pronto-steel', 'Pronto-twilight', ], + disable_inventory => 1, + disable_select => 1, + }, + 'acct_def_cgp_sendmdnmode' => { + label => 'Acct. default send read receipts', + type => 'select', + select_list => [ '', 'Never', 'Manually', 'Automatically' ], + disable_inventory => 1, + disable_select => 1, + }, + }, + }; +} + 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. @@ -115,8 +340,8 @@ otherwise returns false. The additional fields I and I (see L) should be defined. An FS::cust_svc record will be created and inserted. -The additional field I should be set to I for new domains or I -for transfers. +The additional field I should be set to I for new domains, I +for transfers, or I for no action (registered elsewhere). A registration or transfer email will be submitted unless $FS::svc_domain::whois_hack is true. @@ -129,15 +354,15 @@ in the same package, it is automatically used. Otherwise an error is returned. If any I configuration file exists, an SOA record is added to the domain_record table (see ). -If any machines are defined in the I configuration file, NS -records are added to the domain_record table (see L). +If any records are defined in the I configuration file, +appropriate records are added to the domain_record table (see +L). -If any machines are defined in the I configuration file, MX -records are added to the domain_record table (see L). +Currently available options are: I -Any problems adding FS::domain_record records will emit warnings, but will -not return errors from this method. If your configuration files are correct -you shouln't have any problems. +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 @@ -152,22 +377,15 @@ sub insert { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - $error = $self->check; - return $error if $error; - - return "Domain in use (here)" - if qsearchs( 'svc_domain', { 'domain' => $self->domain } ); - - my $whois = $self->whois; - return "Domain in use (see whois)" - if ( $self->action eq "N" && $whois ); - return "Domain not found (see whois)" - if ( $self->action eq "M" && ! $whois ); + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; - $error = $self->SUPER::insert; - return $error if $error; - - $self->submit_internic unless $whois_hack; + $error = $self->SUPER::insert(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } if ( $soamachine ) { my $soa = new FS::domain_record { @@ -175,40 +393,34 @@ sub insert { 'reczone' => '@', 'recaf' => 'IN', 'rectype' => 'SOA', - 'recdata' => "$soamachine $soaemail ( ". time2str("%Y%m%e", time). "00 ". + 'recdata' => "$soamachine $soaemail ( ". time2str("%Y%m%d", time). "00 ". "$soarefresh $soaretry $soaexpire $soadefaultttl )" }; $error = $soa->insert; - warn "WARNING: couldn't insert SOA record for new domain: $error" if $error; - - foreach my $nsmachine ( @nsmachines ) { - my $ns = new FS::domain_record { - 'svcnum' => $self->svcnum, - 'reczone' => '@', - 'recaf' => 'IN', - 'rectype' => 'NS', - 'recdata' => $nsmachine, - }; - my $error = $ns->insert; - warn "WARNING: couldn't insert NS record for new domain: $error" - if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "couldn't insert SOA record for new domain: $error"; } - foreach my $mxmachine ( @mxmachines ) { - my $mx = new FS::domain_record { + foreach my $record ( @defaultrecords ) { + my($zone,$af,$type,$data) = split(/\s+/,$record,4); + my $domain_record = new FS::domain_record { 'svcnum' => $self->svcnum, - 'reczone' => '@', - 'recaf' => 'IN', - 'rectype' => 'mx', - 'recdata' => $mxmachine, + 'reczone' => $zone, + 'recaf' => $af, + 'rectype' => $type, + 'recdata' => $data, }; - my $error = $mx->insert; - warn "WARNING: couldn't insert MX record for new domain: $error" - if $error; + my $error = $domain_record->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "couldn't insert record for new domain: $error"; + } } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -220,6 +432,49 @@ error, otherwise returns false. The corresponding FS::cust_svc record will be deleted as well. +=cut + +sub delete { + my $self = shift; + + return "Can't delete a domain which has accounts!" + if qsearch( 'svc_acct', { 'domsvc' => $self->svcnum } ); + + #return "Can't delete a domain with (domain_record) zone entries!" + # if qsearch('domain_record', { 'svcnum' => $self->svcnum } ); + + 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; + + foreach my $domain_record ( reverse $self->domain_record ) { + my $error = $domain_record->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't delete DNS entry: ". + join(' ', map $domain_record->$_(), + qw( reczone recaf rectype recdata ) + ). + ":$error"; + } + } + + my $error = $self->SUPER::delete(@_); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; +} + =item replace OLD_RECORD Replaces OLD_RECORD with this one in the database. If there is an error, @@ -228,14 +483,20 @@ returns the error, otherwise returns false. =cut sub replace { - my ( $new, $old ) = ( shift, shift ); - my $error; + my $new = shift; - return "Can't change domain - reorder." - if $old->getfield('domain') ne $new->getfield('domain'); + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; - $new->SUPER::replace($old); + return "Can't change domain - reorder." + if $old->getfield('domain') ne $new->getfield('domain') + && ! $conf->exists('svc_domain-edit_domain'); + # Better to do it here than to force the caller to remember that svc_domain is weird. + $new->setfield(action => 'I'); + my $error = $new->SUPER::replace($old, @_); + return $error if $error; } =item suspend @@ -268,11 +529,41 @@ Sets any fixed values; see L. sub check { my $self = shift; - my $error; 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_numbern('catchall') + || $self->ut_numbern('max_accounts') + || $self->ut_anything('trailer') #well + || $self->ut_textn('cgp_aliases') #well + || $self->ut_enum('acct_def_password_selfchange', [ '', 'Y' ]) + || $self->ut_enum('acct_def_password_recover', [ '', 'Y' ]) + || $self->ut_textn('acct_def_cgp_accessmodes') + || $self->ut_alphan('acct_def_quota') + || $self->ut_alphan('acct_def_file_quota') + || $self->ut_alphan('acct_def_maxnum') + || $self->ut_alphan('acct_def_maxsize') + #settings + || $self->ut_alphasn('acct_def_cgp_rulesallowed') + || $self->ut_enum('acct_def_cgp_rpopallowed', [ '', 'Y' ]) + || $self->ut_enum('acct_def_cgp_mailtoall', [ '', 'Y' ]) + || $self->ut_enum('acct_def_cgp_addmailtrailer', [ '', 'Y' ]) + #XXX archive messages + #preferences + || $self->ut_alphasn('acct_def_cgp_deletemode') + || $self->ut_alphan('acct_def_cgp_emptytrash') + || $self->ut_alphan('acct_def_cgp_language') + || $self->ut_textn('acct_def_cgp_timezone') + || $self->ut_textn('acct_def_cgp_skinname') + || $self->ut_textn('acct_def_cgp_prontoskinname') + || $self->ut_alphan('acct_def_cgp_sendmdnmode') + #mail + #XXX rules, archive rule, spam foldering rule(s) + ; + return $error if $error; #hmm my $pkgnum; @@ -285,186 +576,121 @@ 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]->username. '@'. $mydomain); - } - } - } - #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.. + # http://wiki.mozilla.org/TLD_List + # but this will have to do for now... + $recref->{suffix} ||= $2; } else { return "Illegal domain ". $recref->{domain}. " (or unknown registry - try \$whois_hack)"; } - $recref->{action} =~ /^(M|N)$/ or return "Illegal action"; - $recref->{action} = $1; - - $self->ut_textn('purpose'); - -} - -=item whois - -Returns the Net::Whois::Domain object (see L) for this domain, or -undef if the domain is not found in whois. + $self->suffix =~ /(^|\.)(\w+)$/ + or return "can't parse suffix for TLD: ". $self->suffix; + my $tld = $2; + return "No such TLD: .$tld" unless tld_exists($tld); -(If $FS::svc_domain::whois_hack is true, returns that in all cases instead.) + if ( $recref->{catchall} ne '' ) { + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $recref->{catchall} } ); + return "Unknown catchall" unless $svc_acct; + } -=cut + $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->SUPER::check; -sub whois { - $whois_hack or new Net::Whois::Domain $_[0]->domain; } -=item _whois - -Depriciated. +sub _check_duplicate { + my $self = shift; -=cut + $self->lock_table; -sub _whois { - die "_whois depriciated"; + if ( qsearchs( 'svc_domain', { 'domain' => $self->domain } ) ) { + return "Domain in use (here)"; + } else { + return ''; + } } -=item submit_internic - -Submits a registration email for this domain. +=item domain_record =cut -sub submit_internic { +sub domain_record { my $self = shift; - my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } ); - return unless $cust_pkg; - my $cust_main = qsearchs( 'cust_main', { 'custnum' => $cust_pkg->custnum } ); - return unless $cust_main; - - my %subs = ( - 'action' => $self->action, - 'purpose' => $self->purpose, - 'domain' => $self->domain, - 'company' => $cust_main->company - || $cust_main->getfield('first'). ' '. - $cust_main->getfield('last') - , - 'city' => $cust_main->city, - 'state' => $cust_main->state, - 'zip' => $cust_main->zip, - 'country' => $cust_main->country, - 'last' => $cust_main->getfield('last'), - 'first' => $cust_main->getfield('first'), - 'daytime' => $cust_main->daytime, - 'fax' => $cust_main->fax, - 'email' => $self->email, - 'tech_contact' => $tech_contact, - 'primary' => shift @nameservers, - 'primary_ip' => shift @nameserver_ips, + my %order = ( + 'SOA' => 1, + 'NS' => 2, + 'MX' => 3, + 'CNAME' => 4, + 'A' => 5, + 'TXT' => 6, + 'PTR' => 7, ); - #yuck - my @xtemplate = @template; - my @body; - my $line; - OLOOP: while ( defined( $line = shift @xtemplate ) ) { - - if ( $line =~ /^###LOOP###$/ ) { - my(@buffer); - LOADBUF: while ( defined( $line = shift @xtemplate ) ) { - last LOADBUF if ( $line =~ /^###ENDLOOP###$/ ); - push @buffer, $line; - } - my %lubs = ( - 'address' => $cust_main->address2 - ? [ $cust_main->address1, $cust_main->address2 ] - : [ $cust_main->address1 ] - , - 'secondary' => [ @nameservers ], - 'secondary_ip' => [ @nameserver_ips ], - ); - LOOP: while (1) { - my @xbuffer = @buffer; - SUBLOOP: while ( defined( $line = shift @xbuffer ) ) { - if ( $line =~ /###(\w+)###/ ) { - #last LOOP unless my($lub)=shift@{$lubs{$1}}; - next OLOOP unless my $lub = shift @{$lubs{$1}}; - $line =~ s/###(\w+)###/$lub/e; - redo SUBLOOP; - } else { - push @body, $line; - } - } #SUBLOOP - } #LOOP - - } + my %sort = ( + #'SOA' => sub { $_[0]->recdata cmp $_[1]->recdata }, #sure hope not though +# 'SOA' => sub { 0; }, +# 'NS' => sub { 0; }, + 'MX' => sub { my( $a_weight, $a_name ) = split(/\s+/, $_[0]->recdata); + my( $b_weight, $b_name ) = split(/\s+/, $_[1]->recdata); + $a_weight <=> $b_weight or $a_name cmp $b_name; + }, + 'CNAME' => sub { $_[0]->reczone cmp $_[1]->reczone }, + 'A' => sub { $_[0]->reczone cmp $_[1]->reczone }, + +# 'TXT' => sub { 0; }, + 'PTR' => sub { $_[0]->reczone <=> $_[1]->reczone }, + ); - if ( $line =~ /###(\w+)###/ ) { - #$line =~ s/###(\w+)###/$subs{$1}/eg; - $line =~ s/###(\w+)###/$subs{$1}/e; - redo OLOOP; - } else { - push @body, $line; - } + map { $_ } #return $self->num_domain_record( PARAMS ) unless wantarray; + sort { $order{$a->rectype} <=> $order{$b->rectype} + or &{ $sort{$a->rectype} || sub { 0; } }($a, $b) + } + qsearch('domain_record', { svcnum => $self->svcnum } ); - } #OLOOP +} - my $subject; - if ( $self->action eq "M" ) { - $subject = "MODIFY DOMAIN ". $self->domain; - } elsif ( $self->action eq "N" ) { - $subject = "NEW DOMAIN ". $self->domain; +sub catchall_svc_acct { + my $self = shift; + if ( $self->catchall ) { + qsearchs( 'svc_acct', { 'svcnum' => $self->catchall } ); } else { - croak "submit_internic called with action ". $self->action; + ''; } +} - $ENV{SMTPHOSTS} = $smtpmachine; - $ENV{MAILADDRESS} = $from; - my $header = Mail::Header->new( [ - "From: $from", - "To: $to", - "Sender: $from", - "Reply-To: $from", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: $subject", - ] ); - - my($msg)=Mail::Internet->new( - 'Header' => $header, - 'Body' => \@body, - ); +=item whois - $msg->smtpsend or die "Can't send registration email"; #die? warn? +# 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.) -=back +=cut -=head1 VERSION +sub whois { + #$whois_hack or new Net::Whois::Domain $_[0]->domain; + #$whois_hack or die "whois_hack not set...\n"; +} -$Id: svc_domain.pm,v 1.6 2000-03-01 08:13:59 ivan Exp $ +=back =head1 BUGS -All BIND/DNS fields should be included (and exported). - Delete doesn't send a registration template. All registries should be supported. @@ -476,9 +702,8 @@ The $recref stuff in sub check should be cleaned up. =head1 SEE ALSO L, 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