diff options
Diffstat (limited to 'FS/bin')
| -rwxr-xr-x | FS/bin/freeside-addgroup | 2 | ||||
| -rwxr-xr-x | FS/bin/freeside-apply_payments_and_credits | 79 | ||||
| -rwxr-xr-x | FS/bin/freeside-cdr-sftp_and_import | 187 | ||||
| -rw-r--r-- | FS/bin/freeside-check | 31 | ||||
| -rwxr-xr-x | FS/bin/freeside-daily | 40 | ||||
| -rwxr-xr-x | FS/bin/freeside-expiration-alerter | 241 | ||||
| -rwxr-xr-x | FS/bin/freeside-monthly | 3 | ||||
| -rw-r--r-- | FS/bin/freeside-queued | 209 | ||||
| -rw-r--r-- | FS/bin/freeside-selfservice-server | 23 | ||||
| -rwxr-xr-x | FS/bin/freeside-sqlradius-reset | 23 | ||||
| -rwxr-xr-x | FS/bin/freeside-upgrade | 33 | ||||
| -rwxr-xr-x | FS/bin/freeside-void-payments | 222 |
12 files changed, 743 insertions, 350 deletions
diff --git a/FS/bin/freeside-addgroup b/FS/bin/freeside-addgroup index 7b30f7d..25c2345 100755 --- a/FS/bin/freeside-addgroup +++ b/FS/bin/freeside-addgroup @@ -24,7 +24,7 @@ my $error = $access_group->insert; die $error if $error; if ( $opt_s ) { - foreach my $rightname ( FS::AccessRight->rights ) { + foreach my $rightname ( FS::AccessRight->default_superuser_rights ) { my $access_right = new FS::access_right { 'righttype' => 'FS::access_group', 'rightobjnum' => $access_group->groupnum, diff --git a/FS/bin/freeside-apply_payments_and_credits b/FS/bin/freeside-apply_payments_and_credits new file mode 100755 index 0000000..d789c6c --- /dev/null +++ b/FS/bin/freeside-apply_payments_and_credits @@ -0,0 +1,79 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $DEBUG ); +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_main; +use DBI; + +$DEBUG = 1; + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my $unapplied_payments_sql = <<EOF; +SELECT custnum FROM cust_pay WHERE paid > + ( ( SELECT coalesce(sum(amount),0) FROM cust_bill_pay + WHERE cust_pay.paynum = cust_bill_pay.paynum ) + + ( SELECT coalesce(sum(amount),0) FROM cust_pay_refund + WHERE cust_pay.paynum = cust_pay_refund.paynum) + ) +EOF + +my $unapplied_credits_sql = <<EOF; +SELECT custnum FROM cust_credit WHERE cust_credit.amount > + ( ( SELECT coalesce(sum(cust_credit_bill.amount),0) FROM cust_credit_bill + WHERE cust_credit.crednum = cust_credit_bill.crednum ) + + ( SELECT coalesce(sum(cust_Credit_refund.amount),0) FROM cust_credit_refund + WHERE cust_credit.crednum = cust_credit_refund.crednum) + ) +EOF + +my %custnum = (); + +my $sth = $dbh->prepare($unapplied_payments_sql) or die $dbh->errstr; +$sth->execute or die "unapplied payment search failed: ". $sth->errstr; + +map { $custnum{$_->[0]} = 1 } @{ $sth->fetchall_arrayref }; + +$sth = $dbh->prepare($unapplied_credits_sql) or die $dbh->errstr; +$sth->execute or die "unapplied credit search failed: ". $sth->errstr; + +map { $custnum{$_->[0]} = 1 } @{ $sth->fetchall_arrayref }; + +foreach my $custnum ( keys %custnum ) { + + warn "processing customer $custnum\n" if $DEBUG; + + my $cust_main = qsearchs('cust_main', { 'custnum' => $custnum } ) + or die "customer $custnum no longer exists!\n"; + + my $error = $cust_main->apply_payments_and_credits; + die $error if $error; + +} + +sub usage { + die "Usage:\n\n freeside-apply_payments_and_credits user\n"; +} + +=head1 NAME + +freeside-apply_payments_and_credits - Command line interface to apply payments and credits to invoice + +=head1 SYNOPSIS + + freeside-apply_payments_and_credits username + +=head1 DESCRIPTION + +Finds unapplied payment and credit amounts and applies them to any outstanding +uncovered invoice amounts. + +B<username> is a username added by freeside-adduser. + +=cut + + + diff --git a/FS/bin/freeside-cdr-sftp_and_import b/FS/bin/freeside-cdr-sftp_and_import new file mode 100755 index 0000000..e87698f --- /dev/null +++ b/FS/bin/freeside-cdr-sftp_and_import @@ -0,0 +1,187 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Net::SFTP::Foreign::Compat; +use Net::FTP; +use FS::UID qw(adminsuidsetup datasrc); +use FS::cdr; + +### +# parse command line +### + +use vars qw( $opt_m $opt_p $opt_r $opt_e $opt_d $opt_v ); +getopts('m:p:r:e:d:v'); + +$opt_e ||= 'csv'; +#$opt_e = ".$opt_e" unless $opt_e =~ /^\./; +$opt_e =~ s/^\.//; + +$opt_p ||= ''; + +my $user = shift or die &usage; +adminsuidsetup $user; + +# %%%FREESIDE_CACHE%%% +my $cachedir = '/usr/local/etc/freeside/cache.'. datasrc. '/cdrs'; +mkdir $cachedir unless -d $cachedir; + +my $format = shift or die &usage; + +use vars qw( $servername ); +$servername = shift or die &usage; + +### +# get the file list +### + +warn "Retrieving directory listing\n" if $opt_v; + +$opt_m = 'sftp' if !defined($opt_m); +$opt_m = lc($opt_m); + +my $ls; + +if($opt_m eq 'ftp') { + my $ls_ftp = ftp(); + + $ls = [ grep { /^$opt_p.*\.$opt_e$/i } $ls_ftp->ls ]; +} +elsif($opt_m eq 'sftp') { + my $ls_sftp = sftp(); + + $ls_sftp->setcwd($opt_r) or die "can't chdir to $opt_r\n" + if $opt_r; + + $ls = $ls_sftp->ls('.', wanted => qr/^$opt_p.*\.$opt_e$/i, + names_only => 1 ); +} +else { + die "Method '$opt_m' not supported; must be ftp or sftp\n"; +} + +### +# import each file +### + +foreach my $filename ( @$ls ) { + + warn "Downloading $filename\n" if $opt_v; + + #get the file + if($opt_m eq 'ftp') { + my $ftp = ftp(); + $ftp->get($filename, "$cachedir/$filename") + or die "Can't get $filename: ". $ftp->message . "\n"; + } + else { + my $sftp = sftp(); + $sftp->get($filename, "$cachedir/$filename") + or die "Can't get $filename: ". $sftp->error . "\n"; + } + + warn "Processing $filename\n" if $opt_v; + + my $error = FS::cdr::batch_import( { + 'file' => "$cachedir/$filename", + 'format' => $format, + 'params' => { 'cdrbatch' => $filename, }, + 'empty_ok' => 1, + } ); + die $error if $error; + + if ( $opt_d ) { + if($opt_m eq 'ftp') { + my $ftp = ftp(); + $ftp->rename($filename, "$opt_d/$filename") + or die "Can't move $filename to $opt_d: ".$ftp->message . "\n"; + } + else { + my $sftp = sftp(); + $sftp->rename($filename, "$opt_d/$filename") + or die "can't move $filename to $opt_d: ". $sftp->error . "\n"; + } + } + + unlink "$cachedir/$filename"; + +} + +### +# subs +### + +sub usage { + "Usage: \n cdr.import user format servername\n"; +} + +use vars qw( $sftp $ftp ); + +sub ftp { + return $ftp if $ftp && $ftp->pwd; + + my ($hostname, $user) = reverse split('@', $servername); + my ($user, $pass) = split(':', $user); + + my $ftp = Net::FTP->new($hostname) or die "FTP connection to '$hostname' failed."; + $ftp->login($user, $pass) or die "FTP login failed: ".$ftp->message; + $ftp->cwd($opt_r) or die "can't chdir to $opt_r\n" if $opt_r; + return $ftp; +} + +sub sftp { + + #reuse connections + return $sftp if $sftp && $sftp->cwd; + + my %sftp = ( host => $servername ); + + $sftp = Net::SFTP::Foreign->new(%sftp); + $sftp->error and die "SFTP connection failed: ". $sftp->error; + + $sftp; +} + +=head1 NAME + +cdr.sftp_and_import - Download CDR files from a remote server via SFTP + +=head1 SYNOPSIS + + cdr.sftp_and_import [ -m method ][ -p prefix ] [ -e extension ] [ -r remotefolder ] [ -d donefolder ] [ -v ] user format [sftpuser@]servername + +=head1 DESCRIPTION + +Command line tool to download CDR files from a remote server via SFTP or FTP and then +import them into the database. + +-m: transfer method (sftp or ftp), defaults to sftp + +-p: file prefix, if specified + +-e: file extension, defaults to .csv + +-r: if specified, changes into this remote folder before starting + +-d: if specified, moves files to the specified folder when done + +-v: verbose + +user: freeside username + +format: CDR format name + +[sftpuser@]servername: remote server +(or ftpuser:ftppass@servername) + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cdr> + +=cut + +1; + diff --git a/FS/bin/freeside-check b/FS/bin/freeside-check new file mode 100644 index 0000000..9930aae --- /dev/null +++ b/FS/bin/freeside-check @@ -0,0 +1,31 @@ +#!/usr/bin/perl +#!/usr/bin/perl -w + +use strict; +use FS::UID qw( adminsuidsetup ); +use FS::Cron::check qw( + check_queued check_selfservice check_apache check_bop_failures + check_sg check_sg_login check_sgng + alert error_msg +); + +my $user = shift or die &usage; +my @emails = @ARGV; +#die "no notification email given" unless @emails; + +eval { adminsuidsetup $user }; + +if ( $@ ) { alert("Database down: $@", @emails); exit; } + +check_queued or alert('Queue daemon not running', @emails); +check_selfservice or alert(error_msg(), @emails); +check_apache or alert('Apache not running: '. error_msg(), @emails); + +#no-ops unless you are sg +my $sg = 'FS::ClientAPI::SG'; +check_sg or alert("$sg not responding: ". error_msg(), @emails); +check_sg_login or alert("$sg login errort: ". error_msg(), @emails); +check_sgng or alert("${sg}NG not responding: ". error_msg(), @emails); + +check_bop_failures or alert(error_msg(), @emails); + diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 13079b4..728fa96 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -3,10 +3,11 @@ use strict; use Getopt::Std; use FS::UID qw(adminsuidsetup); +use FS::Conf; &untaint_argv; #what it sounds like (eww) use vars qw(%opt); -getopts("p:a:d:vl:sy:nm", \%opt); +getopts("p:a:d:vl:sy:nmrkg:", \%opt); my $user = shift or die &usage; adminsuidsetup $user; @@ -14,17 +15,33 @@ adminsuidsetup $user; use FS::Cron::bill qw(bill); bill(%opt); -#what to do about the below when using -m? that is the question. +#you can skip this just by not having the config +use FS::Cron::upload qw(upload); +upload(%opt); + +# Send alerts about upcoming credit card expiration. +use FS::Cron::alert_expiration qw(alert_expiration); +my $conf = new FS::Conf; +alert_expiration(%opt) if($conf->exists('alert_expiration')); -use FS::Cron::notify qw(notify_flat_delay); -notify_flat_delay(%opt); +#what to do about the below when using -m? that is the question. +#you don't want to skip this, besides, it should be cheap use FS::Cron::expire_user_pref qw(expire_user_pref); expire_user_pref(); -use FS::Cron::vacuum qw(vacuum); -vacuum(); +unless ( $opt{k} ) { + + use FS::Cron::notify qw(notify_flat_delay); + notify_flat_delay(%opt); + + #Pg 8.1+ auto-vaccums, 7.4 w/postgresql-contrib + #use FS::Cron::vacuum qw(vacuum); + #vacuum(); +} + +#you can skip this just by not having the config use FS::Cron::backup qw(backup_scp); backup_scp(); @@ -42,7 +59,7 @@ sub untaint_argv { } sub usage { - die "Usage:\n\n freeside-daily [ -d 'date' ] user [ custnum custnum ... ]\n"; + die "Usage:\n\n freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] [ -l level ] [ -m ] [ -k ] user [ custnum custnum ... ]\n"; } ### @@ -55,7 +72,7 @@ freeside-daily - Run daily billing and invoice collection events. =head1 SYNOPSIS - freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] [ -l level ] [ -m ] user [ custnum custnum ... ] + freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] [ -l level ] [ -m ] [ -r ] [ -k ] user [ custnum custnum ... ] =head1 DESCRIPTION @@ -81,6 +98,9 @@ the bill and collect methods of a cust_main object. See L<FS::cust_main>. -a: Only process customers with the specified agentnum + -g: Don't process the provided pkgpart (or pkgparts, specified as a comma- + separated list). + -s: re-charge setup fees -v: enable debugging @@ -89,6 +109,10 @@ the bill and collect methods of a cust_main object. See L<FS::cust_main>. -m: Experimental multi-process mode uses the job queue for multi-process and/or multi-machine billing. + -r: Multi-process mode dry run option + + -k: skip notify_flat_delay and vacuum + user: From the mapsecrets file - see config.html from the base documentation custnum: if one or more customer numbers are specified, only bills those diff --git a/FS/bin/freeside-expiration-alerter b/FS/bin/freeside-expiration-alerter deleted file mode 100755 index 0bb61db..0000000 --- a/FS/bin/freeside-expiration-alerter +++ /dev/null @@ -1,241 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; -use Date::Format; -use Time::Local; -use Text::Template; -use Getopt::Std; -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_main; - -use vars qw($smtpmachine %agent_failure_body); - -#hush, perl! -$FS::alerter::_template::first = ""; -$FS::alerter::_template::last = ""; -$FS::alerter::_template::company = ""; -$FS::alerter::_template::payby = ""; -$FS::alerter::_template::expdate = ""; - -# Set the mail program and other variables -my $mail_sender = "billing\@mydomain.tld"; # or invoice_from if available -my $failure_recipient = "postmaster"; # or invoice_from if available -my $warning_time = 30 * 24 * 60 * 60; -my $urgent_time = 15 * 24 * 60 * 60; -my $panic_time = 5 * 24 * 60 * 60; -my $window_time = 24 * 60 * 60; - -&untaint_argv; #what it sounds like (eww) - -#we're at now now (and later). -my($_date)= $^T; - -# Get the current month -my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($_date) )[0,1,2,3,4,5]; -$mon++; - -# Login to the database -my $user = shift or die &usage; -adminsuidsetup $user; - -# Get the needed configuration files -my $conf = new FS::Conf; -$smtpmachine = $conf->config('smtpmachine'); - -my(@customers)=qsearch('cust_main',{}); -if (scalar(@customers) == 0) -{ - exit 1; -} - -# Now I can start looping -foreach my $customer (@customers) -{ - my $paydate = $customer->getfield('paydate'); - next if $paydate =~ /^\s*$/; #skip empty expiration dates - - my $custnum = $customer->getfield('custnum'); - my $first = $customer->getfield('first'); - my $last = $customer->getfield('last'); - my $company = $customer->getfield('company'); - my $payby = $customer->getfield('payby'); - my $payinfo = $customer->getfield('payinfo'); - my $daytime = $customer->getfield('daytime'); - my $night = $customer->getfield('night'); - - my ($payyear,$paymonth,$payday) = split (/-/,$paydate); - - my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear); - - #credit cards expire at the end of the month/year of their exp date - if ($payby eq 'CARD' || $payby eq 'DCRD') { - ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++); - $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear); - $expire_time--; - } - - if (($expire_time < $_date + $warning_time && - $expire_time > $_date + $warning_time - $window_time) || - ($expire_time < $_date + $urgent_time && - $expire_time > $_date + $urgent_time - $window_time) || - ($expire_time < $_date + $panic_time && - $expire_time > $_date + $panic_time - $window_time)) { - - # Prepare for sending email, now inside the customer loop so i can be agent - # virtualized - - my $agentnum = $customer->agentnum; - - $mail_sender = $conf->config('invoice_from', $agentnum ) - if $conf->exists('invoice_from', $agentnum); - $failure_recipient = $conf->config('invoice_from', $agentnum) - if $conf->exists('invoice_from', $agentnum); - - $ENV{MAILADDRESS} = $mail_sender; - - my @alerter_template = $conf->config('alerter_template', $agentnum) - or die "cannot load config file alerter_template"; - - my $alerter = new Text::Template TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @alerter_template ] - or die "can't create new Text::Template object: $Text::Template::ERROR"; - - $alerter->compile() or die "can't compile template: $Text::Template::ERROR"; - - my @packages = $customer->ncancelled_pkgs; - if (scalar(@packages) != 0) { - my @invoicing_list = $customer->invoicing_list; - if ( grep { $_ ne 'POST' } @invoicing_list ) { - my $header = new Mail::Header ( [ - "From: $mail_sender", - "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ), - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Date: ". time2str("%a, %d %b %Y %X %z", time), - "Subject: Billing Arrangement Expiration", - ] ); - $FS::alerter::_template::first = $first; - $FS::alerter::_template::last = $last; - $FS::alerter::_template::company = $company; - if ($payby eq 'CARD' || $payby eq 'DCRD') { - $FS::alerter::_template::payby = "credit card (" . - substr($payinfo, 0, 2) . "xxxxxxxxxx" . - substr($payinfo, -4) . ")"; - }elsif ($payby eq 'COMP') { - $FS::alerter::_template::payby = "complimentary account"; - }else{ - $FS::alerter::_template::payby = "current method"; - } - $FS::alerter::_template::expdate = $expire_time; - - $FS::alerter::_template::company_name = - $conf->config('company_name', $agentnum); - $FS::alerter::_template::company_address = - join("\n", $conf->config('company_address', $agentnum) ). "\n"; - - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ $alerter->fill_in( PACKAGE => 'FS::alerter::_template' ) ], - ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or die "Can't send expiration email: $!"; - - } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) { - push @{$agent_failure_body{$customer->agentnum}}, - sprintf(qq{%5d %-32.32s %4s %10s %12s %12s}, - $custnum, - $first . " " . $last . " " . $company, - $payby, - $paydate, - $daytime, - $night - ); - } - } - } -} - -# Now I need to send failure EMAIL - -foreach my $agentnum ( keys %agent_failure_body ) { - - $mail_sender = $conf->config('invoice_from', $agentnum ) - if $conf->exists('invoice_from', $agentnum); - $failure_recipient = $conf->config('invoice_from', $agentnum) - if $conf->exists('invoice_from', $agentnum); - - $ENV{MAILADDRESS} = $mail_sender; - my $header = new Mail::Header ( [ - "From: Account Processor", - "To: $failure_recipient", - "Sender: $mail_sender", - "Reply-To: $mail_sender", - "Subject: Unnotified Billing Arrangement Expirations", - ] ); - - my $message = new Mail::Internet ( - 'Header' => $header, - 'Body' => [ @{$agent_failure_body{$agentnum}} ], - ); - $!=0; - $message->smtpsend( Host => $smtpmachine ) - or $message->smtpsend( Host => $smtpmachine, Debug => 1 ) - or die "can't send alerter failure email to $failure_recipient". - " via server $smtpmachine with SMTP: $!"; -} - -# subroutines -sub untaint_argv { - foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV - $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal argument \"$ARGV[$_]\""; - $ARGV[$_]=$1; - } -} - -sub usage { - die "Usage:\n\n freeside-expiration-alerter user\n"; -} - -=head1 NAME - -freeside-expiration-alerter - Emails notifications of credit card expirations. - -=head1 SYNOPSIS - - freeside-expiration-alerter user - -=head1 DESCRIPTION - -Emails customers notice that their credit card or other billing arrangement -is about to expire. Usually run as a cron job. - -user: From the mapsecrets file - see config.html from the base documentation - -=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> - -=cut - - diff --git a/FS/bin/freeside-monthly b/FS/bin/freeside-monthly index 1e41b78..a81e3e9 100755 --- a/FS/bin/freeside-monthly +++ b/FS/bin/freeside-monthly @@ -15,6 +15,9 @@ adminsuidsetup $user; use FS::Cron::bill qw(bill); bill(%opt, 'check_freq'=>'1m' ); +use FS::Cron::upload qw(upload); +upload(%opt); + ### # subroutines ### diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued index d4f09c1..e97a52c 100644 --- a/FS/bin/freeside-queued +++ b/FS/bin/freeside-queued @@ -4,9 +4,11 @@ use strict; use vars qw( $DEBUG $kids $max_kids %kids ); use POSIX qw(:sys_wait_h); use IO::File; +use Getopt::Std; use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh myconnect); use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); -use FS::Record qw(qsearch qsearchs); +use FS::Conf; +use FS::Record qw(qsearch); use FS::queue; use FS::queue_depend; @@ -15,9 +17,12 @@ use Net::SSH 0.07; $DEBUG = 0; -$max_kids = '10'; #guess it should be a config file... $kids = 0; +&untaint_argv; #what it sounds like (eww) +use vars qw(%opt); +getopts('sn', \%opt ); + my $user = shift or die &usage; warn "starting daemonization (forking)\n" if $DEBUG; @@ -27,7 +32,6 @@ daemonize1('freeside-queued'); warn "dropping privledges\n" if $DEBUG; drop_root(); - $ENV{HOME} = (getpwuid($>))[7]; #for ssh warn "connecting to database\n" if $DEBUG; @@ -48,6 +52,9 @@ daemonize2(); #-- +my $conf = new FS::Conf; +$max_kids = $conf->config('queued-max_kids') || 10; + my $warnkids=0; while (1) { @@ -81,114 +88,135 @@ while (1) { # local $FS::UID::AutoCommit = 0; $FS::UID::AutoCommit = 0; - my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'. + my $nodepend = 'AND NOT EXISTS( SELECT 1 FROM queue_depend'. ' WHERE queue_depend.jobnum = queue.jobnum )'; - my $order_by = "ORDER BY jobnum ". ( driver_name eq 'mysql' - ? 'LIMIT 1 FOR UPDATE' - : 'FOR UPDATE LIMIT 1' ); + #anything with a priority goes after stuff without one + my $order_by = ' ORDER BY COALESCE(priority,0) ASC, jobnum ASC '; + + my $limit = $max_kids - $kids; + + $order_by .= ( driver_name eq 'mysql' + ? " LIMIT $limit FOR UPDATE " + : " FOR UPDATE LIMIT $limit " ); - my $job = qsearchs({ + my $hashref = { 'status' => 'new' }; + if ( $opt{'s'} ) { + $hashref->{'secure'} = 'Y'; + } elsif ( $opt{'n'} ) { + $hashref->{'secure'} = ''; + } + + my @jobs = qsearch({ 'table' => 'queue', - 'hashref' => { 'status' => 'new' }, + 'hashref' => $hashref, 'extra_sql' => $nodepend, 'order_by' => $order_by, - }) or do { - # if $oldAutoCommit { + }); + + unless ( @jobs ) { dbh->commit or do { warn "WARNING: database error, closing connection: ". dbh->errstr; undef $FS::UID::dbh; next; }; - # } sleep 1; next; - }; - - my %hash = $job->hash; - $hash{'status'} = 'locked'; - my $ljob = new FS::queue ( \%hash ); - my $error = $ljob->replace($job); - if ( $error ) { - warn "WARNING: database error locking job, closing connection: ". - dbh->errstr; - undef $FS::UID::dbh; - next; } - # if $oldAutoCommit { - dbh->commit or do { - warn "WARNING: database error, closing connection: ". dbh->errstr; - undef $FS::UID::dbh; - next; - }; - # } - - $FS::UID::AutoCommit = 1; - #} - - my @args = $ljob->args; - splice @args, 0, 1, $ljob if $args[0] eq '_JOB'; + foreach my $job ( @jobs ) { - defined( my $pid = fork ) or do { - warn "WARNING: can't fork: $!\n"; my %hash = $job->hash; - $hash{'status'} = 'failed'; - $hash{'statustext'} = "[freeside-queued] can't fork: $!"; + $hash{'status'} = 'locked'; my $ljob = new FS::queue ( \%hash ); my $error = $ljob->replace($job); - die $error if $error; - next; #don't increment the kid counter - }; - - if ( $pid ) { - $kids++; - $kids{$pid} = 1; - } else { #kid time - - #get new db handle - $FS::UID::dbh->{InactiveDestroy} = 1; - - forksuidsetup($user); - - #auto-use classes... - #if ( $ljob->job =~ /(FS::part_export::\w+)::/ ) { - if ( $ljob->job =~ /(FS::(part_export|cust_main)::\w+)::/ - || $ljob->job =~ /(FS::\w+)::/ - ) - { - my $class = $1; - eval "use $class;"; + if ( $error ) { + warn "WARNING: database error locking job, closing connection: ". + dbh->errstr; + undef $FS::UID::dbh; + next; + } + + dbh->commit or do { + warn "WARNING: database error, closing connection: ". dbh->errstr; + undef $FS::UID::dbh; + next; + }; + + $FS::UID::AutoCommit = 1; + + my @args = $ljob->args; + splice @args, 0, 1, $ljob if $args[0] eq '_JOB'; + + defined( my $pid = fork ) or do { + warn "WARNING: can't fork: $!\n"; + my %hash = $job->hash; + $hash{'status'} = 'failed'; + $hash{'statustext'} = "[freeside-queued] can't fork: $!"; + my $ljob = new FS::queue ( \%hash ); + my $error = $ljob->replace($job); + die $error if $error; + next; #don't increment the kid counter + }; + + if ( $pid ) { + $kids++; + $kids{$pid} = 1; + } else { #kid time + + #get new db handle + $FS::UID::dbh->{InactiveDestroy} = 1; + + forksuidsetup($user); + + dbh->{'private_profile'} = {} if UNIVERSAL::can(dbh, 'sprintProfile'); + + #auto-use classes... + if ( $ljob->job =~ /(FS::(part_export|cust_main)::\w+)::/ + || $ljob->job =~ /(FS::\w+)::/ + ) + { + my $class = $1; + eval "use $class;"; + if ( $@ ) { + warn "job use $class failed"; + my %hash = $ljob->hash; + $hash{'status'} = 'failed'; + $hash{'statustext'} = $@; + my $fjob = new FS::queue( \%hash ); + my $error = $fjob->replace($ljob); + die $error if $error; + exit; #end-of-kid + }; + } + + my $eval = "&". $ljob->job. '(@args);'; + warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; + eval $eval; #throw away return value? suppose so if ( $@ ) { - warn "job use $class failed"; + warn "job $eval failed"; my %hash = $ljob->hash; $hash{'status'} = 'failed'; $hash{'statustext'} = $@; my $fjob = new FS::queue( \%hash ); my $error = $fjob->replace($ljob); die $error if $error; - exit; #end-of-kid - }; - } - - my $eval = "&". $ljob->job. '(@args);'; - warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG; - eval $eval; #throw away return value? suppose so - if ( $@ ) { - warn "job $eval failed"; - my %hash = $ljob->hash; - $hash{'status'} = 'failed'; - $hash{'statustext'} = $@; - my $fjob = new FS::queue( \%hash ); - my $error = $fjob->replace($ljob); - die $error if $error; - } else { - $ljob->delete; + } else { + $ljob->delete; + } + + if ( UNIVERSAL::can(dbh, 'sprintProfile') ) { + open(PROFILE,">%%%FREESIDE_LOG%%%/queueprofile.$$.".time) + or die "can't open profile file: $!"; + print PROFILE dbh->sprintProfile(); + close PROFILE or die "can't close profile file: $!"; + } + + exit; + #end-of-kid } - exit; - #end-of-kid - } + } #foreach my $job } continue { if ( sigterm() ) { @@ -201,6 +229,15 @@ while (1) { } } +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + #$ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + # Date::Parse + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + sub usage { die "Usage:\n\n freeside-queued user\n"; } @@ -221,12 +258,16 @@ freeside-queued - Job queue daemon =head1 SYNOPSIS - freeside-queued user + freeside-queued [ -s | -n ] user =head1 DESCRIPTION Job queue daemon. Should be running at all times. +-s: "secure" jobs only (queued billing jobs) + +-n: non-"secure" jobs only (other jobs) + user: from the mapsecrets file - see config.html from the base documentation =head1 VERSION diff --git a/FS/bin/freeside-selfservice-server b/FS/bin/freeside-selfservice-server index 2087e71..544f307 100644 --- a/FS/bin/freeside-selfservice-server +++ b/FS/bin/freeside-selfservice-server @@ -15,9 +15,11 @@ use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); use FS::UID qw(adminsuidsetup forksuidsetup); use FS::ClientAPI; use FS::ClientAPI_SessionCache; +use FS::Record qw( qsearch qsearchs ); use FS::Conf; use FS::cust_svc; +use FS::agent; $FREESIDE_LOG = "%%%FREESIDE_LOG%%%"; $FREESIDE_LOCK = "%%%FREESIDE_LOCK%%%"; @@ -97,7 +99,28 @@ while (1) { if ( $keepalives && $keepalive_count++ > 10 ) { $keepalive_count = 0; lock_write; + nstore_fd( { _token => '_keepalive' }, $writer ); + foreach my $agent ( qsearch( 'agent', { disabled => '' } ) ) { + my $config = qsearchs( 'conf', { name => 'selfservice-bulk_ftp_dir', + agentnum => $agent->agentnum, + } ) + or next; + + my $session = + FS::ClientAPI->dispatch( 'Agent/agent_login', + { username => $agent->username, + password => $agent->_password, + } + ); + + nstore_fd( { _token => '_ftp_scan', + dir => $config->value, + session_id => $session->{session_id}, + }, + $writer + ); + } unlock_write; } next; diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset index 7d1d343..a77bad6 100755 --- a/FS/bin/freeside-sqlradius-reset +++ b/FS/bin/freeside-sqlradius-reset @@ -42,6 +42,10 @@ unless ( $opt_n ) { } } +use FS::svc_Common; +$FS::svc_Common::overlimit_missing_cust_svc_nonfatal_kludge = 1; +$FS::svc_Common::overlimit_missing_cust_svc_nonfatal_kludge = 1; + foreach my $export ( @exports ) { #my @svcparts = map { $_->svcpart } $export->export_svc; @@ -49,14 +53,25 @@ foreach my $export ( @exports ) { my @svc_x = map { $_->svc_x } - map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } - grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + #map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + #grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) } + # $export->export_svc; + map { @{ $_->[1] } } + grep { scalar( @{ $_->[1] } ) } + map { [ $_, [ qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) ] ] } $export->export_svc; + foreach my $svc_x ( @svc_x ) { - $svc_x->check; #set any fixed usergroup so it'll export even if all - #svc_acct records don't have the group yet + #$svc_x->check; #set any fixed usergroup so it'll export even if all + # #svc_acct records don't have the group yet + #more efficient? + my $x = $svc_x->setfixed( $svc_x->_fieldhandlers); + unless ( ref($x) ) { + warn "WARNING: can't set fixed usergroups for svcnum ". $svc_x->svcnum. + "\n"; + } if ($overlimit_groups && $svc_x->overlimit) { $svc_x->usergroup( &{ $svc_x->_fieldhandlers->{'usergroup'} } diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade index c988e13..6ced372 100755 --- a/FS/bin/freeside-upgrade +++ b/FS/bin/freeside-upgrade @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use vars qw($opt_d $opt_s $opt_q $opt_v); +use vars qw($opt_d $opt_s $opt_q $opt_v $opt_r); use vars qw($DEBUG $DRY_RUN); use Getopt::Std; use DBIx::DBSchema 0.31; @@ -17,7 +17,7 @@ my $start = time; die "Not running uid freeside!" unless checkeuid(); -getopts("dqs"); +getopts("dqrs"); $DEBUG = !$opt_q; #$DEBUG = $opt_v; @@ -60,20 +60,24 @@ if (dbdef->table('cust_main')->column('agent_custid') && ! $opt_s) { #from 1.3 to 1.4... if not, it needs to be hooked into -upgrade here or #you'll lose all the part_svc settings it migrates to part_svc_column +my @statements = + grep { $_ !~ /^CREATE +INDEX +h_queue/ } #useless, holds up queue insertion + dbdef->sql_update_schema( dbdef_dist(datasrc), $dbh ); + if ( $DRY_RUN ) { print - join(";\n", @bugfix, dbdef->sql_update_schema( dbdef_dist(datasrc), $dbh ) ). ";\n"; + join(";\n", @bugfix, @statements ). ";\n"; exit; } else { - foreach my $statement ( @bugfix ) { + foreach my $statement ( @bugfix, @statements ) { $dbh->do( $statement ) or die "Error: ". $dbh->errstr. "\n executing: $statement"; } - warn "Pre-schema change upgrades completed in ". (time-$start). " seconds\n"; # if $DEBUG; - $start = time; +# warn "Pre-schema change upgrades completed in ". (time-$start). " seconds\n"; # if $DEBUG; +# $start = time; - dbdef->update_schema( dbdef_dist(datasrc), $dbh ); +# dbdef->update_schema( dbdef_dist(datasrc), $dbh ); } warn "Schema upgrade completed in ". (time-$start). " seconds\n"; # if $DEBUG; @@ -127,7 +131,7 @@ $FS::UID::AutoCommit = 0; $FS::UID::callback_hack = 1; $dbh = adminsuidsetup($user); $FS::UID::callback_hack = 0; -unless ( $DRY_RUN ) { +unless ( $DRY_RUN || $opt_s ) { my $dir = "%%%FREESIDE_CONF%%%/conf.". datasrc; if (!scalar(qsearch('conf', {}))) { my $error = FS::Conf::init_config($dir); @@ -149,11 +153,13 @@ $start = time; upgrade() unless $DRY_RUN || $opt_s; +$dbh->commit or die $dbh->errstr; + warn "Table updates completed in ". (time-$start). " seconds\n"; # if $DEBUG; $start = time; upgrade_sqlradius() - unless $DRY_RUN || $opt_s; + unless $DRY_RUN || $opt_s || $opt_r; warn "SQL RADIUS updates completed in ". (time-$start). " seconds\n"; # if $DEBUG; $start = time; @@ -161,7 +167,7 @@ $start = time; $dbh->commit or die $dbh->errstr; $dbh->disconnect or die $dbh->errstr; -warn "Commit and disconnection completed in ". (time-$start). " seconds; upgrade done!\n"; # if $DEBUG; +warn "Final commit and disconnection completed in ". (time-$start). " seconds; upgrade done!\n"; # if $DEBUG; ### @@ -172,7 +178,7 @@ sub dbdef_create { # reverse engineer the schema from the DB and save to file } sub usage { - die "Usage:\n freeside-upgrade [ -d ] [ -s ] [ -q | -v ] user\n"; + die "Usage:\n freeside-upgrade [ -d ] [ -r ] [ -s ] [ -q | -v ] user\n"; } =head1 NAME @@ -181,7 +187,7 @@ freeside-upgrade - Upgrades database schema for new freeside verisons. =head1 SYNOPSIS - freeside-upgrade [ -d ] [ -s ] [ -q | -v ] + freeside-upgrade [ -d ] [ -r ] [ -s ] [ -q | -v ] =head1 DESCRIPTION @@ -203,6 +209,9 @@ Also performs other upgrade functions: [ -q ]: Run quietly. This may become the default at some point. + [ -r ]: Skip sqlradius updates. Useful for occassions where the sqlradius + databases may be inaccessible. + [ -v ]: Run verbosely, sending debugging information to STDERR. This is the current default. diff --git a/FS/bin/freeside-void-payments b/FS/bin/freeside-void-payments new file mode 100755 index 0000000..412033c --- /dev/null +++ b/FS/bin/freeside-void-payments @@ -0,0 +1,222 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $user $cust_main @customers ); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::Conf; +use FS::cust_main; +use FS::cust_pay; +use FS::cust_pay_void; +use Business::OnlinePayment; # For retrieving the void list only. +use Time::Local; +use Date::Parse 'str2time'; +use Date::Format 'time2str'; + +my %opt; +getopts("r:f:ca:g:s:e:vnX:", \%opt); + +$user = shift or die &usage; +&adminsuidsetup( $user ); + +# The -g and -a options need to override this. +my $method = $opt{'c'} ? 'ECHECK' : 'CARD'; +my $gateway; +if($opt{'g'}) { + $gateway = FS::payment_gateway->by_key($opt{'g'}) + or die "Payment gateway not found: '".$opt{'g'}."'."; +} +elsif($opt{'a'}) { + my $agent = FS::agent->by_key($opt{'a'}) + or die "Agent not found: '".$opt{'a'}."'."; + $gateway = $agent->payment_gateway(method => $method) + or die "Agent has no payment gateway for method '$method'."; +} + +if(defined($opt{'X'})) { + die "Cancellation reason not found: '".$opt{'X'}."'" + if(! qsearchs('reason', { reasonnum => $opt{'X'} } ) ); +} + +my ($processor, $login, $password, $action, @bop_options) = + FS::cust_main->default_payment_gateway($method); +my $gatewaynum = ''; + +if($gateway) { +# override the default gateway + $gatewaynum = $gateway->gatewaynum . '-' if $gateway->gatewaynum; + $processor = $gateway->gateway_module; + $login = $gateway->gateway_username; + $password = $gateway->gateway_password; + $action = $gateway->gateway_action; + @bop_options = $gateway->options; +} + +my @auths; +if($opt{'f'}) { +# Read the list of authorization numbers from a file. + my $in; + open($in, '< '. $opt{'f'}) or die "Unable to open file: '".$opt{'f'}."'."; + @auths = grep /^\d+$/, <$in>; + chomp @auths; +} +else { +# Get the list from the processor. This requires the processor module to +# support get_returns. + my $transaction = new Business::OnlinePayment ( $processor, @bop_options ); + if(! $transaction->can('get_returns')) { + die "'$processor' does not provide an automated void list."; + } + my @local = localtime; +# Start and end dates for this can be set via -s and -e. If they're not, +# end defaults to midnight today and start defaults to one day before end. + my $end = defined($opt{'e'}) ? + str2time($opt{'e'}) : timelocal(0, 0, 0, @local[3,4,5]); + my $start = defined($opt{'s'}) ? + str2time($opt{'s'}) : $end - 86400; + die "Invalid date range: '$start'-'$end'" if not ($start and $end); + $transaction->content ( + login => $login, + password => $password, + start => time2str("%Y-%m-%d",$start), + end => time2str("%Y-%m-%d",$end), + ); + @auths = $transaction->get_returns; +} + +$opt{'r'} ||= 'freeside-void-payments'; +my $success = 0; +my $notfound = 0; +my $canceled = 0; +print "Voiding ".scalar(@auths)." transactions:\n" if $opt{'v'}; +foreach my $authnum (@auths) { + my $paybatch = $gatewaynum . $processor . ':' . $authnum; + my $cust_pay = qsearchs('cust_pay', { paybatch => $paybatch } ); + my $error; + my $cancel_error; + if($cust_pay) { + $error = $cust_pay->void($opt{'r'}); + $success++ if not $error; + if($opt{'X'} and not $error) { + $cancel_error = join(';',$cust_pay->cust_main->cancel('reason' => $opt{'X'})); + $canceled++ if !$cancel_error; + } + } + else { + my $cpv = qsearchs('cust_pay_void', { paybatch => $paybatch }); + if($cpv) { + $error = 'already voided '.time2str('%Y-%m-%d', $cpv->void_date) . + ' by ' . $cpv->otaker; + } + else { + $error = 'not found'; + $notfound++; + } + } + if($opt{'v'}) { + print $authnum; + if($error) { + print "\t($error)"; + } + elsif($opt{'X'}) { + print "\t(canceled service)" if !$cancel_error; + print "\n\t(cancellation failed: $cancel_error)" if $cancel_error; + } + print "\n"; + } +} + +if($opt{'v'}) { + print scalar(@auths)." transactions: $success voided, $notfound not found\n"; + print "$canceled customer".($canceled == 1 ? '' : 's')." canceled\n" if $opt{'X'}; +} + +sub usage { + die "Usage:\n\n freeside-void-payments [ -f file | [ -s start-date ] [ -e end-date ] ] [ -r 'reason' ] [ -g gatewaynum | -a agentnum ] [ -c ] [ -v ] [ -n ] [-X reasonnum ] user\n"; +} + +__END__ + +# Documentation + +=head1 NAME + +freeside-void-payments - Automatically void a list of returned payments. + +=head1 SYNOPSIS + + freeside-void-payments [ -f file | [ -s start-date ] [ -e end-date ] ] [ -r 'reason' ] [ -g gatewaynum | -a agentnum ] [ -c ] [ -v ] [ -n ] user + +=head1 DESCRIPTION + +Voids payments that were returned by the payment processor. Can be +run periodically from crontab or manually after receiving a list of +returned payments. Normally this is a meaningful operation only for +electronic checks. + +This script voids payments based on the combination of gateway (see +L<FS::payment_gateway>) and authorization number, since this is +generally how the processor will identify them later. + + -f: Read the list of authorization numbers from the specified file. + If they are not from the default payment gateway, -g or -a + must be given to identify the gateway. + + If -f is not given, the script will attempt to contact the gateway + and download a list of returned transactions. To support this, + the Business::OnlinePayment module for the processor must implement + the I<get_returns()> method. For an example, see + L<Business::OnlinePayment::WesternACH>. + + -s, -e: Specify the starting and ending dates for the void list. + This has no effect if -f is given. The end date defaults to + today, and the start date defaults to one day before the end date. + + -r: The reason for voiding the payments, to be stored in the database. + + -g: The L<FS::payment_gateway> number for the gateway that handled + these payments. If -f is not given, this determines which + gateway will be contacted. This overrides -a. + + -a: The agentnum whose default gateway will be used. If neither -a + nor -g is given, the system default gateway will be used. + + -c: Use the default gateway for check transactions rather than + credit cards. + + -v: Be verbose. + + -X: Automatically cancel all packages belonging to customers whose payments + were returned. Requires a cancellation reasonnum (from L<FS::reason>). + +A warning will be emitted for each transaction that can't be found. +This may happen if it's already been voided, or if the gateway +doesn't match. + +=head1 EXAMPLE + +Given 'returns.txt', which contains one authorization number on each +line, provided by your default e-check processor: + + freeside-void-payments -f returns.txt -c -r 'Returned check' + +If your default processor is Western ACH, which supports automated +returns processing, this voids all returned payments since 2009-06-01: + + freeside-void-payments -r 'Returned check' -s 2009-06-01 + +This, in your crontab, will void returned payments for the last +day at 8:30 every morning: + + 30 8 * * * /usr/local/bin/freeside-void-payments -r 'Returned check' + +=head1 BUGS + +Most payment gateways don't support it, making the script largely useless. + +=head1 SEE ALSO + +L<Business::OnlinePayment>, L<FS::cust_pay> + +=cut |