diff options
Diffstat (limited to 'FS')
77 files changed, 2771 insertions, 1359 deletions
@@ -140,11 +140,13 @@ L<FS::msgcat> - Message catalogs =head1 Remote API modules +L<FS::SelfService> + L<FS::SignupClient> L<FS::SessionClient> -L<FS::MailAdminServer> +L<FS::MailAdminServer> (deprecated in favor of the self-service server) =head2 Command-line utilities diff --git a/FS/FS/CGI.pm b/FS/FS/CGI.pm index 86d20f6cb..25f0de7b3 100644 --- a/FS/FS/CGI.pm +++ b/FS/FS/CGI.pm @@ -59,7 +59,7 @@ sub header { <META HTTP-Equiv="Expires" Content="0"> </HEAD> <BODY BGCOLOR="#e8e8e8"$etc> - <FONT SIZE=7> + <FONT SIZE=6> $title </FONT> <BR><BR> @@ -209,7 +209,9 @@ Returns current URL with LEVEL levels of path removed from the end (default 0). sub popurl { my($up)=@_; my $cgi = &FS::UID::cgi; - my $url = new URI::URL ( $cgi->isa('Apache') ? $cgi->uri : $cgi->url ); + my $url_string = $cgi->isa('Apache') ? $cgi->uri : $cgi->url; + $url_string =~ s/\?.*//; + my $url = new URI::URL ( $url_string ); my(@path)=$url->path_components; splice @path, 0-$up; $url->path_components(@path); diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 421a08210..81da5bcb1 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -24,6 +24,7 @@ FS::ClientAPI->register_handlers( 'MyAccount/list_pkgs' => \&list_pkgs, 'MyAccount/order_pkg' => \&order_pkg, 'MyAccount/cancel_pkg' => \&cancel_pkg, + 'MyAccount/charge' => \&charge, ); use vars qw( @cust_main_editable_fields ); @@ -35,26 +36,23 @@ use vars qw( @cust_main_editable_fields ); ); #store in db? -my $cache = new Cache::SharedMemoryCache(); +my $cache = new Cache::SharedMemoryCache( { + 'namespace' => 'FS::ClientAPI::MyAccount', +} ); -#false laziness w/FS::ClientAPI::passwd::passwd (needs to handle encrypted pw) +#false laziness w/FS::ClientAPI::passwd::passwd sub login { my $p = shift; my $svc_domain = qsearchs('svc_domain', { 'domain' => $p->{'domain'} } ) - or return { error => "Domain not found" }; + or return { error => 'Domain '. $p->{'domain'}. ' not found' }; - my $svc_acct = - ( length($p->{'password'}) < 13 - && qsearchs( 'svc_acct', { 'username' => $p->{'username'}, - 'domsvc' => $svc_domain->svcnum, - '_password' => $p->{'password'} } ) - ) - || qsearchs( 'svc_acct', { 'username' => $p->{'username'}, - 'domsvc' => $svc_domain->svcnum, - '_password' => $p->{'password'} } ); - - unless ( $svc_acct ) { return { error => 'Incorrect password.' } } + my $svc_acct = qsearchs( 'svc_acct', { 'username' => $p->{'username'}, + 'domsvc' => $svc_domain->svcnum, } + ); + return { error => 'User not found.' } unless $svc_acct; + return { error => 'Incorrect password.' } + unless $svc_acct->check_password($p->{'password'}); my $session = { 'svcnum' => $svc_acct->svcnum, @@ -277,7 +275,7 @@ sub order_pkg { $cust_pkg->reexport; } - return { error => '' }; + return { error => '', pkgnum => $cust_pkg->pkgnum }; } diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm index 375958b9c..4655b0984 100644 --- a/FS/FS/ClientAPI/Signup.pm +++ b/FS/FS/ClientAPI/Signup.pm @@ -4,6 +4,7 @@ use strict; use Tie::RefHash; use FS::Conf; use FS::Record qw(qsearch qsearchs dbdef); +use FS::Msgcat qw(gettext); use FS::agent; use FS::cust_main_county; use FS::part_pkg; @@ -12,7 +13,7 @@ use FS::cust_main; use FS::cust_pkg; use FS::svc_acct; use FS::acct_snarf; -use FS::Msgcat qw(gettext); +use FS::queue; use FS::ClientAPI; #hmm FS::ClientAPI->register_handlers( @@ -171,7 +172,8 @@ sub new_customer { my @acct_snarf; my $snarfnum = 1; - while ( length($packet->{"snarf_machine$snarfnum"}) ) { + while ( exists($packet->{"snarf_machine$snarfnum"}) + && length($packet->{"snarf_machine$snarfnum"}) ) { my $acct_snarf = new FS::acct_snarf ( { 'machine' => $packet->{"snarf_machine$snarfnum"}, 'protocol' => $packet->{"snarf_protocol$snarfnum"}, @@ -189,12 +191,28 @@ sub new_customer { $error = $svc_acct->check; return { 'error' => $error } if $error; + #setup a job dependancy to delay provisioning + my $placeholder = new FS::queue ( { + 'job' => 'FS::ClientAPI::Signup::__placeholder', + 'status' => 'locked', + } ); + $error = $placeholder->insert; + return { 'error' => $error } if $error; + use Tie::RefHash; tie my %hash, 'Tie::RefHash'; %hash = ( $cust_pkg => [ $svc_acct ] ); #msgcat - $error = $cust_main->insert( \%hash, \@invoicing_list, 'noexport' => 1 ); - return { 'error' => $error } if $error; + $error = $cust_main->insert( + \%hash, + \@invoicing_list, + 'depend_jobnum' => $placeholder->jobnum, + ); + if ( $error ) { + my $perror = $placeholder->delete; + $error .= " (Additionally, error removing placeholder: $perror)" if $perror; + return { 'error' => $error }; + } if ( $conf->exists('signup_server-realtime') ) { @@ -222,11 +240,20 @@ sub new_customer { local $FS::svc_Common::noexport_hack = 1; $cust_main->cancel('quiet'=>1); + my $perror = $placeholder->depended_delete; + warn "error removing provisioning jobs after decline: $perror" if $perror; + unless ( $perror ) { + $perror = $placeholder->delete; + warn "error removing placeholder after decline: $perror" if $perror; + } + return { 'error' => '_decline' }; } } - $cust_main->reexport; + + $error = $placeholder->delete; + return { 'error' => $error } if $error; return { error => '' }; diff --git a/FS/FS/ClientAPI/passwd.pm b/FS/FS/ClientAPI/passwd.pm index 29606227d..cb839ecef 100644 --- a/FS/FS/ClientAPI/passwd.pm +++ b/FS/FS/ClientAPI/passwd.pm @@ -3,7 +3,7 @@ package FS::ClientAPI::passwd; use strict; use FS::Record qw(qsearchs); use FS::svc_acct; -#use FS::svc_domain; +use FS::svc_domain; use FS::ClientAPI; #hmm FS::ClientAPI->register_handlers( @@ -15,26 +15,23 @@ FS::ClientAPI->register_handlers( sub passwd { my $packet = shift; - #my $domain = qsearchs('svc_domain', { 'domain' => $packet->{'domain'} } ) - # or return { error => "Domain $domain not found" }; + my $domain = $FS::ClientAPI::domain || $packet->{'domain'}; + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + or return { error => "Domain $domain not found" }; my $old_password = $packet->{'old_password'}; my $new_password = $packet->{'new_password'}; my $new_gecos = $packet->{'new_gecos'}; my $new_shell = $packet->{'new_shell'}; -#false laziness w/FS::ClientAPI::MyAccount::login (needs to handle encrypted pw) - my $svc_acct = - ( length($old_password) < 13 - && qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, - #'domsvc' => $svc_domain->svcnum, - '_password' => $old_password } ) - ) - || qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, - #'domsvc' => $svc_domain->svcnum, - '_password' => $old_password } ); - - unless ( $svc_acct ) { return { error => 'Incorrect password.' } } + #false laziness w/FS::ClientAPI::MyAccount::login + + my $svc_acct = qsearchs( 'svc_acct', { 'username' => $packet->{'username'}, + 'domsvc' => $svc_domain->svcnum, } + ); + return { error => 'User not found.' } unless $svc_acct; + return { error => 'Incorrect password.' } + unless $svc_acct->check_password($old_password); my %hash = $svc_acct->hash; my $new_svc_acct = new FS::svc_acct ( \%hash ); diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index dbdb7d760..5bf4ec706 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -108,6 +108,22 @@ sub exists { -e "$dir/$file"; } +=item config_orbase KEY SUFFIX + +Returns the configuration value or values (depending on context) for +KEY_SUFFIX, if it exists, otherwise for KEY + +=cut + +sub config_orbase { + my( $self, $file, $suffix ) = @_; + if ( $self->exists("${file}_$suffix") ) { + $self->config("${file}_$suffix"); + } else { + $self->config($file); + } +} + =item touch KEY Creates the specified configuration key if it does not exist. @@ -197,6 +213,18 @@ sub config_items { 'type' => 'textarea', } } glob($self->dir. '/invoice_latex_*') + ), + ( map { + my $basename = basename($_); + $basename =~ /^(.*)$/; + $basename = $1; + new FS::ConfItem { + 'key' => $basename, + 'section' => 'billing', + 'description' => 'Alternate Notes section for LaTeX typeset PostScript invoices. See the <a href="../docs/billing.html">billing documentation</a> for details.', + 'type' => 'textarea', + } + } glob($self->dir. '/invoice_latexnotes_*') ); } @@ -358,6 +386,13 @@ httemplate/docs/config.html }, { + 'key' => 'unapplycredits', + 'section' => 'UI', + 'description' => 'Enable "unapplication" of unclosed credits.', + 'type' => 'checkbox', + }, + + { 'key' => 'dirhash', 'section' => 'shell', 'description' => 'Optional numeric value to control directory hashing. If positive, hashes directories for the specified number of levels from the front of the username. If negative, hashes directories for the specified number of levels from the end of the username. Some examples: <ul><li>1: user -> <a href="#home">/home</a>/u/user<li>2: user -> <a href="#home">/home</a>/u/s/user<li>-1: user -> <a href="#home">/home</a>/r/user<li>-2: user -> <a href="#home">home</a>/r/e/user</ul>', @@ -497,12 +532,19 @@ httemplate/docs/config.html 'type' => 'textarea', }, + { + 'key' => 'invoice_latexsmallfooter', + 'section' => 'billing', + 'description' => 'Optional small footer for multi-page LaTeX typeset PostScript invoices.', + 'type' => 'textarea', + }, + { 'key' => 'invoice_default_terms', 'section' => 'billing', 'description' => 'Optional default invoice term, used to calculate a due date printed on invoices.', 'type' => 'select', - 'select_enum' => [ '', 'Payable upon receipt', 'Net 10', 'Net 15', 'Net 30', 'Net 45', 'Net 60' ], + 'select_enum' => [ '', 'Payable upon receipt', 'Net 0', 'Net 10', 'Net 15', 'Net 30', 'Net 45', 'Net 60' ], }, { @@ -595,6 +637,20 @@ httemplate/docs/config.html }, { + 'key' => 'password-noampersand', + 'section' => 'password', + 'description' => 'Disallow ampersands in passwords', + 'type' => 'checkbox', + }, + + { + 'key' => 'password-noexclamation', + 'section' => 'password', + 'description' => 'Disallow exclamations in passwords (Not setting this could break old text Livingston or Cistron Radius servers)', + 'type' => 'checkbox', + }, + + { 'key' => 'qmailmachines', 'section' => 'deprecated', 'description' => '<b>DEPRECATED</b>, add <i>qmail</i> and <i>shellcommands</i> <a href="../browse/part_export.cgi">exports</a> instead. This option used to export `/var/qmail/control/virtualdomains\', `/var/qmail/control/recipientmap\', and `/var/qmail/control/rcpthosts\'. Setting this option (even if empty) also turns on user `.qmail-extension\' file maintenance in conjunction with the <b>shellmachine</b> option.', @@ -623,8 +679,8 @@ httemplate/docs/config.html { 'key' => 'report_template', - 'section' => 'required', - 'description' => 'Required template file for reports. See the <a href="../docs/billing.html">billing documentation</a> for details.', + 'section' => 'deprecated', + 'description' => 'Deprecated template file for reports.', 'type' => 'textarea', }, @@ -927,6 +983,13 @@ httemplate/docs/config.html }, { + 'key' => 'legacy_link-steal', + 'section' => 'UI', + 'description' => 'Allow "stealing" an already-audited service from one customer (or package) to another using the link function.', + 'type' => 'checkbox', + }, + + { 'key' => 'queue_dangerous_controls', 'section' => 'UI', 'description' => 'Enable queue modification controls on account pages and for new jobs. Unless you are a developer working on new export code, you should probably leave this off to avoid causing provisioning problems.', @@ -1001,7 +1064,7 @@ httemplate/docs/config.html { 'key' => 'signup_server-realtime', 'section' => '', - 'description' => 'Run billing for signup server signups immediately, and suspend accounts which subsequently have a balance.', + 'description' => 'Run billing for signup server signups immediately, and do not provision accounts which subsequently have a balance.', 'type' => 'checkbox', }, @@ -1171,6 +1234,36 @@ httemplate/docs/config.html 'description' => 'A list of system usernames that cannot be edited or removed, one per line. Use a bare username to prohibit modification/deletion of the username in any domain, or username@domain to prohibit modification/deletetion of a specific username and domain.', 'type' => 'textarea', }, + + { + 'key' => 'disable_autoreverse', + 'section' => 'BIND', + 'description' => 'Disable automatic synchronization of reverse-ARPA entries.', + 'type' => 'checkbox', + }, + + { + 'key' => 'svc_www-enable_subdomains', + 'section' => '', + 'description' => 'Enable selection of specific subdomains for virtual host creation.', + 'type' => 'checkbox', + }, + + { + 'key' => 'svc_www-usersvc_svcpart', + 'section' => '', + 'description' => 'Allowable service definition svcparts for virtual hosts, one per line.', + 'type' => 'textarea', + }, + + { + 'key' => 'global_unique-username', + 'section' => 'username', + 'description' => 'Global username uniqueness control: none (usual setting - check uniqueness per exports), username (all usernames are globally unique, regardless of domain or exports), or username@domain (all username@domain pairs are globally unique, regardless of exports)', + 'type' => 'select', + 'select_enum' => [ 'none', 'username', 'username@domain' ], + }, + ); 1; diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm index 331de0225..b620c0114 100644 --- a/FS/FS/Record.pm +++ b/FS/FS/Record.pm @@ -9,7 +9,7 @@ use Carp qw(carp cluck croak confess); use File::CounterFile; use Locale::Country; use DBI qw(:sql_types); -use DBIx::DBSchema 0.19; +use DBIx::DBSchema 0.23; use FS::UID qw(dbh checkruid getotaker datasrc driver_name); use FS::SearchCache; use FS::Msgcat qw(gettext); @@ -462,6 +462,8 @@ To make a distinct duplicate of an FS::Record object, you can do: sub hash { my($self) = @_; + confess $self. ' -> hash: Hash attribute is undefined' + unless defined($self->{'Hash'}); %{ $self->{'Hash'} }; } @@ -622,7 +624,24 @@ returns the error, otherwise returns false. =cut sub replace { - my ( $new, $old ) = ( shift, shift ); + my $new = shift; + + my $old; + if ( @_ ) { + $old = shift; + } else { + warn "[debug]$me replace called with no arguments; autoloading old record\n" + if $DEBUG; + my $primary_key = $new->dbdef_table->primary_key; + if ( $primary_key ) { + $old = qsearchs($new->table, { $primary_key => $new->$primary_key() } ) + or croak "can't find ". $new->table. ".$primary_key ". + $new->$primary_key(); + } else { + croak $new->table. " has no primary key; pass old record as argument"; + } + } + warn "[debug]$me $new ->replace $old\n" if $DEBUG; return "Records not in same table!" unless $new->table eq $old->table; @@ -651,7 +670,7 @@ sub replace { $old->getfield($_) eq '' #? "( $_ IS NULL OR $_ = \"\" )" ? ( driver_name =~ /^Pg$/i - ? "$_ IS NULL" + ? "( $_ IS NULL OR $_ = '' ) " : "( $_ IS NULL OR $_ = \"\" )" ) : "$_ = ". _quote($old->getfield($_),$old->table,$_) @@ -792,6 +811,21 @@ sub ut_float { ''; } +=item ut_snumber COLUMN + +Check/untaint signed numeric data (whole numbers). May not be null. If there +is an error, returns the error, otherwise returns false. + +=cut + +sub ut_snumber { + my($self, $field) = @_; + $self->getfield($field) =~ /^(-?)\s*(\d+)$/ + or return "Illegal or empty (numeric) $field: ". $self->getfield($field); + $self->setfield($field, "$1$2"); + ''; +} + =item ut_number COLUMN Check/untaint simple numeric data (whole numbers). May not be null. If there @@ -1014,9 +1048,13 @@ sub ut_zip { $self->getfield($field); $self->setfield($field,$1); } else { - $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/ - or return gettext('illegal_zip'). " $field: ". $self->getfield($field); - $self->setfield($field,$1); + if ( $self->getfield($field) =~ /^\s*$/ ) { + $self->setfield($field,''); + } else { + $self->getfield($field) =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/ + or return gettext('illegal_zip'). " $field: ". $self->getfield($field); + $self->setfield($field,$1); + } } ''; } diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm index f56ba3915..04b9620e2 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -16,7 +16,7 @@ use FS::Conf; @ISA = qw(Exporter); @EXPORT_OK = qw(checkeuid checkruid cgisuidsetup adminsuidsetup forksuidsetup - getotaker dbh datasrc getsecrets driver_name ); + getotaker dbh datasrc getsecrets driver_name myconnect ); $freeside_uid = scalar(getpwnam('freeside')); @@ -84,11 +84,8 @@ sub forksuidsetup { $ENV{'BASH_ENV'} = ''; croak "Not running uid freeside!" unless checkeuid(); - getsecrets; - $dbh = DBI->connect($datasrc,$db_user,$db_pass, { - 'AutoCommit' => 0, - 'ChopBlanks' => 1, - } ) or die "DBI->connect error: $DBI::errstr\n"; + + $dbh = &myconnect; foreach ( keys %callback ) { &{$callback{$_}}; @@ -100,6 +97,11 @@ sub forksuidsetup { $dbh; } +sub myconnect { + $dbh = DBI->connect( getsecrets, {'AutoCommit' => 0, 'ChopBlanks' => 1, } ) + or die "DBI->connect error: $DBI::errstr\n"; +} + =item install_callback A package can install a callback to be run in adminsuidsetup by passing diff --git a/FS/FS/agent.pm b/FS/FS/agent.pm index 9b7492d07..f77c59362 100644 --- a/FS/FS/agent.pm +++ b/FS/FS/agent.pm @@ -167,10 +167,6 @@ sub pkgpart_hashref { =back -=head1 VERSION - -$Id: agent.pm,v 1.3.4.2 2003-09-30 15:01:42 ivan Exp $ - =head1 BUGS =head1 SEE ALSO diff --git a/FS/FS/agent_type.pm b/FS/FS/agent_type.pm index 988533ae3..6afcc3ea5 100644 --- a/FS/FS/agent_type.pm +++ b/FS/FS/agent_type.pm @@ -148,10 +148,6 @@ sub pkgpart { =back -=head1 VERSION - -$Id: agent_type.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ - =head1 BUGS =head1 SEE ALSO diff --git a/FS/FS/cust_bill.pm b/FS/FS/cust_bill.pm index 3f4166d4e..038ed69b4 100644 --- a/FS/FS/cust_bill.pm +++ b/FS/FS/cust_bill.pm @@ -13,6 +13,8 @@ use Date::Format; use Mail::Internet 1.44; use Mail::Header; use Text::Template; +use File::Temp 0.14; +use String::ShellQuote; use FS::UID qw( datasrc ); use FS::Record qw( qsearch qsearchs ); use FS::cust_main; @@ -382,15 +384,23 @@ sub owed { $balance; } -=item send +=item send [ TEMPLATENAME [ , AGENTNUM ] ] Sends this invoice to the destinations configured for this customer: send emails or print. See L<FS::cust_main_invoice>. +TEMPLATENAME, if specified, is the name of a suffix for alternate invoices. + +AGENTNUM, if specified, means that this invoice will only be sent for customers +of the specified agent. + =cut sub send { - my($self,$template) = @_; + my $self = shift; + my $template = scalar(@_) ? shift : ''; + return '' if scalar(@_) && $_[0] && $self->cust_main->agentnum ne shift; + my @print_text = $self->print_text('', $template); my @invoicing_list = $self->cust_main->invoicing_list; @@ -417,9 +427,9 @@ sub send { $!=0; $message->smtpsend( Host => $smtpmachine ) or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or return "(customer # ". $self->custnum. ") can't send invoice email". - " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ). - " via server $smtpmachine with SMTP: $!"; + or die "(customer # ". $self->custnum. ") can't send invoice email". + " to ". join(', ', grep { $_ ne 'POST' } @invoicing_list ). + " via server $smtpmachine with SMTP: $!\n"; } @@ -429,11 +439,11 @@ sub send { if ( grep { $_ eq 'POST' } @invoicing_list ) { #postal open(LPR, "|$lpr") - or return "Can't open pipe to $lpr: $!"; + or die "Can't open pipe to $lpr: $!\n"; print LPR @print_text; close LPR - or return $! ? "Error closing $lpr: $!" - : "Exit status $? from $lpr"; + or die $! ? "Error closing $lpr: $!\n" + : "Exit status $? from $lpr\n"; } ''; @@ -879,15 +889,20 @@ sub realtime_bop { } ); my $error = $cust_pay->insert; if ( $error ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH debited but database not updated - '. - 'error applying payment, invnum #' . $self->invnum. - " ($processor): $error"; - warn $e; - return $e; - } else { - return ''; + $cust_pay->invnum(''); #try again with no specific invnum + my $error2 = $cust_pay->insert; + if ( $error2 ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH debited but database not updated - '. + "error inserting payment ($processor): $error2". + ' (previously tried insert with invnum #' . $self->invnum. + ": $error )"; + warn $e; + return $e; + } } + return ''; #no error + #} elsif ( $options{'report_badcard'} ) { } else { @@ -896,7 +911,7 @@ sub realtime_bop { if ( !$realtime_bop_decline_quiet && $conf->exists('emaildecline') && grep { $_ ne 'POST' } $cust_main->invoicing_list - && ! grep { $_ eq $transaction->error_message } + && ! grep { $transaction->error_message =~ /$_/ } $conf->config('emaildecline-exclude') ) { my @templ = $conf->config('declinetemplate'); @@ -1048,6 +1063,31 @@ sub batch_card { ''; } +sub _agent_template { + my $self = shift; + + my $cust_bill_event = qsearchs( 'part_bill_event', + { + 'payby' => $self->cust_main->payby, + 'plan' => 'send_agent', + 'eventcode' => { 'op' => 'LIKE', + 'value' => '_%, '. $self->cust_main->agentnum. ');' }, + }, + '', + 'ORDER BY seconds LIMIT 1' + ); + + return '' unless $cust_bill_event; + + if ( $cust_bill_event->eventcode =~ /\(\s*'(.*)'\s*,\s*(\d+)\s*\)\;$/ ) { + return $1; + } else { + warn "can't parse eventcode for agent-specific invoice template"; + return ''; + } + +} + =item print_text [ TIME [ , TEMPLATE ] ] Returns an text invoice, as a list of lines. @@ -1190,10 +1230,11 @@ sub print_text { sprintf("%10.2f", $balance_due ) ]; #create the template + $template ||= $self->_agent_template; my $templatefile = 'invoice_template'; - $templatefile .= "_$template" if $template; + $templatefile .= "_$template" if length($template); my @invoice_template = $conf->config($templatefile) - or die "cannot load config file $templatefile"; + or die "cannot load config file $templatefile"; $invoice_lines = 0; my $wasfunc = 0; foreach ( grep /invoice_lines\(\d*\)/, @invoice_template ) { #kludgy @@ -1280,9 +1321,12 @@ sub print_text { } -=item print_ps [ TIME [ , TEMPLATE ] ] +=item print_latex [ TIME [ , TEMPLATE ] ] -Returns an postscript invoice, as a scalar. +Internal method - returns a filename of a filled-in LaTeX template for this +invoice (Note: add ".tex" to get the actual filename). + +See print_ps and print_pdf for methods that return PostScript and PDF output. TIME an optional value used to control the printing of overdue messages. The default is now. It isn't the date of the invoice; that's the `_date' field. @@ -1292,7 +1336,7 @@ L<Time::Local> and L<Date::Parse> for conversion functions. =cut #still some false laziness w/print_text -sub print_ps { +sub print_latex { my( $self, $today, $template ) = @_; $today ||= time; @@ -1312,8 +1356,10 @@ sub print_ps { @buf = (); #create the template + $template ||= $self->_agent_template; my $templatefile = 'invoice_latex'; - $templatefile .= "_$template" if $template; + my $suffix = length($template) ? "_$template" : ''; + $templatefile .= $suffix; my @invoice_template = $conf->config($templatefile) or die "cannot load config file $templatefile"; @@ -1330,17 +1376,26 @@ sub print_ps { 'zip' => _latex_escape($cust_main->zip), 'country' => _latex_escape($cust_main->country), 'footer' => join("\n", $conf->config('invoice_latexfooter') ), + 'smallfooter' => join("\n", $conf->config('invoice_latexsmallfooter') ), 'quantity' => 1, 'terms' => $conf->config('invoice_default_terms') || 'Payable upon receipt', - 'notes' => join("\n", $conf->config('invoice_latexnotes') ), + #'notes' => join("\n", $conf->config('invoice_latexnotes') ), ); - $invoice_data{'footer'} =~ s/\n+$//; - $invoice_data{'notes'} =~ s/\n+$//; - my $countrydefault = $conf->config('countrydefault') || 'US'; $invoice_data{'country'} = '' if $invoice_data{'country'} eq $countrydefault; + #do variable substitutions in notes + $invoice_data{'notes'} = + join("\n", + map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b } + $conf->config_orbase('invoice_latexnotes', $suffix) + ); + + $invoice_data{'footer'} =~ s/\n+$//; + $invoice_data{'smallfooter'} =~ s/\n+$//; + $invoice_data{'notes'} =~ s/\n+$//; + $invoice_data{'po_line'} = ( $cust_main->payby eq 'BILL' && $cust_main->payinfo ) ? _latex_escape("Purchase Order #". $cust_main->payinfo) @@ -1452,27 +1507,53 @@ sub print_ps { $var; } - my $dir = '/tmp'; #! /usr/local/etc/freeside/invoices.datasrc/ - my $unique = int(rand(2**31)); #UGH... use File::Temp or something + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + my $fh = new File::Temp( TEMPLATE => 'invoice.'. $self->invnum. '.XXXXXXXX', + DIR => $dir, + SUFFIX => '.tex', + UNLINK => 0, + ) or die "can't open temp file: $!\n"; + print $fh join("\n", @filled_in ), "\n"; + close $fh; + + $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename; + return $1; + +} + +=item print_ps [ TIME [ , TEMPLATE ] ] +Returns an postscript invoice, as a scalar. + +TIME an optional value used to control the printing of overdue messages. The +default is now. It isn't the date of the invoice; that's the `_date' field. +It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see +L<Time::Local> and L<Date::Parse> for conversion functions. + +=cut + +sub print_ps { + my $self = shift; + + my $file = $self->print_latex(@_); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; chdir($dir); - my $file = $self->invnum. ".$unique"; - open(TEX,">$file.tex") or die "can't open $file.tex: $!\n"; - print TEX join("\n", @filled_in ), "\n"; - close TEX; + my $sfile = shell_quote $file; + + system("pslatex $sfile.tex >/dev/null 2>&1") == 0 + or die "pslatex $file.tex failed; see $file.log for details?\n"; + system("pslatex $sfile.tex >/dev/null 2>&1") == 0 + or die "pslatex $file.tex failed; see $file.log for details?\n"; - #error checking!! - system('pslatex', "$file.tex"); - system('pslatex', "$file.tex"); - #system('dvips', '-t', 'letter', "$file.dvi", "$file.ps"); - system('dvips', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ); + system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" ) == 0 + or die "dvips failed"; - open(POSTSCRIPT, "<$file.ps") or die "can't open $file.ps (probable error in LaTeX template): $!\n"; + open(POSTSCRIPT, "<$file.ps") + or die "can't open $file.ps: $! (error in LaTeX template?)\n"; - #rm $file.dvi $file.log $file.aux - #unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps"); - unlink("$file.dvi", "$file.log", "$file.aux"); + unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex"); my $ps = ''; while (<POSTSCRIPT>) { @@ -1485,7 +1566,61 @@ sub print_ps { } -# quick subroutine for print_ps +=item print_pdf [ TIME [ , TEMPLATE ] ] + +Returns an PDF invoice, as a scalar. + +TIME an optional value used to control the printing of overdue messages. The +default is now. It isn't the date of the invoice; that's the `_date' field. +It is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see +L<Time::Local> and L<Date::Parse> for conversion functions. + +=cut + +sub print_pdf { + my $self = shift; + + my $file = $self->print_latex(@_); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + chdir($dir); + + #system('pdflatex', "$file.tex"); + #system('pdflatex', "$file.tex"); + #! LaTeX Error: Unknown graphics extension: .eps. + + my $sfile = shell_quote $file; + + system("pslatex $sfile.tex >/dev/null 2>&1") == 0 + or die "pslatex $file.tex failed: $!"; + system("pslatex $sfile.tex >/dev/null 2>&1") == 0 + or die "pslatex $file.tex failed: $!"; + + #system('dvipdf', "$file.dvi", "$file.pdf" ); + system( + "dvips -q -t letter -f $sfile.dvi ". + "| gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$sfile.pdf ". + " -c save pop -" + ) == 0 + or die "dvips | gs failed: $!"; + + open(PDF, "<$file.pdf") + or die "can't open $file.pdf: $! (error in LaTeX template?)\n"; + + unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex"); + + my $pdf = ''; + while (<PDF>) { + $pdf .= $_; + } + + close PDF; + + return $pdf; + +} + +# quick subroutine for print_latex # # There are ten characters that LaTeX treats as special characters, which # means that they do not simply typeset themselves: @@ -1583,20 +1718,31 @@ sub _items_cust_bill_pkg { my $part_pkg = qsearchs('part_pkg', { pkgpart=>$cust_pkg->pkgpart } ); my $pkg = $part_pkg->pkg; + my %labels; + #tie %labels, 'Tie::IxHash'; + push @{ $labels{$_->[0]} }, $_->[1] foreach $cust_pkg->labels; + my @ext_description; + foreach my $label ( keys %labels ) { + my @values = @{ $labels{$label} }; + my $num = scalar(@values); + if ( $num > 5 ) { + push @ext_description, "$label ($num)"; + } else { + push @ext_description, map { "$label: $_" } @values; + } + } + if ( $cust_bill_pkg->setup != 0 ) { my $description = $pkg; $description .= ' Setup' if $cust_bill_pkg->recur != 0; - my @d = (); - @d = $cust_bill_pkg->details if $cust_bill_pkg->recur == 0; + my @d = @ext_description; + push @d, $cust_bill_pkg->details if $cust_bill_pkg->recur == 0; push @b, { 'description' => $description, #'pkgpart' => $part_pkg->pkgpart, 'pkgnum' => $cust_pkg->pkgnum, 'amount' => sprintf("%10.2f", $cust_bill_pkg->setup), - 'ext_description' => [ ( map { $_->[0]. ": ". $_->[1] } - $cust_pkg->labels ), - @d, - ], + 'ext_description' => \@d, }; } @@ -1608,8 +1754,7 @@ sub _items_cust_bill_pkg { #'pkgpart' => $part_pkg->pkgpart, 'pkgnum' => $cust_pkg->pkgnum, 'amount' => sprintf("%10.2f", $cust_bill_pkg->recur), - 'ext_description' => [ ( map { $_->[0]. ": ". $_->[1] } - $cust_pkg->labels ), + 'ext_description' => [ @ext_description, $cust_bill_pkg->details, ], }; @@ -1660,7 +1805,7 @@ sub _items_credits { #'description' => 'Credit ref\#'. $_->crednum. # " (". time2str("%x",$_->cust_credit->_date) .")". # $reason, - 'description' => 'Credit applied'. + 'description' => 'Credit applied '. time2str("%x",$_->cust_credit->_date). $reason, 'amount' => sprintf("%10.2f",$_->amount), }; @@ -1705,9 +1850,6 @@ The delete method. print_text formatting (and some logic :/) is in source, but needs to be slurped in from a file. Also number of lines ($=). -missing print_ps for a nice postscript copy (maybe HylaFAX-cover-page-style -or something similar so the look can be completely customized?) - =head1 SEE ALSO L<FS::Record>, L<FS::cust_main>, L<FS::cust_bill_pay>, L<FS::cust_pay>, diff --git a/FS/FS/cust_bill_pkg.pm b/FS/FS/cust_bill_pkg.pm index 72f9ce4a9..0f27a8d5e 100644 --- a/FS/FS/cust_bill_pkg.pm +++ b/FS/FS/cust_bill_pkg.pm @@ -138,10 +138,6 @@ sub cust_pkg { =back -=head1 VERSION - -$Id: cust_bill_pkg.pm,v 1.3 2002-04-06 22:32:43 ivan Exp $ - =head1 BUGS =head1 SEE ALSO diff --git a/FS/FS/cust_credit_refund.pm b/FS/FS/cust_credit_refund.pm index cc3b32cdb..85187c38a 100644 --- a/FS/FS/cust_credit_refund.pm +++ b/FS/FS/cust_credit_refund.pm @@ -183,10 +183,6 @@ sub cust_credit { =back -=head1 VERSION - -$Id: cust_credit_refund.pm,v 1.9 2002-01-26 01:52:31 ivan Exp $ - =head1 BUGS Delete and replace methods. diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 417937a24..011308ca0 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,7 +1,7 @@ package FS::cust_main; use strict; -use vars qw( @ISA $conf $Debug $import ); +use vars qw( @ISA $conf $DEBUG $import ); use Safe; use Carp; BEGIN { @@ -38,8 +38,8 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::Record ); -$Debug = 0; -#$Debug = 1; +$DEBUG = 0; +#$DEBUG = 1; $import = 0; @@ -223,10 +223,16 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); -Currently available options are: I<noexport> +Currently available options are: I<depend_jobnum> and I<noexport>. -If I<noexport> is set true, no provisioning jobs (exports) are scheduled. -(You can schedule them later with the B<reexport> method.) +If I<depend_jobnum> is set, all provisioning jobs will have a dependancy +on the supplied jobnum (they will not run until the specific job completes). +This can be used to defer provisioning until some action completes (such +as running the customer's credit card sucessfully). + +The I<noexport> option is deprecated. If I<noexport> is set true, no +provisioning jobs (exports) are scheduled. (You can schedule them later with +the B<reexport> method.) =cut @@ -235,6 +241,9 @@ sub insert { my $cust_pkgs = @_ ? shift : {}; my $invoicing_list = @_ ? shift : ''; my %options = @_; + warn "FS::cust_main::insert called with options ". + join(', ', map { "$_: $options{$_}" } keys %options ). "\n" + if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -286,7 +295,6 @@ sub insert { } # packages - #local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -321,7 +329,7 @@ sub insert { } -=item order_pkgs HASHREF, [ , OPTION => VALUE ... ] ] +=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] Like the insert method on an existing record, this method orders a package and included services atomicaly. Pass a Tie::RefHash data structure to this @@ -334,14 +342,20 @@ be a better explanation of this, but until then, here's an example: $cust_pkg => [ $svc_acct ], ... ); - $cust_main->order_pkgs( \%hash, 'noexport'=>1 ); + $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); + +Currently available options are: I<depend_jobnum> and I<noexport>. -Currently available options are: I<noexport> +If I<depend_jobnum> is set, all provisioning jobs will have a dependancy +on the supplied jobnum (they will not run until the specific job completes). +This can be used to defer provisioning until some action completes (such +as running the customer's credit card sucessfully). -If I<noexport> is set true, no provisioning jobs (exports) are scheduled. -(You can schedule them later with the B<reexport> method for each -cust_pkg object. Using the B<reexport> method on the cust_main object is not -recommended, as existing services will also be reexported.) +The I<noexport> option is deprecated. If I<noexport> is set true, no +provisioning jobs (exports) are scheduled. (You can schedule them later with +the B<reexport> method for each cust_pkg object. Using the B<reexport> method +on the cust_main object is not recommended, as existing services will also be +reexported.) =cut @@ -350,6 +364,12 @@ sub order_pkgs { my $cust_pkgs = shift; my $seconds = shift; my %options = @_; + my %svc_options = (); + $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} + if exists $options{'depend_jobnum'}; + warn "FS::cust_main::order_pkgs called with options ". + join(', ', map { "$_: $options{$_}" } keys %options ). "\n" + if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -377,7 +397,7 @@ sub order_pkgs { $svc_something->seconds( $svc_something->seconds + $$seconds ); $$seconds = 0; } - $error = $svc_something->insert; + $error = $svc_something->insert(%svc_options); if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "inserting svc_ (transaction rolled back): $error"; @@ -392,6 +412,9 @@ sub order_pkgs { =item reexport +This method is deprecated. See the I<depend_jobnum> option to the insert and +order_pkgs methods for a better way to defer provisioning. + Re-schedules all exports by calling the B<reexport> method of all associated packages (see L<FS::cust_pkg>). If there is an error, returns the error; otherwise returns false. @@ -401,6 +424,9 @@ otherwise returns false. sub reexport { my $self = shift; + carp "warning: FS::cust_main::reexport is deprectated; ". + "use the depend_jobnum option to insert or order_pkgs to delay export"; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -986,6 +1012,38 @@ sub suspend { grep { $_->suspend } $self->unsuspended_pkgs; } +=item suspend_if_pkgpart PKGPART [ , PKGPART ... ] + +Suspends all unsuspended packages (see L<FS::cust_pkg>) matching the listed +PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list on +success or a list of errors. + +=cut + +sub suspend_if_pkgpart { + my $self = shift; + my @pkgparts = @_; + grep { $_->suspend } + grep { my $pkgpart = $_->pkgpart; grep { $pkgpart eq $_ } @pkgparts } + $self->unsuspended_pkgs; +} + +=item suspend_unless_pkgpart PKGPART [ , PKGPART ... ] + +Suspends all unsuspended packages (see L<FS::cust_pkg>) unless they match the +listed PKGPARTs (see L<FS::part_pkg>). Always returns a list: an empty list +on success or a list of errors. + +=cut + +sub suspend_unless_pkgpart { + my $self = shift; + my @pkgparts = @_; + grep { $_->suspend } + grep { my $pkgpart = $_->pkgpart; ! grep { $pkgpart eq $_ } @pkgparts } + $self->unsuspended_pkgs; +} + =item cancel [ OPTION => VALUE ... ] Cancels all uncancelled packages (see L<FS::cust_pkg>) for this customer. @@ -1000,7 +1058,7 @@ Always returns a list: an empty list on success or a list of errors. sub cancel { my $self = shift; - grep { $_->cancel(@_) } $self->ncancelled_pkgs; + grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs; } =item agent @@ -1040,6 +1098,7 @@ If there is an error, returns the error, otherwise returns false. sub bill { my( $self, %options ) = @_; + return '' if $self->payby eq 'COMP'; my $time = $options{'time'} || time; my $error; @@ -1056,6 +1115,8 @@ sub bill { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + $self->select_for_update; #mutex + # find the packages which are due for billing, find out how much they are # & generate invoice database. @@ -1453,8 +1514,10 @@ sub collect { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + $self->select_for_update; #mutex + my $balance = $self->balance; - warn "collect customer". $self->custnum. ": balance $balance" if $Debug; + warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -1480,14 +1543,14 @@ sub collect { last if $self->balance <= 0; warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")" - if $Debug; + if $DEBUG; foreach my $part_bill_event ( sort { $a->seconds <=> $b->seconds || $a->weight <=> $b->weight || $a->eventpart <=> $b->eventpart } grep { $_->seconds <= ( $invoice_time - $cust_bill->_date ) - && ! qsearchs( 'cust_bill_event', { + && ! qsearch( 'cust_bill_event', { 'invnum' => $cust_bill->invnum, 'eventpart' => $_->eventpart, 'status' => 'done', @@ -1501,7 +1564,7 @@ sub collect { || $self->balance <= 0; # or if balance<=0 warn "calling invoice event (". $part_bill_event->eventcode. ")\n" - if $Debug; + if $DEBUG; my $cust_main = $self; #for callback my $error; @@ -2146,6 +2209,18 @@ sub cust_refund { qsearch( 'cust_refund', { 'custnum' => $self->custnum } ) } +=item select_for_update + +Selects this record with the SQL "FOR UPDATE" command. This can be useful as +a mutex. + +=cut + +sub select_for_update { + my $self = shift; + qsearch('cust_main', { 'custnum' => $self->custnum }, '*', 'FOR UPDATE' ); +} + =back =head1 SUBROUTINES @@ -2336,7 +2411,7 @@ sub batch_import { my %cust_main = ( agentnum => $agentnum, refnum => $refnum, - country => 'US', #default + country => $conf->config('countrydefault') || 'US', payby => 'BILL', #default paydate => '12/2037', #default ); diff --git a/FS/FS/cust_main_county.pm b/FS/FS/cust_main_county.pm index c124f960b..4ea2199b2 100644 --- a/FS/FS/cust_main_county.pm +++ b/FS/FS/cust_main_county.pm @@ -108,7 +108,7 @@ sub check { $self->exempt_amount(0) unless $self->exempt_amount; $self->ut_numbern('taxnum') - || $self->ut_textn('state') + || $self->ut_anything('state') || $self->ut_textn('county') || $self->ut_text('country') || $self->ut_float('tax') @@ -193,8 +193,9 @@ END foreach my $country ( sort keys %cust_main_county ) { $script_html .= "\nif ( country == \"$country\" ) {\n"; foreach my $state ( sort keys %{$cust_main_county{$country}} ) { - my $text = $state || '(n/a)'; - $script_html .= qq!opt(what.form.${prefix}state, "$state", "$text");\n!; + my( $dstate = $state ) =~ s/\n//g; + my $text = $dstate || '(n/a)'; + $script_html .= qq!opt(what.form.${prefix}state, "$dstate", "$text");\n!; } $script_html .= "}\n"; } diff --git a/FS/FS/cust_main_invoice.pm b/FS/FS/cust_main_invoice.pm index a5533a088..be0e06994 100644 --- a/FS/FS/cust_main_invoice.pm +++ b/FS/FS/cust_main_invoice.pm @@ -168,10 +168,6 @@ sub address { =back -=head1 VERSION - -$Id: cust_main_invoice.pm,v 1.12 2002-04-12 13:22:02 ivan Exp $ - =head1 BUGS =head1 SEE ALSO diff --git a/FS/FS/cust_pay.pm b/FS/FS/cust_pay.pm index 1afd22a43..0eae59f21 100644 --- a/FS/FS/cust_pay.pm +++ b/FS/FS/cust_pay.pm @@ -416,10 +416,6 @@ sub cust_main { =back -=head1 VERSION - -$Id: cust_pay.pm,v 1.21.4.3 2003-09-10 10:54:47 ivan Exp $ - =head1 BUGS Delete and replace methods. diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 923378b7f..a3297ab47 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,7 +1,7 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck); +use vars qw(@ISA $disable_agentcheck $DEBUG); use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearch qsearchs ); use FS::cust_svc; @@ -29,6 +29,8 @@ use Mail::Header; @ISA = qw( FS::Record ); +$DEBUG = 0; + $disable_agentcheck = 0; sub _cache { @@ -460,7 +462,10 @@ sub unsuspend { unless ( ! $self->getfield('susp') ) { my %hash = $self->hash; + my $inactive = time - $hash{'susp'}; $hash{'susp'} = ''; + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive + if $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace($self); if ( $error ) { @@ -483,7 +488,7 @@ Useful for billing metered services. sub last_bill { my $self = shift; - if ( $self->dbdef_table->column('manual_flag') ) { + if ( $self->dbdef_table->column('last_bill') ) { return $self->setfield('last_bill', $_[1]) if @_; return $self->getfield('last_bill') if $self->getfield('last_bill'); } @@ -635,6 +640,9 @@ sub attribute_since_sqlradacct { =item reexport +This method is deprecated. See the I<depend_jobnum> option to the insert and +order_pkgs methods in FS::cust_main for a better way to defer provisioning. + =cut sub reexport { @@ -718,6 +726,12 @@ sub order { push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc; } } + if ( $DEBUG ) { + foreach my $svcpart ( keys %svcnum ) { + warn "initial svcpart $svcpart: existing svcnums ". + join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n"; + } + } my @cust_svc; #generate @cust_svc @@ -731,13 +745,29 @@ sub order { } push @cust_svc, [ map { - ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : (); - } map { $_->svcpart } + my $svcnum = $svcnum{$_->{svcpart}}; + if ( $svcnum && @$svcnum ) { + my $num = ( $_->{quantity} < scalar(@$svcnum) ) + ? $_->{quantity} + : scalar(@$svcnum); + splice @$svcnum, 0, $num; + } else { + (); + } + } map { { 'svcpart' => $_->svcpart, + 'quantity' => $_->quantity } } qsearch('pkg_svc', { pkgpart => $pkgpart, quantity => { op=>'>', value=>'0', } } ) ]; } + if ( $DEBUG ) { + foreach my $svcpart ( keys %svcnum ) { + warn "after regular move svcpart $svcpart: existing svcnums ". + join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n"; + } + } + #special-case until this can be handled better # move services to new svcparts - even if the svcparts don't match (svcdb # needs to...) @@ -774,7 +804,15 @@ sub order { } } - + + if ( $DEBUG ) { + foreach my $svcpart ( keys %svcnum ) { + warn "after special-case move svcpart $svcpart: existing svcnums ". + join(', ', map { $_->svcnum } @{$svcnum{$svcpart}} ). "\n"; + } + } + + #check for leftover services foreach (keys %svcnum) { next unless @{ $svcnum{$_} }; diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm index aa81003b1..fe0652b51 100644 --- a/FS/FS/cust_refund.pm +++ b/FS/FS/cust_refund.pm @@ -44,6 +44,8 @@ inherits from FS::Record. The following fields are currently supported: =item refund - Amount of the refund +=item reason - Reason for the refund + =item _date - specified as a UNIX timestamp; see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion functions. @@ -221,6 +223,7 @@ sub check { $self->ut_numbern('refundnum') || $self->ut_numbern('custnum') || $self->ut_money('refund') + || $self->ut_text('reason') || $self->ut_numbern('_date') || $self->ut_textn('paybatch') || $self->ut_enum('closed', [ '', 'Y' ]) @@ -265,10 +268,6 @@ sub check { =back -=head1 VERSION - -$Id: cust_refund.pm,v 1.18.4.2 2002-11-19 09:52:02 ivan Exp $ - =head1 BUGS Delete and replace methods. diff --git a/FS/FS/cust_svc.pm b/FS/FS/cust_svc.pm index 91874e0d2..a77e44f7c 100644 --- a/FS/FS/cust_svc.pm +++ b/FS/FS/cust_svc.pm @@ -286,10 +286,15 @@ sub label { my $domain = $svc_domain->domain; $tag = "$domuser\@$domain"; } elsif ( $svcdb eq 'svc_forward' ) { - my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->srcsvc } ); - $tag = $svc_acct->email. '->'; + if ( $svc_x->srcsvc ) { + my $svc_acct = $svc_x->srcsvc_acct; + $tag = $svc_acct->email; + } else { + $tag = $svc_x->src; + } + $tag .= '->'; if ( $svc_x->dstsvc ) { - $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $svc_x->dstsvc } ); + my $svc_acct = $svc_x->dstsvc_acct; $tag .= $svc_acct->email; } else { $tag .= $svc_x->dst; @@ -368,13 +373,15 @@ sub seconds_since_sqlradacct { my $seconds = 0; foreach my $part_export ( @part_export ) { + next if $part_export->option('ignore_accounting'); + my $dbh = DBI->connect( map { $part_export->option($_) } qw(datasrc username password) ) or die "can't connect to sqlradius database: ". $DBI::errstr; #select a unix time conversion function based on database type my $str2time; - if ( $dbh->{Driver}->{Name} eq 'mysql' ) { + if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) { $str2time = 'UNIX_TIMESTAMP('; } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { $str2time = 'EXTRACT( EPOCH FROM '; @@ -484,13 +491,15 @@ sub attribute_since_sqlradacct { foreach my $part_export ( @part_export ) { + next if $part_export->option('ignore_accounting'); + my $dbh = DBI->connect( map { $part_export->option($_) } qw(datasrc username password) ) or die "can't connect to sqlradius database: ". $DBI::errstr; #select a unix time conversion function based on database type my $str2time; - if ( $dbh->{Driver}->{Name} eq 'mysql' ) { + if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) { $str2time = 'UNIX_TIMESTAMP('; } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { $str2time = 'EXTRACT( EPOCH FROM '; @@ -553,7 +562,7 @@ sub get_session_history { #select a unix time conversion function based on database type my $str2time; - if ( $dbh->{Driver}->{Name} eq 'mysql' ) { + if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) { $str2time = 'UNIX_TIMESTAMP('; } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) { $str2time = 'EXTRACT( EPOCH FROM '; diff --git a/FS/FS/domain_record.pm b/FS/FS/domain_record.pm index dd16675fb..4dfa5b6fd 100644 --- a/FS/FS/domain_record.pm +++ b/FS/FS/domain_record.pm @@ -1,7 +1,8 @@ package FS::domain_record; use strict; -use vars qw( @ISA $noserial_hack ); +use vars qw( @ISA $noserial_hack $DEBUG ); +use FS::Conf; #use FS::Record qw( qsearch qsearchs ); use FS::Record qw( qsearchs dbh ); use FS::svc_domain; @@ -9,6 +10,8 @@ use FS::svc_www; @ISA = qw(FS::Record); +$DEBUG = 1; + =head1 NAME FS::domain_record - Object methods for domain_record records @@ -110,6 +113,18 @@ sub insert { } } + my $conf = new FS::Conf; + if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) { + my $reverse = $self->reverse_record; + if ( $reverse && ! $reverse->recnum ) { + my $error = $reverse->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error adding corresponding reverse-ARPA record: $error"; + } + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -153,6 +168,18 @@ sub delete { } } + my $conf = new FS::Conf; + if ( $self->rectype =~ /^A$/ && ! $conf->exists('disable_autoreverse') ) { + my $reverse = $self->reverse_record; + if ( $reverse && $reverse->recnum && $reverse->recdata eq $self->zone.'.' ){ + my $error = $reverse->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error removing corresponding reverse-ARPA record: $error"; + } + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -241,7 +268,7 @@ sub check { if ( $self->rectype eq 'SOA' ) { my $recdata = $self->recdata; $recdata =~ s/\s+/ /g; - $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( (\d+ ){5}\))$/i + $recdata =~ /^([a-z0-9\.\-]+ [\w\-\+]+\.[a-z0-9\.\-]+ \( ((\d+|((\d+[WDHMS])+)) ){5}\))$/i or return "Illegal data for SOA record: $recdata"; $self->recdata($1); } elsif ( $self->rectype eq 'NS' ) { @@ -284,10 +311,16 @@ sub increment_serial { my $soa = qsearchs('domain_record', { svcnum => $self->svcnum, - reczone => '@', #or full domain ? + reczone => '@', + recaf => 'IN', + rectype => 'SOA', } ) + || qsearchs('domain_record', { + svcnum => $self->svcnum, + reczone => $self->svc_domain->domain.'.', recaf => 'IN', rectype => 'SOA', - } ) or return "soa record not found; can't increment serial"; + } ) + or return "soa record not found; can't increment serial"; my $data = $soa->recdata; $data =~ s/(\(\D*)(\d+)/$1.($2+1)/e; #well, it works. @@ -328,11 +361,44 @@ sub zone { $zone; } -=back +=item reverse_record + +Returns the corresponding reverse-ARPA record as another FS::domain_record +object. If the specific record does not exist in the database but the +reverse-ARPA zone itself does, an appropriate new record is created. If no +reverse-ARPA zone is available at all, returns false. + +(You can test whether or not record itself exists in the database or is a new +object that might need to be inserted by checking the recnum field) -=head1 VERSION +Mostly used by the insert and delete methods - probably should see them for +examples. -$Id: domain_record.pm,v 1.11.4.2 2003-03-29 04:52:35 ivan Exp $ +=cut + +sub reverse_record { + my $self = shift; + warn "reverse_record called\n" if $DEBUG; + #should support classless reverse-ARPA ala rfc2317 too + $self->recdata =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ + or return ''; + my $domain = "$3.$2.$1.in-addr.arpa"; + my $ptr_reczone = $4; + warn "reverse_record: searching for domain: $domain\n" if $DEBUG; + my $svc_domain = qsearchs('svc_domain', { 'domain' => $domain } ) + or return ''; + warn "reverse_record: found domain: $domain\n" if $DEBUG; + my %hash = ( + 'svcnum' => $svc_domain->svcnum, + 'reczone' => $ptr_reczone, + 'recaf' => 'IN', + 'rectype' => 'PTR', + ); + qsearchs('domain_record', \%hash ) + or new FS::domain_record { %hash, 'recdata' => $self->zone.'.' }; +} + +=back =head1 BUGS diff --git a/FS/FS/export_svc.pm b/FS/FS/export_svc.pm index da9ac698a..a212949c9 100644 --- a/FS/FS/export_svc.pm +++ b/FS/FS/export_svc.pm @@ -2,7 +2,7 @@ package FS::export_svc; use strict; use vars qw( @ISA ); -use FS::Record qw( qsearch qsearchs ); +use FS::Record qw( qsearch qsearchs dbh ); use FS::part_export; use FS::part_svc; @@ -67,7 +67,144 @@ otherwise returns false. =cut -# the insert method can be inherited from FS::Record +sub insert { + my $self = shift; + my $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; + + $error = $self->check; + return $error if $error; + + #check for duplicates! + my @checks = (); + my $svcdb = $self->part_svc->svcdb; + if ( $svcdb eq 'svc_acct' ) { + + if ( $self->part_export->nodomain =~ /^Y/i ) { + push @checks, { + label => 'usernames', + method => 'username', + sortby => sub { $a cmp $b }, + }; + } else { + push @checks, { + label => 'username@domain', + method => 'email', + sortby => sub { + my($auser, $adomain) = split('@', $a); + my($buser, $bdomain) = split('@', $b); + $adomain cmp $bdomain || $auser cmp $buser; + }, + }; + } + + unless ( $self->part_svc->part_svc_column('uid')->columnflag eq 'F' ) { + push @checks, { + label => 'uids', + method => 'uid', + sortby => sub { $a <=> $b }, + }; + } + + } elsif ( $svcdb eq 'svc_domain' ) { + push @checks, { + label => 'domains', + method => 'domain', + sortby => sub { $a cmp $b }, + }; + } else { + warn "WARNING: No duplicate checking done on merge of $svcdb exports"; + } + + foreach my $check ( @checks ) { + my @current_svc = $self->part_export->svc_x; + #warn "current: ". scalar(@current_svc). " $current_svc[0]\n"; + my @new_svc = $self->part_svc->svc_x; + #warn "new: ". scalar(@new_svc). " $new_svc[0]\n"; + my $method = $check->{'method'}; + my %cur_svc = map { $_->$method() => $_ } @current_svc; + my @dup_svc = grep { $cur_svc{$_->$method()} } @new_svc; + #my @diff_customer = grep { + # $_->cust_pkg->custnum != $cur_svc{$_->$method()}->cust_pkg->custnum + # } @dup_svc; + + + + if ( @dup_svc ) { #aye, that's the rub + #error out for now, eventually accept different options of adjustments + # to make to allow us to continue forward + $dbh->rollback if $oldAutoCommit; + + my @diff_customer_svc = grep { + my $cust_pkg = $_->cust_svc->cust_pkg; + my $custnum = $cust_pkg ? $cust_pkg->custnum : 0; + my $other_cust_pkg = $cur_svc{$_->$method()}->cust_svc->cust_pkg; + my $other_custnum = $other_cust_pkg ? $other_cust_pkg->custnum : 0; + $custnum != $other_custnum; + } @dup_svc; + + my $label = $check->{'label'}; + my $sortby = $check->{'sortby'}; + return "Can't export ". + $self->part_svc->svcpart.':'.$self->part_svc->svc. " service to ". + $self->part_export->exportnum.':'.$self->part_export->exporttype. + ' on '. $self->part_export->machine. + ' : '. scalar(@dup_svc). " duplicate $label". + ' ('. scalar(@diff_customer_svc). " from different customers)". + #": ". join(', ', sort $sortby map { $_->$method() } @dup_svc ) + ": ". join(', ', sort $sortby map { $_->$method() } @diff_customer_svc ) + ; + } + } + + #end of duplicate check, whew + + $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + +# if ( $self->part_svc->svcdb eq 'svc_acct' ) { +# +# if ( $self->part_export->nodomain =~ /^Y/i ) { +# +# select username from svc_acct where svcpart = $svcpart +# group by username having count(*) > 1; +# +# } else { +# +# select username, domain +# from svc_acct +# join svc_domain on ( svc_acct.domsvc = svc_domain.svcnum ) +# group by username, domain having count(*) > 1; +# +# } +# +# } elsif ( $self->part_svc->svcdb eq 'svc_domain' ) { +# +# #similar but easier domain checking one +# +# } #etc.? +# +# my @services = +# map { $_->part_svc } +# grep { $_->svcpart != $self->svcpart } +# $self->part_export->export_svc; + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error +} =item delete @@ -108,6 +245,28 @@ sub check { ; } +=item part_export + +Returns the FS::part_export object (see L<FS::part_export>). + +=cut + +sub part_export { + my $self = shift; + qsearchs( 'part_export', { 'exportnum' => $self->exportnum } ); +} + +=item part_svc + +Returns the FS::part_svc object (see L<FS::part_svc>). + +=cut + +sub part_svc { + my $self = shift; + qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } ); +} + =back =head1 BUGS diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm index 58c6827ea..5a1df5239 100644 --- a/FS/FS/nas.pm +++ b/FS/FS/nas.pm @@ -134,10 +134,6 @@ sub heartbeat { =back -=head1 VERSION - -$Id: nas.pm,v 1.6 2002-03-04 12:48:49 ivan Exp $ - =head1 BUGS heartbeat method uses SQL directly and doesn't update history tables. diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index f6df02088..f722dd917 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -1,7 +1,7 @@ package FS::part_export; use strict; -use vars qw( @ISA @EXPORT_OK %exports ); +use vars qw( @ISA @EXPORT_OK $DEBUG %exports ); use Exporter; use Tie::IxHash; use FS::Record qw( qsearch qsearchs dbh ); @@ -12,6 +12,8 @@ use FS::export_svc; @ISA = qw(FS::Record); @EXPORT_OK = qw(export_info); +$DEBUG = 0; + =head1 NAME FS::part_export - Object methods for part_export records @@ -303,7 +305,7 @@ sub part_svc { =item svc_x -Returns a list of associate FS::svc_* records. +Returns a list of associated FS::svc_* records. =cut @@ -468,18 +470,22 @@ sub _export_delete { return "_export_delete: unknown export type ". $self->exporttype; } -#fallbacks providing null operations +#call svcdb-specific fallbacks sub _export_suspend { my $self = shift; #warn "warning: _export_suspened unimplemented for". ref($self); - ''; + my $svc_x = shift; + my $new = $svc_x->clone_suspended; + $self->_export_replace( $new, $svc_x ); } sub _export_unsuspend { my $self = shift; #warn "warning: _export_unsuspend unimplemented for ". ref($self); - ''; + my $svc_x = shift; + my $old = $svc_x->clone_kludge_unsuspend; + $self->_export_replace( $svc_x, $old ); } =back @@ -507,7 +513,7 @@ on the export: sub export_info { #warn $_[0]; - return $exports{$_[0]} if @_; + return $exports{$_[0]} || {} if @_; #{ map { %{$exports{$_}} } keys %exports }; my $r = { map { %{$exports{$_}} } keys %exports }; } @@ -526,522 +532,48 @@ sub export_info { # ''; #} -tie my %sysvshell_options, 'Tie::IxHash', - 'crypt' => { label=>'Password encryption', - type=>'select', options=>[qw(crypt md5)], - default=>'crypt', - }, -; - -tie my %bsdshell_options, 'Tie::IxHash', - 'crypt' => { label=>'Password encryption', - type=>'select', options=>[qw(crypt md5)], - default=>'crypt', - }, -; - -tie my %shellcommands_options, 'Tie::IxHash', - #'machine' => { label=>'Remote machine' }, - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username' - #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' - }, - 'useradd_stdin' => { label=>'Insert command STDIN', - type =>'textarea', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'userdel -r $username', - #default=>'rm -rf $dir', - }, - 'userdel_stdin' => { label=>'Delete command STDIN', - type =>'textarea', - default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username', - #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. - # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. - # 'find . -depth -print | cpio -pdm $new_dir; '. - # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. - # 'rm -rf $old_dir'. - #')' - }, - 'usermod_stdin' => { label=>'Modify command STDIN', - type =>'textarea', - default=>'', - }, - 'usermod_pwonly' => { label=>'Disallow username changes', - type =>'checkbox', - }, - 'suspend' => { label=>'Suspension command', - default=>'', - }, - 'suspend_stdin' => { label=>'Suspension command STDIN', - default=>'', - }, - 'unsuspend' => { label=>'Unsuspension command', - default=>'', - }, - 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', - default=>'', - }, -; - -tie my %shellcommands_withdomain_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - #default=>'' - }, - 'useradd_stdin' => { label=>'Insert command STDIN', - type =>'textarea', - #default=>"$_password\n$_password\n", - }, - 'userdel' => { label=>'Delete command', - #default=>'', - }, - 'userdel_stdin' => { label=>'Delete command STDIN', - type =>'textarea', - #default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, - 'usermod_stdin' => { label=>'Modify command STDIN', - type =>'textarea', - #default=>"$_password\n$_password\n", - }, - 'usermod_pwonly' => { label=>'Disallow username changes', - type =>'checkbox', - }, - 'suspend' => { label=>'Suspension command', - default=>'', - }, - 'suspend_stdin' => { label=>'Suspension command STDIN', - default=>'', - }, - 'unsuspend' => { label=>'Unsuspension command', - default=>'', - }, - 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', - default=>'', - }, -; - -tie my %www_shellcommands_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'mkdir /var/www/$zone; chown $username /var/www/$zone; ln -s /var/www/$zone $homedir/$zone', - }, - 'userdel' => { label=>'Delete command', - default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm $homedir/$zone', - }, - 'usermod' => { label=>'Modify command', - default=>'[ -n "$old_zone" ] && rm $old_homedir/$old_zone; [ "$old_zone" != "$new_zone" -a -n "$new_zone" ] && mv /var/www/$old_zone /var/www/$new_zone; [ "$old_username" != "$new_username" ] && chown -R $new_username /var/www/$new_zone; ln -s /var/www/$new_zone $new_homedir/$new_zone', - }, -; - -tie my %apache_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'httpd_conf' => { label=>'httpd.conf snippet location', - default=>'/etc/apache/httpd-freeside.conf', }, - 'template' => { - label => 'Template', - type => 'textarea', - default => <<'END', -<VirtualHost $domain> #generic -#<VirtualHost ip.addr> #preferred, http://httpd.apache.org/docs/dns-caveats.html -DocumentRoot /var/www/$zone -ServerName $zone -ServerAlias *.$zone -#BandWidthModule On -#LargeFileLimit 4096 12288 -</VirtualHost> - -END - }, -; - -tie my %domain_shellcommands_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, -; - -tie my %textradius_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'users' => { label=>'users file location', default=>'/etc/raddb/users' }, -; - -tie my %sqlradius_options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source ' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, -; - -tie my %sqlradius_withdomain_options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source ' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, -; - -tie my %cyrus_options, 'Tie::IxHash', - 'server' => { label=>'IMAP server' }, - 'username' => { label=>'Admin username' }, - 'password' => { label=>'Admin password' }, -; - -tie my %cp_options, 'Tie::IxHash', - 'port' => { label=>'Port number' }, - 'username' => { label=>'Username' }, - 'password' => { label=>'Password' }, - 'domain' => { label=>'Domain' }, - 'workgroup' => { label=>'Default Workgroup' }, -; - -tie my %infostreet_options, 'Tie::IxHash', - 'url' => { label=>'XML-RPC Access URL', }, - 'login' => { label=>'InfoStreet login', }, - 'password' => { label=>'InfoStreet password', }, - 'groupID' => { label=>'InfoStreet groupID', }, -; - -tie my %vpopmail_options, 'Tie::IxHash', - #'machine' => { label=>'vpopmail machine', }, - 'dir' => { label=>'directory', }, # ?more info? default? - 'uid' => { label=>'vpopmail uid' }, - 'gid' => { label=>'vpopmail gid' }, - 'restart' => { label=> 'vpopmail restart command', - default=> 'cd /home/vpopmail/domains; for domain in *; do /home/vpopmail/bin/vmkpasswd $domain; done; /var/qmail/bin/qmail-newu; killall -HUP qmail-send', - }, -; - -tie my %communigate_pro_options, 'Tie::IxHash', - 'port' => { label=>'Port number', default=>'106', }, - 'login' => { label=>'The administrator account name. The name can contain a domain part.', }, - 'password' => { label=>'The administrator account password.', }, - 'accountType' => { label=>'Type for newly-created accounts', - type=>'select', - options=>[qw( MultiMailbox TextMailbox MailDirMailbox )], - default=>'MultiMailbox', - }, - 'externalFlag' => { label=> 'Create accounts with an external (visible for legacy mailers) INBOX.', - type=>'checkbox', - }, - 'AccessModes' => { label=>'Access modes', - default=>'Mail POP IMAP PWD WebMail WebSite', - }, -; - -tie my %communigate_pro_singledomain_options, 'Tie::IxHash', - 'port' => { label=>'Port number', default=>'106', }, - 'login' => { label=>'The administrator account name. The name can contain a domain part.', }, - 'password' => { label=>'The administrator account password.', }, - 'domain' => { label=>'Domain', }, - 'accountType' => { label=>'Type for newly-created accounts', - type=>'select', - options=>[qw( MultiMailbox TextMailbox MailDirMailbox )], - default=>'MultiMailbox', - }, - 'externalFlag' => { label=> 'Create accounts with an external (visible for legacy mailers) INBOX.', - type=>'checkbox', - }, - 'AccessModes' => { label=>'Access modes', - default=>'Mail POP IMAP PWD WebMail WebSite', - }, -; - -tie my %bind_options, 'Tie::IxHash', - #'machine' => { label=>'named machine' }, - 'named_conf' => { label => 'named.conf location', - default=> '/etc/bind/named.conf' }, - 'zonepath' => { label => 'path to zone files', - default=> '/etc/bind/', }, -; - -tie my %bind_slave_options, 'Tie::IxHash', - #'machine' => { label=> 'Slave machine' }, - 'master' => { label=> 'Master IP address(s) (semicolon-separated)' }, - 'named_conf' => { label => 'named.conf location', - default => '/etc/bind/named.conf' }, -; - -tie my %http_options, 'Tie::IxHash', - 'method' => { label =>'Method', - type =>'select', - #options =>[qw(POST GET)], - options =>[qw(POST)], - default =>'POST' }, - 'url' => { label => 'URL', default => 'http://', }, - 'insert_data' => { - label => 'Insert data', - type => 'textarea', - default => join("\n", - 'DomainName $svc_x->domain', - 'Email ( grep { $_ ne "POST" } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]', - 'test 1', - 'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i', - ), - }, - 'delete_data' => { - label => 'Delete data', - type => 'textarea', - default => join("\n", - ), - }, - 'replace_data' => { - label => 'Replace data', - type => 'textarea', - default => join("\n", - ), - }, -; - -tie my %sqlmail_options, 'Tie::IxHash', - 'datasrc' => { label=>'DBI data source' }, - 'username' => { label=>'Database username' }, - 'password' => { label=>'Database password' }, -; - -tie my %ldap_options, 'Tie::IxHash', - 'dn' => { label=>'Root DN' }, - 'password' => { label=>'Root DN password' }, - 'userdn' => { label=>'User DN' }, - 'attributes' => { label=>'Attributes', - type=>'textarea', - default=>join("\n", - 'uid $username', - 'mail $username\@$domain', - 'uidno $uid', - 'gidno $gid', - 'cn $first', - 'sn $last', - 'mailquota $quota', - 'vmail', - 'location', - 'mailtag', - 'mailhost', - 'mailmessagestore $dir', - 'userpassword $crypt_password', - 'hint', - 'answer $sec_phrase', - 'objectclass top,person,inetOrgPerson', - ), - }, - 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', }, -; - -tie my %forward_shellcommands_options, 'Tie::IxHash', - 'user' => { label=>'Remote username', default=>'root' }, - 'useradd' => { label=>'Insert command', - default=>'', - }, - 'userdel' => { label=>'Delete command', - default=>'', - }, - 'usermod' => { label=>'Modify command', - default=>'', - }, -; - -#export names cannot have dashes... -%exports = ( - 'svc_acct' => { - 'sysvshell' => { - 'desc' => - 'Batch export of /etc/passwd and /etc/shadow files (Linux/SysV).', - 'options' => \%sysvshell_options, - 'nodomain' => 'Y', - 'notes' => 'MD5 crypt requires installation of <a href="http://search.cpan.org/search?dist=Crypt-PasswdMD5">Crypt::PasswdMD5</a> from CPAN. Run bin/sysvshell.export to export the files.', - }, - 'bsdshell' => { - 'desc' => - 'Batch export of /etc/passwd and /etc/master.passwd files (BSD).', - 'options' => \%bsdshell_options, - 'nodomain' => 'Y', - 'notes' => 'MD5 crypt requires installation of <a href="http://search.cpan.org/search?dist=Crypt-PasswdMD5">Crypt::PasswdMD5</a> from CPAN. Run bin/bsdshell.export to export the files.', - }, -# 'nis' => { -# 'desc' => -# 'Batch export of /etc/global/passwd and /etc/global/shadow for NIS ', -# 'options' => {}, -# }, - 'textradius' => { - 'desc' => 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)', - 'options' => \%textradius_options, - 'notes' => 'This will edit a text RADIUS users file in place on a remote server. Requires installation of <a href="http://search.cpan.org/search?dist=RADIUS-UserFile">RADIUS::UserFile</a> from CPAN. If using RADIUS::UserFile 1.01, make sure to apply <a href="http://rt.cpan.org/NoAuth/Bug.html?id=1210">this patch</a>. Also make sure <a href="http://rsync.samba.org/">rsync</a> is installed on the remote machine, and <a href="../docs/ssh.html">SSH is setup for unattended operation</a>.', - }, - - 'shellcommands' => { - 'desc' => 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', - 'options' => \%shellcommands_options, - 'nodomain' => 'Y', - 'notes' => 'Run remote commands via SSH. Usernames are considered unique (also see shellcommands_withdomain). You probably want this if the commands you are running will not accept a domain as a parameter. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>Use these buttons for some useful presets:<UL><LI><INPUT TYPE="button" VALUE="Linux/NetBSD/OpenBSD" onClick=\'this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username"; this.form.useradd_stdin.value = ""; this.form.userdel.value = "userdel -r $username"; this.form.userdel_stdin.value=""; this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username"; this.form.usermod_stdin.value = "";\'><LI><INPUT TYPE="button" VALUE="FreeBSD" onClick=\'this.form.useradd.value = "pw useradd $username -d $dir -m -s $shell -u $uid -g $gid -c $finger -h 0"; this.form.useradd_stdin.value = "$_password\n"; this.form.userdel.value = "pw userdel $username -r"; this.form.userdel_stdin.value=""; this.form.usermod.value = "pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -c $new_finger -h 0"; this.form.usermod_stdin.value = "$new__password\n";\'><LI><INPUT TYPE="button" VALUE="Just maintain directories (use with sysvshell or bsdshell)" onClick=\'this.form.useradd.value = "cp -pr /etc/skel $dir; chown -R $uid.$gid $dir"; this.form.useradd_stdin.value = ""; this.form.usermod.value = "[ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $new_uid.$new_gid $new_dir; rm -rf $old_dir )"; this.form.usermod_stdin.value = ""; this.form.userdel.value = "rm -rf $dir"; this.form.userdel_stdin.value="";\'></UL>The following variables are available for interpolation (prefixed with new_ or old_ for replace operations): <UL><LI><code>$username</code><LI><code>$_password</code><LI><code>$quoted_password</code> - unencrypted password quoted for the shell<LI><code>$crypt_password</code> - encrypted password<LI><code>$uid</code><LI><code>$gid</code><LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes)<LI><code>$dir</code> - home directory<LI><code>$shell</code><LI><code>$quota</code><LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available.</UL>', - }, - - 'shellcommands_withdomain' => { - 'desc' => 'Real-time export via remote SSH (vpopmail, etc.).', - 'options' => \%shellcommands_withdomain_options, - 'notes' => 'Run remote commands via SSH. username@domain (rather than just usernames) are considered unique (also see shellcommands). You probably want this if the commands you are running will accept a domain as a parameter, and will allow the same username with different domains. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>Use these buttons for some useful presets:<UL><LI><INPUT TYPE="button" VALUE="vpopmail" onClick=\'this.form.useradd.value = "/home/vpopmail/bin/vadduser $username\\\@$domain $quoted_password"; this.form.useradd_stdin.value = ""; this.form.userdel.value = "/home/vpopmail/bin/vdeluser $username\\\@$domain"; this.form.userdel_stdin.value=""; this.form.usermod.value = "/home/vpopmail/bin/vpasswd $new_username\\\@$new_domain $new_quoted_password"; this.form.usermod_stdin.value = ""; this.form.usermod_pwonly.checked = true;\'></UL>The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): <UL><LI><code>$username</code><LI><code>$domain</code><LI><code>$_password</code><LI><code>$quoted_password</code> - unencrypted password quoted for the shell<LI><code>$crypt_password</code> - encrypted password<LI><code>$uid</code><LI><code>$gid</code><LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes)<LI><code>$dir</code> - home directory<LI><code>$shell</code><LI><code>$quota</code><LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available.</UL>', - }, - - 'ldap' => { - 'desc' => 'Real-time export to LDAP', - 'options' => \%ldap_options, - 'notes' => 'Real-time export to arbitrary LDAP attributes. Requires installation of <a href="http://search.cpan.org/search?dist=Net-LDAP">Net::LDAP</a> from CPAN.', - }, - - 'sqlradius' => { - 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator)', - 'options' => \%sqlradius_options, - 'nodomain' => 'Y', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a>, <a href="http://radius.innercite.com/">ICRADIUS</a> or <a href="http://www.open.com.au/radiator/">Radiator</a>. This export does not export RADIUS realms (see also sqlradius_withdomain). An existing RADIUS database will be updated in realtime, but you can use <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the <a href="http://search.cpan.org/doc/TIMB/DBI/DBI.pm#connect">DBI documentation</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a> for the exact syntax of a DBI data source.<ul><li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected.<li>Using ICRADIUS, add a dummy "op" column to your database: <blockquote><code>ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'</code></blockquote><li>Using Radiator, see the <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a> for configuration information.</ul>', - }, - - 'sqlradius_withdomain' => { - 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator) with realms', - 'options' => \%sqlradius_withdomain_options, - 'nodomain' => '', - 'notes' => 'Real-time export of radcheck, radreply and usergroup tables to any SQL database for <a href="http://www.freeradius.org/">FreeRADIUS</a>, <a href="http://radius.innercite.com/">ICRADIUS</a> or <a href="http://www.open.com.au/radiator/">Radiator</a>. This export exports domains to RADIUS realms (see also sqlradius). An existing RADIUS database will be updated in realtime, but you can use <a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the <a href="http://search.cpan.org/doc/TIMB/DBI/DBI.pm#connect">DBI documentation</a> and the <a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a> for the exact syntax of a DBI data source.<ul><li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected.<li>Using ICRADIUS, add a dummy "op" column to your database: <blockquote><code>ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'<br>ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT \'==\'</code></blockquote><li>Using Radiator, see the <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a> for configuration information.</ul>', - }, - - 'sqlmail' => { - 'desc' => 'Real-time export to SQL-backed mail server', - 'options' => \%sqlmail_options, - 'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', - }, - - 'cyrus' => { - 'desc' => 'Real-time export to Cyrus IMAP server', - 'options' => \%cyrus_options, - 'nodomain' => 'Y', - 'notes' => 'Integration with <a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>. Cyrus::IMAP::Admin should be installed locally and the connection to the server secured. <B>svc_acct.quota</B>, if available, is used to set the Cyrus quota. ' - }, - - 'cp' => { - 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', - 'options' => \%cp_options, - 'notes' => 'Real-time export to <a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>. Requires installation of <a href="http://search.cpan.org/search?dist=Net-APP">Net::APP</a> from CPAN.', - }, - - 'infostreet' => { - 'desc' => 'Real-time export to InfoStreet streetSmartAPI', - 'options' => \%infostreet_options, - 'nodomain' => 'Y', - 'notes' => 'Real-time export to <a href="http://www.infostreet.com/">InfoStreet</a> streetSmartAPI. Requires installation of <a href="http://search.cpan.org/search?dist=Frontier-Client">Frontier::Client</a> from CPAN.', - }, - - 'vpopmail' => { - 'desc' => 'Real-time export to vpopmail text files', - 'options' => \%vpopmail_options, - 'notes' => 'Real time export to <a href="http://inter7.com/vpopmail/">vpopmail</a> text files. <a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> must be installed, and you will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a> to <b>vpopmail</b>@<i>export.host</i>.', - }, - - 'communigate_pro' => { - 'desc' => 'Real-time export to a CommuniGate Pro mail server', - 'options' => \%communigate_pro_options, - 'notes' => 'Real time export to a <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> mail server. The <a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> must be installed as CGP::CLI.', - }, - - 'communigate_pro_singledomain' => { - 'desc' => 'Real-time export to a CommuniGate Pro mail server, one domain only', - 'options' => \%communigate_pro_singledomain_options, - 'nodomain' => 'Y', - 'notes' => 'Real time export to a <a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> mail server. This is an unusual export to CommuniGate Pro that forces all accounts into a single domain. As CommuniGate Pro supports multiple domains, unless you have a specific reason for using this export, you probably want to use the communigate_pro export instead. The <a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> must be installed as CGP::CLI.', - }, - - }, - - 'svc_domain' => { - - 'bind' => { - 'desc' =>'Batch export to BIND named', - 'options' => \%bind_options, - 'notes' => 'Batch export of BIND zone and configuration files to primary nameserver. <a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> must be installed. Run bin/bind.export to export the files.', - }, - - 'bind_slave' => { - 'desc' =>'Batch export to slave BIND named', - 'options' => \%bind_slave_options, - 'notes' => 'Batch export of BIND configuration file to a secondary nameserver. Zones are slaved from the listed masters. <a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> must be installed. Run bin/bind.export to export the files.', - }, - - 'http' => { - 'desc' => 'Send an HTTP or HTTPS GET or POST request', - 'options' => \%http_options, - 'notes' => 'Send an HTTP or HTTPS GET or POST to the specified URL. <a href="http://search.cpan.org/search?dist=libwww-perl">libwww-perl</a> must be installed. For HTTPS support, <a href="http://search.cpan.org/search?dist=Crypt-SSLeay">Crypt::SSLeay</a> or <a href="http://search.cpan.org/search?dist=IO-Socket-SSL">IO::Socket::SSL</a> is required.', - }, - - 'sqlmail' => { - 'desc' => 'Real-time export to SQL-backed mail server', - 'options' => \%sqlmail_options, - #'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', - }, - - 'domain_shellcommands' => { - 'desc' => 'Run remote commands via SSH, for domains.', - 'options' => \%domain_shellcommands_options, - 'notes' => 'Run remote commands via SSH, for domains. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>Use these buttons for some useful presets:<UL><LI><INPUT TYPE="button" VALUE="qmail catchall .qmail-domain-default maintenance" onClick=\'this.form.useradd.value = "[ \"$uid\" -a \"$gid\" -a \"$dir\" -a \"$qdomain\" ] && [ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }"; this.form.userdel.value = ""; this.form.usermod.value = "";\'></UL>The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): <UL><LI><code>$domain</code><LI><code>$qdomain</code> - domain with periods replaced by colons<LI><code>$uid</code> - of catchall account<LI><code>$gid</code> - of catchall account<LI><code>$dir</code> - home directory of catchall account<LI>All other fields in <a href="../docs/schema.html#svc_domain">svc_domain</a> are also available.</UL>', - }, - - - }, - - 'svc_acct_sm' => {}, - - 'svc_forward' => { - 'sqlmail' => { - 'desc' => 'Real-time export to SQL-backed mail server', - 'options' => \%sqlmail_options, - #'nodomain' => 'Y', - 'notes' => 'Database schema can be made to work with Courier IMAP and Exim. Others could work but are untested. (...extended description from pc-intouch?...)', - }, - - 'forward_shellcommands' => { - 'desc' => 'Run remote commands via SSH, for forwards', - 'options' => \%forward_shellcommands_options, - 'notes' => 'Run remote commands via SSH, for forwards. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>Use these buttons for some useful presets:<UL><LI><INPUT TYPE="button" VALUE="text vpopmail maintenance" onClick=\'this.form.useradd.value = "[ -d /home/vpopmail/domains/$domain/$username ] && { echo \"$destination\" > /home/vpopmail/domains/$domain/$username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$domain/$username/.qmail; }"; this.form.userdel.value = "rm /home/vpopmail/domains/$domain/$username/.qmail"; this.form.usermod.value = "mv /home/vpopmail/domains/$old_domain/$old_username/.qmail /home/vpopmail/domains/$new_domain/$new_username; [ \"$old_destination\" != \"$new_destination\" ] && { echo \"$new_destination\" > /home/vpopmail/domains/$new_domain/$new_username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$new_domain/$new_username/.qmail; }";\'></UL>The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): <UL><LI><code>$username</code><LI><code>$domain</code><LI><code>$destination</code> - forward destination<LI>All other fields in <a href="../docs/schema.html#svc_forward">svc_forward</a> are also available.</UL>', - }, - }, - - 'svc_www' => { - 'www_shellcommands' => { - 'desc' => 'Run remote commands via SSH, for virtual web sites.', - 'options' => \%www_shellcommands_options, - 'notes' => 'Run remote commands via SSH, for virtual web sites. You will need to <a href="../docs/ssh.html">setup SSH for unattended operation</a>.<BR><BR>The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): <UL><LI><code>$zone</code><LI><code>$username</code><LI><code>$homedir</code><LI>All other fields in <a href="../docs/schema.html#svc_www">svc_www</a> are also available.</UL>', - }, - - 'apache' => { - 'desc' => 'Export an Apache httpd.conf file snippet.', - 'options' => \%apache_options, - 'notes' => 'Batch export of an httpd.conf snippet from a template. Typically used with something like <code>Include /etc/apache/httpd-freeside.conf</code> in httpd.conf. <a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> must be installed. Run bin/apache.export to export the files.', - }, - }, - -); +foreach my $INC ( @INC ) { + foreach my $file ( glob("$INC/FS/part_export/*.pm") ) { + warn "attempting to load export info from $file\n" if $DEBUG; + $file =~ /\/(\w+)\.pm$/ or do { + warn "unrecognized file in $INC/FS/part_export/: $file\n"; + next; + }; + my $mod = $1; + my $info = eval "use FS::part_export::$mod; ". + "\\%FS::part_export::$mod\::info;"; + if ( $@ ) { + die "error using FS::part_export::$mod (skipping): $@\n" if $@; + next; + } + unless ( keys %$info ) { + warn "no %info hash found in FS::part_export::$mod, skipping\n" + unless $mod =~ /^(passwdfile|null)$/; #hack but what the heck + next; + } + warn "got export info from FS::part_export::$mod: $info\n" if $DEBUG; + no strict 'refs'; + foreach my $svc ( + ref($info->{'svc'}) ? @{$info->{'svc'}} : $info->{'svc'} + ) { + unless ( $svc ) { + warn "blank svc for FS::part_export::$mod (skipping)\n"; + next; + } + $exports{$svc}->{$mod} = $info; + } + } +} =back =head1 NEW EXPORT CLASSES -Should be added to the %export hash here, and a module should be added in -FS/FS/part_export/ (an example may be found in eg/export_template.pm) +A module should be added in FS/FS/part_export/ (an example may be found in +eg/export_template.pm) =head1 BUGS -All the stuff in the %exports hash should be generated from the specific -export modules. - Hmm... cust_export class (not necessarily a database table...) ... ? deprecated column... diff --git a/FS/FS/part_export/apache.pm b/FS/FS/part_export/apache.pm index 9161d72b3..17fbabff8 100644 --- a/FS/FS/part_export/apache.pm +++ b/FS/FS/part_export/apache.pm @@ -1,7 +1,46 @@ package FS::part_export::apache; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use FS::part_export::null; @ISA = qw(FS::part_export::null); +tie my %options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'httpd_conf' => { label=>'httpd.conf snippet location', + default=>'/etc/apache/httpd-freeside.conf', }, + 'restart' => { label=>'Apache restart command', + default=>'apachectl graceful', + }, + 'template' => { + label => 'Template', + type => 'textarea', + default => <<'END', +<VirtualHost $domain> #generic +#<VirtualHost ip.addr> #preferred, http://httpd.apache.org/docs/dns-caveats.html +DocumentRoot /var/www/$zone +ServerName $zone +ServerAlias *.$zone +#BandWidthModule On +#LargeFileLimit 4096 12288 +</VirtualHost> + +END + }, +; + +%info = ( + 'svc' => 'svc_www', + 'desc' => 'Export an Apache httpd.conf file snippet.', + 'options' => \%options, + 'notes' => <<'END' +Batch export of an httpd.conf snippet from a template. Typically used with +something like <code>Include /etc/apache/httpd-freeside.conf</code> in +httpd.conf. <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> +must be installed. Run bin/apache.export to export the files. +END +); + +1; + diff --git a/FS/FS/part_export/bind.pm b/FS/FS/part_export/bind.pm index b72c9bdb0..1ef7b6598 100644 --- a/FS/FS/part_export/bind.pm +++ b/FS/FS/part_export/bind.pm @@ -1,7 +1,35 @@ package FS::part_export::bind; -use vars qw(@ISA); +use vars qw(@ISA %info %options); +use Tie::IxHash; use FS::part_export::null; @ISA = qw(FS::part_export::null); +tie %options, 'Tie::IxHash', + 'named_conf' => { label => 'named.conf location', + default=> '/etc/bind/named.conf' }, + 'zonepath' => { label => 'path to zone files', + default=> '/etc/bind/', }, + 'bind_release' => { label => 'ISC BIND Release', + type => 'select', + options => [qw(BIND8 BIND9)], + default => 'BIND8' }, + 'bind9_minttl' => { label => 'The minttl required by bind9 and RFC1035.', + default => '1D' }, + 'reload' => { label => 'Optional reload command. If not specified, defaults to "ndc" under BIND8 and "rndc" under BIND9.', }, +; + +%info = ( + 'svc' => 'svc_domain', + 'desc' => 'Batch export to BIND named', + 'options' => \%options, + 'notes' => <<'END' +Batch export of BIND zone and configuration files to a primary nameserver. +<a href="http://search.cpan.org/search?dist=File-Rsync">File::Rsync</a> +must be installed. Run bin/bind.export to export the files. +END +); + +1; + diff --git a/FS/FS/part_export/bind_slave.pm b/FS/FS/part_export/bind_slave.pm index ebb29c1d7..c89325f8d 100644 --- a/FS/FS/part_export/bind_slave.pm +++ b/FS/FS/part_export/bind_slave.pm @@ -1,7 +1,28 @@ package FS::part_export::bind_slave; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use FS::part_export::null; @ISA = qw(FS::part_export::null); +tie my %options, 'Tie::IxHash', + 'master' => { label=> 'Master IP address(s) (semicolon-separated)' }, + %FS::part_export::bind::options, +; +delete $options{'zonepath'}; + +%info = ( + 'svc' => 'svc_domain', + 'desc' =>'Batch export to slave BIND named', + 'options' => \%options, + 'notes' => <<'END' +Batch export of BIND configuration file to a secondary nameserver. Zones are +slaved from the listed masters. +<a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> +must be installed. Run bin/bind.export to export the files. +END +); + +1; + diff --git a/FS/FS/part_export/bsdshell.pm b/FS/FS/part_export/bsdshell.pm index 06642097f..7b5feb252 100644 --- a/FS/FS/part_export/bsdshell.pm +++ b/FS/FS/part_export/bsdshell.pm @@ -1,7 +1,25 @@ package FS::part_export::bsdshell; -use vars qw(@ISA); -use FS::part_export::null; +use vars qw(@ISA %info); +use Tie::IxHash; +use FS::part_export::passwdfile; -@ISA = qw(FS::part_export::null); +@ISA = qw(FS::part_export::passwdfile); + +tie my %options, 'Tie::IxHash', %FS::part_export::passwdfile::options; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => + 'Batch export of /etc/passwd and /etc/master.passwd files (BSD)', + 'options' => \%options, + 'nodomain' => 'Y', + 'notes' => <<'END' +MD5 crypt requires installation of +<a href="http://search.cpan.org/dist/Crypt-PasswdMD5">Crypt::PasswdMD5</a> +from CPAN. Run bin/bsdshell.export to export the files. +END +); + +1; diff --git a/FS/FS/part_export/communigate_pro.pm b/FS/FS/part_export/communigate_pro.pm index 557aad91d..6da201799 100644 --- a/FS/FS/part_export/communigate_pro.pm +++ b/FS/FS/part_export/communigate_pro.pm @@ -1,11 +1,42 @@ package FS::part_export::communigate_pro; -use vars qw(@ISA); +use vars qw(@ISA %info %options); +use Tie::IxHash; use FS::part_export; use FS::queue; @ISA = qw(FS::part_export); +tie %options, 'Tie::IxHash', + 'port' => { label=>'Port number', default=>'106', }, + 'login' => { label=>'The administrator account name. The name can contain a domain part.', }, + 'password' => { label=>'The administrator account password.', }, + 'accountType' => { label=>'Type for newly-created accounts', + type=>'select', + options=>[qw( MultiMailbox TextMailbox MailDirMailbox )], + default=>'MultiMailbox', + }, + 'externalFlag' => { label=> 'Create accounts with an external (visible for legacy mailers) INBOX.', + type=>'checkbox', + }, + 'AccessModes' => { label=>'Access modes', + default=>'Mail POP IMAP PWD WebMail WebSite', + }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Real-time export to a CommuniGate Pro mail server', + 'options' => \%options, + 'notes' => <<'END' +Real time export to a +<a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> +mail server. The +<a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> +must be installed as CGP::CLI. +END +); + sub rebless { shift; } sub export_username { @@ -142,3 +173,6 @@ sub communigate_pro_command { #subroutine, not method $cli->Logout or die "Can't logout of CGPro: $CGP::ERR_STRING\n"; } + +1; + diff --git a/FS/FS/part_export/communigate_pro_singledomain.pm b/FS/FS/part_export/communigate_pro_singledomain.pm index 11574af9b..6a1bf60eb 100644 --- a/FS/FS/part_export/communigate_pro_singledomain.pm +++ b/FS/FS/part_export/communigate_pro_singledomain.pm @@ -1,11 +1,37 @@ package FS::part_export::communigate_pro_singledomain; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use FS::part_export::communigate_pro; @ISA = qw(FS::part_export::communigate_pro); +tie my %options, 'Tie::IxHash', %FS::part_export::communigate_pro::options, + 'domain' => { label=>'Domain', }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => + 'Real-time export to a CommuniGate Pro mail server, one domain only', + 'options' => \%options, + 'nodomain' => 'Y', + 'notes' => <<'END' +Real time export to a +<a href="http://www.stalker.com/CommuniGatePro/">CommuniGate Pro</a> +mail server. This is an unusual export to CommuniGate Pro that forces all +accounts into a single domain. As CommuniGate Pro supports multipledomains, +unless you have a specific reason for using this export, you probably want to +use the communigate_pro export instead. The +<a href="http://www.stalker.com/CGPerl/">CommuniGate Pro Perl Interface</a> +must be installed as CGP::CLI. +END +); + sub export_username { my($self, $svc_acct) = (shift, shift); $svc_acct->username. '@'. $self->option('domain'); } + +1; + diff --git a/FS/FS/part_export/cp.pm b/FS/FS/part_export/cp.pm index c4750dd5d..a295c574b 100644 --- a/FS/FS/part_export/cp.pm +++ b/FS/FS/part_export/cp.pm @@ -1,10 +1,32 @@ package FS::part_export::cp; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use FS::part_export; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + 'port' => { label=>'Port number' }, + 'username' => { label=>'Username' }, + 'password' => { label=>'Password' }, + 'domain' => { label=>'Domain' }, + 'workgroup' => { label=>'Default Workgroup' }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Real-time export to Critical Path Account Provisioning Protocol', + 'options'=> \%options, + 'notes' => <<'END' +Real-time export to +<a href="http://www.cp.net/">Critial Path Account Provisioning Protocol</a>. +Requires installation of +<a href="http://search.cpan.org/dist/Net-APP">Net::APP</a> +from CPAN. +END +); + sub rebless { shift; } sub _export_insert { @@ -134,3 +156,5 @@ sub cp_command { #subroutine, not method } +1; + diff --git a/FS/FS/part_export/cyrus.pm b/FS/FS/part_export/cyrus.pm index 110ff198f..84c9e5a30 100644 --- a/FS/FS/part_export/cyrus.pm +++ b/FS/FS/part_export/cyrus.pm @@ -1,10 +1,31 @@ package FS::part_export::cyrus; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use FS::part_export; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + 'server' => { label=>'IMAP server' }, + 'username' => { label=>'Admin username' }, + 'password' => { label=>'Admin password' }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Real-time export to Cyrus IMAP server', + 'options' => \%options, + 'nodomain' => 'Y', + 'notes' => <<'END' +Integration with +<a href="http://asg.web.cmu.edu/cyrus/imapd/">Cyrus IMAP Server</a>. +Cyrus::IMAP::Admin should be installed locally and the connection to the +server secured. <B>svc_acct.quota</B>, if available, is used to set the +Cyrus quota. +END +); + sub rebless { shift; } sub _export_insert { @@ -95,4 +116,5 @@ sub cyrus_connect { #sub cyrus_replace { #subroutine, not method #} +1; diff --git a/FS/FS/part_export/domain_shellcommands.pm b/FS/FS/part_export/domain_shellcommands.pm index cf5603394..0ba561711 100644 --- a/FS/FS/part_export/domain_shellcommands.pm +++ b/FS/FS/part_export/domain_shellcommands.pm @@ -1,11 +1,60 @@ package FS::part_export::domain_shellcommands; use strict; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use FS::part_export; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + default=>'', + }, + 'userdel' => { label=>'Delete command', + default=>'', + }, + 'usermod' => { label=>'Modify command', + default=>'', + }, +; + +%info = ( + 'svc' => 'svc_domain', + 'desc' => 'Run remote commands via SSH, for domains (qmail, ISPMan).', + 'options' => \%options, + 'notes' => <<'END' +Run remote commands via SSH, for domains. You will need to +<a href="../docs/ssh.html">setup SSH for unattended operation</a>. +<BR><BR>Use these buttons for some useful presets: +<UL> + <LI> + <INPUT TYPE="button" VALUE="qmail catchall .qmail-domain-default maintenance" onClick=' + this.form.useradd.value = "[ \"$uid\" -a \"$gid\" -a \"$dir\" -a \"$qdomain\" ] && [ -e $dir/.qmail-$qdomain-default ] || { touch $dir/.qmail-$qdomain-default; chown $uid:$gid $dir/.qmail-$qdomain-default; }"; + this.form.userdel.value = ""; + this.form.usermod.value = ""; + '> + <LI> + <INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' + this.form.useradd.value = "/usr/local/ispman/bin/ispman.addDomain -d $domain changeme"; + this.form.userdel.value = "/usr/local/ispman/bin/ispman.deleteDomain -d $domain"; + this.form.usermod.value = ""; + '> +</UL> +The following variables are available for interpolation (prefixed with <code>new_</code> or <code>old_</code> for replace operations): +<UL> + <LI><code>$domain</code> + <LI><code>$qdomain</code> - domain with periods replaced by colons + <LI><code>$uid</code> - of catchall account + <LI><code>$gid</code> - of catchall account + <LI><code>$dir</code> - home directory of catchall account + <LI>All other fields in + <a href="../docs/schema.html#svc_domain">svc_domain</a> are also available. +</UL> +END +); + sub rebless { shift; } sub _export_insert { @@ -97,7 +146,7 @@ sub shellcommands_queue { } sub ssh_cmd { #subroutine, not method - use Net::SSH '0.07'; + use Net::SSH '0.08'; &Net::SSH::ssh_cmd( { @_ } ); } @@ -108,3 +157,5 @@ sub ssh_cmd { #subroutine, not method #sub shellcommands_delete { #subroutine, not method #} +1; + diff --git a/FS/FS/part_export/forward_shellcommands.pm b/FS/FS/part_export/forward_shellcommands.pm index f6fcb6062..fe304350c 100644 --- a/FS/FS/part_export/forward_shellcommands.pm +++ b/FS/FS/part_export/forward_shellcommands.pm @@ -1,11 +1,58 @@ package FS::part_export::forward_shellcommands; use strict; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use FS::part_export; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + default=>'', + }, + 'userdel' => { label=>'Delete command', + default=>'', + }, + 'usermod' => { label=>'Modify command', + default=>'', + }, +; + +%info = ( + 'svc' => 'svc_forward', + 'desc' => 'Run remote commands via SSH, for forwards', + 'options' => \%options, + 'notes' => <<'END' +Run remote commands via SSH, for forwards. You will need to +<a href="../docs/ssh.html">setup SSH for unattended operation</a>. +<BR><BR>Use these buttons for some useful presets: +<UL> + <LI> + <INPUT TYPE="button" VALUE="text vpopmail maintenance" onClick=' + this.form.useradd.value = "[ -d /home/vpopmail/domains/$domain/$username ] && { echo \"$destination\" > /home/vpopmail/domains/$domain/$username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$domain/$username/.qmail; }"; + this.form.userdel.value = "rm /home/vpopmail/domains/$domain/$username/.qmail"; + this.form.usermod.value = "mv /home/vpopmail/domains/$old_domain/$old_username/.qmail /home/vpopmail/domains/$new_domain/$new_username; [ \"$old_destination\" != \"$new_destination\" ] && { echo \"$new_destination\" > /home/vpopmail/domains/$new_domain/$new_username/.qmail; chown vpopmail:vchkpw /home/vpopmail/domains/$new_domain/$new_username/.qmail; }"; + '> + <LI> + <INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' + this.form.useradd.value = ""; + this.form.userdel.value = ""; + this.form.usermod.value = ""; + '> +</UL> +The following variables are available for interpolation (prefixed with +<code>new_</code> or <code>old_</code> for replace operations): +<UL> + <LI><code>$username</code> + <LI><code>$domain</code> + <LI><code>$destination</code> - forward destination + <LI>All other fields in <a href="../docs/schema.html#svc_forward">svc_forward</a> are also available. +</UL> +END +); + sub rebless { shift; } sub _export_insert { @@ -97,7 +144,7 @@ sub shellcommands_queue { } sub ssh_cmd { #subroutine, not method - use Net::SSH '0.07'; + use Net::SSH '0.08'; &Net::SSH::ssh_cmd( { @_ } ); } @@ -108,3 +155,5 @@ sub ssh_cmd { #subroutine, not method #sub shellcommands_delete { #subroutine, not method #} +1; + diff --git a/FS/FS/part_export/http.pm b/FS/FS/part_export/http.pm index 0e02f0f8e..0be2a0f36 100644 --- a/FS/FS/part_export/http.pm +++ b/FS/FS/part_export/http.pm @@ -1,10 +1,54 @@ package FS::part_export::http; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use FS::part_export; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + 'method' => { label =>'Method', + type =>'select', + #options =>[qw(POST GET)], + options =>[qw(POST)], + default =>'POST' }, + 'url' => { label => 'URL', default => 'http://', }, + 'insert_data' => { + label => 'Insert data', + type => 'textarea', + default => join("\n", + 'DomainName $svc_x->domain', + 'Email ( grep { $_ ne "POST" } $svc_x->cust_svc->cust_pkg->cust_main->invoicing_list)[0]', + 'test 1', + 'reseller $svc_x->cust_svc->cust_pkg->part_pkg->pkg =~ /reseller/i', + ), + }, + 'delete_data' => { + label => 'Delete data', + type => 'textarea', + default => join("\n", + ), + }, + 'replace_data' => { + label => 'Replace data', + type => 'textarea', + default => join("\n", + ), + }, +; + +%info = ( + 'svc' => 'svc_domain', + 'desc' => 'Send an HTTP or HTTPS GET or POST request', + 'options' => \%options, + 'notes' => <<'END' +Send an HTTP or HTTPS GET or POST to the specified URL. For HTTPS support, +<a href="http://search.cpan.org/dist/Crypt-SSLeay">Crypt::SSLeay</a> +or <a href="http://search.cpan.org/dist/IO-Socket-SSL">IO::Socket::SSL</a> +is required. +END +); + sub rebless { shift; } sub _export_insert { @@ -86,3 +130,5 @@ sub http { } +1; + diff --git a/FS/FS/part_export/infostreet.pm b/FS/FS/part_export/infostreet.pm index caca7c5e1..309e7ce6f 100644 --- a/FS/FS/part_export/infostreet.pm +++ b/FS/FS/part_export/infostreet.pm @@ -1,11 +1,32 @@ package FS::part_export::infostreet; -use vars qw(@ISA %infostreet2cust_main $DEBUG); +use vars qw(@ISA %info %infostreet2cust_main $DEBUG); +use Tie::IxHash; use FS::UID qw(dbh); use FS::part_export; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + 'url' => { label=>'XML-RPC Access URL', }, + 'login' => { label=>'InfoStreet login', }, + 'password' => { label=>'InfoStreet password', }, + 'groupID' => { label=>'InfoStreet groupID', }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Real-time export to InfoStreet streetSmartAPI', + 'options' => \%options, + 'nodomain' => 'Y', + 'notes' => <<'END' +Real-time export to +<a href="http://www.infostreet.com/">InfoStreet</a> streetSmartAPI. +Requires installation of +<a href="http://search.cpan.org/dist/Frontier-Client">Frontier::Client</a> from CPAN. +END +); + $DEBUG = 0; %infostreet2cust_main = ( @@ -252,4 +273,5 @@ sub _infostreet_parse { #subroutine, not method } keys %$arg; } +1; diff --git a/FS/FS/part_export/ldap.pm b/FS/FS/part_export/ldap.pm index 57fd1f3f4..823d99dbf 100644 --- a/FS/FS/part_export/ldap.pm +++ b/FS/FS/part_export/ldap.pm @@ -1,11 +1,50 @@ package FS::part_export::ldap; -use vars qw(@ISA @saltset); +use vars qw(@ISA %info @saltset); +use Tie::IxHash; use FS::Record qw( dbh ); use FS::part_export; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + 'dn' => { label=>'Root DN' }, + 'password' => { label=>'Root DN password' }, + 'userdn' => { label=>'User DN' }, + 'attributes' => { label=>'Attributes', + type=>'textarea', + default=>join("\n", + 'uid $username', + 'mail $username\@$domain', + 'uidno $uid', + 'gidno $gid', + 'cn $first', + 'sn $last', + 'mailquota $quota', + 'vmail', + 'location', + 'mailtag', + 'mailhost', + 'mailmessagestore $dir', + 'userpassword $crypt_password', + 'hint', + 'answer $sec_phrase', + 'objectclass top,person,inetOrgPerson', + ), + }, + 'radius' => { label=>'Export RADIUS attributes', type=>'checkbox', }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Real-time export to LDAP', + 'options' => \%options, + 'notes' => <<'END' +Real-time export to arbitrary LDAP attributes. Requires installation of +<a href="http://search.cpan.org/dist/Net-LDAP">Net::LDAP</a> from CPAN. +END +); + @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); sub rebless { shift; } @@ -251,3 +290,5 @@ sub ldap_connect { $ldap; } +1; + diff --git a/FS/FS/part_export/passwdfile.pm b/FS/FS/part_export/passwdfile.pm new file mode 100644 index 000000000..2978d2503 --- /dev/null +++ b/FS/FS/part_export/passwdfile.pm @@ -0,0 +1,18 @@ +package FS::part_export::passwdfile; + +use strict; +use vars qw(@ISA %options); +use Tie::IxHash; +use FS::part_export::null; + +@ISA = qw(FS::part_export::null); + +tie %options, 'Tie::IxHash', + 'crypt' => { label=>'Password encryption', + type=>'select', options=>[qw(crypt md5)], + default=>'crypt', + }, +; + +1; + diff --git a/FS/FS/part_export/postfix.pm b/FS/FS/part_export/postfix.pm new file mode 100644 index 000000000..4fd19ee61 --- /dev/null +++ b/FS/FS/part_export/postfix.pm @@ -0,0 +1,32 @@ +package FS::part_export::postfix; + +use vars qw(@ISA %info); +use Tie::IxHash; +use FS::part_export::null; + +@ISA = qw(FS::part_export::null); + +tie my %options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'aliases' => { label=>'aliases file location', default=>'/etc/aliases' }, + 'virtual' => { label=>'virtual file location', default=>'/etc/postfix/virtual' }, + 'mydomain' => { label=>'local domain', default=>'' }, + 'newaliases' => { label=>'newaliases command', default=>'newaliases' }, + 'postmap' => { label=>'postmap command', + default=>'postmap hash:/etc/postfix/virtual', }, + 'reload' => { label=>'reload command', + default=>'postfix reload' }, +; + +%info = ( + 'svc' => 'svc_forward', + 'desc' => 'Postfix text files', + 'options' => \%options, + 'notes' => <<'END' +Batch export of Postfix aliases and virtual files. +<a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> +must be installed. Run bin/postfix.export to export the files. +END +); + +1; diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm index f65638984..4f201cf9c 100644 --- a/FS/FS/part_export/shellcommands.pm +++ b/FS/FS/part_export/shellcommands.pm @@ -1,11 +1,165 @@ package FS::part_export::shellcommands; -use vars qw(@ISA @saltset); +use vars qw(@ISA %info @saltset); +use Tie::IxHash; use String::ShellQuote; use FS::part_export; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + default=>'useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username' + #default=>'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir' + }, + 'useradd_stdin' => { label=>'Insert command STDIN', + type =>'textarea', + default=>'', + }, + 'userdel' => { label=>'Delete command', + default=>'userdel -r $username', + #default=>'rm -rf $dir', + }, + 'userdel_stdin' => { label=>'Delete command STDIN', + type =>'textarea', + default=>'', + }, + 'usermod' => { label=>'Modify command', + default=>'usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username', + #default=>'[ -d $old_dir ] && mv $old_dir $new_dir || ( '. + # 'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '. + # 'find . -depth -print | cpio -pdm $new_dir; '. + # 'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '. + # 'rm -rf $old_dir'. + #')' + }, + 'usermod_stdin' => { label=>'Modify command STDIN', + type =>'textarea', + default=>'', + }, + 'usermod_pwonly' => { label=>'Disallow username changes', + type =>'checkbox', + }, + 'suspend' => { label=>'Suspension command', + default=>'usermod -L $username', + }, + 'suspend_stdin' => { label=>'Suspension command STDIN', + default=>'', + }, + 'unsuspend' => { label=>'Unsuspension command', + default=>'usermod -U $username', + }, + 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', + default=>'', + }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => + 'Real-time export via remote SSH (i.e. useradd, userdel, etc.)', + 'options' => \%options, + 'nodomain' => 'Y', + 'notes' => <<'END' +Run remote commands via SSH. Usernames are considered unique (also see +shellcommands_withdomain). You probably want this if the commands you are +running will not accept a domain as a parameter. You will need to +<a href="../docs/ssh.html">setup SSH for unattended operation</a>. + +<BR><BR>Use these buttons for some useful presets: +<UL> + <LI> + <INPUT TYPE="button" VALUE="Linux" onClick=' + this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username"; + this.form.useradd_stdin.value = ""; + this.form.userdel.value = "userdel -r $username"; + this.form.userdel_stdin.value=""; + this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username"; + this.form.usermod_stdin.value = ""; + this.form.suspend.value = "usermod -L $username"; + this.form.suspend_stdin.value=""; + this.form.unsuspend.value = "usermod -U $username"; + this.form.unsuspend_stdin.value=""; + '> + <LI> + <INPUT TYPE="button" VALUE="FreeBSD before 4.10 / 5.3" onClick=' + this.form.useradd.value = "lockf /etc/passwd.lock pw useradd $username -d $dir -m -s $shell -u $uid -g $gid -c $finger -h 0"; + this.form.useradd_stdin.value = "$_password\n"; + this.form.userdel.value = "lockf /etc/passwd.lock pw userdel $username -r"; this.form.userdel_stdin.value=""; + this.form.usermod.value = "lockf /etc/passwd.lock pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -c $new_finger -h 0"; + this.form.usermod_stdin.value = "$new__password\n"; this.form.suspend.value = "lockf /etc/passwd.lock pw lock $username"; + this.form.suspend_stdin.value=""; + this.form.unsuspend.value = "lockf /etc/passwd.lock pw unlock $username"; this.form.unsuspend_stdin.value=""; + '> + Note: On FreeBSD versions before 5.3 and 4.10 (4.10 is after 4.9, not + 4.1!), due to deficient locking in pw(1), you must disable the chpass(1), + chsh(1), chfn(1), passwd(1), and vipw(1) commands, or replace them with + wrappers that prepend "lockf /etc/passwd.lock". Alternatively, apply the + patch in + <A HREF="http://www.freebsd.org/cgi/query-pr.cgi?pr=23501">FreeBSD PR#23501</A> + and use the "FreeBSD 4.10 / 5.3 or later" button below. + <LI> + <INPUT TYPE="button" VALUE="FreeBSD 4.10 / 5.3 or later" onClick=' + this.form.useradd.value = "pw useradd $username -d $dir -m -s $shell -u $uid -g $gid -c $finger -h 0"; + this.form.useradd_stdin.value = "$_password\n"; + this.form.userdel.value = "pw userdel $username -r"; + this.form.userdel_stdin.value=""; + this.form.usermod.value = "pw usermod $old_username -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -c $new_finger -h 0"; + this.form.usermod_stdin.value = "$new__password\n"; + this.form.suspend.value = "pw lock $username"; + this.form.suspend_stdin.value=""; + this.form.unsuspend.value = "pw unlock $username"; + this.form.unsuspend_stdin.value=""; + '> + <LI> + <INPUT TYPE="button" VALUE="NetBSD/OpenBSD" onClick=' + this.form.useradd.value = "useradd -c $finger -d $dir -m -s $shell -u $uid -p $crypt_password $username"; + this.form.useradd_stdin.value = ""; + this.form.userdel.value = "userdel -r $username"; + this.form.userdel_stdin.value=""; + this.form.usermod.value = "usermod -c $new_finger -d $new_dir -m -l $new_username -s $new_shell -u $new_uid -p $new_crypt_password $old_username"; + this.form.usermod_stdin.value = ""; + this.form.suspend.value = ""; + this.form.suspend_stdin.value=""; + this.form.unsuspend.value = ""; + this.form.unsuspend_stdin.value=""; + '> + <LI> + <INPUT TYPE="button" VALUE="Just maintain directories (use with sysvshell or bsdshell)" onClick=' + this.form.useradd.value = "cp -pr /etc/skel $dir; chown -R $uid.$gid $dir"; this.form.useradd_stdin.value = ""; + this.form.usermod.value = "[ -d $old_dir ] && mv $old_dir $new_dir || ( chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; find . -depth -print | cpio -pdm $new_dir; chmod u-t $new_dir; chown -R $new_uid.$new_gid $new_dir; rm -rf $old_dir )"; + this.form.usermod_stdin.value = ""; + this.form.userdel.value = "rm -rf $dir"; + this.form.userdel_stdin.value=""; + this.form.suspend.value = ""; + this.form.suspend_stdin.value=""; + this.form.unsuspend.value = ""; + this.form.unsuspend_stdin.value=""; + '> +</UL> + +The following variables are available for interpolation (prefixed with new_ or +old_ for replace operations): +<UL> + <LI><code>$username</code> + <LI><code>$_password</code> + <LI><code>$quoted_password</code> - unencrypted password quoted for the shell + <LI><code>$crypt_password</code> - encrypted password + <LI><code>$uid</code> + <LI><code>$gid</code> + <LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes) + <LI><code>$first</code> - First name of GECOS, already quoted for the shell (do not add additional quotes) + <LI><code>$last</code> - Last name of GECOS, already quoted for the shell (do not add additional quotes) + <LI><code>$dir</code> - home directory + <LI><code>$shell</code> + <LI><code>$quota</code> + <LI><code>@radius_groups</code> + <LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available. +</UL> +END +); + @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); sub rebless { shift; } @@ -22,14 +176,25 @@ sub _export_delete { sub _export_suspend { my($self) = shift; - $self->_export_command('suspend', @_); + $self->_export_command_or_super('suspend', @_); } sub _export_unsuspend { my($self) = shift; - $self->_export_command('unsuspend', @_); + $self->_export_command_or_super('unsuspend', @_); } +sub _export_command_or_super { + my($self, $action) = (shift, shift); + if ( $self->option($action) =~ /^\s*$/ ) { + my $method = "SUPER::_export_$action"; + $self->$method(@_); + } else { + $self->_export_command($action, @_); + } +}; + + sub _export_command { my ( $self, $action, $svc_acct) = (shift, shift, shift); my $command = $self->option($action); @@ -56,12 +221,26 @@ sub _export_command { $email = ''; } + $finger =~ /^(.*)\s+(\S+)$/ or $finger =~ /^((.*))$/; + ($first, $last ) = ( $1, $2 ); + $first = shell_quote $first; + $last = shell_quote $last; $finger = shell_quote $finger; $quoted_password = shell_quote $_password; $domain = $svc_acct->domain; - $crypt_password = ''; #surpress "used only once" warnings - $crypt_password = crypt( $svc_acct->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))] ); + + #eventually should check a "password-encoding" field + if ( length($svc_acct->_password) == 13 + || $svc_acct->_password =~ /^\$(1|2a?)\$/ ) { + $crypt_password = shell_quote $svc_acct->_password; + } else { + $crypt_password = crypt( + $svc_acct->_password, + $saltset[int(rand(64))].$saltset[int(rand(64))] + ); + } + + @radius_groups = $svc_acct->radius_groups; $self->shellcommands_queue( $svc_acct->svcnum, user => $self->option('user')||'root', @@ -81,14 +260,29 @@ sub _export_replace { ${"old_$_"} = $old->getfield($_) foreach $old->fields; ${"new_$_"} = $new->getfield($_) foreach $new->fields; } + $new_finger =~ /^(.*)\s+(\S+)$/ or $finger =~ /^((.*))$/; + ($new_first, $new_last ) = ( $1, $2 ); + $new_first = shell_quote $new_first; + $new_last = shell_quote $new_last; $new_finger = shell_quote $new_finger; $quoted_new__password = shell_quote $new__password; #old, wrong? $new_quoted_password = shell_quote $new__password; #new, better? $old_domain = $old->domain; $new_domain = $new->domain; - $new_crypt_password = ''; #surpress "used only once" warnings - $new_crypt_password = crypt( $new->_password, - $saltset[int(rand(64))].$saltset[int(rand(64))]); + + #eventuall should check a "password-encoding" field + if ( length($new->_password) == 13 + || $new->_password =~ /^\$(1|2a?)\$/ ) { + $new_crypt_password = shell_quote $new->_password; + } else { + $new_crypt_password = + crypt( $new->_password, $saltset[int(rand(64))].$saltset[int(rand(64))] + ); + } + + @old_radius_groups = $old->radius_groups; + @new_radius_groups = $new->radius_groups; + if ( $self->option('usermod_pwonly') ) { my $error = ''; if ( $old_username ne $new_username ) { @@ -103,6 +297,10 @@ sub _export_replace { if ( $old_dir ne $new_dir ) { $error ||= "can't change dir"; } + if ( join("\n", sort @old_radius_groups) ne + join("\n", sort @new_radius_groups) ) { + $error ||= "can't change RADIUS groups"; + } return $error. ' ('. $self->exporttype. ' to '. $self->machine. ')' if $error; } @@ -125,7 +323,7 @@ sub shellcommands_queue { } sub ssh_cmd { #subroutine, not method - use Net::SSH '0.07'; + use Net::SSH '0.08'; &Net::SSH::ssh_cmd( { @_ } ); } @@ -136,3 +334,5 @@ sub ssh_cmd { #subroutine, not method #sub shellcommands_delete { #subroutine, not method #} +1; + diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm index a15c24d88..89ee95fa3 100644 --- a/FS/FS/part_export/shellcommands_withdomain.pm +++ b/FS/FS/part_export/shellcommands_withdomain.pm @@ -1,7 +1,105 @@ package FS::part_export::shellcommands_withdomain; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use FS::part_export::shellcommands; @ISA = qw(FS::part_export::shellcommands); +tie my %options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + #default=>'' + }, + 'useradd_stdin' => { label=>'Insert command STDIN', + type =>'textarea', + #default=>"$_password\n$_password\n", + }, + 'userdel' => { label=>'Delete command', + #default=>'', + }, + 'userdel_stdin' => { label=>'Delete command STDIN', + type =>'textarea', + #default=>'', + }, + 'usermod' => { label=>'Modify command', + default=>'', + }, + 'usermod_stdin' => { label=>'Modify command STDIN', + type =>'textarea', + #default=>"$_password\n$_password\n", + }, + 'usermod_pwonly' => { label=>'Disallow username changes', + type =>'checkbox', + }, + 'suspend' => { label=>'Suspension command', + default=>'', + }, + 'suspend_stdin' => { label=>'Suspension command STDIN', + default=>'', + }, + 'unsuspend' => { label=>'Unsuspension command', + default=>'', + }, + 'unsuspend_stdin' => { label=>'Unsuspension command STDIN', + default=>'', + }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Real-time export via remote SSH (vpopmail, ISPMan)', + 'options' => \%options, + 'notes' => <<'END' +Run remote commands via SSH. username@domain (rather than just usernames) are +considered unique (also see shellcommands). You probably want this if the +commands you are running will accept a domain as a parameter, and will allow +the same username with different domains. You will need to +<a href="../docs/ssh.html">setup SSH for unattended operation</a>. + +<BR><BR>Use these buttons for some useful presets: +<UL> + <LI><INPUT TYPE="button" VALUE="vpopmail" onClick=' + this.form.useradd.value = "/home/vpopmail/bin/vadduser $username\\\@$domain $quoted_password"; + this.form.useradd_stdin.value = ""; + this.form.userdel.value = "/home/vpopmail/bin/vdeluser $username\\\@$domain"; + this.form.userdel_stdin.value=""; + this.form.usermod.value = "/home/vpopmail/bin/vpasswd $new_username\\\@$new_domain $new_quoted_password"; + this.form.usermod_stdin.value = ""; + this.form.usermod_pwonly.checked = true; + '> + <LI><INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' + this.form.useradd.value = "/usr/local/ispman/bin/ispman.addUser -d $domain -f $first -l $last -q $quota -p $quoted_password $username"; + this.form.useradd_stdin.value = ""; + this.form.userdel.value = "/usr/local/ispman/bin/ispman.delUser -d $domain $username"; + this.form.userdel_stdin.value=""; + this.form.usermod.value = "/usr/local/ispman/bin/ispman.passwd.user $new_username\\\@$new_domain $new_quoted_password"; + this.form.usermod_stdin.value = ""; + this.form.usermod_pwonly.checked = true; + '> +</UL> + +The following variables are available for interpolation (prefixed with +<code>new_</code> or <code>old_</code> for replace operations): +<UL> + <LI><code>$username</code> + <LI><code>$domain</code> + <LI><code>$_password</code> + <LI><code>$quoted_password</code> - unencrypted password quoted for the shell + <LI><code>$crypt_password</code> - encrypted password + <LI><code>$uid</code> + <LI><code>$gid</code> + <LI><code>$finger</code> - GECOS, already quoted for the shell (do not add additional quotes) + <LI><code>$first</code> - First name of GECOS, already quoted for the shell (do not add additional quotes) + <LI><code>$last</code> - Last name of GECOS, already quoted for the shell (do not add additional quotes) + <LI><code>$dir</code> - home directory + <LI><code>$shell</code> + <LI><code>$quota</code> + <LI><code>@radius_groups</code> + <LI>All other fields in <a href="../docs/schema.html#svc_acct">svc_acct</a> are also available. +</UL> +END +); + +1; + diff --git a/FS/FS/part_export/sqlmail.pm b/FS/FS/part_export/sqlmail.pm index 8ccad3c7e..6d61e0e29 100644 --- a/FS/FS/part_export/sqlmail.pm +++ b/FS/FS/part_export/sqlmail.pm @@ -1,6 +1,7 @@ package FS::part_export::sqlmail; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use Digest::MD5 qw(md5_hex); use FS::Record qw(qsearchs); use FS::part_export; @@ -8,6 +9,41 @@ use FS::svc_domain; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + 'datasrc' => { label => 'DBI data source' }, + 'username' => { label => 'Database username' }, + 'password' => { label => 'Database password' }, + 'server_type' => { + label => 'Server type', + type => 'select', + options => [qw(dovecot_plain dovecot_crypt dovecot_digest_md5 courier_plain + courier_crypt)], + default => ['dovecot_plain'], }, + 'svc_acct_table' => { label => 'User Table', default => 'user_acct' }, + 'svc_forward_table' => { label => 'Forward Table', default => 'forward' }, + 'svc_domain_table' => { label => 'Domain Table', default => 'domain' }, + 'svc_acct_fields' => { label => 'svc_acct Export Fields', + default => 'username _password domsvc svcnum' }, + 'svc_forward_fields' => { label => 'svc_forward Export Fields', + default => 'domain svcnum catchall' }, + 'svc_domain_fields' => { label => 'svc_domain Export Fields', + default => 'srcsvc dstsvc dst' }, + 'resolve_dstsvc' => { label => q{Resolve svc_forward.dstsvc to an email address and store it in dst. (Doesn't require that you also export dstsvc.)}, + type => 'checkbox' }, +; + +%info = ( + 'svc' => [qw( svc_acct svc_domain svc_forward )], + 'desc' => 'Real-time export to SQL-backed mail server', + 'options' => \%options, + 'nodomain' => '', + 'notes' => <<'END' +Database schema can be made to work with Courier IMAP, Exim and Dovecot. +Others could work but are untested. (more detailed description from +Kristian / fire2wire? ) +END +); + sub rebless { shift; } sub _export_insert { @@ -180,3 +216,5 @@ sub update_values { } +1; + diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 8a8f9beba..fd5bb89fd 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -1,11 +1,64 @@ package FS::part_export::sqlradius; -use vars qw(@ISA); +use vars qw(@ISA %info %options $notes1 $notes2); +use Tie::IxHash; use FS::Record qw( dbh ); use FS::part_export; @ISA = qw(FS::part_export); +tie %options, 'Tie::IxHash', + 'datasrc' => { label=>'DBI data source ' }, + 'username' => { label=>'Database username' }, + 'password' => { label=>'Database password' }, + 'ignore_accounting' => { + type => 'checkbox', + label=>'Ignore accounting records from this database' + }, +; + +$notes1 = <<'END'; +Real-time export of radcheck, radreply and usergroup tables to any SQL database +for <a href="http://www.freeradius.org/">FreeRADIUS</a>, +<a href="http://radius.innercite.com/">ICRADIUS</a> +or <a href="http://www.open.com.au/radiator/">Radiator</a>. +END + +$notes2 = <<'END'; +An existing RADIUS database will be updated in realtime, but you can use +<a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a> +to delete the entire RADIUS database and repopulate the tables from the +Freeside database. See the +<a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a> +and the +<a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a> +for the exact syntax of a DBI data source. +<ul> + <li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes. This is fixed in 0.9.1. Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected. + <li>Using ICRADIUS, add a dummy "op" column to your database: + <blockquote><code> + ALTER TABLE radcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br> + ALTER TABLE radreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br> + ALTER TABLE radgroupcheck ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '=='<br> + ALTER TABLE radgroupreply ADD COLUMN op VARCHAR(2) NOT NULL DEFAULT '==' + </code></blockquote> + <li>Using Radiator, see the + <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a> + for configuration information. +</ul> +END + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator)', + 'options' => \%options, + 'nodomain' => 'Y', + 'notes' => $notes1. + 'This export does not export RADIUS realms (see also '. + 'sqlradius_withdomain). '. + $notes2 +); + sub rebless { shift; } sub export_username { @@ -280,3 +333,5 @@ sub sqlradius_connect { DBI->connect(@_) or die $DBI::errstr; } +1; + diff --git a/FS/FS/part_export/sqlradius_withdomain.pm b/FS/FS/part_export/sqlradius_withdomain.pm index 1c8f38c9d..6130e5eb6 100644 --- a/FS/FS/part_export/sqlradius_withdomain.pm +++ b/FS/FS/part_export/sqlradius_withdomain.pm @@ -1,8 +1,22 @@ package FS::part_export::sqlradius_withdomain; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use FS::part_export::sqlradius; +tie my %options, 'Tie::IxHash', %FS::part_export::sqlradius::options; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator) with realms', + 'options' => \%options, + 'nodomain' => '', + 'notes' => $FS::part_export::sqlradius::notes1. + 'This export exports domains to RADIUS realms (see also '. + 'sqlradius). '. + $FS::part_export::sqlradius::notes2 +); + @ISA = qw(FS::part_export::sqlradius); sub export_username { @@ -10,3 +24,5 @@ sub export_username { $svc_acct->email; } +1; + diff --git a/FS/FS/part_export/sysvshell.pm b/FS/FS/part_export/sysvshell.pm index f3f6b34b6..244c3bf82 100644 --- a/FS/FS/part_export/sysvshell.pm +++ b/FS/FS/part_export/sysvshell.pm @@ -1,7 +1,25 @@ package FS::part_export::sysvshell; -use vars qw(@ISA); -use FS::part_export::null; +use vars qw(@ISA %info); +use Tie::IxHash; +use FS::part_export::passwdfile; -@ISA = qw(FS::part_export::null); +@ISA = qw(FS::part_export::passwdfile); + +tie my %options, 'Tie::IxHash', %FS::part_export::passwdfile::options; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => + 'Batch export of /etc/passwd and /etc/shadow files (Linux, Solaris)', + 'options' => \%options, + 'nodomain' => 'Y', + 'notes' => <<'END' +MD5 crypt requires installation of +<a href="http://search.cpan.org/dist/Crypt-PasswdMD5">Crypt::PasswdMD5</a> +from CPAN. Run bin/sysvshell.export to export the files. +END +); + +1; diff --git a/FS/FS/part_export/textradius.pm b/FS/FS/part_export/textradius.pm index 1492f2672..65936eaf6 100644 --- a/FS/FS/part_export/textradius.pm +++ b/FS/FS/part_export/textradius.pm @@ -1,12 +1,35 @@ package FS::part_export::textradius; -use vars qw(@ISA $prefix); +use vars qw(@ISA %info $prefix); use Fcntl qw(:flock); +use Tie::IxHash; use FS::UID qw(datasrc); use FS::part_export; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'users' => { label=>'users file location', default=>'/etc/raddb/users' }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => + 'Real-time export to a text /etc/raddb/users file (Livingston, Cistron)', + 'options' => \%options, + 'notes' => <<'END' +This will edit a text RADIUS users file in place on a remote server. +Requires installation of +<a href="http://search.cpan.org/dist/RADIUS-UserFile">RADIUS::UserFile</a> +from CPAN. If using RADIUS::UserFile 1.01, make sure to apply +<a href="http://rt.cpan.org/NoAuth/Bug.html?id=1210">this patch</a>. Also +make sure <a href="http://rsync.samba.org/">rsync</a> is installed on the +remote machine, and <a href="../docs/ssh.html">SSH is setup for unattended +operation</a>. +END +); + $prefix = "/usr/local/etc/freeside/export."; sub rebless { shift; } @@ -164,3 +187,5 @@ sub textradius_upload { } +1; + diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm index a505a0f47..0fc8266ea 100644 --- a/FS/FS/part_export/vpopmail.pm +++ b/FS/FS/part_export/vpopmail.pm @@ -1,13 +1,40 @@ package FS::part_export::vpopmail; -use vars qw(@ISA @saltset $exportdir); +use vars qw(@ISA %info @saltset $exportdir); use Fcntl qw(:flock); +use Tie::IxHash; use File::Path; use FS::UID qw( datasrc ); use FS::part_export; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + #'machine' => { label=>'vpopmail machine', }, + 'dir' => { label=>'directory', }, # ?more info? default? + 'uid' => { label=>'vpopmail uid' }, + 'gid' => { label=>'vpopmail gid' }, + 'restart' => { label=> 'vpopmail restart command', + default=> 'cd /home/vpopmail/domains; for domain in *; do /home/vpopmail/bin/vmkpasswd $domain; done; /var/qmail/bin/qmail-newu; killall -HUP qmail-send', + }, +; + +%info = ( + 'svc' => 'svc_acct', + 'desc' => 'Real-time export to vpopmail text files', + 'options' => \%options, + 'notes' => <<'END' +This export is currently unmaintained. See shellcommands_withdomain for an +export that uses vpopmail CLI commands instead.<BR> +<BR> +Real time export to <a href="http://inter7.com/vpopmail/">vpopmail</a> text +files. <a href="http://search.cpan.org/dist/File-Rsync">File::Rsync</a> +must be installed, and you will need to +<a href="../docs/ssh.html">setup SSH for unattended operation</a> +to <b>vpopmail</b>@<i>export.host</i>. +END +); + @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' ); sub rebless { shift; } @@ -223,4 +250,5 @@ sub vpopmail_sync { ssh("vpopmail\@$machine", $restart) if $restart; } +1; diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm index 20658c7a2..dd909376b 100644 --- a/FS/FS/part_export/www_shellcommands.pm +++ b/FS/FS/part_export/www_shellcommands.pm @@ -1,11 +1,64 @@ package FS::part_export::www_shellcommands; use strict; -use vars qw(@ISA); +use vars qw(@ISA %info); +use Tie::IxHash; use FS::part_export; @ISA = qw(FS::part_export); +tie my %options, 'Tie::IxHash', + 'user' => { label=>'Remote username', default=>'root' }, + 'useradd' => { label=>'Insert command', + default=>'mkdir $homedir/$zone; chown $username $homedir/$zone; ln -s $homedir/$zone /var/www/$zone', + }, + 'userdel' => { label=>'Delete command', + default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm -rf $homedir/$zone', + }, + 'usermod' => { label=>'Modify command', + default=>'[ -n "$old_zone" ] && rm /var/www/$old_zone; [ "$old_zone" != "$new_zone" -a -n "$new_zone" ] && ( mv $old_homedir/$old_zone $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone ); [ "$old_username" != "$new_username" ] && chown -R $new_username $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone', + }, +; + +%info = ( + 'svc' => 'svc_www', + 'desc' => 'Run remote commands via SSH, for virtual web sites.', + 'options' => \%options, + 'notes' => <<'END' +Run remote commands via SSH, for virtual web sites. You will need to +<a href="../docs/ssh.html">setup SSH for unattended operation</a>. +<BR><BR>Use these buttons for some useful presets: +<UL> + <LI> + <INPUT TYPE="button" VALUE="Maintain directories" onClick=' + this.form.user.value = "root"; + this.form.useradd.value = "mkdir $homedir/$zone; chown $username $homedir/$zone; ln -s $homedir/$zone /var/www/$zone"; + this.form.userdel.value = "[ -n \"$zone\" ] && rm -rf /var/www/$zone; rm -rf $homedir/$zone"; + this.form.usermod.value = "[ -n \"$old_zone\" ] && rm /var/www/$old_zone; [ \"$old_zone\" != \"$new_zone\" -a -n \"$new_zone\" ] && ( mv $old_homedir/$old_zone $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone ); [ \"$old_username\" != \"$new_username\" ] && chown -R $new_username $new_homedir/$new_zone; ln -sf $new_homedir/$new_zone /var/www/$new_zone"; + '> + <LI> + <INPUT TYPE="button" VALUE="ISPMan CLI" onClick=' + this.form.user.value = "root"; + this.form.useradd.value = "/usr/local/ispman/bin/ispman.addvhost -d $domain $bare_zone"; + this.form.userdel.value = "/usr/local/ispman/bin/ispman.deletevhost -d $domain $bare_zone"; + this.form.usermod.value = ""; + '> +</UL> +The following variables are available for interpolation (prefixed with +<code>new_</code> or <code>old_</code> for replace operations): +<UL> + <LI><code>$zone</code> - fully-qualified zone of this virtual host + <LI><code>$bare_zone</code> - just the zone of this virtual host, without the domain portion + <LI><code>$domain</code> - base domain + <LI><code>$username</code> + <LI><code>$homedir</code> + <LI>All other fields in <a href="../docs/schema.html#svc_www">svc_www</a> + are also available. +</UL> +END +); + + sub rebless { shift; } sub _export_insert { @@ -30,6 +83,8 @@ sub _export_command { } my $domain_record = $svc_www->domain_record; # or die ? my $zone = $domain_record->zone; # or die ? + my $domain = $domain_record->svc_domain->domain; + ( my $bare_zone = $zone ) =~ s/\.$domain$//; my $svc_acct = $svc_www->svc_acct; # or die ? my $username = $svc_acct->username; my $homedir = $svc_acct->dir; # or die ? @@ -55,23 +110,17 @@ sub _export_replace { ${"new_$_"} = $new->getfield($_) foreach $new->fields; } my $old_domain_record = $old->domain_record; # or die ? - my $old_zone = $old_domain_record->reczone; # or die ? - unless ( $old_zone =~ /\.$/ ) { - my $old_svc_domain = $old_domain_record->svc_domain; # or die ? - $old_zone .= '.'. $old_svc_domain->domain; - } - + my $old_zone = $old_domain_record->zone; # or die ? + my $old_domain = $old_domain_record->svc_domain->domain; + ( my $old_bare_zone = $old_zone ) =~ s/\.$old_domain$//; my $old_svc_acct = $old->svc_acct; # or die ? my $old_username = $old_svc_acct->username; my $old_homedir = $old_svc_acct->dir; # or die ? my $new_domain_record = $new->domain_record; # or die ? - my $new_zone = $new_domain_record->reczone; # or die ? - unless ( $new_zone =~ /\.$/ ) { - my $new_svc_domain = $new_domain_record->svc_domain; # or die ? - $new_zone .= '.'. $new_svc_domain->domain; - } - + my $new_zone = $new_domain_record->zone; # or die ? + my $new_domain = $new_domain_record->svc_domain->domain; + ( my $new_bare_zone = $new_zone ) =~ s/\.$new_domain$//; my $new_svc_acct = $new->svc_acct; # or die ? my $new_username = $new_svc_acct->username; my $new_homedir = $new_svc_acct->dir; # or die ? @@ -96,7 +145,7 @@ sub shellcommands_queue { } sub ssh_cmd { #subroutine, not method - use Net::SSH '0.07'; + use Net::SSH '0.08'; &Net::SSH::ssh_cmd( { @_ } ); } diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 243b53f91..ba03fe0bb 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -1,15 +1,19 @@ package FS::part_pkg; use strict; -use vars qw( @ISA ); -use FS::Record qw( qsearch dbh ); +use vars qw( @ISA $DEBUG ); +use FS::Conf; +use FS::Record qw( qsearch qsearchs dbh dbdef ); use FS::pkg_svc; +use FS::part_svc; +use FS::cust_pkg; use FS::agent_type; use FS::type_pkgs; -use FS::Conf; @ISA = qw( FS::Record ); +$DEBUG = 0; + =head1 NAME FS::part_pkg - Object methods for part_pkg objects @@ -105,16 +109,33 @@ sub clone { new $class ( \%hash ); # ? } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this billing item definition to the database. If there is an error, returns the error, otherwise returns false. +Currently available options are: I<pkg_svc>, I<primary_svc>, I<cust_pkg> and +I<custnum_ref>. + +If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as +values, appropriate FS::pkg_svc records will be inserted. + +If I<primary_svc> is set to the svcpart of the primary service, the appropriate +FS::pkg_svc record will be updated. + +If I<cust_pkg> is set to a pkgnum of a FS::cust_pkg record (or the FS::cust_pkg +record itself), the object will be updated to point to this package definition. + +In conjunction with I<cust_pkg>, if I<custnum_ref> is set to a scalar reference, +the scalar will be updated with the custnum value from the cust_pkg record. + =cut sub insert { my $self = shift; - + my %options = @_; + warn "FS::part_pkg::insert called on $self with options %options" if $DEBUG; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -148,6 +169,45 @@ sub insert { } } + warn " inserting pkg_svc records" if $DEBUG; + my $pkg_svc = $options{'pkg_svc'} || {}; + foreach my $part_svc ( qsearch('part_svc', {} ) ) { + my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; + my $primary_svc = $options{'primary_svc'} == $part_svc->svcpart ? 'Y' : ''; + + my $pkg_svc = new FS::pkg_svc( { + 'pkgpart' => $self->pkgpart, + 'svcpart' => $part_svc->svcpart, + 'quantity' => $quantity, + 'primary_svc' => $primary_svc, + } ); + my $error = $pkg_svc->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ( $options{'cust_pkg'} ) { + warn " updating cust_pkg record " if $DEBUG; + my $old_cust_pkg = + ref($options{'cust_pkg'}) + ? $options{'cust_pkg'} + : qsearchs('cust_pkg', { pkgnum => $options{'cust_pkg'} } ); + ${ $options{'custnum_ref'} } = $old_cust_pkg->custnum + if $options{'custnum_ref'}; + my %hash = $old_cust_pkg->hash; + $hash{'pkgpart'} = $self->pkgpart, + my $new_cust_pkg = new FS::cust_pkg \%hash; + local($FS::cust_pkg::disable_agentcheck) = 1; + my $error = $new_cust_pkg->replace($old_cust_pkg); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error modifying cust_pkg record: $error"; + } + } + + warn " commiting transaction" if $DEBUG; $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -164,11 +224,83 @@ sub delete { # check & make sure the pkgpart isn't in cust_pkg or type_pkgs? } -=item replace OLD_RECORD +=item replace OLD_RECORD [ , OPTION => VALUE ... ] Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. +Currently available options are: I<pkg_svc> and I<primary_svc> + +If I<pkg_svc> is set to a hashref with svcparts as keys and quantities as +values, the appropriate FS::pkg_svc records will be replace. + +If I<primary_svc> is set to the svcpart of the primary service, the appropriate +FS::pkg_svc record will be updated. + +=cut + +sub replace { + my( $new, $old ) = ( shift, shift ); + my %options = @_; + warn "FS::part_pkg::replace called on $new to replace $old ". + "with options %options" + if $DEBUG; + + 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; + + warn " replacing part_pkg record" if $DEBUG; + my $error = $new->SUPER::replace($old); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + warn " replacing pkg_svc records" if $DEBUG; + my $pkg_svc = $options{'pkg_svc'} || {}; + foreach my $part_svc ( qsearch('part_svc', {} ) ) { + my $quantity = $pkg_svc->{$part_svc->svcpart} || 0; + my $primary_svc = $options{'primary_svc'} == $part_svc->svcpart ? 'Y' : ''; + + my $old_pkg_svc = qsearchs('pkg_svc', { + 'pkgpart' => $old->pkgpart, + 'svcpart' => $part_svc->svcpart, + } ); + my $old_quantity = $old_pkg_svc ? $old_pkg_svc->quantity : 0; + my $old_primary_svc = + ( $old_pkg_svc && $old_pkg_svc->dbdef_table->column('primary_svc') ) + ? $old_pkg_svc->primary_svc + : ''; + next unless $old_quantity != $quantity || $old_primary_svc ne $primary_svc; + + my $new_pkg_svc = new FS::pkg_svc( { + 'pkgpart' => $new->pkgpart, + 'svcpart' => $part_svc->svcpart, + 'quantity' => $quantity, + 'primary_svc' => $primary_svc, + } ); + my $error = $old_pkg_svc + ? $new_pkg_svc->replace($old_pkg_svc) + : $new_pkg_svc->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + warn " commiting transaction" if $DEBUG; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; +} + =item check Checks all fields to make sure this is a valid billing item definition. If @@ -266,20 +398,24 @@ sub pkg_svc { =item svcpart [ SVCDB ] -Returns the svcpart of a single service definition (see L<FS::part_svc>) +Returns the svcpart of the primary service definition (see L<FS::part_svc>) associated with this billing item definition (see L<FS::pkg_svc>). Returns -false if there not exactly one service definition with quantity 1, or if -SVCDB is specified and does not match the svcdb of the service definition, +false if there not a primary service definition or exactly one service +definition with quantity 1, or if SVCDB is specified and does not match the +svcdb of the service definition, =cut sub svcpart { my $self = shift; my $svcdb = scalar(@_) ? shift : ''; - my @pkg_svc = grep { - $_->quantity == 1 - && ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) - } $self->pkg_svc; + my @svcdb_pkg_svc = + grep { ( $svcdb eq $_->part_svc->svcdb || !$svcdb ) } $self->pkg_svc; + my @pkg_svc = (); + @pkg_svc = grep { $_->primary_svc =~ /^Y/i } @svcdb_pkg_svc + if dbdef->table('pkg_svc')->column('primary_svc'); + @pkg_svc = grep {$_->quantity == 1 } @svcdb_pkg_svc + unless @pkg_svc; return '' if scalar(@pkg_svc) != 1; $pkg_svc[0]->svcpart; } diff --git a/FS/FS/part_pop_local.pm b/FS/FS/part_pop_local.pm index 0b7cdf6c9..3c16cc506 100644 --- a/FS/FS/part_pop_local.pm +++ b/FS/FS/part_pop_local.pm @@ -98,10 +98,6 @@ sub check { =back -=head1 VERSION - -$Id: part_pop_local.pm,v 1.1 2001-09-26 09:17:06 ivan Exp $ - =head1 BUGS US/CA-centric. diff --git a/FS/FS/part_svc.pm b/FS/FS/part_svc.pm index 552019acb..1812c614f 100644 --- a/FS/FS/part_svc.pm +++ b/FS/FS/part_svc.pm @@ -6,6 +6,7 @@ use FS::Record qw( qsearch qsearchs fields dbh ); use FS::part_svc_column; use FS::part_export; use FS::export_svc; +use FS::cust_svc; @ISA = qw(FS::Record); @@ -21,8 +22,12 @@ FS::part_svc - Object methods for part_svc objects $record = new FS::part_svc { 'column' => 'value' }; $error = $record->insert; + $error = $record->insert( [ 'pseudofield' ] ); + $error = $record->insert( [ 'pseudofield' ], \%exportnums ); $error = $new_record->replace($old_record); + $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ] ); + $error = $new_record->replace($old_record, '1.3-COMPAT', [ 'pseudofield' ], \%exportnums ); $error = $record->delete; @@ -59,25 +64,40 @@ database, see L<"insert">. sub table { 'part_svc'; } -=item insert EXTRA_FIELDS_ARRAYREF +=item insert [ EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF ] ] Adds this service definition to the database. If there is an error, returns the error, otherwise returns false. -TODOC: +The following pseudo-fields may be defined, and will be maintained in +the part_svc_column table appropriately (see L<FS::part_svc_column>). + +=over 4 =item I<svcdb>__I<field> - Default or fixed value for I<field> in I<svcdb>. =item I<svcdb>__I<field>_flag - defines I<svcdb>__I<field> action: null, `D' for default, or `F' for fixed -TODOC: EXTRA_FIELDS_ARRAYREF +=back + +If you want to add part_svc_column records for fields that do not exist as +(real or virtual) fields in the I<svcdb> table, make sure to list then in +EXTRA_FIELDS_ARRAYREF also. + +If EXPORTNUMS_HASHREF is specified (keys are exportnums and values are +boolean), the appopriate export_svc records will be inserted. =cut sub insert { my $self = shift; my @fields = (); + my @exportnums = (); @fields = @{shift(@_)} if @_; + if ( @_ ) { + my $exportnums = shift; + @exportnums = grep $exportnums->{$_}, keys %$exportnums; + } local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -96,6 +116,8 @@ sub insert { return $error; } + # add part_svc_column records + my $svcdb = $self->svcdb; # my @rows = map { /^${svcdb}__(.*)$/; $1 } # grep ! /_flag$/, @@ -133,6 +155,20 @@ sub insert { } + # add export_svc records + + foreach my $exportnum ( @exportnums ) { + my $export_svc = new FS::export_svc ( { + 'exportnum' => $exportnum, + 'svcpart' => $self->svcpart, + } ); + $error = $export_svc->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -140,7 +176,7 @@ sub insert { =item delete -Currently unimplemented. +Currently unimplemented. Set the "disabled" field instead. =cut @@ -149,14 +185,14 @@ sub delete { # check & make sure the svcpart isn't in cust_svc or pkg_svc (in any packages)? } -=item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF ] ] +=item replace OLD_RECORD [ '1.3-COMPAT' [ , EXTRA_FIELDS_ARRAYREF [ , EXPORTNUMS_HASHREF ] ] ] Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. TODOC: 1.3-COMPAT -TODOC: EXTRA_FIELDS_ARRAYREF +TODOC: EXTRA_FIELDS_ARRAYREF (same as insert method) =cut @@ -187,6 +223,9 @@ sub replace { shift; my @fields = (); @fields = @{shift(@_)} if @_; + my $exportnums = @_ ? shift : ''; + + # maintain part_svc_column records my $svcdb = $new->svcdb; foreach my $field ( @@ -219,6 +258,39 @@ sub replace { return $error; } } + + # maintain export_svc records + + if ( $exportnums ) { + + #false laziness w/ edit/process/agent_type.cgi + foreach my $part_export ( qsearch('part_export', {}) ) { + my $exportnum = $part_export->exportnum; + my $hashref = { + 'exportnum' => $exportnum, + 'svcpart' => $new->svcpart, + }; + my $export_svc = qsearchs('export_svc', $hashref); + + if ( $export_svc && ! $exportnums->{$exportnum} ) { + $error = $export_svc->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } elsif ( ! $export_svc && $exportnums->{$exportnum} ) { + $export_svc = new FS::export_svc ( $hashref ); + $error = $export_svc->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + } + + } + } else { $dbh->rollback if $oldAutoCommit; return 'non-1.3-COMPAT interface not yet written'; @@ -326,6 +398,28 @@ sub part_export { qsearch('export_svc', { 'svcpart' => $self->svcpart } ); } +=item cust_svc + +Returns a list of associated FS::cust_svc records. + +=cut + +sub cust_svc { + my $self = shift; + qsearch('cust_svc', { 'svcpart' => $self->svcpart } ); +} + +=item svc_x + +Returns a list of associated FS::svc_* records. + +=cut + +sub svc_x { + my $self = shift; + map { $_->svc_x } $self->cust_svc; +} + =back =head1 BUGS diff --git a/FS/FS/part_svc_column.pm b/FS/FS/part_svc_column.pm index 37e841e87..9a46245ff 100644 --- a/FS/FS/part_svc_column.pm +++ b/FS/FS/part_svc_column.pm @@ -100,10 +100,6 @@ sub check { =back -=head1 VERSION - -$Id: part_svc_column.pm,v 1.1 2001-09-07 20:49:15 ivan Exp $ - =head1 BUGS =head1 SEE ALSO diff --git a/FS/FS/pkg_svc.pm b/FS/FS/pkg_svc.pm index 1812dbf29..3956dd831 100644 --- a/FS/FS/pkg_svc.pm +++ b/FS/FS/pkg_svc.pm @@ -46,6 +46,8 @@ FS::Record. The following fields are currently supported: =item quantity - Quantity of this service definition that this billing item definition includes +=item primary_svc - primary flag, empty or 'Y' + =back =head1 METHODS @@ -108,6 +110,11 @@ sub check { return "Unknown pkgpart!" unless $self->part_pkg; return "Unknown svcpart!" unless $self->part_svc; + if ( $self->dbdef_table->column('primary_svc') ) { + $error = $self->ut_enum('primary_svc', [ '', 'Y' ] ); + return $error if $error; + } + ''; #no error } @@ -135,10 +142,6 @@ sub part_svc { =back -=head1 VERSION - -$Id: pkg_svc.pm,v 1.1 1999-08-04 09:03:53 ivan Exp $ - =head1 BUGS =head1 SEE ALSO diff --git a/FS/FS/port.pm b/FS/FS/port.pm index 13455ca89..1fb439ee7 100644 --- a/FS/FS/port.pm +++ b/FS/FS/port.pm @@ -131,10 +131,6 @@ sub session { =back -=head1 VERSION - -$Id: port.pm,v 1.5 2001-02-14 04:33:06 ivan Exp $ - =head1 BUGS The author forgot to customize this manpage. diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index d35dc883f..f376a7bce 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -1,7 +1,7 @@ package FS::queue; use strict; -use vars qw( @ISA @EXPORT_OK $conf $jobnums); +use vars qw( @ISA @EXPORT_OK $DEBUG $conf $jobnums); use Exporter; use FS::UID; use FS::Conf; @@ -14,6 +14,9 @@ use FS::cust_svc; @ISA = qw(FS::Record); @EXPORT_OK = qw( joblisting ); +$DEBUG = 0; +#$DEBUG = 1; + $FS::UID::callback{'FS::queue'} = sub { $conf = new FS::Conf; }; @@ -120,7 +123,10 @@ sub insert { } } - push @$jobnums, $self->jobnum if $jobnums; + if ( $jobnums ) { + warn "jobnums global is active: $jobnums\n" if $DEBUG; + push @$jobnums, $self->jobnum; + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -239,6 +245,7 @@ sub cust_svc { =item queue_depend Returns the FS::queue_depend objects associated with this job, if any. +(Dependancies that must complete before this job can be run). =cut @@ -247,7 +254,6 @@ sub queue_depend { qsearch('queue_depend', { 'jobnum' => $self->jobnum } ); } - =item depend_insert OTHER_JOBNUM Inserts a dependancy for this job - it will not be run until the other job @@ -268,6 +274,39 @@ sub depend_insert { $queue_depend->insert; } +=item queue_depended + +Returns the FS::queue_depend objects that associate other jobs with this job, +if any. (The jobs that are waiting for this job to complete before they can +run). + +=cut + +sub queue_depended { + my $self = shift; + qsearch('queue_depend', { 'depend_jobnum' => $self->jobnum } ); +} + +=item depended_delete + +Deletes the other queued jobs (FS::queue objects) that are waiting for this +job, if any. If there is an error, returns the error, otherwise returns false. + +=cut + +sub depended_delete { + my $self = shift; + my $error; + foreach my $job ( + map { qsearchs('queue', { 'jobnum' => $_->jobnum } ) } $self->queue_depended + ) { + $error = $job->depended_delete; + return $error if $error; + $error = $job->delete; + return $error if $error + } +} + =back =head1 SUBROUTINES @@ -313,9 +352,7 @@ END my $args; if ( $dangerous || $queue->job !~ /^FS::part_export::/ || !$noactions ) { - $args = encode_entities( join(' ', - map { length($_)<54 ? $_ : substr($_,0,32)."..." } $queue->args #1&g - ) ); + $args = encode_entities( join(' ', $queue->args) ); } else { $args = ''; } @@ -383,10 +420,6 @@ END =back -=head1 VERSION - -$Id: queue.pm,v 1.15 2002-07-02 06:48:59 ivan Exp $ - =head1 BUGS $jobnums global diff --git a/FS/FS/queue_arg.pm b/FS/FS/queue_arg.pm index 08fe47341..ef0473a07 100644 --- a/FS/FS/queue_arg.pm +++ b/FS/FS/queue_arg.pm @@ -105,10 +105,6 @@ sub check { =back -=head1 VERSION - -$Id: queue_arg.pm,v 1.1 2001-09-11 00:08:18 ivan Exp $ - =head1 BUGS =head1 SEE ALSO diff --git a/FS/FS/session.pm b/FS/FS/session.pm index de0f2a76a..f4565602d 100644 --- a/FS/FS/session.pm +++ b/FS/FS/session.pm @@ -245,10 +245,6 @@ sub svc_acct { =back -=head1 VERSION - -$Id: session.pm,v 1.7 2001-04-15 13:35:12 ivan Exp $ - =head1 BUGS Maybe you shouldn't be able to insert a session if there's currently an open diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index 2e236ee2e..b561e873a 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -1,7 +1,7 @@ package FS::svc_Common; use strict; -use vars qw( @ISA $noexport_hack ); +use vars qw( @ISA $noexport_hack $DEBUG ); use FS::Record qw( qsearchs fields dbh ); use FS::cust_svc; use FS::part_svc; @@ -9,6 +9,9 @@ use FS::queue; @ISA = qw( FS::Record ); +$DEBUG = 0; +#$DEBUG = 1; + =head1 NAME FS::svc_Common - Object method for all svc_ records @@ -28,7 +31,7 @@ inherit from, i.e. FS::svc_acct. FS::svc_Common inherits from FS::Record. =over 4 -=item insert [ JOBNUM_ARRAYREF [ OBJECTS_ARRAYREF ] ] +=item insert [ , OPTION => VALUE ... ] Adds this record to the database. If there is an error, returns the error, otherwise returns false. @@ -36,19 +39,36 @@ otherwise returns false. The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be defined. An FS::cust_svc record will be created and inserted. -If an arrayref is passed as parameter, the B<jobnum>s of any export jobs will -be added to the array. +Currently available options are: I<jobnums>, I<child_objects> and +I<depend_jobnum>. + +If I<jobnum> is set to an array reference, the jobnums of any export jobs will +be added to the referenced array. + +If I<child_objects> is set to an array reference of FS::tablename objects (for +example, FS::acct_snarf objects), they will have their svcnum fieldsset and +will be inserted after this record, but before any exports are run. -If an arrayref of FS::tablename objects (for example, FS::acct_snarf objects) -is passed as the optional second parameter, they will have their svcnum fields -set and will be inserted after this record, but before any exports are run. +If I<depend_jobnum> 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 sub insert { my $self = shift; - local $FS::queue::jobnums = shift if @_; - my $objects = scalar(@_) ? shift : []; + my %options = @_; + warn "FS::svc_Common::insert called with options ". + join(', ', map { "$_: $options{$_}" } keys %options ). "\n" + if $DEBUG; + + my @jobnums = (); + local $FS::queue::jobnums = \@jobnums; + warn "FS::svc_Common::insert: set \$FS::queue::jobnums to $FS::queue::jobnums" + if $DEBUG; + my $objects = $options{'child_objects'} || []; + my $depend_jobnums = $options{'depend_jobnum'} || []; + $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums); my $error; local $SIG{HUP} = 'IGNORE'; @@ -108,6 +128,10 @@ sub insert { #new-style exports! unless ( $noexport_hack ) { + + warn "FS::svc_Common::insert: \$FS::queue::jobnums is $FS::queue::jobnums" + if $DEBUG; + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { my $error = $part_export->export_insert($self); if ( $error ) { @@ -116,6 +140,26 @@ sub insert { " (transaction rolled back): $error"; } } + + foreach my $depend_jobnum ( @$depend_jobnums ) { + warn "inserting dependancies on supplied job $depend_jobnum\n" + if $DEBUG; + foreach my $jobnum ( @jobnums ) { + my $queue = qsearchs('queue', { 'jobnum' => $jobnum } ); + warn "inserting dependancy for job $jobnum on $depend_jobnum\n" + if $DEBUG; + my $error = $queue->depend_insert($depend_jobnum); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error queuing job dependancy: $error"; + } + } + } + + } + + if ( exists $options{'jobnums'} ) { + push @{ $options{'jobnums'} }, @jobnums; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -376,11 +420,31 @@ methods. Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>). sub cancel { ''; } -=back +=item clone_suspended -=head1 VERSION +Constructor used by FS::part_export::_export_suspend fallback. Stub returning +same object for svc_ classes which don't implement a suspension fallback +(everything except svc_acct at the moment). Document better. -$Id: svc_Common.pm,v 1.12.4.4 2003-11-12 12:29:55 ivan Exp $ +=cut + +sub clone_suspended { + shift; +} + +=item clone_kludge_unsuspend + +Constructor used by FS::part_export::_export_unsuspend fallback. Stub returning +same object for svc_ classes which don't implement a suspension fallback +(everything except svc_acct at the moment). Document better. + +=cut + +sub clone_kludge_unsuspend { + shift; +} + +=back =head1 BUGS diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index e7812bfe5..91b51620d 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -7,6 +7,7 @@ use vars qw( @ISA $DEBUG $me $conf $username_ampersand $username_letter $username_letterfirst $username_noperiod $username_nounderscore $username_nodash $username_uppercase + $password_noampersand $password_noexclamation $mydomain $welcome_template $welcome_from $welcome_subject $welcome_mimetype $smtpmachine @@ -15,6 +16,7 @@ use vars qw( @ISA $DEBUG $me $conf @saltset @pw_set ); use Carp; use Fcntl qw(:flock); +use Crypt::PasswdMD5; use FS::UID qw( datasrc ); use FS::Conf; use FS::Record qw( qsearch qsearchs fields dbh dbdef ); @@ -32,10 +34,13 @@ use FS::radius_usergroup; use FS::export_svc; use FS::part_export; use FS::Msgcat qw(gettext); +use FS::svc_forward; +use FS::svc_www; @ISA = qw( FS::svc_Common ); $DEBUG = 0; +#$DEBUG = 1; $me = '[FS::svc_acct]'; #ask FS::UID to run this stuff for us later @@ -54,6 +59,8 @@ $FS::UID::callback{'FS::svc_acct'} = sub { $username_nodash = $conf->exists('username-nodash'); $username_uppercase = $conf->exists('username-uppercase'); $username_ampersand = $conf->exists('username-ampersand'); + $password_noampersand = $conf->exists('password-noexclamation'); + $password_noexclamation = $conf->exists('password-noexclamation'); $mydomain = $conf->config('domain'); $dirhash = $conf->config('dirhash') || 0; if ( $conf->exists('welcome_email') ) { @@ -180,7 +187,7 @@ Creates a new account. To add the account to the database, see L<"insert">. sub table { 'svc_acct'; } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this account to the database. If there is an error, returns the error, otherwise returns false. @@ -189,23 +196,28 @@ The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be defined. An FS::cust_svc record will be created and inserted. The additional field I<usergroup> can optionally be defined; if so it should -contain an arrayref of group names. See L<FS::radius_usergroup>. (used in -sqlradius export only) +contain an arrayref of group names. See L<FS::radius_usergroup>. The additional field I<child_objects> can optionally be defined; if so it should contain an arrayref of FS::tablename objects. They will have their svcnum fields set and will be inserted after this record, but before any exports are run. +Currently available options are: I<depend_jobnum> + +If I<depend_jobnum> 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)). + (TODOC: L<FS::queue> and L<freeside-queued>) (TODOC: new exports!) - =cut sub insert { my $self = shift; + my %options = @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -222,14 +234,6 @@ sub insert { $error = $self->check; return $error if $error; - #no, duplicate checking just got a whole lot more complicated - #(perhaps keep this check with a config option to turn on?) - - #return gettext('username_in_use'). ": ". $self->username - # if qsearchs( 'svc_acct', { 'username' => $self->username, - # 'domsvc' => $self->domsvc, - # } ); - if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) { my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum}); unless ( $cust_svc ) { @@ -240,96 +244,18 @@ sub insert { $self->svcpart($cust_svc->svcpart); } - #new duplicate username checking - - my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); - unless ( $part_svc ) { + $error = $self->_check_duplicate; + if ( $error ) { $dbh->rollback if $oldAutoCommit; - return 'unknown svcpart '. $self->svcpart; - } - - my @dup_user = qsearch( 'svc_acct', { 'username' => $self->username } ); - my @dup_userdomain = qsearch( 'svc_acct', { 'username' => $self->username, - 'domsvc' => $self->domsvc } ); - my @dup_uid; - if ( $part_svc->part_svc_column('uid')->columnflag ne 'F' - && $self->username !~ /^(toor|(hyla)?fax)$/ ) { - @dup_uid = qsearch( 'svc_acct', { 'uid' => $self->uid } ); - } else { - @dup_uid = (); - } - - if ( @dup_user || @dup_userdomain || @dup_uid ) { - my $exports = FS::part_export::export_info('svc_acct'); - my %conflict_user_svcpart; - my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', ); - - foreach my $part_export ( $part_svc->part_export ) { - - #this will catch to the same exact export - my @svcparts = map { $_->svcpart } - qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); - - #this will catch to exports w/same exporthost+type ??? - #my @other_part_export = qsearch('part_export', { - # 'machine' => $part_export->machine, - # 'exporttype' => $part_export->exporttype, - #} ); - #foreach my $other_part_export ( @other_part_export ) { - # push @svcparts, map { $_->svcpart } - # qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); - #} - - #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; - #silly kludge to avoid uninitialized value errors - my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} ) - ? $exports->{$part_export->exporttype}{'nodomain'} - : ''; - if ( $nodomain =~ /^Y/i ) { - $conflict_user_svcpart{$_} = $part_export->exportnum - foreach @svcparts; - } else { - $conflict_userdomain_svcpart{$_} = $part_export->exportnum - foreach @svcparts; - } - } - - foreach my $dup_user ( @dup_user ) { - my $dup_svcpart = $dup_user->cust_svc->svcpart; - if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { - $dbh->rollback if $oldAutoCommit; - return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. - " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; - } - } - - foreach my $dup_userdomain ( @dup_userdomain ) { - my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; - if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { - $dbh->rollback if $oldAutoCommit; - return "duplicate username\@domain: conflicts with svcnum ". - $dup_userdomain->svcnum. " via exportnum ". - $conflict_userdomain_svcpart{$dup_svcpart}; - } - } - - foreach my $dup_uid ( @dup_uid ) { - my $dup_svcpart = $dup_uid->cust_svc->svcpart; - if ( exists($conflict_user_svcpart{$dup_svcpart}) - || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { - $dbh->rollback if $oldAutoCommit; - return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum. - " via exportnum ". $conflict_user_svcpart{$dup_svcpart} - || $conflict_userdomain_svcpart{$dup_svcpart}; - } - } - + return $error; } - #see? i told you it was more complicated - my @jobnums; - $error = $self->SUPER::insert(\@jobnums, $self->child_objects || [] ); + $error = $self->SUPER::insert( + 'jobnums' => \@jobnums, + 'child_objects' => $self->child_objects, + %options, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -399,6 +325,22 @@ sub insert { return "error queuing welcome email: $error"; } + if ( $options{'depend_jobnum'} ) { + warn "$me depend_jobnum found; adding to welcome email dependancies" + if $DEBUG; + if ( ref($options{'depend_jobnum'}) ) { + warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ). + "to welcome email dependancies" + if $DEBUG; + push @jobnums, @{ $options{'depend_jobnum'} }; + } else { + warn "$me adding job $options{'depend_jobnum'} ". + "to welcome email dependancies" + if $DEBUG; + push @jobnums, $options{'depend_jobnum'}; + } + } + foreach my $jobnum ( @jobnums ) { my $error = $wqueue->depend_insert($jobnum); if ( $error ) { @@ -445,7 +387,7 @@ sub delete { if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } ); return "Can't delete an account with (svc_www) web service!" - if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } ); + if qsearch( 'svc_www', { 'usersvc' => $self->svcnum } ); # what about records in session ? (they should refer to history table) @@ -516,8 +458,8 @@ Replaces OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. The additional field I<usergroup> can optionally be defined; if so it should -contain an arrayref of group names. See L<FS::radius_usergroup>. (used in -sqlradius export only) +contain an arrayref of group names. See L<FS::radius_usergroup>. + =cut @@ -593,6 +535,15 @@ sub replace { } + if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) { + $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart; + $error = $new->_check_duplicate; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + $error = $new->SUPER::replace($old); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -630,16 +581,6 @@ Calls any export-specific suspend hooks. sub suspend { my $self = shift; return "can't suspend system account" if $self->_check_system; - my %hash = $self->hash; - unless ( $hash{_password} =~ /^\*SUSPENDED\* / - || $hash{_password} eq '*' - ) { - $hash{_password} = '*SUSPENDED* '.$hash{_password}; - my $new = new FS::svc_acct ( \%hash ); - my $error = $new->replace($self); - return $error if $error; - } - $self->SUPER::suspend; } @@ -732,6 +673,12 @@ sub check { unless ( $username_ampersand ) { $recref->{username} =~ /\&/ and return gettext('illegal_username'); } + if ( $password_noampersand ) { + $recref->{_password} =~ /\&/ and return gettext('illegal_password'); + } + if ( $password_noexclamation ) { + $recref->{_password} =~ /\!/ and return gettext('illegal_password'); + } $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum}; $recref->{popnum} = $1; @@ -751,9 +698,7 @@ sub check { return "Only root can have uid 0" if $recref->{uid} == 0 - && $recref->{username} ne 'root' - && $recref->{username} ne 'toor'; - + && $recref->{username} !~ /^(root|toor|smtp)$/; $recref->{dir} =~ /^([\/\w\-\.\&]*)$/ or return "Illegal directory: ". $recref->{dir}; @@ -799,6 +744,15 @@ sub check { # $error = $self->ut_textn('finger'); # return $error if $error; + if ( $self->getfield('finger') eq '' ) { + my $cust_pkg = $self->svcnum + ? $self->cust_svc->cust_pkg + : qsearchs('cust_pkg', { 'pkgnum' => $self->getfield('pkgnum') } ); + if ( $cust_pkg ) { + my $cust_main = $cust_pkg->cust_main; + $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') ); + } + } $self->getfield('finger') =~ /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/ or return "Illegal finger: ". $self->getfield('finger'); @@ -868,6 +822,122 @@ sub _check_system { ); } +=item _check_duplicate + +Internal function to check for duplicates usernames, username@domain pairs and +uids. + +If the I<global_unique-username> configuration value is set to B<username> or +B<username@domain>, enforces global username or username@domain uniqueness. + +In all cases, check for duplicate uids and usernames or username@domain pairs +per export and with identical I<svcpart> values. + +=cut + +sub _check_duplicate { + my $self = shift; + + #this is Pg-specific. what to do for mysql etc? + # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ ) + warn "$me locking svc_acct table for duplicate search" if $DEBUG; + dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE") + or die dbh->errstr; + warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG; + + my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } ); + unless ( $part_svc ) { + return 'unknown svcpart '. $self->svcpart; + } + + my $global_unique = $conf->config('global_unique-username'); + + my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum } + qsearch( 'svc_acct', { 'username' => $self->username } ); + return gettext('username_in_use') + if $global_unique eq 'username' && @dup_user; + + my @dup_userdomain = grep { !$self->svcnum || $_->svcnum != $self->svcnum } + qsearch( 'svc_acct', { 'username' => $self->username, + 'domsvc' => $self->domsvc } ); + return gettext('username_in_use') + if $global_unique eq 'username@domain' && @dup_userdomain; + + my @dup_uid; + if ( $part_svc->part_svc_column('uid')->columnflag ne 'F' + && $self->username !~ /^(toor|(hyla)?fax)$/ ) { + @dup_uid = grep { !$self->svcnum || $_->svcnum != $self->svcnum } + qsearch( 'svc_acct', { 'uid' => $self->uid } ); + } else { + @dup_uid = (); + } + + if ( @dup_user || @dup_userdomain || @dup_uid ) { + my $exports = FS::part_export::export_info('svc_acct'); + my %conflict_user_svcpart; + my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', ); + + foreach my $part_export ( $part_svc->part_export ) { + + #this will catch to the same exact export + my @svcparts = map { $_->svcpart } $part_export->export_svc; + + #this will catch to exports w/same exporthost+type ??? + #my @other_part_export = qsearch('part_export', { + # 'machine' => $part_export->machine, + # 'exporttype' => $part_export->exporttype, + #} ); + #foreach my $other_part_export ( @other_part_export ) { + # push @svcparts, map { $_->svcpart } + # qsearch('export_svc', { 'exportnum' => $part_export->exportnum }); + #} + + #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'}; + #silly kludge to avoid uninitialized value errors + my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} ) + ? $exports->{$part_export->exporttype}{'nodomain'} + : ''; + if ( $nodomain =~ /^Y/i ) { + $conflict_user_svcpart{$_} = $part_export->exportnum + foreach @svcparts; + } else { + $conflict_userdomain_svcpart{$_} = $part_export->exportnum + foreach @svcparts; + } + } + + foreach my $dup_user ( @dup_user ) { + my $dup_svcpart = $dup_user->cust_svc->svcpart; + if ( exists($conflict_user_svcpart{$dup_svcpart}) ) { + return "duplicate username: conflicts with svcnum ". $dup_user->svcnum. + " via exportnum ". $conflict_user_svcpart{$dup_svcpart}; + } + } + + foreach my $dup_userdomain ( @dup_userdomain ) { + my $dup_svcpart = $dup_userdomain->cust_svc->svcpart; + if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { + return "duplicate username\@domain: conflicts with svcnum ". + $dup_userdomain->svcnum. " via exportnum ". + $conflict_userdomain_svcpart{$dup_svcpart}; + } + } + + foreach my $dup_uid ( @dup_uid ) { + my $dup_svcpart = $dup_uid->cust_svc->svcpart; + if ( exists($conflict_user_svcpart{$dup_svcpart}) + || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) { + return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum. + " via exportnum ". $conflict_user_svcpart{$dup_svcpart} + || $conflict_userdomain_svcpart{$dup_svcpart}; + } + } + + } + + return ''; + +} =item radius @@ -889,6 +959,10 @@ Note that this is now the preferred method for reading RADIUS attributes - accessing the columns directly is discouraged, as the column names are expected to change in the future. +Internal function to check the username against the list of system usernames +from the I<system_usernames> configuration value. Returns true if the username +is listed on the system username list. + =cut sub radius_reply { @@ -1059,7 +1133,6 @@ sub attribute_since_sqlradacct { $self->cust_svc->attribute_since_sqlradacct(@_); } - =item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END Returns an array of hash references of this customers login history for the @@ -1090,6 +1163,71 @@ sub radius_groups { } } +=item clone_suspended + +Constructor used by FS::part_export::_export_suspend fallback. Document +better. + +=cut + +sub clone_suspended { + my $self = shift; + my %hash = $self->hash; + $hash{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ); + new FS::svc_acct \%hash; +} + +=item clone_kludge_unsuspend + +Constructor used by FS::part_export::_export_unsuspend fallback. Document +better. + +=cut + +sub clone_kludge_unsuspend { + my $self = shift; + my %hash = $self->hash; + $hash{_password} = ''; + new FS::svc_acct \%hash; +} + +=item check_password + +Checks the supplied password against the (possibly encrypted) password in the +database. Returns true for a sucessful authentication, false for no match. + +Currently supported encryptions are: classic DES crypt() and MD5 + +=cut + +sub check_password { + my($self, $check_password) = @_; + + #remove old-style SUSPENDED kludge, they should be allowed to login to + #self-service and pay up + ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //; + + #eventually should check a "password-encoding" field + if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login + return 0; + } elsif ( length($password) < 13 ) { #plaintext + $check_password eq $password; + } elsif ( length($password) == 13 ) { #traditional DES crypt + crypt($check_password, $password) eq $password; + } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt + unix_md5_crypt($check_password, $password) eq $password; + } elsif ( $password =~ /^\$2a?\$/ ) { #Blowfish + warn "Can't check password: Blowfish encryption not yet supported, svcnum". + $self->svcnum. "\n"; + 0; + } else { + warn "Can't check password: Unrecognized encryption for svcnum ". + $self->svcnum. "\n"; + 0; + } + +} + =back =head1 SUBROUTINES @@ -1273,6 +1411,9 @@ counterintuitive. radius_usergroup_selector? putting web ui components in here? they should probably live somewhere else... +insertion of RADIUS group stuff in insert could be done with child_objects now +(would probably clean up export of them too) + =head1 SEE ALSO L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface, diff --git a/FS/FS/svc_acct_pop.pm b/FS/FS/svc_acct_pop.pm index d2247658b..e3622e063 100644 --- a/FS/FS/svc_acct_pop.pm +++ b/FS/FS/svc_acct_pop.pm @@ -185,10 +185,6 @@ END =back -=head1 VERSION - -$Id: svc_acct_pop.pm,v 1.7.4.2 2003-07-04 01:37:44 ivan Exp $ - =head1 BUGS It should be renamed to part_pop. diff --git a/FS/FS/svc_acct_sm.pm b/FS/FS/svc_acct_sm.pm index c92f1421f..11a0c1a5d 100644 --- a/FS/FS/svc_acct_sm.pm +++ b/FS/FS/svc_acct_sm.pm @@ -236,10 +236,6 @@ sub check { =back -=head1 VERSION - -$Id: svc_acct_sm.pm,v 1.5 2001-09-06 20:41:59 ivan Exp $ - =head1 BUGS The remote commands should be configurable. diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 58e4c790b..c0190fcd5 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -9,7 +9,7 @@ use Carp; use Mail::Internet 1.44; use Mail::Header; use Date::Format; -use Net::Whois 1.0; +#use Net::Whois::Raw; use FS::Record qw(fields qsearch qsearchs dbh); use FS::Conf; use FS::svc_Common; @@ -90,7 +90,7 @@ Creates a new domain. To add the domain to the database, see L<"insert">. sub table { 'svc_domain'; } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this domain to the database. If there is an error, returns the error, otherwise returns false. @@ -116,6 +116,12 @@ If any records are defined in the I<defaultrecords> configuration file, appropriate records are added to the domain_record table (see L<FS::domain_record>). +Currently available options are: I<depend_jobnum> + +If I<depend_jobnum> 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 sub insert { @@ -149,7 +155,7 @@ sub insert { return "Domain not found (see whois)"; } - $error = $self->SUPER::insert; + $error = $self->SUPER::insert(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -342,7 +348,8 @@ sub check { " (or unknown registry - try \$whois_hack)"; } - $recref->{action} =~ /^(M|N)$/ or return "Illegal action"; + $recref->{action} =~ /^(M|N)$/ + or return "Illegal action: ". $recref->{action}; $recref->{action} = $1; if ( $recref->{catchall} ne '' ) { @@ -385,15 +392,16 @@ sub catchall_svc_acct { =item whois -Returns the Net::Whois::Domain object (see L<Net::Whois>) for this domain, or -undef if the domain is not found in whois. +# Returns the Net::Whois::Domain object (see L<Net::Whois>) 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 diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm index 2b1fb9225..5ec396143 100644 --- a/FS/FS/svc_forward.pm +++ b/FS/FS/svc_forward.pm @@ -66,7 +66,7 @@ database, see L<"insert">. sub table { 'svc_forward'; } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this mail forwarding alias to the database. If there is an error, returns the error, otherwise returns false. @@ -74,6 +74,12 @@ the error, otherwise returns false. The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be defined. An FS::cust_svc record will be created and inserted. +Currently available options are: I<depend_jobnum> + +If I<depend_jobnum> 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 sub insert { @@ -94,7 +100,7 @@ sub insert { $error = $self->check; return $error if $error; - $error = $self->SUPER::insert; + $error = $self->SUPER::insert(@_); if ($error) { $dbh->rollback if $oldAutoCommit; return $error; diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm index d7a42c8ae..2e9ab8522 100644 --- a/FS/FS/svc_www.pm +++ b/FS/FS/svc_www.pm @@ -74,7 +74,7 @@ points to. You can ask the object for a copy with the I<hash> method. sub table { 'svc_www'; } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this record to the database. If there is an error, returns the error, otherwise returns false. @@ -82,6 +82,13 @@ otherwise returns false. The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be defined. An FS::cust_svc record will be created and inserted. +Currently available options are: I<depend_jobnum> + +If I<depend_jobnum> 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 sub insert { @@ -124,7 +131,7 @@ sub insert { $self->recnum($domain_record->recnum); } - $error = $self->SUPER::insert; + $error = $self->SUPER::insert(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; diff --git a/FS/FS/type_pkgs.pm b/FS/FS/type_pkgs.pm index 99a79b93f..8b58c7f57 100644 --- a/FS/FS/type_pkgs.pm +++ b/FS/FS/type_pkgs.pm @@ -109,10 +109,6 @@ sub part_pkg { =back -=head1 VERSION - -$Id: type_pkgs.pm,v 1.1.14.1 2002-10-04 12:56:35 ivan Exp $ - =head1 BUGS =head1 SEE ALSO diff --git a/FS/MANIFEST b/FS/MANIFEST index 80b246f48..bb594ae32 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -27,7 +27,6 @@ bin/freeside-setup bin/freeside-sqlradius-radacctd bin/freeside-sqlradius-reset bin/freeside-sqlradius-seconds -bin/freeside-tax-report FS.pm FS/CGI.pm FS/InitHandler.pm @@ -152,6 +151,8 @@ t/part_export_option.t t/part_export-bind.t t/part_export-bind_slave.t t/part_export-bsdshell.t +t/part_export-communigate_pro.t +t/part_export-communigate_pro_singledomain.t t/part_export-cp.t t/part_export-cyrus.t t/part_export-domain_shellcommands.t @@ -160,6 +161,8 @@ t/part_export-http.t t/part_export-infostreet.t t/part_export-ldap.t t/part_export-null.t +t/part_export-passwdfile.t +t/part_export-postfix.t t/part_export-shellcommands.t t/part_export-shellcommands_withdomain.t t/part_export-sqlmail.t diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 9ff21d421..70894400b 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -16,7 +16,7 @@ my $user = shift or die &usage; adminsuidsetup $user; -$FS::cust_main::Debug = 1 if $opt_v; +$FS::cust_main::DEBUG = 1 if $opt_v; my %search; $search{'payby'} = $opt_p if $opt_p; @@ -57,10 +57,8 @@ foreach $cust_main ( @cust_main ) { if ( driver_name eq 'Pg' ) { dbh->{AutoCommit} = 1; #so we can vacuum - foreach my $statement ( 'vacuum', 'vacuum analyze' ) { - my $sth = dbh->prepare($statement) or die dbh->errstr; - $sth->execute or die $sth->errstr; - } + my $sth = dbh->prepare('vacuum analyze') or die dbh->errstr; + $sth->execute or die $sth->errstr; } #local hack diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index 6ea27c05f..e14ddad8e 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -7,7 +7,7 @@ use Fcntl qw(:flock); use POSIX qw(:sys_wait_h setsid); use Date::Format; use IO::File; -use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh); +use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh myconnect); use FS::Record qw(qsearch qsearchs); use FS::queue; use FS::queue_depend; @@ -51,7 +51,16 @@ $< = $FS::UID::freeside_uid; $> = $FS::UID::freeside_uid; $ENV{HOME} = (getpwuid($>))[7]; #for ssh -adminsuidsetup $user; + +$@ = 'not connected'; +while ( $@ ) { + eval { adminsuidsetup $user; }; + if ( $@ ) { + warn $@; + warn "sleeping for reconnect...\n"; + sleep 5; + } +} $log_file = "/usr/local/etc/freeside/queuelog.". $FS::UID::datasrc; @@ -75,18 +84,34 @@ while (1) { } $warnkids=0; - my $nodepend = driver_name eq 'mysql' - ? '' - : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. - ' WHERE queue_depend.jobnum = queue.jobnum ) '; + unless ( dbh && dbh->ping ) { + warn "WARNING: connection to database lost, reconnecting...\n"; + + eval { myconnect; }; + + unless ( !$@ && dbh && dbh->ping ) { + warn "WARNING: still no connection to database, sleeping for retry...\n"; + sleep 10; + next; + } else { + warn "WARNING: reconnected to database\n"; + } + } #my($job, $ljob); #{ # my $oldAutoCommit = $FS::UID::AutoCommit; # local $FS::UID::AutoCommit = 0; $FS::UID::AutoCommit = 0; - my $dbh = dbh; - + + #assuming mysql 4.1 w/subqueries now + #my $nodepend = driver_name eq 'mysql' + # ? '' + # : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. + # ' WHERE queue_depend.jobnum = queue.jobnum ) '; + my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. + ' WHERE queue_depend.jobnum = queue.jobnum ) '; + my $job = qsearchs( 'queue', { 'status' => 'new' }, @@ -95,25 +120,43 @@ while (1) { ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE" : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1" ) or do { - $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; + # if $oldAutoCommit { + dbh->commit or do { + warn "WARNING: database error, closing connection: ". dbh->errstr; + undef $FS::UID::dbh; + next; + }; + # } sleep 5; #connecting to db is expensive next; }; - if ( driver_name eq 'mysql' - && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) { - $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; - sleep 5; #would be better if mysql could do everything in query above - next; - } + #assuming mysql 4.1 w/subqueries now + #if ( driver_name eq 'mysql' + # && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) { + # dbh->commit or die dbh->errstr; #if $oldAutoCommit; + # sleep 5; #would be better if mysql could do everything in query above + # next; + #} my %hash = $job->hash; $hash{'status'} = 'locked'; my $ljob = new FS::queue ( \%hash ); my $error = $ljob->replace($job); - die $error if $error; + if ( $error ) { + warn "WARNING: database error locking job, closing connection: ". + dbh->errstr; + undef $FS::UID::dbh; + next; + } - $dbh->commit or die $dbh->errstr; #if $oldAutoCommit; + # if $oldAutoCommit { + dbh->commit or do { + warn "WARNING: database error, closing connection: ". dbh->errstr; + undef $FS::UID::dbh; + next; + }; + # } $FS::UID::AutoCommit = 1; #} diff --git a/FS/bin/freeside-reexport b/FS/bin/freeside-reexport index b5c50a422..54af9dd80 100644 --- a/FS/bin/freeside-reexport +++ b/FS/bin/freeside-reexport @@ -1,6 +1,8 @@ -#!/usr/bin/perl -Tw +#!/usr/bin/perl -w use strict; +use vars qw($opt_s $opt_u $opt_p); +use Getopt::Std; use FS::UID qw(adminsuidsetup); use FS::Record qw(qsearch qsearchs); use FS::part_export; @@ -20,25 +22,32 @@ if ( $export_x =~ /^(\d+)$/ ) { or die "no exports of type $export_x found\n"; } -my $svc_something = shift or die &usage; -my $svc_x; -if ( $svc_something =~ /^(\d+)$/ ) { - my $cust_svc = qsearchs('cust_svc', { svcnum=>$1 } ) - or die "svcnum $svc_something not found\n"; - $svc_x = $cust_svc->svc_x; -} else { - $svc_x = qsearchs('svc_acct', { username=>$svc_something } ) - or die "username $svc_something not found\n"; +getopts('s:u:p:'); + +my @svc_x = (); +if ( $opt_s ) { + my $cust_svc = qsearchs('cust_svc', { svcnum=>$opt_s } ) + or die "svcnum $opt_s not found\n"; + push @svc_x, $cust_svc->svc_x; +} elsif ( $opt_u ) { + my $svc_x = qsearchs('svc_acct', { username=>$opt_u } ) + or die "username $opt_u not found\n"; + push @svc_x, $svc_x; +} elsif ( $opt_p ) { + push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart=>$opt_p } ); + die "no services with svcpart $opt_p found\n" unless @svc_x; } foreach my $part_export ( @part_export ) { - my $error = $part_export->export_insert($svc_x); - die $error if $error; + foreach my $svc_x ( @svc_x ) { + my $error = $part_export->export_insert($svc_x); + die $error if $error; + } } sub usage { - die "Usage:\n\n freeside-reexport user exportnum|exporttype svcnum|username\n"; + die "Usage:\n\n freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ]\n"; } =head1 NAME @@ -47,7 +56,7 @@ freeside-reexport - Command line tool to re-trigger export jobs for existing ser =head1 SYNOPSIS - freeside-reexport user exportnum|exporttype svcnum|username + freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ] =head1 DESCRIPTION diff --git a/FS/bin/freeside-selfservice-server b/FS/bin/freeside-selfservice-server index f9571fa1e..c045893d1 100644 --- a/FS/bin/freeside-selfservice-server +++ b/FS/bin/freeside-selfservice-server @@ -8,14 +8,15 @@ # Proc::Daemon or somesuch use strict; -use vars qw( $Debug %kids $kids $max_kids $shutdown $log_file $ssh_pid ); +use vars qw( $Debug %kids $kids $max_kids $shutdown $log_file $ssh_pid + $keepalives ); use subs qw( lock_write unlock_write ); use Fcntl qw(:flock); use POSIX qw(:sys_wait_h setsid); use IO::Handle; use IO::Select; use IO::File; -use Storable qw(nstore_fd fd_retrieve); +use Storable 2.09 qw(nstore_fd fd_retrieve); use Net::SSH qw(sshopen2); use FS::UID qw(adminsuidsetup forksuidsetup); use FS::ClientAPI; @@ -24,21 +25,22 @@ use FS::Conf; use FS::cust_bill; use FS::cust_pkg; -$Debug = 2; # >= 2 will log packet contents, including potentially compromising - # information +$Debug = 1; # 2 will turn on more logging + # 3 will log packet contents, including passwords $shutdown = 0; $max_kids = '10'; #? +$keepalives = 0; #let clientd turn it on, so we don't barf on old ones $kids = 0; my $user = shift or die &usage; my $machine = shift or die &usage; my $tag = scalar(@ARGV) ? shift : ''; -my $pid_file = "/var/run/freeside-selfservice-server.$user.pid"; -#my $pid_file = "/var/run/freeside-selfservice-server.$user.pid"; $FS::UID::datasrc not posible, but should include machine name at least, hmm + +# $FS::UID::datasrc not posible +my $pid_file = "/var/run/freeside-selfservice-server.$user.$machine.pid"; my $lock_file = "/usr/local/etc/freeside/selfservice.$machine.writelock"; -open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; &init($user); @@ -57,6 +59,7 @@ while (1) { warn "entering main loop\n" if $Debug; my $undisp = 0; + my $keepalive_count = 0; my $s = IO::Select->new( $reader ); while (1) { @@ -67,6 +70,12 @@ while (1) { my @handles = $s->can_read(5); unless ( @handles ) { &shutdown if $shutdown; + if ( $keepalives && $keepalive_count++ > 10 ) { + $keepalive_count = 0; + lock_write; + nstore_fd( { _token => '_keepalive' }, $writer ); + unlock_write; + } next; } @@ -88,7 +97,13 @@ while (1) { } warn "packet received\n". join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) - if $Debug > 1; + if $Debug > 2; + + if ( $packet->{_packet} eq '_enable_keepalive' ) { + warn "enabling keep alives\n" if $Debug; + $keepalives=1; + next; + } #prevent runaway forking my $warnkids = 0; @@ -106,9 +121,12 @@ while (1) { warn "child $pid spawned\n" if $Debug; } else { #kid time - #get new db handle - $FS::UID::dbh->{InactiveDestroy} = 1; - forksuidsetup($user); + ##get new db handle + #$FS::UID::dbh->{InactiveDestroy} = 1; + #forksuidsetup($user); + + #get db handle + adminsuidsetup($user); my $type = $packet->{_packet}; warn "calling $type handler\n" if $Debug; @@ -119,8 +137,9 @@ while (1) { } $rv->{_token} = $packet->{_token}; #identifier - warn "sending response\n" if $Debug; + open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; lock_write; + warn "sending response\n" if $Debug; nstore_fd($rv, $writer) or die "FATAL: can't send response: $!"; $writer->flush or die "FATAL: can't flush: $!"; unlock_write; @@ -131,6 +150,7 @@ while (1) { } + &shutdown if $shutdown; warn "connection lost, reconnecting\n" if $Debug; sleep 3; @@ -180,6 +200,10 @@ sub init { #false laziness w/freeside-queued my $freeside_gid = scalar(getgrnam('freeside')) or die "can't setgid to freeside group\n"; + + open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; + chown $FS::UID::freeside_uid, $freeside_gid, $lock_file; + $) = $freeside_gid; $( = $freeside_gid; #if freebsd can't setuid(), presumably it can't setgid() either. grr fleabsd @@ -212,10 +236,12 @@ sub init { } sub shutdown { + &reap_kids; my $wait = 12; #wait up to 1 minute while ( $kids > 0 && $wait-- ) { warn "waiting for $kids children to terminate"; sleep 5; + &reap_kids; } warn "abandoning $kids children" if $kids; kill 'TERM', $ssh_pid if $ssh_pid; @@ -244,6 +270,8 @@ sub _do_logmsg { } sub lock_write { + warn "locking $lock_file mutex for write to write stream\n" if $Debug > 1; + #broken on freebsd? #flock($writer, LOCK_EX) or die "FATAL: can't lock write stream: $!"; @@ -252,6 +280,8 @@ sub lock_write { } sub unlock_write { + warn "unlocking $lock_file mutex\n" if $Debug > 1; + #broken on freebsd? #flock($writer, LOCK_UN) or die "WARNING: can't release write lock: $!"; diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup index 213dcb947..65e67b5a7 100755 --- a/FS/bin/freeside-setup +++ b/FS/bin/freeside-setup @@ -6,6 +6,8 @@ BEGIN { $FS::Record::setup_hack = 1; } use strict; use vars qw($opt_s); use Getopt::Std; +use Locale::Country; +use Locale::SubCountry; use DBI; use DBIx::DBSchema 0.20; use DBIx::DBSchema::Table; @@ -240,60 +242,40 @@ foreach my $statement ( $dbdef->sql($dbh) ) { or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement"; } -#not really sample data (and shouldn't default to US) - #cust_main_county +foreach my $country ( sort map uc($_), all_country_codes ) { -#USPS state codes -foreach ( qw( -AL AK AS AZ AR CA CO CT DC DE FM FL GA GU HI ID IL IN IA KS KY LA -ME MH MD MA MI MN MS MO MT NC ND NE NH NJ NM NV NY MP OH OK OR PA PW PR RI -SC SD TN TX UT VT VI VA WA WV WI WY AE AA AP -) ) { - my($cust_main_county)=new FS::cust_main_county({ - 'state' => $_, - 'tax' => 0, - 'country' => 'US', - }); - my($error); - $error=$cust_main_county->insert; - die $error if $error; -} + my $subcountry = eval { new Locale::SubCountry($country) }; + my @states = $subcountry ? $subcountry->all_codes : undef; -#AU "offical" state codes ala mark.williamson@ebbs.com.au (Mark Williamson) -foreach ( qw( -VIC NSW NT QLD TAS ACT WA SA -) ) { - my($cust_main_county)=new FS::cust_main_county({ - 'state' => $_, - 'tax' => 0, - 'country' => 'AU', - }); - my($error); - $error=$cust_main_county->insert; - die $error if $error; -} + if ( !scalar(@states) || ( scalar(@states) == 1 && !defined($states[0]) ) ) { -#ISO 2-letter country codes (same as country TLDs) except US and AU -foreach ( qw( -AF AL DZ AS AD AO AI AQ AG AR AM AW AT AZ BS BH BD BB BY BE BZ BJ BM BT BO -BA BW BV BR IO BN BG BF BI KH CM CA CV KY CF TD CL CN CX CC CO KM CG CK CR CI -HR CU CY CZ DK DJ DM DO TP EC EG SV GQ ER EE ET FK FO FJ FI FR FX GF PF TF GA -GM GE DE GH GI GR GL GD GP GU GT GN GW GY HT HM HN HK HU IS IN ID IR IQ IE IL -IT JM JP JO KZ KE KI KP KR KW KG LA LV LB LS LR LY LI LT LU MO MK MG MW MY MV -ML MT MH MQ MR MU YT MX FM MD MC MN MS MA MZ MM NA NR NP NL AN NC NZ NI NE NG -NU NF MP NO OM PK PW PA PG PY PE PH PN PL PT PR QA RE RO RU RW KN LC VC WS SM -ST SA SN SC SL SG SK SI SB SO ZA GS ES LK SH PM SD SR SJ SZ SE CH SY TW TJ TZ -TH TG TK TO TT TN TR TM TC TV UG UA AE GB UM UY UZ VU VA VE VN VG VI WF EH -YE YU ZR ZM ZW -) ) { - my($cust_main_county)=new FS::cust_main_county({ - 'tax' => 0, - 'country' => $_, - }); - my($error); - $error=$cust_main_county->insert; - die $error if $error; + my $cust_main_county = new FS::cust_main_county({ + 'tax' => 0, + 'country' => $country, + }); + my $error = $cust_main_county->insert; + die $error if $error; + + } else { + + if ( $states[0] =~ /^(\d+|\w)$/ ) { + @states = map $subcountry->full_name($_), @states + } + + foreach my $state ( @states ) { + + my $cust_main_county = new FS::cust_main_county({ + 'state' => $state, + 'tax' => 0, + 'country' => $country, + }); + my $error = $cust_main_county->insert; + die $error if $error; + + } + + } } #billing events @@ -436,7 +418,7 @@ sub tables_hash_hack { 'custnum', 'int', '', '', '_date', @date_type, 'amount', @money_type, - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'reason', 'text', 'NULL', '', 'closed', 'char', 'NULL', 1, ], @@ -466,7 +448,7 @@ sub tables_hash_hack { 'last', 'varchar', '', $char_d, # 'middle', 'varchar', 'NULL', $char_d, 'first', 'varchar', '', $char_d, - 'ss', 'char', 'NULL', 11, + 'ss', 'varchar', 'NULL', 11, 'company', 'varchar', 'NULL', $char_d, 'address1', 'varchar', '', $char_d, 'address2', 'varchar', 'NULL', $char_d, @@ -498,7 +480,7 @@ sub tables_hash_hack { 'paydate', 'varchar', 'NULL', 10, 'payname', 'varchar', 'NULL', $char_d, 'tax', 'char', 'NULL', 1, - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'refnum', 'int', '', '', 'referral_custnum', 'int', 'NULL', '', 'comments', 'text', 'NULL', '', @@ -600,7 +582,7 @@ sub tables_hash_hack { 'pkgnum', 'int', '', '', 'custnum', 'int', '', '', 'pkgpart', 'int', '', '', - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'setup', @date_type, 'bill', @date_type, 'susp', @date_type, @@ -620,7 +602,7 @@ sub tables_hash_hack { 'custnum', 'int', '', '', '_date', @date_type, 'refund', @money_type, - 'otaker', 'varchar', '', 8, + 'otaker', 'varchar', '', 32, 'reason', 'varchar', '', $char_d, 'payby', 'char', '', 4, # CARD/BILL/COMP, should be index # into payment type table. @@ -823,10 +805,10 @@ sub tables_hash_hack { 'columns' => [ 'recnum', 'int', '', '', 'svcnum', 'int', '', '', - 'reczone', 'varchar', '', $char_d, + 'reczone', 'varchar', '', 255, 'recaf', 'char', '', 2, - 'rectype', 'char', '', 5, - 'recdata', 'varchar', '', $char_d, + 'rectype', 'varchar', '', 5, + 'recdata', 'varchar', '', 255, ], 'primary_key' => 'recnum', 'unique' => [], diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset index 74f90a582..11cbe9e36 100755 --- a/FS/bin/freeside-sqlradius-reset +++ b/FS/bin/freeside-sqlradius-reset @@ -1,4 +1,4 @@ -#!/usr/bin/perl -Tw +#!/usr/bin/perl -w use strict; use FS::UID qw(adminsuidsetup); @@ -12,9 +12,18 @@ adminsuidsetup $user; #my $machine = shift or die &usage; -my @exports = qsearch('part_export', { exporttype=>'sqlradius' } ); -push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } ); - +my @exports = (); +if ( @ARGV ) { + foreach my $exportnum ( @ARGV ) { + foreach my $exporttype (qw( sqlradius sqlradius_withdomain )) { + push @exports, qsearch('part_export', { exportnum => $exportnum, + exporttype => $exporttype, } ); + } + } + } else { + @exports = qsearch('part_export', { exporttype=>'sqlradius' } ); + push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } ); +} foreach my $export ( @exports ) { my $icradius_dbh = DBI->connect( @@ -47,8 +56,7 @@ foreach my $export ( @exports ) { } sub usage { - #die "Usage:\n\n sqlradius_reset user machine\n"; - die "Usage:\n\n freeside-sqlradius-reset user\n"; + die "Usage:\n\n freeside-sqlradius-reset user [ exportnum, ... ]\n"; } =head1 NAME @@ -57,12 +65,13 @@ freeside-sqlradius-reset - Command line interface to reset and recreate RADIUS S =head1 SYNOPSIS - freeside-sqlradius-reset username + freeside-sqlradius-reset username [ EXPORTNUM, ... ] =head1 DESCRIPTION Deletes the radcheck, radreply and usergroup tables and repopulates them from -the Freeside database, for all sqlradius exports. +the Freeside database, for the specified exports, or, if no exports are +specified, for all sqlradius and sqlradius_withdomain exports. B<username> is a username added by freeside-adduser. diff --git a/FS/bin/freeside-tax-report b/FS/bin/freeside-tax-report deleted file mode 100755 index d48da87a6..000000000 --- a/FS/bin/freeside-tax-report +++ /dev/null @@ -1,292 +0,0 @@ -#!/usr/bin/perl -Tw - - -use strict; -use Date::Parse; -use Time::Local; -use Getopt::Std; -use Text::Template; -use Net::SMTP; -use Mail::Header; -use Mail::Internet; -use FS::Conf; -use FS::UID qw(adminsuidsetup); -use FS::Record qw(qsearch); -use FS::cust_bill; -use FS::cust_bill_pay; -use FS::cust_pay; - - -&untaint_argv; #what it sounds like (eww) -use vars qw($opt_v $opt_p $opt_m $opt_e $opt_t $opt_s $opt_f $report_lines $report_template @buf $header); -getopts("vpmef:s:"); #switches - -#we're at now now (and later). -my($_finishdate)= $opt_f ? str2time($main::opt_f) : $^T; -my($_startdate)= $opt_s ? str2time($main::opt_s) : $^T; - -# Get the current month -my ($ssec,$smin,$shour,$smday,$smon,$syear) = - (localtime($_startdate) )[0,1,2,3,4,5]; -$smon++; -$syear += 1900; - -# Get the current month -my ($fsec,$fmin,$fhour,$fmday,$fmon,$fyear) = - (localtime($_finishdate) )[0,1,2,3,4,5]; -$fmon++; -$fyear += 1900; - -# Login to the database -my $user = shift or die &usage; -adminsuidsetup $user; - -# Get the needed configuration files -my $conf = new FS::Conf; -my $lpr = $conf->config('lpr'); -my $email = $conf->config('email'); -my $smtpmachine = $conf->config('smtpmachine'); -my $mail_sender = $conf->exists('invoice_from') ? $conf->config('invoice_from') : - 'postmaster'; -my @report_template = $conf->config('report_template') - or die "cannot load config file report_template"; -$report_lines = 0; -foreach ( grep /report_lines\(\d+\)/, @report_template ) { #kludgy :/ - /report_lines\((\d+)\)/; - $report_lines += $1; -} -die "no report_lines() functions in template?" unless $report_lines; -$report_template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @report_template ], -) or die "can't create new Text::Template object: $Text::Template::ERROR"; - - -my(@cust_bills)=qsearch('cust_bill',{}); -if (scalar(@cust_bills) == 0) -{ - exit 1; -} - -# Open print and email pipes -# $lpr and opt_p for printing -# $email and opt_m for email - -if ($lpr && $main::opt_p) -{ - open(LPR, "|$lpr"); -} - -if ($email && $main::opt_m) -{ - $ENV{MAILADDRESS} = $mail_sender; - $header = new Mail::Header ( [ - "From: Account Processor", - "To: $email", - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Subject: Sales Taxes Invoiced", - ] ); -} - -my $comped = 0; -my $comped_tax = 0; -my $other = 0; -my $other_tax = 0; -my $total = 0; -my $taxed = 0; -my $untaxed = 0; -my $total_tax = 0; - -# Now I can start looping -foreach my $cust_bill (@cust_bills) -{ - my $_date = $cust_bill->getfield('_date'); - my $invnum = $cust_bill->getfield('invnum'); - my $charged = $cust_bill->getfield('charged'); - - if ($_date >= $_startdate && $_date <= $_finishdate) { - $total += $charged; - - # The following lines were used to produce rather verbose reports - #my ($sec,$min,$hour,$mday,$mon,$year) = - # (localtime($_date) )[0,1,2,3,4,5]; - #$mon++; - #$year -= 100 if $year >= 100; - #$year = "0" . $year if $year < 10; - - my $invoice_amt =0; - my $invoice_tax =0; - my $invoice_comped =0; - my(@cust_bill_pkgs)= $cust_bill->cust_bill_pkg; - foreach my $cust_bill_pkg (@cust_bill_pkgs) { - - my $recur = $cust_bill_pkg->getfield('recur'); - my $setup = $cust_bill_pkg->getfield('setup'); - my $pkgnum = $cust_bill_pkg->getfield('pkgnum'); - - if ($pkgnum == 0) { - # The following line was used to produce rather verbose reports - # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Tax $invnum", $recur+$setup)); - $invoice_tax += $recur; - $invoice_tax += $setup; - } else { - # The following line was used to produce rather verbose reports - # push @buf, ('', sprintf(qq{%10s%15s%14.2f}, "$mon/$mday/$year", "Inv $invnum", $recur+$setup)); - $invoice_amt += $recur; - $invoice_amt += $setup; - } - - } - - my(@cust_bill_pays)= $cust_bill->cust_bill_pay; - foreach my $cust_bill_pay (@cust_bill_pays) { - my $payby = $cust_bill_pay->cust_pay->payby; - my $paid = $cust_bill_pay->getfield('amount'); - if ($payby =~ 'COMP') { - $invoice_comped += $paid; - } - } - - if (abs($invoice_comped - ($invoice_amt + $invoice_tax)) < 0.0001){ - $comped += $invoice_amt; - $comped_tax += $invoice_tax; - } elsif ($invoice_comped > 0) { - push @buf, sprintf(qq{\nInvoice %10d has inexpliciable complimentary payments of %14.9f\n}, $invnum, $invoice_comped); - $other += $invoice_amt; - $other_tax += $invoice_tax; - } elsif ($invoice_tax > 0) { - $total_tax += $invoice_tax; - $taxed += $invoice_amt; - } else { - $untaxed += $invoice_amt; - } - - } - -} - -push @buf, ('', sprintf(qq{%25s%14.2f}, "Complimentary", $comped)); -push @buf, sprintf(qq{%25s%14.2f}, "Complimentary Tax", $comped_tax); -push @buf, sprintf(qq{%25s%14.2f}, "Other", $other); -push @buf, sprintf(qq{%25s%14.2f}, "Other Tax", $other_tax); -push @buf, sprintf(qq{%25s%14.2f}, "Untaxed", $untaxed); -push @buf, sprintf(qq{%25s%14.2f}, "Taxed", $taxed); -push @buf, sprintf(qq{%25s%14.2f}, "Tax", $total_tax); -push @buf, ('', sprintf(qq{%39s}, "========="), sprintf(qq{%39.2f}, $total)); - -sub FS::tax_report::_template::report_lines { - my $lines = shift; - map { - scalar(@buf) ? shift @buf : '' ; - } - ( 1 .. $lines ); -} - -$FS::tax_report::_template::title = qq~SALES TAXES INVOICED for $smon/$smday/$syear through $fmon/$fmday/$fyear~; -$FS::tax_report::_template::title = $opt_t if $opt_t; -$FS::tax_report::_template::page = 1; -$FS::tax_report::_template::date = $^T; -$FS::tax_report::_template::date = $^T; -$FS::tax_report::_template::fdate = $_finishdate; -$FS::tax_report::_template::fdate = $_finishdate; -$FS::tax_report::_template::sdate = $_startdate; -$FS::tax_report::_template::sdate = $_startdate; -$FS::tax_report::_template::total_pages = - int( scalar(@buf) / $report_lines); -$FS::tax_report::_template::total_pages++ if scalar(@buf) % $report_lines; - -my @report; -while (@buf) { - push @report, split("\n", - $report_template->fill_in( PACKAGE => 'FS::tax_report::_template' ) - ); - $FS::tax_report::_template::page++; -} - -if ($opt_v) { - print map "$_\n", @report; -} -if($lpr && $opt_p) -{ - print LPR map "$_\n", @report; - print LPR "\f" if $opt_e; - close LPR || die "Could not close printer: $lpr\n"; -} -if($email && $opt_m) -{ - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ (@report) ], - ); - $!=0; - $message->smtpsend( Host => "$smtpmachine" ) - or die "can't send report to $email via $smtpmachine: $!"; -} - - -# subroutines -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/ :\.]*)$/ || die "Illegal argument \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-tax-report [-v] [-p] [-e] user\n"; -} - -=head1 NAME - -freeside-tax-report - Prints or emails sales taxes invoiced in a given period. - -=head1 SYNOPSIS - - freeside-tax-report [-v] [-p] [-m] [-e] [-t "title"] [-s date] [-f date] user - -=head1 DESCRIPTION - -Prints or emails sales taxes invoiced in a given period. - --v: Verbose - Prints records to STDOUT. - --p: Print to printer lpr as found in the conf directory. - --m: Email output to user found in the Conf email file. - --e: Print a final form feed to the printer. - --t: supply a title for the top of each page. - --s: starting date for inclusion - --f: final date for inclusion - -user: From the mapsecrets file - see config.html from the base documentation - -=head1 VERSION - -$Id: freeside-tax-report,v 1.4.4.1 2002-09-09 22:57:32 ivan Exp $ - -=head1 BUGS - -Yes..... Use at your own risk. No guarantees or warrantees of any -kind apply to this program. Parts of this program are hacked from -other GNU licensed software created mainly by Ivan Kohler. - -This is released under the GNU Public License. See www.gnu.org -for more information regarding this license. - -=head1 SEE ALSO - -L<FS::cust_main>, config.html from the base documentation - -=head1 AUTHOR - -Jeff Finucane <jeff@cmh.net> - -based on print-batch by Joel Griffiths <griff@aver-computer.com> - -=cut - diff --git a/FS/t/part_export-communigate_pro.t b/FS/t/part_export-communigate_pro.t new file mode 100644 index 000000000..88b8b64e0 --- /dev/null +++ b/FS/t/part_export-communigate_pro.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::communigate_pro; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-communigate_pro_singledomain.t b/FS/t/part_export-communigate_pro_singledomain.t new file mode 100644 index 000000000..6f8a64e0f --- /dev/null +++ b/FS/t/part_export-communigate_pro_singledomain.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::communigate_pro_singledomain; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-passwdfile.t b/FS/t/part_export-passwdfile.t new file mode 100644 index 000000000..0f18f3044 --- /dev/null +++ b/FS/t/part_export-passwdfile.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::passwdfile; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/part_export-postfix.t b/FS/t/part_export-postfix.t new file mode 100644 index 000000000..9518caad6 --- /dev/null +++ b/FS/t/part_export-postfix.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::part_export::postfix; +$loaded=1; +print "ok 1\n"; |