diff options
Diffstat (limited to 'FS/bin')
49 files changed, 5170 insertions, 0 deletions
diff --git a/FS/bin/freeside-addgroup b/FS/bin/freeside-addgroup new file mode 100755 index 000000000..25c23455a --- /dev/null +++ b/FS/bin/freeside-addgroup @@ -0,0 +1,50 @@ +#!/usr/bin/perl + +use strict; +use vars qw($opt_s); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::CurrentUser; +use FS::AccessRight; +use FS::access_group; +use FS::access_right; +use FS::access_groupagent; + +getopts("s"); +my $user = shift or die &usage; #just for adminsuidsetup +my $group = shift or die &usage; + +$FS::CurrentUser::upgrade_hack = 1; +#adminsuidsetup $rootuser; +adminsuidsetup $user; + +my $access_group = new FS::access_group { 'groupname' => $group }; +my $error = $access_group->insert; +die $error if $error; + +if ( $opt_s ) { + foreach my $rightname ( FS::AccessRight->default_superuser_rights ) { + my $access_right = new FS::access_right { + 'righttype' => 'FS::access_group', + 'rightobjnum' => $access_group->groupnum, + 'rightname' => $rightname, + }; + my $ar_error = $access_right->insert; + die $ar_error if $ar_error; + } + + foreach my $agent ( qsearch('agent', {} ) ) { + my $access_groupagent = new FS::access_groupagent { + 'groupnum' => $access_group->groupnum, + 'agentnum' => $agent->agentnum, + }; + my $aga_error = $access_groupagent->insert; + die $aga_error if $aga_error; + } +} + +sub usage { + die "Usage:\n\n freeside-addgroup [ -s ] username groupname" +} + diff --git a/FS/bin/freeside-addoutsource b/FS/bin/freeside-addoutsource new file mode 100644 index 000000000..9cb12195a --- /dev/null +++ b/FS/bin/freeside-addoutsource @@ -0,0 +1,32 @@ +#!/bin/sh + +domain=$1 + +FREESIDE_CONF=%%%FREESIDE_CONF%%% +FREESIDE_CACHE=%%%FREESIDE_CACHE%%% +FREESIDE_EXPORT=%%%FREESIDE_EXPORT%%% + +#without this, [a-z]* matches CVS/, the copy doesn't return a sucessful error +# status, and the rest of the commands aren't run +export LANG=C + +createdb $domain && \ +\ +mkdir $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain && \ +\ +chown freeside $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain && \ +\ +cp /home/ivan/freeside/conf/[a-z]* $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain && \ +\ +touch $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain/secrets && \ +\ +chown freeside $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain/secrets && \ +\ +chmod 600 $FREESIDE_CONF/conf.DBI:Pg:dbname=$domain/secrets && \ +\ +echo -e "DBI:Pg:dbname=$domain\nfreeside\n" >$FREESIDE_CONF/conf.DBI:Pg:dbname=$domain/secrets && \ +\ +mkdir $FREESIDE_CACHE/counters.DBI:Pg:dbname=$domain && \ +mkdir $FREESIDE_CACHE/cache.DBI:Pg:dbname=$domain && \ +mkdir $FREESIDE_EXPORT/export.DBI:Pg:dbname=$domain + diff --git a/FS/bin/freeside-addoutsourceuser b/FS/bin/freeside-addoutsourceuser new file mode 100644 index 000000000..cbe792acc --- /dev/null +++ b/FS/bin/freeside-addoutsourceuser @@ -0,0 +1,18 @@ +#!/bin/sh + +username=$1 +domain=$2 +password=$3 +realdomain=$4 +FREESIDE_CONF=%%%FREESIDE_CONF%%% + +freeside-adduser -s conf.DBI:Pg:dbname=$domain/secrets \ + -n \ + $username #2>/dev/null + +[ -e $FREESIDE_CONF/dbdef.DBI:Pg:dbname=$domain ] \ + || ( freeside-setup -d $realdomain -u $username ) + +freeside-adduser -g 1 $username + +htpasswd -b $FREESIDE_CONF/htpasswd $username $password diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser new file mode 100644 index 000000000..530481377 --- /dev/null +++ b/FS/bin/freeside-adduser @@ -0,0 +1,119 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_s $opt_g $opt_n); +use Fcntl qw(:flock); +use Getopt::Std; + +my $FREESIDE_CONF = "%%%FREESIDE_CONF%%%"; + +getopts("s:g:n"); +my $user = shift or die &usage; + +if ( $opt_s ) { + + #if ( -e "$FREESIDE_CONF/mapsecrets" ) { + # open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") + # or die "can't open $FREESIDE_CONF/mapsecrets: $!"; + # while (<MAPSECRETS>) { + # /^(\S+) / or die "unparsable line in mapsecrets: $_"; + # die "user $user already exists\n" if $user eq $1; + # } + # close MAPSECRETS; + #} + + #insert new entry before a wildcard... + open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") + and flock(MAPSECRETS,LOCK_EX) + or die "can't open $FREESIDE_CONF/mapsecrets: $!"; + open(NEW,">$FREESIDE_CONF/mapsecrets.new") + or die "can't open $FREESIDE_CONF/mapsecrets.new: $!"; + while(<MAPSECRETS>) { + if ( /^\*\s/ ) { + print NEW "$user $opt_s\n"; + } + print NEW $_; + } + close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!"; + close NEW or die "can't close $FREESIDE_CONF/mapsecrets.new: $!"; + rename("$FREESIDE_CONF/mapsecrets.new", "$FREESIDE_CONF/mapsecrets") + or die "can't move mapsecrets.new into place: $!"; + +} + +### + +exit if $opt_n; + +### + +use FS::UID qw(adminsuidsetup); +use FS::CurrentUser; +use FS::access_user; +use FS::access_usergroup; + +$FS::CurrentUser::upgrade_hack = 1; +#adminsuidsetup $rootuser; +adminsuidsetup $user; + +my $access_user = new FS::access_user { + 'username' => $user, + '_password' => 'notyet', + 'first' => 'Firstname', # $opt_f || + 'last' => 'Lastname', # $opt_l || +}; +my $au_error = $access_user->insert; +die $au_error if $au_error; + +if ( $opt_g ) { + + my $access_usergroup = new FS::access_usergroup { + 'usernum' => $access_user->usernum, + 'groupnum' => $opt_g, + }; + my $aug_error = $access_usergroup->insert; + die $aug_error if $aug_error; + +} + +### + +sub usage { + die "Usage:\n\n freeside-adduser [ -n ] [ -s ] [ -g groupnum ] username [ password ]" +} + +=head1 NAME + +freeside-adduser - Command line interface to add (freeside) users. + +=head1 SYNOPSIS + + freeside-adduser [ -n ] [ -s ] [ -g groupnum ] username [ password ] + +=head1 DESCRIPTION + +Adds a user to the Freeside billing system. This is for adding users (internal +sales/tech folks) to the web interface, not for adding customer accounts. + +This functionality is now available in the web interface as well, under +B<Configuration | Employees | View/Edit employees>. + + -g: initial groupnum + + Development/multi-DB options: + + -s: alternate secrets file + + -n: no ACL added, for bootstrapping + +=head1 NOTE + +No explicit htpasswd options are available in 1.7 - passwords are now +maintained automatically. + +=head1 SEE ALSO + +Base Freeside documentation + +=cut + diff --git a/FS/bin/freeside-apply-credits b/FS/bin/freeside-apply-credits new file mode 100755 index 000000000..ea6a7bdd0 --- /dev/null +++ b/FS/bin/freeside-apply-credits @@ -0,0 +1,21 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw( $user $cust_main @customers ); +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_main; + +$user = shift or die &usage; +&adminsuidsetup( $user ); + +my @customers = qsearch('cust_main', {} ); +die "No customers" unless (scalar(@customers) > 0); + +foreach $cust_main (@customers) { + print "Applying credits for customer #". $cust_main->custnum; + $cust_main->apply_credits; +} + + + diff --git a/FS/bin/freeside-apply_payments_and_credits b/FS/bin/freeside-apply_payments_and_credits new file mode 100755 index 000000000..d789c6c2e --- /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 000000000..ba9d6f3cc --- /dev/null +++ b/FS/bin/freeside-cdr-sftp_and_import @@ -0,0 +1,204 @@ +#!/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 $opt_P $opt_a ); +getopts('m:p:r:e:d:v:P:a'); + +$opt_e ||= 'csv'; +#$opt_e = ".$opt_e" unless $opt_e =~ /^\./; +$opt_e =~ s/^\.//; + +$opt_p ||= ''; + +my %options = (); + +my $user = shift or die &usage; +adminsuidsetup $user; + +# %%%FREESIDE_CACHE%%% +my $cachedir = '%%%FREESIDE_CACHE%%%/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') { + $options{'Port'} = $opt_P if $opt_P; + $options{'Debug'} = $opt_v if $opt_v; + $options{'Passive'} = $opt_a if $opt_a; + + my $ls_ftp = ftp(); + + $ls = [ grep { /^$opt_p.*\.$opt_e$/i } $ls_ftp->ls ]; +} +elsif($opt_m eq 'sftp') { + $options{'port'} = $opt_P if $opt_P; + $options{'debug'} = $opt_v if $opt_v; + + 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, + 'batch_namevalue' => $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, %options) + 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 level ] [ -P port ] + [ -a ] 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 + +-P: if specified, sets the port to use + +-a: use ftp passive mode + +-v: set verbosity level; this script only has one level, but it will + be passed as the 'debug' argument to the transport method + +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-cdrd b/FS/bin/freeside-cdrd new file mode 100644 index 000000000..2cf75f31c --- /dev/null +++ b/FS/bin/freeside-cdrd @@ -0,0 +1,160 @@ +#!/usr/bin/perl -w + +use strict; +use FS::Daemon ':all'; #daemonize1 drop_root daemonize2 myexit logfile sig* +use FS::UID qw( adminsuidsetup ); +use FS::Record qw( qsearch ); #qsearchs); +#use FS::cdr; +use FS::cust_pkg; +use FS::queue; + +my $user = shift or die &usage; + +#daemonize1('freeside-sprepaidd', $user); #keep unique pid files w/multi installs +daemonize1('freeside-cdrd'); + +drop_root(); + +adminsuidsetup($user); + +logfile( "%%%FREESIDE_LOG%%%/cdrd-log.". $FS::UID::datasrc ); + +daemonize2(); + +die "not running; no voip_cdr package defs w/ bill_every_call and customer pkgs" + unless _shouldrun(); + +#-- + +my $addl_from = + 'LEFT JOIN part_pkg USING ( pkgpart ) '. + "LEFT JOIN part_pkg_option + ON ( cust_pkg.pkgpart = part_pkg_option.pkgpart + AND part_pkg_option.optionname = 'bill_every_call' )"; + +#XXX should pay attention to disable_src for efficiency + +my $extra_sql = + "WHERE plan = 'voip_cdr' ". + " AND optionvalue = '1' ". + " AND ( susp IS NULL OR susp = 0)". + " AND ( cancel IS NULL OR cancel = 0)". + " AND 0 < ( + SELECT COUNT(*) FROM svc_phone LEFT JOIN cust_svc USING (svcnum) + WHERE cust_pkg.pkgnum = cust_svc.pkgnum + AND 0 < ( SELECT COUNT(*) FROM cdr + WHERE ( freesidestatus IS NULL OR freesidestatus = '' ) + AND ( charged_party = svc_phone.phonenum + OR charged_party = svc_phone.countrycode + || svc_phone.phonenum + OR src = svc_phone.phonenum + OR src = svc_phone.countrycode + || svc_phone.phonenum + ) + ) + ) + AND 0 = ( + SELECT COUNT(*) FROM queue + WHERE queue.job = 'FS::cust_main::queued_bill' + AND queue.custnum = cust_pkg.custnum + ) + + "; +# don't repeatedly queue failures +# AND status != 'failed' + +while (1) { + + my $found = 0; + foreach my $cust_pkg ( + qsearch( { + 'select' => 'cust_pkg.*, part_pkg.plan', + 'table' => 'cust_pkg', + 'addl_from' => $addl_from, + 'hashref' => {}, + 'extra_sql' => $extra_sql, + } ) + ) { + + $found = 1; + + #my $work_cust_pkg = $cust_pkg; + + #my $cust_main = $cust_pkg->cust_main; + + my $time = time; + + my $job = new FS::queue { + 'job' => 'FS::cust_main::queued_bill', + 'secure' => 'Y', + 'custnum' => $cust_pkg->custnum, + }; + my $error = $job->insert( + 'custnum' => $cust_pkg->custnum, + 'time' => $time, + 'invoice_time' => $time, + 'actual_time' => $time, + 'check_freq' => '1d', #well + #'debug' => 1, + ); + + if ( $error ) { + #die "FATAL: error inserting billing job: $error\n"; + warn "WARNING: error inserting billing job (will retry in 30 seconds):". + " $error\n"; + sleep 30; #i dunno, wait and see if the database comes back? + } + + } + + myexit() if sigterm() || sigint(); + sleep 1 unless $found; + +} + +#-- + +sub _shouldrun { + + my $extra_sql = + ' AND 0 < ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.pkgpart = part_pkg.pkgpart + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + ) + '; + + my @part_pkg = + grep $_->option('bill_every_call', 'hush'), + qsearch({ + 'table' => 'part_pkg', + 'hashref' => { 'plan' => 'voip_cdr' }, + 'extra_sql' => $extra_sql, + }) + ; + + scalar(@part_pkg); + +} + +sub usage { + die "Usage:\n\n freeside-cdrd user\n"; +} + +=head1 NAME + +freeside-cdrd - Real-time daemon for CDRs + +=head1 SYNOPSIS + + freeside-cdrd + +=head1 DESCRIPTION + +Runs continuously, searches for CDRs and bills customers who have VoIP +price plands with the B<bill_every_call> option set. + +=head1 SEE ALSO + +=cut + +1; diff --git a/FS/bin/freeside-cdrrewrited b/FS/bin/freeside-cdrrewrited new file mode 100644 index 000000000..3382598f6 --- /dev/null +++ b/FS/bin/freeside-cdrrewrited @@ -0,0 +1,159 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $conf ); +use FS::Daemon ':all'; #daemonize1 drop_root daemonize2 myexit logfile sig* +use FS::UID qw( adminsuidsetup ); +use FS::Record qw( qsearch ); #qsearchs); +#use FS::cdr; +#use FS::cust_pkg; +#use FS::queue; + +my $user = shift or die &usage; + +#daemonize1('freeside-sprepaidd', $user); #keep unique pid files w/multi installs +daemonize1('freeside-cdrrewrited'); + +drop_root(); + +adminsuidsetup($user); + +logfile( "%%%FREESIDE_LOG%%%/cdrrewrited-log.". $FS::UID::datasrc ); + +daemonize2(); + +$conf = new FS::Conf; + +die "not running; cdr-asterisk_forward_rewrite, cdr-charged_party_rewrite ". + " and cdr-taqua-accountcode_rewrite conf options are all off\n" + unless _shouldrun(); + +#-- + +while (1) { + + #hmm... don't want to do an expensive search with an ever-growing bunch + # of unprocessed CDRs during the month... better to mark them all as + # rewritten "skipped", i.e. why we're a daemon in the first place + # instead of just doing this search like normal CDRs + + my $found = 0; + foreach my $cdr ( + qsearch( { + 'table' => 'cdr', + 'extra_sql' => 'FOR UPDATE', + 'hashref' => {}, + 'extra_sql' => 'WHERE freesidestatus IS NULL'. + ' AND freesiderewritestatus IS NULL'. + ' LIMIT 1024', #arbitrary, but don't eat too much memory + } ) + ) { + + $found = 1; + my @status = (); + + if ( $conf->exists('cdr-asterisk_forward_rewrite') + && $cdr->dstchannel =~ /^Local\/(\d+)/i && $1 ne $cdr->dst + ) + { + + my $dst = $1; + + warn "dst ". $cdr->dst. " does not match dstchannel $dst ". + "(". $cdr->dstchannel. "); rewriting CDR as a forwarded call"; + + $cdr->charged_party($cdr->dst); + $cdr->dst($dst); + $cdr->amaflags(2); + + push @status, 'asterisk_forward'; + + } + + if ( $conf->exists('cdr-charged_party_rewrite') && ! $cdr->charged_party ) { + + $cdr->set_charged_party; + push @status, 'charged_party'; + + } + + if ( $conf->exists('cdr-taqua-accountcode_rewrite') + && $cdr->lastapp eq 'acctcode' && $cdr->cdrtypenum == 1 + ) + { + + #find the matching CDR + my $primary = qsearchs('cdr', { + 'sessionnum' => $cdr->sessionnum, + 'src' => $cdr->subscriber, + #'accountcode' => '', + }); + + unless ( $primary ) { + warn "WARNING: can't find primary CDR with session ". $cdr->sessionnum. + ", src ". $cdr->subscriber. "; will keep trying\n"; + next; + } + + $primary->accountcode( $cdr->lastdata ); + #$primary->freesiderewritestatus( 'taqua-accountcode-primary' ); + my $error = $primary->replace; + if ( $error ) { + warn "WARNING: error rewriting primary CDR (will retry): $error\n"; + next; + } + + push @status, 'taqua-accountcode'; + } + + $cdr->freesiderewritestatus( + scalar(@status) ? join('/', @status) : 'skipped' + ); + + my $error = $cdr->replace; + + if ( $error ) { + warn "WARNING: error rewriting CDR (will retry in 30 seconds):". + " $error\n"; + sleep 30; #i dunno, wait and see if the database comes back? + } + + } + + myexit() if sigterm() || sigint(); + #sleep 1 unless $found; + sleep 5 unless $found; + +} + +#-- + +sub _shouldrun { + $conf->exists('cdr-asterisk_forward_rewrite') + || $conf->exists('cdr-charged_party_rewrite') + || $conf->exists('cdr-taqua-accountcode_rewrite'); +} + +sub usage { + die "Usage:\n\n freeside-cdrrewrited user\n"; +} + +=head1 NAME + +freeside-cdrrewrited - Real-time daemon for CDR rewriting + +=head1 SYNOPSIS + + freeside-cdrrewrited + +=head1 DESCRIPTION + +Runs continuously, searches for CDRs and does forwarded-call rewriting if the +"cdr-asterisk_forward_rewrite" or "cdr-charged_party_rewrite" config option is +enabled. + +=head1 SEE ALSO + +=cut + +1; diff --git a/FS/bin/freeside-check b/FS/bin/freeside-check new file mode 100644 index 000000000..9930aae6c --- /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-count-active-customers b/FS/bin/freeside-count-active-customers new file mode 100755 index 000000000..759085a73 --- /dev/null +++ b/FS/bin/freeside-count-active-customers @@ -0,0 +1,17 @@ +#!/bin/sh + +domain=$1 + +echo "\t +select count(*) from cust_main where + 0 < ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + AND ( cust_pkg.cancel IS NULL + OR cust_pkg.cancel = 0 + ) + ) + OR 0 = ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + ); +" | psql -U freeside -q $domain | head -1 + diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily new file mode 100755 index 000000000..ac0a82391 --- /dev/null +++ b/FS/bin/freeside-daily @@ -0,0 +1,148 @@ +#!/usr/bin/perl -w + +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:nmrkg:u", \%opt); + +my $user = shift or die &usage; +adminsuidsetup $user; + +#you can skip this by not having a NetworkMonitoringSystem configured +use FS::Cron::nms_report qw(nms_report); +nms_report(%opt); + +#you can skip this by setting the disable_cron_billing config +use FS::Cron::bill qw(bill); +bill(%opt); + +#you can skip this just by not having the config +use FS::Cron::breakage qw(reconcile_breakage); +reconcile_breakage(%opt); + +#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')); + +#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(); + +unless ( $opt{k} ) { + use FS::Cron::notify qw(notify_flat_delay); + notify_flat_delay(%opt); +} + +#debian Pg 8.1+ auto-vaccums, 7.4 w/postgresql-contrib +if ( $opt{u} ) { + use FS::Cron::vacuum qw(vacuum); + vacuum(); +} + +#you can skip this just by not having the config +use FS::Cron::backup qw(backup); +backup(); + +#same +use FS::Cron::rt_tasks qw(rt_escalate); +rt_escalate(%opt); + +my $deldir = "$FS::UID::cache_dir/cache.$FS::UID::datasrc/"; +unlink <${deldir}.invoice*>; +unlink <${deldir}.letter*>; +unlink <${deldir}.CGItemp*>; + +### +# subroutines +### + +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-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum,agentnum,... ] [ -s ] [ -v ] [ -l level ] [ -m ] [ -k ] user [ custnum custnum ... ]\n"; +} + +### +# documentation +### + +=head1 NAME + +freeside-daily - Run daily billing and invoice collection events. + +=head1 SYNOPSIS + + freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum,agentnum,... ] [ -s ] [ -v ] [ -l level ] [ -m ] [ -r ] [ -k ] user [ custnum custnum ... ] + +=head1 DESCRIPTION + +Bills customers and runs invoice collection events. Should be run from +crontab daily. + +Bills customers. Searches for customers who are due for billing and calls +the bill and collect methods of a cust_main object. See L<FS::cust_main>. + + -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, + but be careful. + + -y: In addition to -d, which specifies an absolute date, the -y switch + specifies an offset, in days. For example, "-y 15" would increment the + "pretend date" 15 days from whatever was specified by the -d switch + (or now, if no -d switch was given). + + -n: When used with "-d" and/or "-y", specifies that invoices should be dated + with today's date, irregardless of the pretend date used to pre-generate + the invoices. + + -p: Only process customers with the specified payby (CARD, DCRD, CHEK, DCHK, BILL, COMP, LECB) + + -a: Only process customers with the specified agentnum. Multiple agentnums can be specified, separated with commas. + + -g: Don't process the provided pkgpart (or pkgparts, specified as a comma- + separated list). + + -s: re-charge setup fees + + -v: enable debugging + + -l: debugging level + + -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 + + -u: Do a vacuum (starting with version 1.9, this is not run by default). + +user: From the mapsecrets file - see config.html from the base documentation + +custnum: if one or more customer numbers are specified, only bills those +customers. Otherwise, bills all customers. + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cust_main>, config.html from the base documentation + +=cut + diff --git a/FS/bin/freeside-dbdef-create b/FS/bin/freeside-dbdef-create new file mode 100755 index 000000000..6c448c74c --- /dev/null +++ b/FS/bin/freeside-dbdef-create @@ -0,0 +1,47 @@ +#!/usr/bin/perl -w + +use strict; +use DBI; +use DBIx::DBSchema 0.26; +use FS::UID qw(adminsuidsetup datasrc driver_name); +use FS::Schema; + +my $user = shift or die &usage; + +$FS::Schema::setup_hack = 1; +$FS::CurrentUser::upgrade_hack = 1; +my($dbh)=adminsuidsetup $user; + +#needs to match FS::Record +my($dbdef_file) = "%%%FREESIDE_CONF%%%/dbdef.". datasrc; + +my $dbdef = new_native DBIx::DBSchema $dbh; + +#print $dbdef->pretty_print; + +#important +$dbdef->save($dbdef_file); + +sub usage { + die "Usage:\n dbdef-create user\n"; +} + +=head1 NAME + +freeside-dbdef-create - Recreate database schema cache + +=head1 SYNOPSIS + + freeside-dbdef-create user + +=head1 DESCRIPTION + +Reverse engineers the database schema and recreates the dbdef cache file. + +=head1 SEE ALSO + +L<DBIx::DBSchema> + +=cut + +1; diff --git a/FS/bin/freeside-dedup-cust_bill_pkg_detail-header b/FS/bin/freeside-dedup-cust_bill_pkg_detail-header new file mode 100755 index 000000000..d887f21c0 --- /dev/null +++ b/FS/bin/freeside-dedup-cust_bill_pkg_detail-header @@ -0,0 +1,57 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( %seen $opt_d ); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_bill_pkg_detail; + +getopts('d'); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $extra_sql = "AND detail LIKE 'Date,Time%'"; +my @cust_bill_pkg_detail = qsearch( { 'table' => 'cust_bill_pkg_detail', + 'hashref' => {format => 'C'}, + 'extra_sql' => $extra_sql, + } ); +for my $detail (@cust_bill_pkg_detail) { + if ( $seen{$detail->billpkgnum} ) { + if ($opt_d) { # dry run + print "DELETE cust_bill_pkg_detail WHERE detailnum=". $detail->detailnum. + "\n"; + } else { + $detail->delete; + } + } else { + $seen{$detail->billpkgnum} = 1; + } +} + +sub usage { + die "Usage:\n\n freeside-sqlradius-dedup-group [-d] user\n"; +} + +=head1 NAME + +freeside-dedup-cust_bill_pkg_detail-header - Command line tool to eliminate duplicate headers from cdr details on invoices + +=head1 SYNOPSIS + + freeside-dedup-cust_bill_pkg_detail-header user + +=head1 DESCRIPTION + + Removes all but one header when duplicate entries exist on invoice + cdr details. + + -d: dry run + +=head1 SEE ALSO + +L<FS::part_pkg::voip_cdr> + +=cut + diff --git a/FS/bin/freeside-delete-addr_blocks b/FS/bin/freeside-delete-addr_blocks new file mode 100755 index 000000000..a7e99766a --- /dev/null +++ b/FS/bin/freeside-delete-addr_blocks @@ -0,0 +1,31 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw( $user $block @blocks ); +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::addr_block; +use FS::svc_broadband; + +$user = shift or die &usage; +&adminsuidsetup( $user ); + +@blocks = qsearch('addr_block', {} ); +die "No address blocks" unless (scalar(@blocks) > 0); + +foreach $block (@blocks) { + my @devices = qsearch('svc_broadband', { 'blocknum' => $block->blocknum } ); + if (@devices) { + print "Skipping block " . $block->ip_gateway . " / " . $block->ip_netmask; + print "\n"; + }else{ + print "Deleting block " . $block->ip_gateway . " / " . $block->ip_netmask; + print "\n"; + $block->delete; + } +} + + +sub usage { + "Usage:\n freeside-delete-addr_blocks user \n"; +} diff --git a/FS/bin/freeside-deloutsource b/FS/bin/freeside-deloutsource new file mode 100644 index 000000000..afc3a0118 --- /dev/null +++ b/FS/bin/freeside-deloutsource @@ -0,0 +1,14 @@ +#!/bin/sh + +domain=$1 +FREESIDE_CONF=%%%FREESIDE_CONF%%% +FREESIDE_CACHE=%%%FREESIDE_CACHE%%% +FREESIDE_EXPORT=%%%FREESIDE_EXPORT%%% + +dropdb $domain && \ +rm -rf $FREESIDE_CONF/conf.DBI:Pg:host=localhost\;dbname=$domain && \ +rm -rf $FREESIDE_CACHE/counters.DBI:Pg:host=localhost\;dbname=$domain && \ +rm -rf $FREESIDE_CACHE/cache.DBI:Pg:host=localhost\;dbname=$domain && \ +rm -rf $FREESIDE_EXPORT/export.DBI:Pg:host=localhost\;dbname=$domain && \ +rm $FREESIDE_CONF/dbdef.DBI:Pg:host=localhost\;dbname=$domain + diff --git a/FS/bin/freeside-deloutsourceuser b/FS/bin/freeside-deloutsourceuser new file mode 100644 index 000000000..dc4ff9cdc --- /dev/null +++ b/FS/bin/freeside-deloutsourceuser @@ -0,0 +1,6 @@ +#!/bin/sh + +username=$1 + +freeside-deluser -h %%%FREESIDE_CONF%%%/htpasswd $username 2>/dev/null + diff --git a/FS/bin/freeside-deluser b/FS/bin/freeside-deluser new file mode 100644 index 000000000..a2a361a83 --- /dev/null +++ b/FS/bin/freeside-deluser @@ -0,0 +1,64 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_h); +use Fcntl qw(:flock); +use Getopt::Std; + +my $FREESIDE_CONF = "%%%FREESIDE_CONF%%%"; + +getopts("h:"); +my $user = shift or die &usage; + +if ( $opt_h ) { + open(HTPASSWD,"<$opt_h") + and flock(HTPASSWD,LOCK_EX) + or die "can't open $opt_h: $!"; + open(HTPASSWD_TMP,">$opt_h.tmp") or die "can't open $opt_h.tmp: $!"; + while (<HTPASSWD>) { + print HTPASSWD_TMP $_ unless /^$user:/; + } + close HTPASSWD_TMP; + rename "$opt_h.tmp", "$opt_h" or die $!; + flock(HTPASSWD,LOCK_UN); + close HTPASSWD; +} + +open(MAPSECRETS,"<$FREESIDE_CONF/mapsecrets") + and flock(MAPSECRETS,LOCK_EX) + or die "can't open $FREESIDE_CONF/mapsecrets: $!"; +open(MAPSECRETS_TMP,">>$FREESIDE_CONF/mapsecrets.tmp") + or die "can't open $FREESIDE_CONF/mapsecrets.tmp: $!"; +while (<MAPSECRETS>) { + print MAPSECRETS_TMP $_ unless /^$user\s/; +} +close MAPSECRETS_TMP; +rename "$FREESIDE_CONF/mapsecrets.tmp", "$FREESIDE_CONF/mapsecrets" or die $!; +flock(MAPSECRETS,LOCK_UN); +close MAPSECRETS; + +sub usage { + die "Usage:\n\n freeside-deluser [ -h htpasswd_file ] username" +} + +=head1 NAME + +freeside-deluser - Command line interface to add (freeside) users. + +=head1 SYNOPSIS + + freeside-deluser [ -h htpasswd_file ] username + +=head1 DESCRIPTION + +Adds a user to the Freeside billing system. This is for adding users (internal +sales/tech folks) to the web interface, not for adding customer accounts. + + -h: Also delete from the given htpasswd filename + +=head1 SEE ALSO + +L<freeside-adduser>, L<htpasswd>(1), base Freeside documentation + +=cut + diff --git a/FS/bin/freeside-disable-reasons b/FS/bin/freeside-disable-reasons new file mode 100755 index 000000000..0af460919 --- /dev/null +++ b/FS/bin/freeside-disable-reasons @@ -0,0 +1,64 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_t $opt_e); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::reason_type; +use FS::reason; + +getopts('t:e'); + +my $user = shift or die &usage; +adminsuidsetup $user; + +die &usage + unless ($opt_t); + +$FS::Record::nowarn_identical = 1; + +my @reason = (); +if ( $opt_t ) { + $opt_t =~ /^(\d+)$/ or die "invalid reason_type"; + @reason = qsearch('reason', { reason_type => $1 } ); + die "no reasons found\n" unless @reason; +} else { + die "no reason_type specified\n"; +} + +foreach my $reason ( @reason ) { + if ( $opt_e ) { + $reason->disabled(''); + }else{ + $reason->disabled('Y'); + } + my $error = $reason->replace + if $reason->modified; + die $error if $error; +} + + +sub usage { + die "Usage:\n\n freeside-disable-reasons -t reason_type [ -e ] user\n"; +} + +=head1 NAME + +freeside-disable-reasons - Command line tool to set the disabled column for reasons + +=head1 SYNOPSIS + + freeside-disable-reasons -t reason_type [ -e ] user + +=head1 DESCRIPTION + + Disables the reasons of the specified reason type. + Enables instead if -e is specified. + +=head1 SEE ALSO + +L<FS::reason>, L<FS::reason_type> + +=cut + diff --git a/FS/bin/freeside-email b/FS/bin/freeside-email new file mode 100755 index 000000000..7a93f78ee --- /dev/null +++ b/FS/bin/freeside-email @@ -0,0 +1,55 @@ +#!/usr/bin/perl -Tw + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw(qsearch); +use FS::svc_acct; + +&untaint_argv; #what it sounds like (eww) +my $user = shift or die &usage; + +adminsuidsetup $user; + +my $conf = new FS::Conf; + +my @svc_acct = qsearch('svc_acct', {}); +my @emails = map $_->email, @svc_acct; + +print join("\n", @emails), "\n"; + +# subroutines + +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-email user\n"; +} + +=head1 NAME + +freeside-email - Prints email addresses of all users on STDOUT + +=head1 SYNOPSIS + + freeside-email user + +=head1 DESCRIPTION + +Prints the email addresses of all customers on STDOUT, separated by newlines. + +user: From the mapsecrets file - see config.html from the base documentation + +=head1 BUGS + +=head1 SEE ALSO + +=cut + diff --git a/FS/bin/freeside-fetch b/FS/bin/freeside-fetch new file mode 100755 index 000000000..f689bfd93 --- /dev/null +++ b/FS/bin/freeside-fetch @@ -0,0 +1,93 @@ +#!/usr/bin/perl -w + +use strict; +use LWP::UserAgent; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::Misc qw(send_email); + +my $user = shift or die &usage; +my $employeelist = shift or die &usage; +my $url = shift or die &usage; +adminsuidsetup $user; + +my @employees = split ',', $employeelist; + +foreach my $employee (@employees) { + + $employee =~ /^(\w+)$/; + + my $access_user = qsearchs( 'access_user', { 'username' => $1 } ); + unless ($access_user) { + warn "Can't find employee $employee... skipping"; + next; + } + + my $email_address = $access_user->option('email_address'); + unless ($email_address) { + warn "No email address for $employee... skipping"; + next; + } + + no warnings 'redefine'; + local *LWP::UserAgent::get_basic_credentials = sub { + return ($access_user->username, $access_user->_password); + }; + + my $ua = new LWP::UserAgent; + $ua->timeout(1800); #30m, some reports can take a while + $ua->agent("FreesideFetcher/0.1 " . $ua->agent); + + my $req = new HTTP::Request GET => $url; + my $res = $ua->request($req); + + my $conf = new FS::Conf; + my $subject = $conf->config('email_report-subject') || 'Freeside report'; + + my %options = ( 'from' => $email_address, + 'to' => $email_address, + 'subject' => $subject, + 'body' => $res->content, + ); + + $options{'content-type'} = $res->content_type + if $res->content_type; + $options{'content-encoding'} = $res->content_encoding + if $res->content_encoding; + + if ($res->is_success) { + send_email %options; + }else{ + warn "fetching $url failed for $employee: " . $res->status_line; + } +} + +sub usage { + die "Usage:\n\n freeside-fetch user employee[,employee ...] url\n\n"; +} + +=head1 NAME + +freeside-fetch - Send a freeside page to a list of employees. + +=head1 SYNOPSIS + + freeside-fetch user employee[,employee ...] url + +=head1 DESCRIPTION + + Fetches a web page specified by url as if employee and emails it to + employee. Useful when run out of cron to send freeside web pages. + + user: From the mapsecrets file - a user with access to the freeside database + + employee: the username of an employee to receive the emailed page. May be a comma separated list + + url: the web page to be received + +=head1 BUGS + + Can leak employee usernames and passwords if requested to access inappropriate urls. + +=cut + diff --git a/FS/bin/freeside-history-requeue b/FS/bin/freeside-history-requeue new file mode 100755 index 000000000..77a4332a3 --- /dev/null +++ b/FS/bin/freeside-history-requeue @@ -0,0 +1,100 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_j $opt_d); +use Getopt::Std; +use Date::Parse; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::queue; + +getopts('j:d'); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $start = shift or die &usage; +my $end = shift or die &usage; + +$start = str2time($start) unless $start =~ /^(\d+)$/; +$end = str2time($end) unless $end =~ /^(\d+)$/; + +my $extra_sql = "AND history_date >= $start AND history_date <= $end"; + +my $hashref = { 'history_action' => 'insert' }; + +$hashref->{'job'} = $opt_j if $opt_j; + +my @h_queue = qsearch({ + 'table' => 'h_queue', + 'hashref' => $hashref, + 'extra_sql' => $extra_sql, +}); + +my $num = 0; + +foreach my $h_queue (@h_queue) { + + my @queue_args = qsearch({ + 'table' => 'h_queue_arg', + 'hashref' => { 'history_action' => 'insert', + 'jobnum' => $h_queue->jobnum, + }, + 'order_by' => 'argnum', + }); + + my @args = map { + my $arg = $_->arg; + $arg =~ s/^db\.suicidegirls\.com$/sg-account/; + $arg; + } @queue_args; + + my $queue = new FS::queue { + map { $_ => $h_queue->$_() } + qw( job _date status statustext svcnum ) + }; + + if ( $opt_d ) { #dry run + print "requeueing job: ". join(' ', @args). "\n"; + my $error = $queue->check; + die "error requeueing job ". $h_queue->jobnum. ": $error" if $error; + } else { + print "requeueing job: ". join(' ', @args). "\n"; + my $error = $queue->insert(@args); + #warn "error requeueing job ". $h_queue->jobnum. ": $error\n" if $error; + print "error requeueing job ". $h_queue->jobnum. ": $error\n" if $error; + } + + $num++; + +} + +print "requeued $num jobs\n"; + +sub usage { + die "Usage:\n\n freeside-history-requeue user start_timestamp end_timestamp\n"; +} + +=head1 NAME + +freeside-history-requeue - Command line tool to re-trigger export jobs for existing services + +=head1 SYNOPSIS + + freeside-history-requeue [ -j job ] [ -d ] user start_timestamp end_timestamp + +=head1 DESCRIPTION + + Re-queues all queued jobs for the specified time period. + + -j: specifies that only jobs with this job string are re-queued. + + -d: dry run + +=head1 SEE ALSO + +L<freeside-reexport>, L<freeside-sqlradius-reset>, L<FS::part_export> + +=cut + +1; diff --git a/FS/bin/freeside-init-config b/FS/bin/freeside-init-config new file mode 100755 index 000000000..fe4729c40 --- /dev/null +++ b/FS/bin/freeside-init-config @@ -0,0 +1,45 @@ +#!/usr/bin/perl -Tw + +use strict; +use vars qw($opt_u $opt_f $opt_v); +use Getopt::Std; +use FS::UID qw(adminsuidsetup checkeuid dbh); +use FS::CurrentUser; +use FS::Record qw(qsearch); +use FS::Conf; + + +die "Not running uid freeside!" unless checkeuid(); + +getopts("u:vf"); +my $dir = shift or die &usage; + +$FS::CurrentUser::upgrade_hack = 1; +$FS::UID::AutoCommit = 0; +$FS::UID::callback_hack = 1; +adminsuidsetup $opt_u; #$user; + +$|=1; + +if (!scalar(qsearch('conf', {})) || $opt_f) { + my $error = FS::Conf::init_config($dir); + if ($error) { + warn "CONFIGURATION INITIALIZATION FAILED\n"; + dbh->rollback or die dbh->errstr; + die $error if $error; + } +} + +warn "Freeside database initialized - committing transaction\n" if $opt_v; + +dbh->commit or die dbh->errstr; +dbh->disconnect or die dbh->errstr; + +warn "Configuration initialization committed successfully\n" if $opt_v; + +sub usage { + die "Usage:\n freeside-init-config [ -v ] [ -f ] directory\n" + # [ -u user ] for devel/multi-db installs +} + +1; diff --git a/FS/bin/freeside-lata-import b/FS/bin/freeside-lata-import new file mode 100755 index 000000000..295b40e0b --- /dev/null +++ b/FS/bin/freeside-lata-import @@ -0,0 +1,80 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw(qsearch qsearchs dbh); +use LWP::Simple; +use HTML::TableExtract; +use Data::Dumper; + +&untaint_argv; #what it sounds like (eww) +use vars qw(%opt); + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my $content = get("http://www.localcallingguide.com/lca_listlata.php"); +my $te = new HTML::TableExtract(); +$te->parse($content); +my $table = $te->first_table_found; +my $sql = 'insert into lata (latanum, description) values '; +my @sql; +foreach my $row ( $table->rows ) { + my @row = @$row; + next unless $row[0] =~ /\d+/; + $row[1] =~ s/'//g; + push @sql, "( ${row[0]}, '${row[1]}')"; +} +$sql .= join(',',@sql); + +my $sth = $dbh->prepare('delete from lata'); +$sth->execute or die $sth->errstr; + +$sth = $dbh->prepare($sql); +$sth->execute or die $sth->errstr; + +$dbh->commit; + +### +# subroutines +### + +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 freeside-lata-import user \n"; +} + +### +# documentation +### + +=head1 NAME + +freeside-lata-import - Pull LATA data from and insert into LATA table + +=head1 SYNOPSIS + + freeside-lata-import user + +=head1 DESCRIPTION + +user - name of an internal Freeside user + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::lata> + +=cut + diff --git a/FS/bin/freeside-monthly b/FS/bin/freeside-monthly new file mode 100755 index 000000000..0d6ea14a2 --- /dev/null +++ b/FS/bin/freeside-monthly @@ -0,0 +1,94 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +use FS::UID qw(adminsuidsetup); + +&untaint_argv; #what it sounds like (eww) +#use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y); +use vars qw(%opt); +getopts("p:a:d:vsy:", \%opt); + +my $user = shift or die &usage; +adminsuidsetup $user; + +use FS::Cron::bill qw(bill); +bill(%opt, 'check_freq'=>'1m' ); + +use FS::Cron::upload qw(upload); +upload(%opt); + +### +# subroutines +### + +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-monthly [ -d 'date' ] user [ custnum custnum ... ]\n"; +} + +### +# documentation +### + +=head1 NAME + +freeside-monthly - Run monthly billing and invoice collection events. + +=head1 SYNOPSIS + + freeside-monthly [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] user [ custnum custnum ... ] + +=head1 DESCRIPTION + +Bills customers and runs invoice collection events, for the alternate monthly +event chain. If you have defined monthly event checks, should be run from +crontab monthly. + +Bills customers. Searches for customers who are due for billing and calls +the bill and collect methods of a cust_main object. See L<FS::cust_main>. + + -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with, + but be careful. + + -y: In addition to -d, which specifies an absolute date, the -y switch + specifies an offset, in days. For example, "-y 15" would increment the + "pretend date" 15 days from whatever was specified by the -d switch + (or now, if no -d switch was given). + + -p: Only process customers with the specified payby (CARD, DCRD, CHEK, DCHK, BILL, COMP, LECB) + + -a: Only process customers with the specified agentnum + + -s: re-charge setup fees + + -v: enable debugging + +user: From the mapsecrets file - see config.html from the base documentation + +custnum: if one or more customer numbers are specified, only bills those +customers. Otherwise, bills all customers. + +=head1 NOTE + +In most cases, you would use freeside-daily only and not freeside-monthly. +freeside-monthly would only be used in cases where you have events that can +only be run once each month, for example, batching invoices to a third-party +print/mail provider. + +=head1 BUGS + +=head1 SEE ALSO + +L<freeside-daily>, L<FS::cust_main>, config.html from the base documentation + +=cut + diff --git a/FS/bin/freeside-msa-import b/FS/bin/freeside-msa-import new file mode 100755 index 000000000..ade3efab9 --- /dev/null +++ b/FS/bin/freeside-msa-import @@ -0,0 +1,74 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw(qsearch qsearchs dbh); +use LWP::Simple; +use Data::Dumper; + +&untaint_argv; #what it sounds like (eww) +use vars qw(%opt); + +my $user = shift or die &usage; +my $dbh = adminsuidsetup $user; + +my $content = get("http://www.census.gov/population/www/metroareas/lists/2009/List1.txt"); +my @content = split(/\n/,$content); + +my $sql = 'insert into msa (msanum, description) values '; +my @sql; +foreach my $row ( @content ) { + next unless $row =~ /^([0-9]{5})\s+([A-Za-z, \-]{5,80}) .{3}ropolitan Statistical Area/; + push @sql, "( $1, '$2')"; +} +$sql .= join(',',@sql); + +my $sth = $dbh->prepare('delete from msa'); +$sth->execute or die $sth->errstr; + +$sth = $dbh->prepare($sql); +$sth->execute or die $sth->errstr; + +$dbh->commit; + +### +# subroutines +### + +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 freeside-msa-import user \n"; +} + +### +# documentation +### + +=head1 NAME + +freeside-msa-import - Pull MSA data from census.gov and insert into MSA table + +=head1 SYNOPSIS + + freeside-msa-import user + +=head1 DESCRIPTION + +user - name of an internal Freeside user + +=head1 SEE ALSO + +L<FS::msa> + +=cut + diff --git a/FS/bin/freeside-paymentech-download b/FS/bin/freeside-paymentech-download new file mode 100755 index 000000000..16ac3c23b --- /dev/null +++ b/FS/bin/freeside-paymentech-download @@ -0,0 +1,137 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Date::Format qw(time2str); +use File::Temp qw(tempdir); #0.19 for ->newdir() interface, not in 5.10.0 +use Net::SFTP::Foreign; +use Expect; +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::pay_batch; +use FS::cust_pay_batch; +use FS::Conf; + +use vars qw( $opt_t $opt_v $opt_a ); +getopts('vta:'); + +#$Net::SFTP::Foreign::debug = -1; +sub usage { " + Usage: + freeside-paymentech-download [ -v ] [ -t ] [ -a archivedir ] user\n +" } + +my $user = shift or die &usage; +adminsuidsetup $user; + +if ( $opt_a ) { + die "no such directory: $opt_a\n" + unless -d $opt_a; + die "archive directory $opt_a is not writable by the freeside user\n" + unless -w $opt_a; +} + +my $unzip_check = `which unzip` or die "can't find unzip executable\n"; + +#my $tmpdir = File::Temp->newdir(); +my $tmpdir = tempdir( CLEANUP => 1 ); #DIR=>somewhere? + +my $conf = new FS::Conf; +my @batchconf = $conf->config('batchconfig-paymentech'); +# BIN, terminalID, merchantID, username, password +my $username = $batchconf[3] or die "no Paymentech batch username configured\n"; +my $password = $batchconf[4] or die "no Paymentech batch password configured\n"; + +my $host = ($opt_t ? 'orbitalbatchvar.paymentech.net' + : 'orbitalbatch.paymentech.net'); +print STDERR "Connecting to $username\@$host...\n" if $opt_v; + +my $sftp = Net::SFTP::Foreign->new( host => $host, + user => $username, + password => $password, + timeout => 30, + ); +die "failed to connect to '$username\@$host'\n(".$sftp->error.")\n" if $sftp->error; + +my @files = map { $_->{filename} } @{ $sftp->ls('.', wanted => qr/_resp\.zip$/) }; +die "no response files found\n" if !@files; + +BATCH: foreach my $filename (@files) { + + #get file + $filename =~ s/_resp\.zip$//; + print STDERR "Retrieving $filename\n" if $opt_v; + $sftp->get("$filename\_resp.zip", "$tmpdir/${filename}_resp.zip"); + if($sftp->error) { + warn "failed to download $filename\n"; + next BATCH; + } + + #unzip file + system('unzip', '-P', $password, '-q', + "$tmpdir/${filename}_resp.zip", '-d', $tmpdir); + if(! -f "$tmpdir/${filename}_resp.xml") { + warn "failed to extract ${filename}_resp.xml from ${filename}_resp.zip\n"; + next BATCH; + } + + #copy to archive dir + if ( $opt_a ) { + print STDERR "Copying $tmpdir/${filename}_resp.xml to archive dir $opt_a\n" + if $opt_v; + system 'cp', "$tmpdir/${filename}_resp.xml", $opt_a; + warn "failed to copy $tmpdir/${filename}_resp.xml to $opt_a: $@" if $@; + } + + #get batchnum & retrieve pending batch + open my $fh, "<$tmpdir/${filename}_resp.xml"; + my ($batchnum) = split ('-', $filename); + $batchnum = sprintf("%d", $batchnum); # remove leading zeroes + my $batch = qsearchs('pay_batch', { batchnum => $batchnum }); + if(! $batch) { + warn "batch '$batchnum' not found\n"; + next BATCH; + } + + #and import results + print STDERR "Importing batch #$batchnum\n" if $opt_v; + my $error = $batch->import_results( filehandle => $fh, + format => 'paymentech' ); + warn "error: $error\n" if $error; + +} + +print STDERR "Finished!\n" if $opt_v; + +=head1 NAME + +freeside-paymentech-download - Retrieve payment batch responses from Chase Paymentech. + +=head1 SYNOPSIS + + paymentech-download [ -v ] [ -t ] [ -a archivedir ] user + +=head1 DESCRIPTION + +Command line tool to download payment batch responses from the Chase Paymentech +gateway. These are XML files packaged in ZIP files. This script downloads them +by SFTP, extracts the contents, and passes them to L<FS::pay_batch::import_result>. + +-v: Be verbose. + +-t: Use the test server. + +-a directory: Archive response files in the provided directory. + +user: freeside username + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::pay_batch> + +=cut + +1; + diff --git a/FS/bin/freeside-paymentech-upload b/FS/bin/freeside-paymentech-upload new file mode 100755 index 000000000..3f8abc047 --- /dev/null +++ b/FS/bin/freeside-paymentech-upload @@ -0,0 +1,133 @@ +#!/usr/bin/perl + +use strict; +use Getopt::Std; +use Date::Format qw(time2str); +use File::Temp qw(tempdir); #0.19 for ->newdir() interface, not in 5.10.0 +use Net::SFTP::Foreign; +use Expect; +use FS::UID qw(adminsuidsetup datasrc); +use FS::Record qw(qsearch qsearchs); +use FS::pay_batch; +use FS::cust_pay_batch; +use FS::Conf; + +use vars qw( $opt_a $opt_t $opt_v $opt_p ); +getopts('avtp:'); + +#$Net::SFTP::Foreign::debug = -1; + +sub usage { " + Usage: + freeside-paymentech-upload [ -v ] [ -t ] user batchnum + freeside-paymentech-upload -a [ -p payby ] [ -v ] [ -t ] user\n +" } + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $zip_check = `which zip` or die "can't find zip executable\n"; + +my @batches; + +if($opt_a) { + my %criteria = (status => 'O'); + $criteria{'payby'} = uc($opt_p) if $opt_p; + @batches = qsearch('pay_batch', \%criteria); + die "No open batches found".($opt_p ? " of type '$opt_p'" : '').".\n" + if !@batches; +} +else { + my $batchnum = shift; + die &usage if !$batchnum; + @batches = qsearchs('pay_batch', { batchnum => $batchnum } ); + die "Can't find payment batch '$batchnum'\n" if !@batches; +} + +my $conf = new FS::Conf; +my @batchconf = $conf->config('batchconfig-paymentech'); +# BIN, terminalID, merchantID, username, password +my $username = $batchconf[3] or die "no Paymentech batch username configured\n"; +my $password = $batchconf[4] or die "no Paymentech batch password configured\n"; + +#my $tmpdir = File::Temp->newdir(); +my $tmpdir = tempdir( CLEANUP => 1 ); #DIR=>somewhere? + +my @filenames; + +foreach my $pay_batch (@batches) { + my $batchnum = $pay_batch->batchnum; + my $filename = sprintf('%06d',$batchnum) . '-' .time2str('%Y%m%d%H%M%S', time); + print STDERR "Exporting batch $batchnum to $filename...\n" if $opt_v; + my $text = $pay_batch->export_batch('paymentech'); + $text =~ s!<fileID>FILEID</fileID>!<fileID>$filename</fileID>! + or die "couldn't find FILEID tag\n"; + open OUT, ">$tmpdir/$filename.xml"; + print OUT $text; + close OUT; + + system('zip', '-P', $password, '-q', '-j', + "$tmpdir/$filename.zip", "$tmpdir/$filename.xml"); + + die "failed to create zip file\n" if (! -f "$tmpdir/$filename.zip" ); + push @filenames, $filename; +} + +my $host = ($opt_t ? 'orbitalbatchvar.paymentech.net' + : 'orbitalbatch.paymentech.net'); +print STDERR "Connecting to $username\@$host...\n" if $opt_v; + +my $sftp = Net::SFTP::Foreign->new( host => $host, + user => $username, + password => $password, + timeout => 30, + ); +die "failed to connect to '$username\@$host'\n(".$sftp->error.")\n" + if $sftp->error; + +foreach my $filename (@filenames) { + $sftp->put("$tmpdir/$filename.zip", "$filename.zip") + or die "failed to upload file (".$sftp->error.")\n"; +} + +print STDERR "Finished!\n" if $opt_v; + +=head1 NAME + +freeside-paymentech-upload - Transmit a payment batch to Chase Paymentech via SFTP. + +=head1 SYNOPSIS + + freeside-paymentech-upload [ -a [ -p PAYBY ] ] [ -v ] [ -t ] user batchnum + +=head1 DESCRIPTION + +Command line tool to upload a payment batch to the Chase Paymentech gateway. +The batch will be exported to the Paymentech XML format, packaged in a ZIP +file, and transmitted via SFTP. Use L<paymentech-download> to retrieve the +response file. + +-a: Send all open batches, instead of specifying a batchnum. + +-p PAYBY: With -a, limit to batches of that payment type, e.g. -p CARD. + +-v: Be verbose. + +-t: Send the transaction to the test server. + +user: freeside username + +batchnum: pay_batch primary key + +=head1 BUGS + +Passing the zip password on the command line is slightly risky. + +=head1 SEE ALSO + +L<FS::pay_batch> + +=cut + +1; + diff --git a/FS/bin/freeside-prepaidd b/FS/bin/freeside-prepaidd new file mode 100644 index 000000000..05b068b02 --- /dev/null +++ b/FS/bin/freeside-prepaidd @@ -0,0 +1,115 @@ +#!/usr/bin/perl -w + +use strict; +use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_pkg; + +my $user = shift or die &usage; + +#daemonize1('freeside-sprepaidd', $user); #keep unique pid files w/multi installs +daemonize1('freeside-prepaidd'); + +drop_root(); + +adminsuidsetup($user); + +logfile( "%%%FREESIDE_LOG%%%/prepaidd-log.". $FS::UID::datasrc ); + +daemonize2(); + +#-- + +while (1) { + + foreach my $cust_pkg ( + qsearch( { + 'select' => 'cust_pkg.*, part_pkg.plan', + 'table' => 'cust_pkg', + 'addl_from' => 'LEFT JOIN part_pkg USING ( pkgpart )', + #'hashref' => { 'plan' => 'prepaid' },#should check part_pkg::is_prepaid + #'extra_sql' => "AND bill < ". time. + 'hashref' => {}, + 'extra_sql' => "WHERE plan = 'prepaid' AND bill < ". time. + " AND bill IS NOT NULL". + " AND ( susp IS NULL OR susp = 0)". + " AND ( cancel IS NULL OR cancel = 0)" + } ) + ) { + + my $work_cust_pkg = $cust_pkg; + + my $cust_main = $cust_pkg->cust_main; + + #insurance: somehow winding up here without things properly applied... + my $a_error = $cust_main->apply_payments_and_credits; + if ( $a_error ) { + warn "Error applying payments&credits, customer #". $cust_main->custnum; + next; + } + + if ( $cust_main->total_unapplied_payments > 0 + || $cust_main->total_unapplied_credits > 0 + ) + { + + #this needs a flag to say only do the prepaid packages... + # and only try em if the renewal price matches.. but this will do for now + my $b_error = $cust_main->bill; + if ( $b_error ) { + warn "Error billing customer #". $cust_main->custnum; + next; + } + $b_error = $cust_main->apply_payments_and_credits; + if ( $b_error ) { + warn "Error applying payments&credits, customer #". $cust_main->custnum; + next; + } + + $work_cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $work_cust_pkg->pkgnum } ); + + next + if $cust_main->balance <= 0 + and $work_cust_pkg->bill >= time; + } + + my $action = $work_cust_pkg->part_pkg->option('recur_action') || 'suspend'; + + my $error = $work_cust_pkg->$action(); + + warn "Error ${action}ing package ". $work_cust_pkg->pkgnum. + " for custnum ". $work_cust_pkg->custnum. + ": $error\n" + if $error; + } + + die "exiting" if sigterm() || sigint(); + sleep 5; + +} + +#-- + +sub usage { + die "Usage:\n\n freeside-prepaidd user\n"; +} + +=head1 NAME + +freeside-prepaidd - Real-time daemon for prepaid packages + +=head1 SYNOPSIS + + freeside-prepaidd + +=head1 DESCRIPTION + +Runs continuously and suspends or cancels any prepaid customer packages which +have passed their renewal date (next bill date). + +=head1 SEE ALSO + +=cut + +1; diff --git a/FS/bin/freeside-prune-applications b/FS/bin/freeside-prune-applications new file mode 100755 index 000000000..d2b6efe0b --- /dev/null +++ b/FS/bin/freeside-prune-applications @@ -0,0 +1,63 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_d $opt_q $opt_v); # $opt_n instead of $opt_d? +use vars qw($DEBUG $DRY_RUN); +use Getopt::Std; +use FS::UID qw(adminsuidsetup checkeuid); +use FS::Misc::prune qw(prune_applications); + +die "Not running uid freeside!" unless checkeuid(); + +getopts("dq"); + +$DEBUG = !$opt_q; +#$DEBUG = $opt_v; + +$DRY_RUN = $opt_d; + +my $user = shift or die &usage; +my $dbh = adminsuidsetup($user); + +my $hashref = {}; + +$hashref->{dry_run} = 1 if $DRY_RUN; +$hashref->{debug} = 1 if $DEBUG; + +print join "\n", prune_applications($hashref); +print "\n" if $DRY_RUN; + +$dbh->commit or die $dbh->errstr; + +### + +sub usage { + die "Usage:\n freeside-prune-applications [ -d ] [ -q | -v ] user\n"; +} + +=head1 NAME + +freeside-prune-applications - Removes stray applications of credit, payment to + bills, refunds, etc. + +=head1 SYNOPSIS + + freeside-prune-applications [ -d ] [ -q | -v ] + +=head1 DESCRIPTION + +Reads your existing database schema and updates it to match the current schema, +adding any columns or tables necessary. + + [ -d ]: Dry run; display affected records (to STDOUT) only, but do not + remove them. + + [ -q ]: Run quietly. This may become the default at some point. + + [ -v ]: Run verbosely, sending debugging information to STDERR. This is the + current default. + +=head1 SEE ALSO + +=cut + diff --git a/FS/bin/freeside-pull-dsl b/FS/bin/freeside-pull-dsl new file mode 100755 index 000000000..e6584072e --- /dev/null +++ b/FS/bin/freeside-pull-dsl @@ -0,0 +1,71 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw(qsearch qsearchs dbh); +use FS::svc_dsl; +use FS::part_export; +use Data::Dumper; + +&untaint_argv; #what it sounds like (eww) +use vars qw(%opt); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my @monitored = qsearch('svc_dsl', { 'monitored' => 'Y' } ); +foreach my $svc_dsl ( @monitored ) { + my @exports = $svc_dsl->part_svc->part_export_dsl_pull; + my $svcnum = $svc_dsl->svcnum; + warn "either zero or more than one DSL-pulling export attached to svcnum " + . "$svcnum, skipping" if ( scalar(@exports) != 1 ); + my $export = $exports[0]; + my $error = $export->dsl_pull($svc_dsl); # this will commit to db by default + warn "Error pulling DSL svcnum $svcnum: $error" unless $error eq ''; +} + +### +# subroutines +### + +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 freeside-pull-dsl user \n"; +} + +### +# documentation +### + +=head1 NAME + +freeside-pull-dsl - Pull DSL order data from telcos/vendors for all monitored DSL orders to update + +=head1 SYNOPSIS + + freeside-pull-dsl user + +=head1 DESCRIPTION + +user - name of an internal Freeside user + +This is still a work in progress - in future may add limiting by exportnum or svcpart or other such stuff. + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::cust_main>, config.html from the base documentation + +=cut + diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued new file mode 100644 index 000000000..756b699d4 --- /dev/null +++ b/FS/bin/freeside-queued @@ -0,0 +1,298 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $DEBUG $kids $max_kids $sleep_time %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::Conf; +use FS::Record qw(qsearch); +use FS::queue; +use FS::queue_depend; + +# no autoloading for non-FS classes... +use Net::SSH 0.07; + +$DEBUG = 0; + +$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; +#daemonize1('freeside-queued',$user); #to keep pid files unique w/multi installs +daemonize1('freeside-queued'); + +warn "dropping privledges\n" if $DEBUG; +drop_root(); + +$ENV{HOME} = (getpwuid($>))[7]; #for ssh + +warn "connecting to database\n" if $DEBUG; +$@ = 'not connected'; +while ( $@ ) { + eval { adminsuidsetup $user; }; + if ( $@ ) { + warn $@; + warn "sleeping for reconnect...\n"; + sleep 5; + } +} + +logfile( "%%%FREESIDE_LOG%%%/queuelog.". $FS::UID::datasrc ); + +warn "completing daemonization (detaching))\n" if $DEBUG; +daemonize2(); + +#-- + +my $conf = new FS::Conf; +$max_kids = $conf->config('queued-max_kids') || 10; +$sleep_time = $conf->config('queued-sleep_time') || 10; + +my $warnkids=0; +while (1) { + + &reap_kids; + #prevent runaway forking + if ( $kids >= $max_kids ) { + warn "WARNING: maximum $kids children reached\n" unless $warnkids++; + &reap_kids; + sleep 1; #waiting for signals is cheap + next; + } + $warnkids=0; + + unless ( dbh && dbh->ping ) { + warn "WARNING: connection to database lost, reconnecting...\n"; + + eval { $FS::UID::dbh = 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 $nodepend = 'AND NOT EXISTS( SELECT 1 FROM queue_depend'. + ' WHERE queue_depend.jobnum = queue.jobnum )'; + + #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 $hashref = { 'status' => 'new' }; + if ( $opt{'s'} ) { + $hashref->{'secure'} = 'Y'; + } elsif ( $opt{'n'} ) { + $hashref->{'secure'} = ''; + } + + #qsearch dies when the db goes away + my @jobs = eval { + qsearch({ + 'table' => 'queue', + 'hashref' => $hashref, + 'extra_sql' => $nodepend, + 'order_by' => $order_by, + }); + }; + if ( $@ ) { + warn "WARNING: error searching for jobs, closing connection: $@"; + undef $FS::UID::dbh; + next; + } + + unless ( @jobs ) { + dbh->commit or do { + warn "WARNING: database error, closing connection: ". dbh->errstr; + undef $FS::UID::dbh; + next; + }; + sleep $sleep_time; + next; + } + + foreach my $job ( @jobs ) { + + 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; + } + + dbh->commit or do { + warn "WARNING: database error, closing connection: ". dbh->errstr; + undef $FS::UID::dbh; + next; + }; + + $FS::UID::AutoCommit = 1; + + my @args = eval { $ljob->args; }; + if ( $@ ) { + warn "WARNING: error retrieving job arguments, closing connection: $@"; + undef $FS::UID::dbh; + next; + } + 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; #XXX still dying if we can't fork AND we can't connect to the db + 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|cust_pkg)::\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 ( $@ ) { + my %hash = $ljob->hash; + $hash{'statustext'} = $@; + if ( $hash{'statustext'} =~ /\/misc\/queued_report/ ) { #use return? + $hash{'status'} = 'done'; + } else { + $hash{'status'} = 'failed'; + warn "job $eval failed"; + } + my $fjob = new FS::queue( \%hash ); + my $error = $fjob->replace($ljob); + die $error if $error; + } 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 + } + + } #foreach my $job + +} continue { + if ( sigterm() ) { + warn "received TERM signal; exiting\n"; + exit; + } + if ( sigint() ) { + warn "received INT signal; exiting\n"; + exit; + } +} + +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"; +} + +sub reap_kids { + foreach my $pid ( keys %kids ) { + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + $kids--; + delete $kids{$kid}; + } + } +} + +=head1 NAME + +freeside-queued - Job queue daemon + +=head1 SYNOPSIS + + 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 + +=head1 BUGS + +=head1 SEE ALSO + +=cut + diff --git a/FS/bin/freeside-radgroup b/FS/bin/freeside-radgroup new file mode 100644 index 000000000..332632942 --- /dev/null +++ b/FS/bin/freeside-radgroup @@ -0,0 +1,76 @@ +#!/usr/bin/perl -w + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch); +use FS::cust_svc; +use FS::svc_acct; + +&untaint_argv; #what it sounds like (eww) + +my($user, $action, $groupname, $svcpart) = @ARGV; + +adminsuidsetup $user; + +my @svc_acct = map { $_->svc_x } qsearch('cust_svc', { svcpart => $svcpart } ); + +if ( lc($action) eq 'add' ) { + foreach my $svc_acct ( @svc_acct ) { + my @groups = $svc_acct->radius_groups; + next if grep { $_ eq $groupname } @groups; + push @groups, $groupname; + my %hash = $svc_acct->hash; + $hash{usergroup} = \@groups; + my $new = new FS::svc_acct \%hash; + my $error = $new->replace($svc_acct); + die $error if $error; + } +} else { + die &usage; +} + +# subroutines + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-radgroup user action groupname svcpart\n"; +} + +=head1 NAME + +freeside-radgroup - Command line utility to manipulate radius groups + +=head1 SYNOPSIS + + freeside-addgroup user action groupname svcpart + +=head1 DESCRIPTION + +B<user> is a freeside user as added with freeside-adduser. + +B<command> is the action to take. Available actions are: I<add> + +B<groupname> is the group to add (or remove, etc.) + +B<svcpart> specifies which accounts will be updated. + +=head1 EXAMPLES + +freeside-radgroup freesideuser add groupname 3 + +Adds I<groupname> to all accounts with service definition 3. + +=head1 BUGS + +=head1 SEE ALSO + +L<freeside-adduser>, L<FS::svc_acct>, L<FS::part_svc> + +=cut + diff --git a/FS/bin/freeside-reexport b/FS/bin/freeside-reexport new file mode 100644 index 000000000..54af9dd80 --- /dev/null +++ b/FS/bin/freeside-reexport @@ -0,0 +1,71 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_s $opt_u $opt_p); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +use FS::svc_acct; +use FS::cust_svc; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $export_x = shift or die &usage; +my @part_export; +if ( $export_x =~ /^(\d+)$/ ) { + @part_export = qsearchs('part_export', { exportnum=>$1 } ) + or die "exportnum $export_x not found\n"; +} else { + @part_export = qsearch('part_export', { exporttype=>$export_x } ) + or die "no exports of type $export_x found\n"; +} + +getopts('s:u:p:'); + +my @svc_x = (); +if ( $opt_s ) { + my $cust_svc = qsearchs('cust_svc', { svcnum=>$opt_s } ) + or die "svcnum $opt_s not found\n"; + push @svc_x, $cust_svc->svc_x; +} elsif ( $opt_u ) { + my $svc_x = qsearchs('svc_acct', { username=>$opt_u } ) + or die "username $opt_u not found\n"; + push @svc_x, $svc_x; +} elsif ( $opt_p ) { + push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart=>$opt_p } ); + die "no services with svcpart $opt_p found\n" unless @svc_x; +} + +foreach my $part_export ( @part_export ) { + foreach my $svc_x ( @svc_x ) { + my $error = $part_export->export_insert($svc_x); + die $error if $error; + } +} + + +sub usage { + die "Usage:\n\n freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ]\n"; +} + +=head1 NAME + +freeside-reexport - Command line tool to re-trigger export jobs for existing services + +=head1 SYNOPSIS + + freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ] + +=head1 DESCRIPTION + + Re-queues the export job for the specified exportnum or exporttype(s) and + specified service (selected by svcnum or username). + +=head1 SEE ALSO + +L<freeside-sqlradius-reset>, L<FS::part_export> + +=cut + diff --git a/FS/bin/freeside-reset-fixed b/FS/bin/freeside-reset-fixed new file mode 100755 index 000000000..5829d441b --- /dev/null +++ b/FS/bin/freeside-reset-fixed @@ -0,0 +1,69 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw($opt_p $opt_s $opt_r); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::cust_svc; +use FS::svc_Common; + +getopts('p:s:r'); + +my $user = shift or die &usage; +adminsuidsetup $user; + +die &usage + if ($opt_p && $opt_s); + +$FS::Record::nowarn_identical = 1; +$FS::svc_Common::noexport_hack = 1 + unless $opt_r; + +my @svc_x = (); +if ( $opt_s ) { + $opt_s =~ /^(\d+)$/ or die "invalid svcnum"; + my $cust_svc = qsearchs('cust_svc', { svcnum => $1 } ) + or die "svcnum $opt_s not found\n"; + push @svc_x, $cust_svc->svc_x; +} elsif ( $opt_p ) { + $opt_p =~ /^(\d+)$/ or die "invalid svcpart"; + push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart => $1 } ); + die "no services with svcpart $opt_p found\n" unless @svc_x; +} else { + push @svc_x, map { $_->svc_x } qsearch('cust_svc', {} ); + die "no services found\n" unless @svc_x; +} + +foreach my $svc_x ( @svc_x ) { + my $result = $svc_x->setfixed; + die $result unless ref($result); + my $error = $svc_x->replace + if $svc_x->modified; + die $error if $error; +} + + +sub usage { + die "Usage:\n\n freeside-reset-fixed user [ -s svcnum | -p svcpart ] [ -r ]\n"; +} + +=head1 NAME + +freeside-reset-fixed - Command line tool to set the fixed columns for existing services + +=head1 SYNOPSIS + + freeside-reset-fixed user [ -s svcnum | -p svcpart ] [ -r ] + +=head1 DESCRIPTION + + Resets the fixed columns for the specified service part or service number. + Re-exports the service if -r is specified. + +=head1 SEE ALSO + +L<freeside-reexport>, L<FS::part_svc> + +=cut + diff --git a/FS/bin/freeside-selfservice-server b/FS/bin/freeside-selfservice-server new file mode 100644 index 000000000..c10623c96 --- /dev/null +++ b/FS/bin/freeside-selfservice-server @@ -0,0 +1,275 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $FREESIDE_LOG $FREESIDE_LOCK ); +use vars qw( $Debug %kids $kids $max_kids $ssh_pid %old_ssh_pid $keepalives ); +use subs qw( lock_write unlock_write myshutdown usage ); +use Fcntl qw(:flock); +use POSIX qw(:sys_wait_h); +use IO::Handle; +use IO::Select; +use IO::File; +use Storable 2.09 qw(nstore_fd fd_retrieve); +use Net::SSH qw(sshopen2); +use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); +use FS::UID qw(adminsuidsetup forksuidsetup); +use FS::ClientAPI qw( load_clientapi_modules ); +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%%%"; + +$Debug = 1; # 2 will turn on more logging + # 3 will log packet contents, including passwords + +$max_kids = '10'; #? +$keepalives = 0; #let clientd turn it on, so we don't barf on old ones +$kids = 0; + +my $user = shift or die &usage; +my $machine = shift or die &usage; +my $tag = scalar(@ARGV) ? shift : ''; + +my $lock_file = "$FREESIDE_LOCK/selfservice.$machine.writelock"; + +# to keep pid files unique w/multi machines (and installs!) +# $FS::UID::datasrc not posible +daemonize1("freeside-selfservice-server","$user.$machine"); + +#false laziness w/Daemon::drop_root +my $freeside_gid = scalar(getgrnam('freeside')) + or die "can't find freeside group\n"; + +open(LOCKFILE,">$lock_file") or die "can't open $lock_file: $!"; +chown $FS::UID::freeside_uid, $freeside_gid, $lock_file; + +drop_root(); + +$ENV{HOME} = (getpwuid($>))[7]; #for ssh + +load_clientapi_modules; + +adminsuidsetup $user; + +#logfile("/usr/local/etc/freeside/selfservice.". $FS::UID::datasrc); #MACHINE +logfile("$FREESIDE_LOG/selfservice.$machine.log"); + +daemonize2(); + +my $conf = new FS::Conf; +if ( $conf->exists('selfservice-ignore_quantity') ) { + $FS::cust_svc::ignore_quantity = 1; + $FS::cust_svc::ignore_quantity = 1; #now it is used twice. +} + +#clear the signup info cache so an "/etc/init.d/freeside restart" will pick +#up new info... (better as a callback in Signup.pm?) +my $cache = new FS::ClientAPI_SessionCache( { + 'namespace' => 'FS::ClientAPI::Signup', +} ); +$cache->remove('signup_info_cache'); + +#and also clear the selfservice skin info cache, for the same reason +my $ss_cache = new FS::ClientAPI_SessionCache( { + 'namespace' => 'FS::ClientAPI::MyAccount', +} ); +$ss_cache->remove($_) + foreach grep /^skin_info_cache_agent/, $ss_cache->get_keys(); + +my $clientd = "/usr/local/sbin/freeside-selfservice-clientd"; #better name? + +my $warnkids=0; +while (1) { + my($writer,$reader,$error) = (new IO::Handle, new IO::Handle, new IO::Handle); + warn "connecting to $machine\n" if $Debug; + + $ssh_pid = sshopen2($machine,$reader,$writer,$clientd,$tag); + +# nstore_fd(\*writer, {'hi'=>'there'}); + + warn "entering main loop\n" if $Debug; + my $undisp = 0; + my $keepalive_count = 0; + my $s = IO::Select->new( $reader ); + while (1) { + + &reap_kids; + + warn "waiting for packet from client\n" if $Debug && !$undisp; + $undisp = 1; + my @handles = $s->can_read(5); + unless ( @handles ) { + myshutdown() if sigint() || sigterm(); + if ( $keepalives && $keepalive_count++ > 10 ) { + $keepalive_count = 0; + lock_write; + + nstore_fd( { _token => '_keepalive' }, $writer ); + +#commenting izoom stuff out until we can move it to a branch (or just remove) +# 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; + } + + $undisp = 0; + + warn "receiving packet from client\n" if $Debug; + + my $packet = eval { fd_retrieve($reader); }; + if ( $@ ) { + warn "Storable error receiving packet from client". + " (assuming lost connection): $@\n" + if $Debug; + if ( $ssh_pid ) { + warn "sending TERM signal to ssh process $ssh_pid\n" if $Debug; + kill 'TERM', $ssh_pid; + $old_ssh_pid{$ssh_pid} = 1; + $ssh_pid = 0; + } + last; + } + warn "packet received\n". + join('', map { " $_=>$packet->{$_}\n" } keys %$packet ) + 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; + while ( $kids >= $max_kids ) { + warn "WARNING: maximum $kids children reached\n" unless $warnkids++; + &reap_kids; + sleep 1; + } + + warn "forking child\n" if $Debug; + defined( my $pid = fork ) or die "can't fork: $!"; + if ( $pid ) { + $kids++; + $kids{$pid} = 1; + warn "child $pid spawned\n" if $Debug; + } else { #kid time + + ##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; + my $rv = eval { FS::ClientAPI->dispatch($type, $packet); }; + if ( $@ ) { + warn my $error = "WARNING: error dispatching $type: $@"; + $rv = { _error => $error }; + } + $rv->{_token} = $packet->{_token}; #identifier + + 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; + + warn "child exiting\n" if $Debug; + exit; #end-of-kid + } + + } + + myshutdown if sigint() || sigterm(); + warn "connection lost, reconnecting\n" if $Debug; + sleep 3; + +} + +### +# utility subroutines +### + +sub reap_kids { + #warn "reaping kids\n"; + foreach my $pid ( keys %kids ) { + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + $kids--; + delete $kids{$kid}; + } + } + + foreach my $pid ( keys %old_ssh_pid ) { + waitpid($pid, WNOHANG) and delete $old_ssh_pid{$pid}; + } + #warn "done reaping\n"; +} + +sub myshutdown { + &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; + die "exiting"; +} + +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: $!"; + + flock(LOCKFILE, LOCK_EX) or die "FATAL: can't lock $lock_file: $!"; + +} + +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: $!"; + + flock(LOCKFILE, LOCK_UN) or die "FATAL: can't unlock $lock_file: $!"; + +} + +sub usage { + die "Usage:\n\n freeside-selfservice-server user machine\n"; +} + diff --git a/FS/bin/freeside-selfservice-xmlrpcd b/FS/bin/freeside-selfservice-xmlrpcd new file mode 100755 index 000000000..e50d51605 --- /dev/null +++ b/FS/bin/freeside-selfservice-xmlrpcd @@ -0,0 +1,351 @@ +#!/usr/bin/perl +# +# based on http://www.perlmonks.org/?node_id=582781 by Justin Hawkins +# and http://poe.perl.org/?POE_Cookbook/Web_Server_With_Forking + +### +# modules and constants and variables, oh my +### + +use warnings; +use strict; + +use constant DEBUG => 1; # Enable much runtime information. +use constant MAX_PROCESSES => 10; # Total server process count. +use constant SERVER_PORT => 8080; # Server port. +use constant TESTING_CHURN => 0; # Randomly test process respawning. + +use POE 1.2; # Base features. +use POE::Filter::HTTPD; # For serving HTTP content. +use POE::Wheel::ReadWrite; # For socket I/O. +use POE::Wheel::SocketFactory; # For serving socket connections. + +use XMLRPC::Transport::HTTP; #SOAP::Transport::HTTP; +use XMLRPC::Lite; # for XMLRPC::Serializer + +use FS::Daemon qw( daemonize1 drop_root logfile daemonize2 ); +use FS::UID qw( adminsuidsetup forksuidsetup dbh ); +use FS::Conf; +use FS::ClientAPI qw( load_clientapi_modules ); +use FS::ClientAPI_XMLRPC; #FS::SelfService::XMLRPC; + +#freeside +my $FREESIDE_LOG = "%%%FREESIDE_LOG%%%"; +my $FREESIDE_LOCK = "%%%FREESIDE_LOCK%%%"; +my $lock_file = "$FREESIDE_LOCK/selfservice-xmlrpcd.writelock"; + +#freeside xmlrpc.cgi +my %typelookup = ( + base64 => [10, sub {$_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/}, 'as_base64'], + dateTime => [35, sub {$_[0] =~ /^\d{8}T\d\d:\d\d:\d\d$/}, 'as_dateTime'], + string => [40, sub {1}, 'as_string'], +); + +### +# freeside init +### + +my $user = shift or die &usage; + +$FS::Daemon::NOSIG = 1; +$FS::Daemon::PID_NEWSTYLE = 1; +daemonize1('selfservice-xmlrpcd'); + +POE::Kernel->has_forked(); #daemonize forks... + +drop_root(); + +adminsuidsetup($user); + +load_clientapi_modules; + +logfile("$FREESIDE_LOG/selfservice-xmlrpcd.log"); + +daemonize2(); + +FS::ClientAPI::Signup::clear_cache(); + +my $conf = new FS::Conf; + +die "not running; selfservice-xmlrpc conf option is off\n" + unless $conf->exists('selfservice-xmlrpc'); + +#parent doesn't need to hold a DB connection open +dbh->disconnect; +undef $FS::UID::dbh; + +### +# the main loop +### + +server_spawn(MAX_PROCESSES); +POE::Kernel->run(); +exit; + +### +# the subroutines +### + +### Spawn the main server. This will run as the parent process. + +sub server_spawn { + my ($max_processes) = @_; + + POE::Session->create( + inline_states => { + _start => \&server_start, + _stop => \&server_stop, + do_fork => \&server_do_fork, + got_error => \&server_got_error, + got_sig_int => \&server_got_sig_int, + got_sig_child => \&server_got_sig_child, + got_connection => \&server_got_connection, + _child => sub { undef }, + }, + heap => { max_processes => MAX_PROCESSES }, + ); +} + +### The main server session has started. Set up the server socket and +### bookkeeping information, then fork the initial child processes. + +sub server_start { + my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; + + $heap->{server} = POE::Wheel::SocketFactory->new + ( BindPort => SERVER_PORT, + SuccessEvent => "got_connection", + FailureEvent => "got_error", + Reuse => "yes", + ); + + $kernel->sig( INT => "got_sig_int" ); + $kernel->sig( TERM => "got_sig_int" ); #huh + + $heap->{children} = {}; + $heap->{is_a_child} = 0; + + warn "Server $$ has begun listening on port ", SERVER_PORT, "\n"; + + $kernel->yield("do_fork"); +} + +### The server session has shut down. If this process has any +### children, signal them to shutdown too. + +sub server_stop { + my $heap = $_[HEAP]; + DEBUG and warn "Server $$ stopped.\n"; + + if ( my @children = keys %{ $heap->{children} } ) { + DEBUG and warn "Server $$ is signaling children to stop.\n"; + kill INT => @children; + } +} + +### The server session has encountered an error. Shut it down. + +sub server_got_error { + my ( $heap, $syscall, $errno, $error ) = @_[ HEAP, ARG0 .. ARG2 ]; + warn( "Server $$ got $syscall error $errno: $error\n", + "Server $$ is shutting down.\n", + ); + delete $heap->{server}; +} + +### The server has a need to fork off more children. Only honor that +### request form the parent, otherwise we would surely "forkbomb". +### Fork off as many child processes as we need. + +sub server_do_fork { + my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; + + return if $heap->{is_a_child}; + + #my $current_children = keys %{ $heap->{children} }; + #for ( $current_children + 2 .. $heap->{max_processes} ) { + while (scalar(keys %{$heap->{children}}) < $heap->{max_processes}) { + + DEBUG and warn "Server $$ is attempting to fork.\n"; + + my $pid = fork(); + + unless ( defined($pid) ) { + DEBUG and + warn( "Server $$ fork failed: $!\n", + "Server $$ will retry fork shortly.\n", + ); + $kernel->delay( do_fork => 1 ); + return; + } + + # Parent. Add the child process to its list. + if ($pid) { + $heap->{children}->{$pid} = 1; + $kernel->sig_child($pid, "got_sig_child"); + next; + } + + # Child. Clear the child process list. + $kernel->has_forked(); + DEBUG and warn "Server $$ forked successfully.\n"; + $heap->{is_a_child} = 1; + $heap->{children} = {}; + + #freeside db connection, etc. + forksuidsetup($user); + + return; + } +} + +### The server session received SIGINT. Don't handle the signal, +### which in turn will trigger the process to exit gracefully. + +sub server_got_sig_int { + my ( $kernel, $heap ) = @_[ KERNEL, HEAP ]; + DEBUG and warn "Server $$ received SIGINT/TERM.\n"; + + if ( my @children = keys %{ $heap->{children} } ) { + DEBUG and warn "Server $$ is signaling children to stop.\n"; + kill INT => @children; + } + + delete $heap->{server}; + $kernel->sig_handled(); +} + +### The server session received a SIGCHLD, indicating that some child +### server has gone away. Remove the child's process ID from our +### list, and trigger more fork() calls to spawn new children. + +sub server_got_sig_child { + my ( $kernel, $heap, $child_pid ) = @_[ KERNEL, HEAP, ARG1 ]; + + return unless delete $heap->{children}->{$child_pid}; + + DEBUG and warn "Server $$ reaped child $child_pid.\n"; + $kernel->yield("do_fork") if exists $_[HEAP]->{server}; +} + +### The server session received a connection request. Spawn off a +### client handler session to parse the request and respond to it. + +sub server_got_connection { + my ( $heap, $socket, $peer_addr, $peer_port ) = @_[ HEAP, ARG0, ARG1, ARG2 ]; + + DEBUG and warn "Server $$ received a connection.\n"; + + POE::Session->create( + inline_states => { + _start => \&client_start, + _stop => \&client_stop, + got_request => \&client_got_request, + got_flush => \&client_flushed_request, + got_error => \&client_got_error, + _parent => sub { 0 }, + }, + heap => { + socket => $socket, + peer_addr => $peer_addr, + peer_port => $peer_port, + }, + ); + + # Gracefully exit if testing process churn. + delete $heap->{server} + if TESTING_CHURN and $heap->{is_a_child} and ( rand() < 0.1 ); +} + +### The client handler has started. Wrap its socket in a ReadWrite +### wheel to begin interacting with it. + +sub client_start { + my $heap = $_[HEAP]; + + $heap->{client} = POE::Wheel::ReadWrite->new + ( Handle => $heap->{socket}, + Filter => POE::Filter::HTTPD->new(), + InputEvent => "got_request", + ErrorEvent => "got_error", + FlushedEvent => "got_flush", + ); + + DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " started.\n"; +} + +### The client handler has stopped. Log that fact. + +sub client_stop { + DEBUG and warn "Client handler $$/", $_[SESSION]->ID, " stopped.\n"; +} + +### The client handler has received a request. If it's an +### HTTP::Response object, it means some error has occurred while +### parsing the request. Send that back and return immediately. +### Otherwise parse and process the request, generating and sending an +### HTTP::Response object in response. + +sub client_got_request { + my ( $heap, $request ) = @_[ HEAP, ARG0 ]; + + forksuidsetup($user) unless dbh && dbh->ping; + + my $serializer = new XMLRPC::Serializer(typelookup => \%typelookup); + + #my $soap = SOAP::Transport::HTTP::Server + my $soap = XMLRPC::Transport::HTTP::Server + -> new + -> dispatch_to('FS::ClientAPI_XMLRPC') + -> serializer($serializer); + + DEBUG and + warn "Client handler $$/", $_[SESSION]->ID, " is handling a request.\n"; + + if ( $request->isa("HTTP::Response") ) { + $heap->{client}->put($request); + return; + } + + $soap->request($request); + $soap->handle; + my $response = $soap->response; + + $heap->{client}->put($response); +} + +### The client handler received an error. Stop the ReadWrite wheel, +### which also closes the socket. + +sub client_got_error { + my ( $heap, $operation, $errnum, $errstr ) = @_[ HEAP, ARG0, ARG1, ARG2 ]; + DEBUG and + warn( "Client handler $$/", $_[SESSION]->ID, + " got $operation error $errnum: $errstr\n", + "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n" + ); + delete $heap->{client}; +} + +### The client handler has flushed its response to the socket. We're +### done with the client connection, so stop the ReadWrite wheel. + +sub client_flushed_request { + my $heap = $_[HEAP]; + DEBUG and + warn( "Client handler $$/", $_[SESSION]->ID, + " flushed its response.\n", + "Client handler $$/", $_[SESSION]->ID, " is shutting down.\n" + ); + delete $heap->{client}; +} + +sub usage { + die "Usage:\n\n freeside-selfservice-xmlrpcd user\n"; +} + +### +# the end +### + +1; diff --git a/FS/bin/freeside-setinvoice b/FS/bin/freeside-setinvoice new file mode 100644 index 000000000..708e2fa30 --- /dev/null +++ b/FS/bin/freeside-setinvoice @@ -0,0 +1,42 @@ +#!/usr/bin/perl + +use strict; +use FS::UID qw(adminsuidsetup); +use FS::Conf; +use FS::Record qw(qsearch qsearchs); +use FS::cust_main; +use FS::svc_acct; + +&untaint_argv; #what it sounds like (eww) +my $user = shift or die &usage; + +adminsuidsetup $user; + +foreach my $cust_main ( + grep { ! scalar($_->invoicing_list) } + qsearch( 'cust_main', {} ) +) { + my @dest; + my @cust_pkg = $cust_main->ncancelled_pkgs; + foreach my $cust_pkg ( @cust_pkg ) { + foreach my $cust_svc ( $cust_pkg->cust_svc ) { + my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $cust_svc->svcnum } ); + push @dest, $svc_acct->svcnum if $svc_acct; + } + } + push @dest, 'POST' unless @dest; + $cust_main->invoicing_list(\@dest); +} + +sub untaint_argv { + foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV + $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\""; + $ARGV[$_]=$1; + } +} + +sub usage { + die "Usage:\n\n freeside-setinvoice user\n"; +} + + diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup new file mode 100755 index 000000000..155c74aa0 --- /dev/null +++ b/FS/bin/freeside-setup @@ -0,0 +1,167 @@ +#!/usr/bin/perl -w + +#to delay loading dbdef until we're ready +BEGIN { $FS::Schema::setup_hack = 1; } + +#to allow initial insert +use FS::part_pkg; +$FS::part_pkg::setup_hack = 1; +$FS::part_pkg::setup_hack = 1; + +use strict; +use vars qw($opt_u $opt_d $opt_v $opt_q); +use Getopt::Std; +use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets); +use FS::CurrentUser; +use FS::Schema qw( dbdef_dist reload_dbdef ); +use FS::Record qw( qsearch ); +#use FS::raddb; +use FS::Setup qw(create_initial_data); +use FS::Conf; + +die "Not running uid freeside!" unless checkeuid(); + +#my %attrib2db = +# map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib; + +getopts("u:vqd:"); +$opt_v = 1 unless $opt_q; #verbose by default now + +my $config_dir = shift || '%%%DIST_CONF%%%' ; +$config_dir =~ /^([\w.:=\/]+)$/ + or die "unacceptable configuration directory name"; +$config_dir = $1; + +getsecrets($opt_u); + +#needs to match FS::Record +my($dbdef_file) = "%%%FREESIDE_CONF%%%/dbdef.". datasrc; + +### + +my $username_len = 32; + +#print "\n\n", <<END, ":"; +#Freeside tracks the RADIUS User-Name, check attribute Password and +#reply attribute Framed-IP-Address for each user. You can specify additional +#check and reply attributes (or you can add them later with the +#fs-radius-add-check and fs-radius-add-reply programs). +# +#First enter any additional RADIUS check attributes you need to track for each +#user, separated by whitespace. +#END +#my @check_attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; } +# split(" ",&getvalue); +# +#print "\n\n", <<END, ":"; +#Now enter any additional reply attributes you need to track for each user, +#separated by whitespace. +#END +#my @attributes = map { $attrib2db{lc($_)} or die "unknown attribute $_"; } +# split(" ",&getvalue); +# +#print "\n\n", <<END, ":"; +#Do you wish to enable the tracking of a second, separate shipping/service +#address? +#END +#my $ship = &_yesno; +# +#sub getvalue { +# my($x)=scalar(<STDIN>); +# chop $x; +# $x; +#} +# +#sub _yesno { +# print " [y/N]:"; +# my $x = scalar(<STDIN>); +# $x =~ /^y/i; +#} + +#my @check_attributes = (); #add later +#my @attributes = (); #add later +#my $ship = $opt_s; + +### +# create a dbdef object from the old data structure +### + +warn "Loading schema objects\n" if $opt_v; + +my $dbdef = dbdef_dist(datasrc); + +#important +$dbdef->save($dbdef_file); +&FS::Schema::reload_dbdef($dbdef_file); + +### +# create 'em +### + +warn "Connecting to database\n" if $opt_v; + +$FS::CurrentUser::upgrade_hack = 1; +$FS::UID::callback_hack = 1; +my $dbh = adminsuidsetup $opt_u; #$user; +$FS::UID::callback_hack = 0; + +#create tables +$|=1; + +warn "Creating tables and indices\n" if $opt_v; + +foreach my $statement ( $dbdef->sql($dbh) ) { + $dbh->do( $statement ) + or die "CREATE error: ". $dbh->errstr. "\ndoing statement: $statement"; +} + +#now go back and reverse engineer the db +#so we pick up the correct column DEFAULTs for #oidless inserts +dbdef_create($dbh, $dbdef_file); +delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload +reload_dbdef($dbdef_file); + +warn "Tables and indices created - commiting transaction\n" if $opt_v; +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; +warn "Database schema committed successfully\n" if $opt_v; + +warn "Initializing configuration\n" if $opt_v; +$FS::UID::callback_hack = 1; +$dbh = adminsuidsetup $opt_u; +$FS::UID::callback_hack = 0; +if (!scalar(qsearch('conf', {}))) { + my $error = FS::Conf::init_config($config_dir); + if ($error) { + $dbh->rollback or die $dbh->errstr; + die $error; + } +} + +warn "Configuration initialized - commiting transaction\n" if $opt_v; +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; +warn "Configuration committed successfully\n" if $opt_v; + +$dbh = adminsuidsetup $opt_u; +create_initial_data('domain' => $opt_d); + +warn "Database initialized - commiting transaction\n" if $opt_v; +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; +warn "Database initialization committed successfully\n" if $opt_v; + +sub dbdef_create { # reverse engineer the schema from the DB and save to file + my( $dbh, $file ) = @_; + my $dbdef = new_native DBIx::DBSchema $dbh; + $dbdef->save($file); +} + +sub usage { + die "Usage:\n freeside-setup -d domain.name [ -q ] [ config/dir ]\n" + # [ -u user ] for devel/multi-db installs +} + +1; + + diff --git a/FS/bin/freeside-sqlradius-dedup-group b/FS/bin/freeside-sqlradius-dedup-group new file mode 100755 index 000000000..441d50f62 --- /dev/null +++ b/FS/bin/freeside-sqlradius-dedup-group @@ -0,0 +1,82 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( %seen @dups ); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; + +my %allowed_types = map { $_ => 1 } qw ( sqlradius sqlradius_withdomain ); + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $export_x = shift; +my @part_export; +if ( !defined($export_x) ) { + @part_export = qsearch('part_export', {} ); +} elsif ( $export_x =~ /^(\d+)$/ ) { + @part_export = qsearchs('part_export', { exportnum=>$1 } ) + or die "exportnum $export_x not found\n"; +} else { + @part_export = qsearch('part_export', { exporttype=>$export_x } ) + or die "no exports of type $export_x found\n"; +} + +@part_export = grep { $allowed_types{$_->exporttype} } @part_export + or die "No sqlradius exports specified."; + +foreach my $part_export ( @part_export ) { + my $dbh = DBI->connect( map $part_export->option($_), + qw ( datasrc username password ) ); + + my $sth = $dbh->prepare("SELECT id,username,groupname + FROM usergroup ORDER By username,groupname,id") + or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + + @dups = (); %seen = (); + while (my $row = $sth->fetchrow_arrayref ) { + my ($userid, $username, $groupname) = @$row; + unless ( exists($seen{$username}{$groupname}) ) { + $seen{$username}{$groupname} = $userid; + next; + } + push @dups, $userid; + } + + $sth = $dbh->prepare("DELETE FROM usergroup WHERE id = ?") + or die $dbh->errstr; + + foreach (@dups) { + $sth->execute($_) or die $sth->errstr; + } + +} + + +sub usage { + die "Usage:\n\n freeside-sqlradius-dedup-group user [ exportnum|exporttype ]\n"; +} + +=head1 NAME + +freeside-sqlradius-dedup-group - Command line tool to eliminate duplicate usergroup entries from radius tables + +=head1 SYNOPSIS + + freeside-sqlradius-dedup-group user [ exportnum|exporttype ] + +=head1 DESCRIPTION + + Removes all but one username groupname pair when duplicate entries exist + for the specified export (selected by exportnum or exporttype) or all + exports if none are specified. + +=head1 SEE ALSO + +L<freeside-reexport>, L<freeside-sqlradius-reset>, L<FS::part_export> + +=cut + diff --git a/FS/bin/freeside-sqlradius-radacctd b/FS/bin/freeside-sqlradius-radacctd new file mode 100644 index 000000000..7b2d04dc7 --- /dev/null +++ b/FS/bin/freeside-sqlradius-radacctd @@ -0,0 +1,145 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( @part_export ); +use subs qw(myshutdown); +use POSIX qw(:sys_wait_h); +#use IO::File; +use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm); +use FS::UID qw(adminsuidsetup); #forksuidsetup driver_name dbh myconnect); +use FS::Record qw(qsearch); # qsearchs); +use FS::part_export; +use FS::part_export::sqlradius; +#use FS::svc_acct; +#use FS::cust_svc; + +my $user = shift or die &usage; + +#daemonize1('freeside-sqlradius-radacctd', $user); #keep unique pid files w/multi installs +daemonize1('freeside-sqlradius-radacctd'); + +drop_root(); + +#$ENV{HOME} = (getpwuid($>))[7]; #for ssh + +adminsuidsetup $user; + +logfile( "%%%FREESIDE_LOG%%%/sqlradius-radacctd-log.". $FS::UID::datasrc ); + +daemonize2(); + +#-- + +my @part_export = FS::part_export::sqlradius->all_sqlradius_withaccounting(); + +die "no sqlradius, sqlradius_withdomain, radiator or phone_sqlradius exports". + " without ignore_accounting" + unless @part_export; + +while (1) { + + #fork off one kid per export (machine) + # _>{'_radacct_kid'} is an evil kludge + foreach my $part_export ( grep ! $_->{'_radacct_kid'}, @part_export ) { + + defined( my $pid = fork ) or do { + warn "WARNING: can't fork to spawn child for ". $part_export->machine; + next; + }; + + if ( $pid ) { + $part_export->{'_radacct_kid'} = $pid; + warn "child $pid spawned for ". $part_export->machine; + } else { #kid time + + adminsuidsetup($user); #get our own db handle + + until ( sigint || sigterm ) { + $part_export->update_svc(); + sleep 1; + } + + warn "child for ". $part_export->machine. " done"; + exit; + + } #eo kid + + } + + #reap up any kids that died... + &reap_kids; + + myshutdown() if sigterm() || sigint(); + + sleep 5; +} + +#-- + +sub myshutdown { + &reap_kids; + + #kill all the kids + kill 'TERM', $_ foreach grep $_, map $_->{'_radacct_kid'}, @part_export; + + my $wait = 12; #wait up to 1 minute + while ( ( grep $_->{'_radacct_kid'}, @part_export ) && $wait-- ) { + warn "waiting for children to terminate"; + sleep 5; + &reap_kids; + } + warn "abandoning children" if grep $_->{'_radacct_kid'}, @part_export; + die "exiting"; +} + +sub reap_kids { + #warn "reaping kids\n"; + foreach my $part_export ( grep $_->{'_radacct_kid'}, @part_export ) { + my $pid = $part_export->{'_radacct_kid'}; + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + $part_export->{'_radacct_kid'} = ''; + } + } + #warn "done reaping\n"; +} + +sub usage { + die "Usage:\n\n freeside-sqlradius-radacctd user\n"; +} + +=head1 NAME + +freeside-sqlradius-radacctd - Real-time radacct import daemon + +=head1 SYNOPSIS + + freeside-sqlradius-radacctd username + +=head1 DESCRIPTION + +Imports records from an the SQL radacct tables of all sqlradius, +sqlradius_withdomain and radiator exports (except those with the +ignore_accounting flag) and updates the following fields in svc_acct (see +L<FS::svc_acct>) for each account: last_login, last_logout, seconds, +upbytes, downbytes, totalbytes. Runs as a daemon and updates the database +in real-time. + +B<username> is a username added by freeside-adduser. + +=head1 RADIUS DATABASE CHANGES + +In 1.7.4+, freeside-upgrade should have taken care of these changes already. + +ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL; + +If you want to ignore the existing accountg records, also do: + +UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL; + +=head1 SEE ALSO + +=cut + +1; + diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset new file mode 100755 index 000000000..a77bad64f --- /dev/null +++ b/FS/bin/freeside-sqlradius-reset @@ -0,0 +1,118 @@ +#!/usr/bin/perl -w + +use strict; +use vars qw( $opt_n ); +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs); +use FS::part_export; +#use FS::svc_acct; +use FS::cust_svc; + +getopts("n"); + +my $user = shift or die &usage; +adminsuidsetup $user; + +#my $machine = shift or die &usage; + +my @exports = (); +if ( @ARGV ) { + foreach my $exportnum ( @ARGV ) { + foreach my $exporttype (qw( sqlradius sqlradius_withdomain phone_sqlradius )) { + push @exports, qsearch('part_export', { exportnum => $exportnum, + exporttype => $exporttype, } ); + } + } + } else { + @exports = qsearch('part_export', { exporttype=>'sqlradius' } ); + push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } ); +} + +unless ( $opt_n ) { + foreach my $export ( @exports ) { + my $icradius_dbh = DBI->connect( + map { $export->option($_) } qw( datasrc username password ) + ) or die $DBI::errstr; + for my $table (qw( radcheck radreply usergroup )) { + my $sth = $icradius_dbh->prepare("DELETE FROM $table"); + $sth->execute or die "Can't reset $table table: ". $sth->errstr; + } + $icradius_dbh->disconnect; + } +} + +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; + my $overlimit_groups = $export->option('overlimit_groups'); + + my @svc_x = + map { $_->svc_x } + #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 + #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'} } + ($svc_x, $overlimit_groups) + ); + } + + #false laziness with FS::svc_acct::insert (like it matters) + my $error = $export->export_insert($svc_x); + die $error if $error; + + } +} + +sub usage { + die "Usage:\n\n freeside-sqlradius-reset user [ exportnum, ... ]\n"; +} + +=head1 NAME + +freeside-sqlradius-reset - Command line interface to reset and recreate RADIUS SQL tables + +=head1 SYNOPSIS + + freeside-sqlradius-reset [ -n ] username [ EXPORTNUM, ... ] + +=head1 DESCRIPTION + +Deletes the radcheck, radreply and usergroup tables and repopulates them from +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. + +The B<-n> option, if supplied, supresses the deletion of the existing data in +the tables. + +=head1 SEE ALSO + +L<freeside-reexport>, L<FS::part_export>, L<FS::part_export::sqlradius> + +=cut + +1; diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds new file mode 100644 index 000000000..9999cbbf3 --- /dev/null +++ b/FS/bin/freeside-sqlradius-seconds @@ -0,0 +1,58 @@ +#!/usr/bin/perl -Tw + +use strict; +use Date::Parse; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearchs); +use FS::svc_acct; + +my $fs_user = shift or die &usage; +adminsuidsetup( $fs_user ); + +my $target_user = shift or die &usage; +my $start = shift or die &usage; +$start = str2time($start); +my $stop = scalar(@ARGV) ? str2time(shift) : time; + +my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } ); +die "username $target_user not found\n" unless $svc_acct; + +print $svc_acct->seconds_since_sqlradacct( $start, $stop ). "\n"; + +sub usage { + die "Usage:\n\n freeside-sqlradius-seconds freeside_username target_username start_date stop_date\n"; +} + + +=head1 NAME + +freeside-sqlradius-seconds - Command line time-online tool + +=head1 SYNOPSIS + + freeside-sqlradius-seconds freeside_username target_username start_date [ stop_date ] + +=head1 DESCRIPTION + +Returns the number of seconds the specified username has been online between +start_date (inclusive) and stop_date (exclusive). +See L<FS::svc_acct/seconds_since_sqlradacct> + +B<freeside_username> is a username added by freeside-adduser. +B<target_username> is the username of the user account to query. +B<start_date> and B<stop_date> are in any format Date::Parse is happy with. +B<stop_date> defaults to now if not specified. + +=head1 BUGS + +Selection of the account in question is rather simplistic in that +B<target_username> doesn't necessarily identify a unique account (and wouldn't +even if a domain was specified), and no sqlradius export is checked for. + +=head1 SEE ALSO + +L<FS::svc_acct/seconds_since_sqlradacct> + +=cut + +1; diff --git a/FS/bin/freeside-sqlradius-set-lastlog b/FS/bin/freeside-sqlradius-set-lastlog new file mode 100755 index 000000000..ad8563076 --- /dev/null +++ b/FS/bin/freeside-sqlradius-set-lastlog @@ -0,0 +1,102 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +use FS::UID qw(adminsuidsetup); +use FS::Record qw(qsearch qsearchs str2time_sql); +use FS::Conf; +use FS::part_export; +use FS::svc_acct; + +my %allowed_types = map { $_ => 1 } qw ( sqlradius sqlradius_withdomain ); +my $conf = new FS::Conf; + +my $user = shift or die &usage; +adminsuidsetup $user; + +my $export_x = shift; +my @part_export; +if ( !defined($export_x) ) { + @part_export = qsearch('part_export', {} ); +} elsif ( $export_x =~ /^(\d+)$/ ) { + @part_export = qsearchs('part_export', { exportnum=>$1 } ) + or die "exportnum $export_x not found\n"; +} else { + @part_export = qsearch('part_export', { exporttype=>$export_x } ) + or die "no exports of type $export_x found\n"; +} + +# gross almost false laziness with FS::part_export::sqlradius::update_svc_acct +@part_export = grep { ! $_->option('ignore_accounting') } + grep { $allowed_types{$_->exporttype} } + @part_export + or die "No sqlradius exports specified."; + + +foreach my $part_export ( @part_export ) { + my $dbh = DBI->connect( map $part_export->option($_), + qw ( datasrc username password ) ); + + my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); + my $group = "UserName"; + $group .= ",Realm" + if ( ref($part_export) =~ /withdomain/ ); + + my $sth = $dbh->prepare("SELECT UserName, Realm, + $str2time max(AcctStartTime)), + $str2time max(AcctStopTime)) + FROM radacct + WHERE AcctStartTime != 0 AND AcctStopTime != 0 + GROUP BY $group") + or die $dbh->errstr; + $sth->execute() or die $sth->errstr; + + while (my $row = $sth->fetchrow_arrayref ) { + my ($username, $realm, $start, $stop) = @$row; + + $username = lc($username) unless $conf->exists('username-uppercase'); + my $extra_sql = ''; + if ( ref($part_export) =~ /withdomain/ ) { + $extra_sql = " And '$realm' = ( SELECT domain FROM svc_domain + WHERE svc_domain.svcnum = svc_acct.domsvc ) "; + } + + my $svc_acct = qsearchs( 'svc_acct', + { 'username' => $username }, + '', + $extra_sql, + ); + if ($svc_acct) { + $svc_acct->last_login($start) + if $start && (!$svc_acct->last_login || $start > $svc_acct->last_login); + $svc_acct->last_logout($stop) + if $stop && (!$svc_acct->last_logout || $stop > $svc_acct->last_logout); + } + } +} + + +sub usage { + die "Usage:\n\n freeside-sqlradius-set_lastlog user [ exportnum|exporttype ]\n"; +} + +=head1 NAME + +freeside-sqlradius-set-lastlog - Command line tool to set last_login and last_logout values from radius tables + +=head1 SYNOPSIS + + freeside-sqlradius-set-lastlog user [ exportnum|exporttype ] + +=head1 DESCRIPTION + + Sets the last_login and last_logout columns of each svc_acct based on + data in the radacct table for the specified export (selected by exportnum + or exporttype) or all exports if none are specified. + +=head1 SEE ALSO + +L<freeside-sqlradius-radacctd>, L<FS::part_export> + +=cut + diff --git a/FS/bin/freeside-torrus-srvderive b/FS/bin/freeside-torrus-srvderive new file mode 100644 index 000000000..3985601c0 --- /dev/null +++ b/FS/bin/freeside-torrus-srvderive @@ -0,0 +1,284 @@ +#!/usr/bin/perl -w + +use strict; +use POSIX qw( :sys_wait_h ); +use Sys::SigAction qw( set_sig_handler ); +use Date::Parse; +use Date::Format; +use FS::Daemon ':all'; #daemonize1 drop_root daemonize2 myexit logfile sig* +use FS::UID qw( adminsuidsetup forksuidsetup dbh driver_name ); +use FS::Record qw( qsearch str2time_sql str2time_sql_closing concat_sql ); +use FS::torrus_srvderive; + +our $DEBUG = 2; +our $max_kids = 3; +our %kids; + +my $user = shift or die &usage; +$FS::Daemon::PID_NEWSTYLE = 1; +daemonize1('torrus-srvderive'); + +drop_root(); + +adminsuidsetup($user); + +logfile( "%%%FREESIDE_LOG%%%/torrus-srvderive-log.". $FS::UID::datasrc ); + +daemonize2(); + +our $conf = new FS::Conf; + +die "not running: network_monitoring_system not Torrus_Internal\n" + unless _shouldrun(); + +#-- + +my $str2time = str2time_sql(); +my $c = str2time_sql_closing(); + +my $_date = concat_sql([ 'srvexport.srv_date', "' '", 'srvexport.srv_time' ]); +$_date = "CAST( $_date AS TIMESTAMP )" if driver_name =~ /^Pg/i; +$_date = str2time_sql. $_date. str2time_sql_closing; + +my $other_date = concat_sql([ 'other.srv_date', "' '", 'other.srv_time' ]); +$other_date = "CAST( $other_date AS TIMESTAMP )" if driver_name =~ /^Pg/i; +$other_date = str2time_sql. $other_date. str2time_sql_closing; + +my $in = concat_sql([ '?', "'_IN'" ]); +my $out = concat_sql([ '?', "'_OUT'" ]); + +my $sql = " + SELECT DISTINCT srv_date, srv_time FROM srvexport + WHERE NOT EXISTS ( + SELECT 1 FROM srvexport AS other + WHERE other.serviceid IN ( $in, $out ) + AND srvexport.srv_date = other.srv_date + AND ABS( $_date - $other_date ) <= 60 + ) +"; + +my $orderlimit = " + ORDER BY srv_date, srv_time + LIMIT 100 +"; #50? + +our $kids = 0; + +#MAIN: while (1) { +while (1) { + + my $found = 0; + + #SERVICEID: foreach my $torrus_srvderive ( qsearch('torrus_srvderive', {}) ) { + foreach my $torrus_srvderive ( qsearch('torrus_srvderive', {}) ) { + + &reap_kids; + if ( $kids >= $max_kids ) { + sleep 5; + myexit() if sigterm() || sigint(); + redo; + } + + defined( my $pid = fork ) or do { + #warn "WARNING: can't fork: $!\n"; + #next; #don't increment the kid counter + die "can't fork: $!\n"; + }; + + if ( $pid ) { + $kids++; + $kids{$pid} = 1; + } else { #kid time + + #get new db handle + $FS::UID::dbh->{InactiveDestroy} = 1; + + forksuidsetup($user); + + my $serviceid = $torrus_srvderive->serviceid; + + my @serviceids = $torrus_srvderive->component_serviceids; + exit unless @serviceids; #don't try to search for empty virtual ports + + #nonlocking select statements; rows in this table never change + dbh->do('SET SESSION TRANSACTION ISOLATION LEVEL READ UNCOMMITTED') + if driver_name eq 'mysql'; + + my @in = (); + for my $dir ('_IN', '_OUT') { + push @in, map dbh->quote("$_$dir"), @serviceids; + } + my $in = join(',', @in); + + if ( ! $torrus_srvderive->last_srv_date ) { + warn "finding initial last_srv_date for $serviceid\n" if $DEBUG; + my $dsql = "SELECT srv_date FROM srvexport WHERE serviceid IN ($in) + ORDER BY srv_date LIMIT 1"; + my $dsth = dbh->prepare($dsql) or die $DBI::errstr; + $dsth->execute or die $dsth->errstr; + my $date = $dsth->fetchrow_arrayref->[0]; + if ( $date ) { + warn "found initial last_srv_date of $date; updating $serviceid\n" + if $DEBUG; + $torrus_srvderive->last_srv_date($date); + my $error = $torrus_srvderive->replace; + die $error if $error; + } else { + warn "no initial last_srv_date for $serviceid; skipping\n" if $DEBUG; + exit; + } + } + + my $ssql = " + $sql AND EXISTS ( + SELECT 1 FROM srvexport AS other + WHERE other.serviceid IN ($in) + AND srvexport.srv_date = other.srv_date + AND ABS( $_date - $other_date ) <= 60 + ) + "; + + $ssql .= " AND srv_date >= '". $torrus_srvderive->last_srv_date. "' " + if $torrus_srvderive->last_srv_date; + + $ssql .= $orderlimit; + + warn "searching for times to add $serviceid\n" if $DEBUG; + warn $ssql if $DEBUG > 2; + my $sth = dbh->prepare($ssql) or die $DBI::errstr; #better recovery here? + + eval { + my $h = set_sig_handler( 'ALRM', sub { die "_timeout\n"; } ); + alarm(15*60); #5*60); #$torrus_srvderive->last_srv_date ? 5*60 : 15*60); + $sth->execute($serviceid, $serviceid) or die $sth->errstr; + alarm(0); + }; + alarm(0); + + if ( $@ && $@ eq "_timeout\n" ) { + #warn "search timed out; reconnecting and restarting\n"; + warn "search timed out\n"; + dbh->clone()->do("KILL QUERY ". dbh->{"mysql_thread_id"}) + if driver_name eq 'mysql'; + dbh->rollback; #or die dbh->errstr; + #adminsuidsetup($user); + #next SERVICEID; #MAIN; + exit; + } elsif ( $@ ) { + die $@; + } + + warn "search for $serviceid finished; checking results\n" if $DEBUG; + + my $prev = 0; + while ( my $row = $sth->fetchrow_arrayref ) { + last if sigterm() || sigint(); + + my( $srv_date, $srv_time ) = @$row; + my $cur = str2time( "$srv_date $srv_time" ); + next if $cur-$prev <= 60; + last if time - $cur <= 300; + + warn "no $serviceid for $srv_date $srv_time; adding\n" + if $DEBUG; + $found++; + + for my $dir ('_IN', '_OUT') { + + my $sin = join(',', map dbh->quote("$_$dir"), @serviceids); + + my $sum = " + SELECT COALESCE(SUM(value),0) FROM srvexport AS other + WHERE other.serviceid IN ($sin) + AND ABS( $cur - $other_date ) <= 60 + "; + + my $isql = " + INSERT INTO srvexport ( srv_date, srv_time, serviceid, value, intvl ) + VALUES ( ?, ?, ?, ($sum), ? ) + "; + my @param = ( time2str('%Y-%m-%d', $cur), #srv_date + time2str('%X', $cur), #srv_time + "$serviceid$dir", + 300, #intvl ... + ); + warn $isql. ' with param '. join(',',@param). "\n" + if $DEBUG > 2; + + my $isth = dbh->prepare($isql) or die $DBI::errstr; #better recovery? + + #stupid mysql deadlocks all the time on insert, so we need to recover + unless ( $isth->execute(@param) ) { + #warn "Error inserting data for $serviceid$dir (restarting): ". + # $isth->errstr; + warn "Error inserting data for $serviceid$dir: ". $isth->errstr; + dbh->rollback; #or die dbh->errstr; + #sleep 5; + #next SERVICEID; #MAIN; + exit; + } + + } + + if ( $srv_date ne $torrus_srvderive->last_srv_date ) { + warn "updating last_srv_date of $serviceid to $srv_date\n" if $DEBUG; + $torrus_srvderive->last_srv_date($srv_date); + my $error = $torrus_srvderive->replace; + die $error if $error; + } + dbh->commit or die dbh->errstr; + + $prev = $cur; + } + warn "done with $serviceid\n" if $DEBUG; + + exit; + #end-of-kid + } + + } #foreach my $torrus_srvderive + dbh->commit or die dbh->errstr; + + myexit() if sigterm() || sigint(); + warn "restarting main loop\n" if $DEBUG > 1; + #sleep 60 unless $found; +} + +sub _shouldrun { + $conf->exists('network_monitoring_system') + && $conf->config('network_monitoring_system') eq 'Torrus_Internal'; +} + +sub usage { + die "Usage:\n\n freeside-cdrrewrited user\n"; +} + +sub reap_kids { + foreach my $pid ( keys %kids ) { + my $kid = waitpid($pid, WNOHANG); + if ( $kid > 0 ) { + $kids--; + delete $kids{$kid}; + } + } +} + +=head1 NAME + +freeside-torrus-srvderive - Freeside's Torrus virtual port daemon. + +=head1 SYNOPSIS + + freeside-torrus-srvderive + +=head1 DESCRIPTION + +Runs continuously, searches for samples in the srvexport table which do not +have an entry for combined virtual ports, and adds them. + +=head1 SEE ALSO + +=cut + +1; + diff --git a/FS/bin/freeside-upgrade b/FS/bin/freeside-upgrade new file mode 100755 index 000000000..e11a0a7fe --- /dev/null +++ b/FS/bin/freeside-upgrade @@ -0,0 +1,309 @@ +#!/usr/bin/perl -w + +use strict; +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; #0.39 +use FS::UID qw(adminsuidsetup checkeuid datasrc driver_name); #getsecrets); +use FS::CurrentUser; +use FS::Schema qw( dbdef dbdef_dist reload_dbdef ); +use FS::Misc::prune qw(prune_applications); +use FS::Conf; +use FS::Record qw(qsearch); +use FS::Upgrade qw(upgrade_schema upgrade_config upgrade upgrade_sqlradius); + +my $start = time; + +die "Not running uid freeside!" unless checkeuid(); + +getopts("dqrs"); + +$DEBUG = !$opt_q; +#$DEBUG = $opt_v; + +$DRY_RUN = $opt_d; + +my $user = shift or die &usage; +$FS::CurrentUser::upgrade_hack = 1; +$FS::UID::callback_hack = 1; +my $dbh = adminsuidsetup($user); +$FS::UID::callback_hack = 0; + +if ( driver_name =~ /^mysql/i ) { #until 0.39 is required above + eval "use DBIx::DBSchema 0.39;"; + die $@ if $@; +} + +#needs to match FS::Schema... +my $dbdef_file = "%%%FREESIDE_CONF%%%/dbdef.". datasrc; + +dbdef_create($dbh, $dbdef_file); + +delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload +reload_dbdef($dbdef_file); + +warn "Upgrade startup completed in ". (time-$start). " seconds\n"; # if $DEBUG; +$start = time; + +#$DBIx::DBSchema::DEBUG = $DEBUG; +#$DBIx::DBSchema::Table::DEBUG = $DEBUG; +#$DBIx::DBSchema::Index::DEBUG = $DEBUG; + +my @bugfix = (); + +if (dbdef->table('cust_main')->column('agent_custid') && ! $opt_s) { + push @bugfix, + "UPDATE cust_main SET agent_custid = NULL where agent_custid = ''"; + + push @bugfix, + "UPDATE h_cust_main SET agent_custid = NULL where agent_custid = ''" + if (dbdef->table('h_cust_main')); +} + +if ( dbdef->table('cgp_rule_condition') && + dbdef->table('cgp_rule_condition')->column('condition') + ) +{ + push @bugfix, + "ALTER TABLE ${_}cgp_rule_condition RENAME COLUMN condition TO conditionname" + for '', 'h_'; + +} + +if ( dbdef->table('areacode') and + dbdef->table('areacode')->primary_key eq 'code' ) +{ + if ( driver_name =~ /^mysql/i ) { + push @bugfix, + 'ALTER TABLE areacode DROP PRIMARY KEY', + 'ALTER TABLE areacode ADD COLUMN (areanum int auto_increment primary key)'; + } + else { + push @bugfix, 'ALTER TABLE areacode DROP CONSTRAINT areacode_pkey'; + } +} + +# RT required field flag +# for consistency with RT schema: mysql is in CamelCase, +# pg is in lowercase, and they use different data types. +my ($t, $creq, $cdis) = + map { driver_name =~ /^mysql/i ? $_ : lc($_) } + ('CustomFields','Required','Disabled'); + +if ( dbdef->table($t) && + ! dbdef->table($t)->column($creq) ) { + push @bugfix, + "ALTER TABLE $t ADD COLUMN $creq ". + dbdef->table($t)->column($cdis)->type . + ' NOT NULL DEFAULT 0'; +} + +if ( $DRY_RUN ) { + print + join(";\n", @bugfix ). ";\n"; +} elsif ( @bugfix ) { + + foreach my $statement ( @bugfix ) { + warn "$statement\n"; + $dbh->do( $statement ) + or die "Error: ". $dbh->errstr. "\n executing: $statement"; + } + + upgrade_schema(); + + dbdef_create($dbh, $dbdef_file); + delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload + reload_dbdef($dbdef_file); + +} + +#you should have run fs-migrate-part_svc ages ago, when you upgraded +#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 = dbdef->sql_update_schema( dbdef_dist(datasrc), + $dbh, + { 'nullify_default' => 1, }, + ); + +@statements = + grep { $_ !~ /^CREATE +INDEX +h_queue/i } #useless, holds up queue insertion + @statements; + +unless ( driver_name =~ /^mysql/i ) { + #not necessary under non-mysql, takes forever on big db + @statements = + grep { $_ !~ /^ *ALTER +TABLE +h_queue +ALTER +COLUMN +job +TYPE +varchar\(512\) *$/i } + @statements; +} + +if ( $DRY_RUN ) { + print + join(";\n", @statements ). ";\n"; + exit; +} else { + foreach my $statement ( @statements ) { + warn "$statement\n"; + $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; + +# dbdef->update_schema( dbdef_dist(datasrc), $dbh ); +} + +warn "Schema upgrade completed in ". (time-$start). " seconds\n"; # if $DEBUG; +$start = time; + +my $hashref = {}; +$hashref->{dry_run} = 1 if $DRY_RUN; +$hashref->{debug} = 1 if $DEBUG && $DRY_RUN; +prune_applications($hashref) unless $opt_s; + +warn "Application pruning completed in ". (time-$start). " seconds\n"; # if $DEBUG; +$start = time; + +print "\n" if $DRY_RUN; + +if ( $dbh->{Driver}->{Name} =~ /^mysql/i && ! $opt_s ) { + + foreach my $table (qw( svc_acct svc_phone )) { + + my $sth = $dbh->prepare( + "SELECT COUNT(*) FROM duplicate_lock WHERE lockname = '$table'" + ) or die $dbh->errstr; + + $sth->execute or die $sth->errstr; + + unless ( $sth->fetchrow_arrayref->[0] ) { + + $sth = $dbh->prepare( + "INSERT INTO duplicate_lock ( lockname ) VALUES ( '$table' )" + ) or die $dbh->errstr; + + $sth->execute or die $sth->errstr; + + } + + } + + warn "Duplication lock creation completed in ". (time-$start). " seconds\n"; # if $DEBUG; + $start = time; + +} + +$dbh->commit or die $dbh->errstr; + +dbdef_create($dbh, $dbdef_file); + +$dbh->disconnect or die $dbh->errstr; + +delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload +$FS::UID::AutoCommit = 0; +$FS::UID::callback_hack = 1; +$dbh = adminsuidsetup($user); +$FS::UID::callback_hack = 0; +unless ( $DRY_RUN || $opt_s ) { + my $dir = "%%%FREESIDE_CONF%%%/conf.". datasrc; + if (!scalar(qsearch('conf', {}))) { + my $error = FS::Conf::init_config($dir); + if ($error) { + warn "CONFIGURATION UPGRADE FAILED\n"; + $dbh->rollback or die $dbh->errstr; + die $error; + } + } +} +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +$FS::UID::AutoCommit = 1; + +$dbh = adminsuidsetup($user); + +warn "Re-initialization with updated schema completed in ". (time-$start). " seconds\n"; # if $DEBUG; +$start = time; + +upgrade_config() + unless $DRY_RUN || $opt_s; + +$dbh->commit or die $dbh->errstr; + +warn "Config updates completed in ". (time-$start). " seconds\n"; # if $DEBUG; +$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 || $opt_r; + +warn "SQL RADIUS updates completed in ". (time-$start). " seconds\n"; # if $DEBUG; +$start = time; + +$dbh->commit or die $dbh->errstr; +$dbh->disconnect or die $dbh->errstr; + +warn "Final commit and disconnection completed in ". (time-$start). " seconds; upgrade done!\n"; # if $DEBUG; + +### + +sub dbdef_create { # reverse engineer the schema from the DB and save to file + my( $dbh, $file ) = @_; + my $dbdef = new_native DBIx::DBSchema $dbh; + $dbdef->save($file); +} + +sub usage { + die "Usage:\n freeside-upgrade [ -d ] [ -r ] [ -s ] [ -q | -v ] user\n"; +} + +=head1 NAME + +freeside-upgrade - Upgrades database schema for new freeside verisons. + +=head1 SYNOPSIS + + freeside-upgrade [ -d ] [ -r ] [ -s ] [ -q | -v ] + +=head1 DESCRIPTION + +Reads your existing database schema and updates it to match the current schema, +adding any columns or tables necessary. + +Also performs other upgrade functions: + +=over 4 + +=item Calls FS:: Misc::prune::prune_applications (probably unnecessary every upgrade, but simply won't find any records to change) + +=item If necessary, moves your configuration information from the filesystem in /usr/local/etc/freeside/conf.<datasrc> to the database. + +=back + + [ -d ]: Dry run; output SQL statements (to STDOUT) only, but do not execute + them. + + [ -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. + + [ -s ]: Schema changes only. Useful for Pg/slony slaves where the data + changes will be replicated from the Pg/slony master. + +=head1 SEE ALSO + +=cut + diff --git a/FS/bin/freeside-void-payments b/FS/bin/freeside-void-payments new file mode 100755 index 000000000..8c1f3dbdf --- /dev/null +++ b/FS/bin/freeside-void-payments @@ -0,0 +1,239 @@ +#!/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'}) and !qsearchs('reason', { reasonnum => opt{'X'} })) { + die "Cancellation reason not found: '".$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 [ options ] user + + options: + -a agentnum use agentnum's gateway information + -g gatewaynum use gatewaynum + -f file read transaction numbers from file + -c use ECHECK gateway instead of CARD + -r reason specify void reason (as a string) + -v be verbose + -s start-date + -e end-date limit by payment return date + -X reasonnum cancel customers whose payments are voided + (specify cancellation reason number) + +"; +} + +__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 ] + [ -X reasonnum ] + user + +=head1 DESCRIPTION + +=pod + +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 get_returns() method. For an example, see + 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 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 FS::reason). + +=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. + +=head1 SEE ALSO + +L<Business::OnlinePayment>, L<FS::cust_pay> + +=cut diff --git a/FS/bin/freeside-wipe-cvv b/FS/bin/freeside-wipe-cvv new file mode 100755 index 000000000..70f0df98f --- /dev/null +++ b/FS/bin/freeside-wipe-cvv @@ -0,0 +1,87 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Std; +use FS::UID qw(adminsuidsetup dbh); +use FS::Record qw(qsearch qsearchs); +use Time::Local 'timelocal'; +use Date::Format 'time2str'; + +my %opt; +getopts('vnd:', \%opt); + +my $user = shift or die &usage; +adminsuidsetup $user; +$FS::UID::AutoCommit = 0; +$FS::Record::nowarn_identical = 1; + +my $extra_sql = FS::cust_main->cancel_sql; +$extra_sql = "WHERE $extra_sql +AND cust_main.payby IN('CARD','DCRD','CHEK','DCHK') +"; + +if($opt{'d'}) { + $opt{'d'} =~ /^(\d+)$/ or die &usage; + my $time = timelocal(0,0,0,(localtime(time-(86400*$1)))[3..5]); + print "Excluding customers canceled after ".time2str("%D",$time)."\n" + if $opt{'v'}; + $extra_sql .= ' AND 0 = (' . FS::cust_main->select_count_pkgs_sql . + " AND cust_pkg.cancel > $time)"; +} + +foreach my $cust_main ( qsearch({ + 'table' => 'cust_main', + 'hashref' => {}, + 'extra_sql' => $extra_sql + }) ) { + if($opt{'v'}) { + print $cust_main->name, "\n"; + } + if($opt{'n'}) { + $cust_main->payinfo(''); + $cust_main->paydate(''); + $cust_main->payby('BILL'); +# can't have a CARD or CHEK without a valid payinfo + } + $cust_main->paycvv(''); + my $error = $cust_main->replace; + if($error) { + dbh->rollback; + die "$error (changes reverted)\n"; + } +} +dbh->commit; + +sub usage { + "Usage:\n\n freeside-wipe-cvv [ -v ] [ -n ] [ -d days ] user\n" +} + +=head1 NAME + +freeside-wipe-cvv - Wipe sensitive payment information from customer records. + +=head1 SYNOPSIS + + freeside-wipe-cvv [ -v ] [ -n ] [ -d days ] user + +=head1 DESCRIPTION + +freeside-wipe-cvv deletes the CVV numbers (and, optionally, credit +card or bank account numbers) of customers who have no non-canceled +packages. Normally CVV numbers are deleted as soon as a payment is +processed; if the customer is canceled before a payment is processed, +this may not happen and the CVV will remain indefinitely, violating +good security practice and (possibly) your merchant agreement. +Running freeside-wipe-cvv will remove this data. + +-v: Be verbose. + +-n: Remove card and account numbers in addition to CVV numbers. This +will also set the customer's payment method to 'BILL'. + +-d days: Only remove CVV/card numbers from customers who have been +inactive for at least that many days. Optional; will default to +all canceled customers. + +=cut + diff --git a/FS/bin/freeside-yori b/FS/bin/freeside-yori new file mode 100644 index 000000000..d1137995d --- /dev/null +++ b/FS/bin/freeside-yori @@ -0,0 +1,16 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use FS::Yori qw(reports report); + +if ( @ARGV ) { + while ( my $report = shift ) { + print report($report). "\n"; + } +} else { + print join("\n", reports() ). "\n"; +} + + +1; |