summaryrefslogtreecommitdiff
path: root/FS
diff options
context:
space:
mode:
Diffstat (limited to 'FS')
-rw-r--r--FS/FS.pm4
-rw-r--r--FS/FS/ClientAPI/MyAccount.pm2
-rw-r--r--FS/FS/Conf.pm54
-rw-r--r--FS/FS/Record.pm12
-rw-r--r--FS/FS/UID.pm14
-rw-r--r--FS/FS/cust_bill.pm114
-rw-r--r--FS/FS/cust_pkg.pm3
-rw-r--r--FS/FS/cust_refund.pm5
-rw-r--r--FS/FS/export_svc.pm163
-rw-r--r--FS/FS/part_export/apache.pm3
-rw-r--r--FS/FS/part_export/postfix.pm5
-rw-r--r--FS/FS/part_export/shellcommands.pm25
-rw-r--r--FS/FS/part_export/shellcommands_withdomain.pm3
-rw-r--r--FS/FS/part_export/vpopmail.pm6
-rw-r--r--FS/FS/part_export/www_shellcommands.pm12
-rw-r--r--FS/FS/part_svc.pm106
-rw-r--r--FS/FS/queue.pm6
-rw-r--r--FS/FS/svc_acct.pm247
-rw-r--r--FS/FS/svc_domain.pm3
-rw-r--r--FS/MANIFEST1
-rw-r--r--FS/bin/freeside-queued77
-rw-r--r--FS/bin/freeside-selfservice-server47
-rwxr-xr-xFS/bin/freeside-sqlradius-reset25
-rwxr-xr-xFS/bin/freeside-tax-report292
24 files changed, 735 insertions, 494 deletions
diff --git a/FS/FS.pm b/FS/FS.pm
index 963c73548..2b16d06a0 100644
--- a/FS/FS.pm
+++ b/FS/FS.pm
@@ -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/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm
index a42c306ce..81da5bcb1 100644
--- a/FS/FS/ClientAPI/MyAccount.pm
+++ b/FS/FS/ClientAPI/MyAccount.pm
@@ -275,7 +275,7 @@ sub order_pkg {
$cust_pkg->reexport;
}
- return { error => '' };
+ return { error => '', pkgnum => $cust_pkg->pkgnum };
}
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
index eedac3fc2..be6e54adb 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_*')
);
}
@@ -637,8 +665,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',
},
@@ -1200,6 +1228,28 @@ httemplate/docs/config.html
'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 292b30b5d..b620c0114 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -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'} };
}
@@ -1046,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/cust_bill.pm b/FS/FS/cust_bill.pm
index 2639abfae..4cc63d962 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;
@@ -1053,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.
@@ -1195,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
@@ -1320,8 +1356,10 @@ sub print_latex {
@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";
@@ -1351,7 +1389,7 @@ sub print_latex {
$invoice_data{'notes'} =
join("\n",
map { my $b=$_; $b =~ s/\$(\w+)/$invoice_data{$1}/eg; $b }
- $conf->config('invoice_latexnotes')
+ $conf->config_orbase('invoice_latexnotes', $suffix)
);
$invoice_data{'footer'} =~ s/\n+$//;
@@ -1469,17 +1507,17 @@ sub print_latex {
$var;
}
- my $dir = '/tmp'; #! /usr/local/etc/freeside/invoices.datasrc/
- my $unique = int(rand(2**31)); #UGH... use File::Temp or something
-
- chdir($dir);
- my $file = $self->invnum. ".$unique";
+ 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;
- open(TEX,">$file.tex") or die "can't open $file.tex: $!\n";
- print TEX join("\n", @filled_in ), "\n";
- close TEX;
-
- return $file;
+ $fh->filename =~ /^(.*).tex$/ or die "unparsable filename: ". $fh->filename;
+ return $1;
}
@@ -1499,13 +1537,21 @@ sub print_ps {
my $file = $self->print_latex(@_);
- #error checking!!
- system('pslatex', "$file.tex");
- system('pslatex', "$file.tex");
- system('dvips', '-q', '-t', 'letter', "$file.dvi", '-o', "$file.ps" );
+ my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
+ chdir($dir);
+
+ 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('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";
+ or die "can't open $file.ps: $! (error in LaTeX template?)\n";
unlink("$file.dvi", "$file.log", "$file.aux", "$file.ps", "$file.tex");
@@ -1536,19 +1582,30 @@ sub print_pdf {
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.
- #error checking!!
- system('pslatex', "$file.tex");
- system('pslatex', "$file.tex");
+ 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 $file.dvi | gs -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$file.pdf -c save pop -");
+ 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 (probably error in LaTeX tempalte: $!\n";
+ or die "can't open $file.pdf: $! (error in LaTeX template?)\n";
unlink("$file.dvi", "$file.log", "$file.aux", "$file.pdf", "$file.tex");
@@ -1748,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),
};
@@ -1793,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_pkg.pm b/FS/FS/cust_pkg.pm
index a62c44e00..a3297ab47 100644
--- a/FS/FS/cust_pkg.pm
+++ b/FS/FS/cust_pkg.pm
@@ -462,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 ) {
diff --git a/FS/FS/cust_refund.pm b/FS/FS/cust_refund.pm
index aa81003b1..4a1037fdd 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' ])
@@ -267,7 +270,7 @@ sub check {
=head1 VERSION
-$Id: cust_refund.pm,v 1.18.4.2 2002-11-19 09:52:02 ivan Exp $
+$Id: cust_refund.pm,v 1.18.4.3 2004-07-06 14:22:57 ivan Exp $
=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/part_export/apache.pm b/FS/FS/part_export/apache.pm
index b16b3040d..17fbabff8 100644
--- a/FS/FS/part_export/apache.pm
+++ b/FS/FS/part_export/apache.pm
@@ -10,6 +10,9 @@ 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',
diff --git a/FS/FS/part_export/postfix.pm b/FS/FS/part_export/postfix.pm
index c24cf19a3..4fd19ee61 100644
--- a/FS/FS/part_export/postfix.pm
+++ b/FS/FS/part_export/postfix.pm
@@ -11,6 +11,11 @@ tie my %options, 'Tie::IxHash',
'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 = (
diff --git a/FS/FS/part_export/shellcommands.pm b/FS/FS/part_export/shellcommands.pm
index 78f9e9690..4f201cf9c 100644
--- a/FS/FS/part_export/shellcommands.pm
+++ b/FS/FS/part_export/shellcommands.pm
@@ -154,6 +154,7 @@ old_ for replace operations):
<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
@@ -175,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);
@@ -228,6 +240,8 @@ sub _export_command {
);
}
+ @radius_groups = $svc_acct->radius_groups;
+
$self->shellcommands_queue( $svc_acct->svcnum,
user => $self->option('user')||'root',
host => $self->machine,
@@ -266,6 +280,9 @@ sub _export_replace {
);
}
+ @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 ) {
@@ -280,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;
}
diff --git a/FS/FS/part_export/shellcommands_withdomain.pm b/FS/FS/part_export/shellcommands_withdomain.pm
index 8a56bab1c..89ee95fa3 100644
--- a/FS/FS/part_export/shellcommands_withdomain.pm
+++ b/FS/FS/part_export/shellcommands_withdomain.pm
@@ -73,7 +73,7 @@ the same username with different domains. You will need to
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 $username\\\@$domain $new_quoted_password";
+ 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;
'>
@@ -95,6 +95,7 @@ The following variables are available for interpolation (prefixed with
<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
diff --git a/FS/FS/part_export/vpopmail.pm b/FS/FS/part_export/vpopmail.pm
index 62fa8bade..0fc8266ea 100644
--- a/FS/FS/part_export/vpopmail.pm
+++ b/FS/FS/part_export/vpopmail.pm
@@ -24,12 +24,14 @@ tie my %options, 'Tie::IxHash',
'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>. See shellcommands_withdomain for an
-export that uses vpopmail commands instead.
+to <b>vpopmail</b>@<i>export.host</i>.
END
);
diff --git a/FS/FS/part_export/www_shellcommands.pm b/FS/FS/part_export/www_shellcommands.pm
index 6847f6470..dd909376b 100644
--- a/FS/FS/part_export/www_shellcommands.pm
+++ b/FS/FS/part_export/www_shellcommands.pm
@@ -10,13 +10,13 @@ use FS::part_export;
tie my %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',
+ default=>'mkdir $homedir/$zone; chown $username $homedir/$zone; ln -s $homedir/$zone /var/www/$zone',
},
'userdel' => { label=>'Delete command',
- default=>'[ -n &quot;$zone&quot; ] && rm -rf /var/www/$zone; rm $homedir/$zone',
+ default=>'[ -n "$zone" ] && rm -rf /var/www/$zone; rm -rf $homedir/$zone',
},
'usermod' => { label=>'Modify command',
- default=>'[ -n &quot;$old_zone&quot; ] && rm $old_homedir/$old_zone; [ &quot;$old_zone&quot; != &quot;$new_zone&quot; -a -n &quot;$new_zone&quot; ] && mv /var/www/$old_zone /var/www/$new_zone; [ &quot;$old_username&quot; != &quot;$new_username&quot; ] && chown -R $new_username /var/www/$new_zone; ln -s /var/www/$new_zone $new_homedir/$new_zone',
+ 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',
},
;
@@ -32,9 +32,9 @@ Run remote commands via SSH, for virtual web sites. You will need to
<LI>
<INPUT TYPE="button" VALUE="Maintain directories" onClick='
this.form.user.value = "root";
- this.form.useradd.value = "mkdir /var/www/$zone; chown $username /var/www/$zone; ln -s /var/www/$zone $homedir/$zone";
- this.form.userdel.value = "[ -n &quot;$zone&quot; ] && rm -rf /var/www/$zone; rm $homedir/$zone";
- this.form.usermod.value = "[ -n &quot;$old_zone&quot; ] && rm $old_homedir/$old_zone; [ &quot;$old_zone&quot; != &quot;$new_zone&quot; -a -n &quot;$new_zone&quot; ] && mv /var/www/$old_zone /var/www/$new_zone; [ &quot;$old_username&quot; != &quot;$new_username&quot; ] && chown -R $new_username /var/www/$new_zone; ln -s /var/www/$new_zone $new_homedir/$new_zone";
+ 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='
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/queue.pm b/FS/FS/queue.pm
index 68a48634c..b21fb6572 100644
--- a/FS/FS/queue.pm
+++ b/FS/FS/queue.pm
@@ -352,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 = '';
}
@@ -424,7 +422,7 @@ END
=head1 VERSION
-$Id: queue.pm,v 1.15.4.1 2004-03-03 13:44:27 ivan Exp $
+$Id: queue.pm,v 1.15.4.2 2004-05-04 18:44:49 ivan Exp $
=head1 BUGS
diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 4b51a3671..f6698ef41 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -33,6 +33,8 @@ 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 );
@@ -191,8 +193,7 @@ 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
@@ -230,14 +231,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 ) {
@@ -248,94 +241,12 @@ 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' => \@jobnums,
@@ -473,7 +384,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)
@@ -544,8 +455,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
@@ -621,6 +532,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;
@@ -817,6 +737,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');
@@ -886,6 +815,123 @@ 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 $svcpart = $self->svcpart;
+ my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
+ unless ( $part_svc ) {
+ return 'unknown svcpart '. $self->svcpart;
+ }
+
+ my $global_unique = $conf->config('global_unique-username');
+
+ my @dup_user = grep { $svcpart != $_->svcpart }
+ qsearch( 'svc_acct', { 'username' => $self->username } );
+ return gettext('username_in_use')
+ if $global_unique eq 'username' && @dup_user;
+
+ my @dup_userdomain = grep { $svcpart != $_->svcpart }
+ 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 { $svcpart != $_->svcpart }
+ 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
@@ -907,6 +953,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 {
@@ -1077,7 +1127,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
diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm
index 45fcdd24a..c0190fcd5 100644
--- a/FS/FS/svc_domain.pm
+++ b/FS/FS/svc_domain.pm
@@ -348,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 '' ) {
diff --git a/FS/MANIFEST b/FS/MANIFEST
index 3d12a4051..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
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-selfservice-server b/FS/bin/freeside-selfservice-server
index 864c2d46e..c045893d1 100644
--- a/FS/bin/freeside-selfservice-server
+++ b/FS/bin/freeside-selfservice-server
@@ -8,7 +8,8 @@
# 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);
@@ -24,11 +25,12 @@ use FS::Conf;
use FS::cust_bill;
use FS::cust_pkg;
-$Debug = 1; # >= 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;
@@ -39,7 +41,6 @@ my $tag = scalar(@ARGV) ? shift : '';
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);
@@ -58,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) {
@@ -68,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;
}
@@ -89,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;
@@ -107,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;
@@ -120,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;
@@ -132,6 +150,7 @@ while (1) {
}
+ &shutdown if $shutdown;
warn "connection lost, reconnecting\n" if $Debug;
sleep 3;
@@ -181,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
@@ -213,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;
@@ -245,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: $!";
@@ -253,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-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
-
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-15 10:11:37 +0000