diff options
Diffstat (limited to 'FS/bin')
46 files changed, 0 insertions, 4673 deletions
diff --git a/FS/bin/freeside-addgroup b/FS/bin/freeside-addgroup deleted file mode 100755 index 25c2345..0000000 --- a/FS/bin/freeside-addgroup +++ /dev/null @@ -1,50 +0,0 @@ -#!/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 deleted file mode 100644 index 9cb1219..0000000 --- a/FS/bin/freeside-addoutsource +++ /dev/null @@ -1,32 +0,0 @@ -#!/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 deleted file mode 100644 index cbe792a..0000000 --- a/FS/bin/freeside-addoutsourceuser +++ /dev/null @@ -1,18 +0,0 @@ -#!/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 deleted file mode 100644 index 5304813..0000000 --- a/FS/bin/freeside-adduser +++ /dev/null @@ -1,119 +0,0 @@ -#!/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 deleted file mode 100755 index ea6a7bd..0000000 --- a/FS/bin/freeside-apply-credits +++ /dev/null @@ -1,21 +0,0 @@ -#!/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 deleted file mode 100755 index d789c6c..0000000 --- a/FS/bin/freeside-apply_payments_and_credits +++ /dev/null @@ -1,79 +0,0 @@ -#!/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 deleted file mode 100755 index ba9d6f3..0000000 --- a/FS/bin/freeside-cdr-sftp_and_import +++ /dev/null @@ -1,204 +0,0 @@ -#!/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 deleted file mode 100644 index 2cf75f3..0000000 --- a/FS/bin/freeside-cdrd +++ /dev/null @@ -1,160 +0,0 @@ -#!/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 deleted file mode 100644 index 0b7f688..0000000 --- a/FS/bin/freeside-cdrrewrited +++ /dev/null @@ -1,129 +0,0 @@ -#!/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 and cdr-charged_party_rewrite ". - " conf options are both 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'; - - } - - $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'); -} - -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 deleted file mode 100644 index 9930aae..0000000 --- a/FS/bin/freeside-check +++ /dev/null @@ -1,31 +0,0 @@ -#!/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 deleted file mode 100755 index 759085a..0000000 --- a/FS/bin/freeside-count-active-customers +++ /dev/null @@ -1,17 +0,0 @@ -#!/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 deleted file mode 100755 index 6a542c7..0000000 --- a/FS/bin/freeside-daily +++ /dev/null @@ -1,135 +0,0 @@ -#!/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 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_scp); -backup_scp(); - -### -# 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 deleted file mode 100755 index 6c448c7..0000000 --- a/FS/bin/freeside-dbdef-create +++ /dev/null @@ -1,47 +0,0 @@ -#!/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 deleted file mode 100755 index d887f21..0000000 --- a/FS/bin/freeside-dedup-cust_bill_pkg_detail-header +++ /dev/null @@ -1,57 +0,0 @@ -#!/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 deleted file mode 100755 index a7e9976..0000000 --- a/FS/bin/freeside-delete-addr_blocks +++ /dev/null @@ -1,31 +0,0 @@ -#!/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 deleted file mode 100644 index afc3a01..0000000 --- a/FS/bin/freeside-deloutsource +++ /dev/null @@ -1,14 +0,0 @@ -#!/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 deleted file mode 100644 index dc4ff9c..0000000 --- a/FS/bin/freeside-deloutsourceuser +++ /dev/null @@ -1,6 +0,0 @@ -#!/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 deleted file mode 100644 index a2a361a..0000000 --- a/FS/bin/freeside-deluser +++ /dev/null @@ -1,64 +0,0 @@ -#!/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 deleted file mode 100755 index 0af4609..0000000 --- a/FS/bin/freeside-disable-reasons +++ /dev/null @@ -1,64 +0,0 @@ -#!/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 deleted file mode 100755 index 7a93f78..0000000 --- a/FS/bin/freeside-email +++ /dev/null @@ -1,55 +0,0 @@ -#!/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 deleted file mode 100755 index f689bfd..0000000 --- a/FS/bin/freeside-fetch +++ /dev/null @@ -1,93 +0,0 @@ -#!/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 deleted file mode 100755 index 77a4332..0000000 --- a/FS/bin/freeside-history-requeue +++ /dev/null @@ -1,100 +0,0 @@ -#!/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 deleted file mode 100755 index fe4729c..0000000 --- a/FS/bin/freeside-init-config +++ /dev/null @@ -1,45 +0,0 @@ -#!/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-monthly b/FS/bin/freeside-monthly deleted file mode 100755 index 0d6ea14..0000000 --- a/FS/bin/freeside-monthly +++ /dev/null @@ -1,94 +0,0 @@ -#!/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-paymentech-download b/FS/bin/freeside-paymentech-download deleted file mode 100755 index 16ac3c2..0000000 --- a/FS/bin/freeside-paymentech-download +++ /dev/null @@ -1,137 +0,0 @@ -#!/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 deleted file mode 100755 index 3f8abc0..0000000 --- a/FS/bin/freeside-paymentech-upload +++ /dev/null @@ -1,133 +0,0 @@ -#!/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 deleted file mode 100644 index 05b068b..0000000 --- a/FS/bin/freeside-prepaidd +++ /dev/null @@ -1,115 +0,0 @@ -#!/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 deleted file mode 100755 index d2b6efe..0000000 --- a/FS/bin/freeside-prune-applications +++ /dev/null @@ -1,63 +0,0 @@ -#!/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 deleted file mode 100755 index e658407..0000000 --- a/FS/bin/freeside-pull-dsl +++ /dev/null @@ -1,71 +0,0 @@ -#!/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 deleted file mode 100644 index 756b699..0000000 --- a/FS/bin/freeside-queued +++ /dev/null @@ -1,298 +0,0 @@ -#!/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 deleted file mode 100644 index 3326329..0000000 --- a/FS/bin/freeside-radgroup +++ /dev/null @@ -1,76 +0,0 @@ -#!/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 deleted file mode 100644 index 54af9dd..0000000 --- a/FS/bin/freeside-reexport +++ /dev/null @@ -1,71 +0,0 @@ -#!/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 deleted file mode 100755 index 5829d44..0000000 --- a/FS/bin/freeside-reset-fixed +++ /dev/null @@ -1,69 +0,0 @@ -#!/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 deleted file mode 100644 index 1c2086e..0000000 --- a/FS/bin/freeside-selfservice-server +++ /dev/null @@ -1,272 +0,0 @@ -#!/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 ); - 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 deleted file mode 100755 index e50d516..0000000 --- a/FS/bin/freeside-selfservice-xmlrpcd +++ /dev/null @@ -1,351 +0,0 @@ -#!/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 deleted file mode 100644 index 708e2fa..0000000 --- a/FS/bin/freeside-setinvoice +++ /dev/null @@ -1,42 +0,0 @@ -#!/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 deleted file mode 100755 index 155c74a..0000000 --- a/FS/bin/freeside-setup +++ /dev/null @@ -1,167 +0,0 @@ -#!/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 deleted file mode 100755 index 441d50f..0000000 --- a/FS/bin/freeside-sqlradius-dedup-group +++ /dev/null @@ -1,82 +0,0 @@ -#!/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 deleted file mode 100644 index 7b2d04d..0000000 --- a/FS/bin/freeside-sqlradius-radacctd +++ /dev/null @@ -1,145 +0,0 @@ -#!/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 deleted file mode 100755 index a77bad6..0000000 --- a/FS/bin/freeside-sqlradius-reset +++ /dev/null @@ -1,118 +0,0 @@ -#!/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 deleted file mode 100644 index 9999cbb..0000000 --- a/FS/bin/freeside-sqlradius-seconds +++ /dev/null @@ -1,58 +0,0 @@ -#!/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 deleted file mode 100755 index ad85630..0000000 --- a/FS/bin/freeside-sqlradius-set-lastlog +++ /dev/null @@ -1,102 +0,0 @@ -#!/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-upgrade b/FS/bin/freeside-upgrade deleted file mode 100755 index aca545b..0000000 --- a/FS/bin/freeside-upgrade +++ /dev/null @@ -1,296 +0,0 @@ -#!/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_'; - -} - -# 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 deleted file mode 100755 index 8c1f3db..0000000 --- a/FS/bin/freeside-void-payments +++ /dev/null @@ -1,239 +0,0 @@ -#!/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 deleted file mode 100755 index 70f0df9..0000000 --- a/FS/bin/freeside-wipe-cvv +++ /dev/null @@ -1,87 +0,0 @@ -#!/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 deleted file mode 100644 index d113799..0000000 --- a/FS/bin/freeside-yori +++ /dev/null @@ -1,16 +0,0 @@ -#!/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; |