summaryrefslogtreecommitdiff
path: root/FS/bin
diff options
context:
space:
mode:
Diffstat (limited to 'FS/bin')
-rw-r--r--FS/bin/freeside-addoutsource24
-rw-r--r--FS/bin/freeside-addoutsourceuser15
-rw-r--r--FS/bin/freeside-adduser63
-rwxr-xr-xFS/bin/freeside-apply-credits21
-rwxr-xr-xFS/bin/freeside-bill128
-rwxr-xr-xFS/bin/freeside-count-active-customers17
-rwxr-xr-xFS/bin/freeside-daily215
-rw-r--r--FS/bin/freeside-deloutsource11
-rw-r--r--FS/bin/freeside-deloutsourceuser6
-rw-r--r--FS/bin/freeside-deluser64
-rwxr-xr-xFS/bin/freeside-email59
-rwxr-xr-xFS/bin/freeside-expiration-alerter226
-rw-r--r--FS/bin/freeside-prepaidd75
-rw-r--r--FS/bin/freeside-queued253
-rw-r--r--FS/bin/freeside-radgroup76
-rw-r--r--FS/bin/freeside-reexport71
-rw-r--r--FS/bin/freeside-selfservice-server222
-rw-r--r--FS/bin/freeside-setinvoice42
-rwxr-xr-xFS/bin/freeside-setup182
-rw-r--r--FS/bin/freeside-sqlradius-radacctd150
-rwxr-xr-xFS/bin/freeside-sqlradius-reset88
-rw-r--r--FS/bin/freeside-sqlradius-seconds58
-rwxr-xr-xFS/bin/freeside-upgrade131
23 files changed, 2197 insertions, 0 deletions
diff --git a/FS/bin/freeside-addoutsource b/FS/bin/freeside-addoutsource
new file mode 100644
index 000000000..db4e7a307
--- /dev/null
+++ b/FS/bin/freeside-addoutsource
@@ -0,0 +1,24 @@
+#!/bin/sh
+
+domain=$1
+
+createdb $domain && \
+\
+mkdir /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain && \
+\
+chown freeside /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain && \
+\
+cp /home/ivan/freeside/conf/[a-z]* /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain && \
+\
+touch /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain/secrets && \
+\
+chown freeside /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain/secrets && \
+\
+chmod 600 /usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain/secrets && \
+\
+echo -e "DBI:Pg:dbname=$domain\nfreeside\n" >/usr/local/etc/freeside/conf.DBI:Pg:dbname=$domain/secrets && \
+\
+mkdir /usr/local/etc/freeside/counters.DBI:Pg:dbname=$domain && \
+mkdir /usr/local/etc/freeside/cache.DBI:Pg:dbname=$domain && \
+mkdir /usr/local/etc/freeside/export.DBI:Pg:dbname=$domain
+
diff --git a/FS/bin/freeside-addoutsourceuser b/FS/bin/freeside-addoutsourceuser
new file mode 100644
index 000000000..cad07f1fd
--- /dev/null
+++ b/FS/bin/freeside-addoutsourceuser
@@ -0,0 +1,15 @@
+#!/bin/sh
+
+username=$1
+domain=$2
+password=$3
+
+freeside-adduser -h /usr/local/etc/freeside/htpasswd \
+ -s conf.DBI:Pg:dbname=$domain/secrets \
+ -b \
+ $username $password 2>/dev/null
+
+[ -e /usr/local/etc/freeside/dbdef.DBI:Pg:dbname=$domain ] \
+ || ( freeside-setup -s $username 2>/dev/null; \
+ /home/ivan/freeside/bin/populate-msgcat $username 2>/dev/null )
+
diff --git a/FS/bin/freeside-adduser b/FS/bin/freeside-adduser
new file mode 100644
index 000000000..c3ee05b9b
--- /dev/null
+++ b/FS/bin/freeside-adduser
@@ -0,0 +1,63 @@
+#!/usr/bin/perl -w
+#
+# $Id: freeside-adduser,v 1.8 2002-09-27 05:36:29 ivan Exp $
+
+use strict;
+use vars qw($opt_h $opt_b $opt_c $opt_s);
+use Fcntl qw(:flock);
+use Getopt::Std;
+
+my $FREESIDE_CONF = "/usr/local/etc/freeside";
+
+getopts("bch:s:");
+die &usage if $opt_c && ! $opt_h;
+my $user = shift or die &usage;
+
+if ( $opt_h ) {
+ my @args = ( 'htpasswd' );
+ push @args, '-b' if $opt_b;
+ push @args, '-c' if $opt_c;
+ push @args, $opt_h, $user;
+ push @args, shift if $opt_b;
+ system(@args) == 0 or die "htpasswd failed: $?";
+}
+
+my $secretfile = $opt_s || 'secrets';
+
+open(MAPSECRETS,">>$FREESIDE_CONF/mapsecrets")
+ and flock(MAPSECRETS,LOCK_EX)
+ or die "can't open $FREESIDE_CONF/mapsecrets: $!";
+print MAPSECRETS "$user $secretfile\n";
+close MAPSECRETS or die "can't close $FREESIDE_CONF/mapsecrets: $!";
+
+sub usage {
+ die "Usage:\n\n freeside-adduser [ -h htpasswd_file [ -c ] [ -b ] ] [ -s secretfile ] username"
+}
+
+=head1 NAME
+
+freeside-adduser - Command line interface to add (freeside) users.
+
+=head1 SYNOPSIS
+
+ freeside-adduser [ -h htpasswd_file [ -c ] ] [ -s secretfile ] 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 call htpasswd for this user with the given filename
+
+ -c: Passed to htpasswd(1)
+
+ -s: Specify an alternate secret file
+
+ -b: same as htpasswd(1), probably insecure, not recommended
+
+=head1 SEE ALSO
+
+L<htpasswd>(1), base Freeside documentation
+
+=cut
+
diff --git a/FS/bin/freeside-apply-credits b/FS/bin/freeside-apply-credits
new file mode 100755
index 000000000..ea6a7bdd0
--- /dev/null
+++ b/FS/bin/freeside-apply-credits
@@ -0,0 +1,21 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use vars qw( $user $cust_main @customers );
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_main;
+
+$user = shift or die &usage;
+&adminsuidsetup( $user );
+
+my @customers = qsearch('cust_main', {} );
+die "No customers" unless (scalar(@customers) > 0);
+
+foreach $cust_main (@customers) {
+ print "Applying credits for customer #". $cust_main->custnum;
+ $cust_main->apply_credits;
+}
+
+
+
diff --git a/FS/bin/freeside-bill b/FS/bin/freeside-bill
new file mode 100755
index 000000000..49ad4a768
--- /dev/null
+++ b/FS/bin/freeside-bill
@@ -0,0 +1,128 @@
+#!/usr/bin/perl -w
+# don't take any world-facing input
+#!/usr/bin/perl -Tw
+
+use strict;
+use Fcntl qw(:flock);
+use Date::Parse;
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_main;
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw($opt_a $opt_c $opt_d $opt_p);
+getopts("acd:p");
+my $user = shift or die &usage;
+
+adminsuidsetup $user;
+
+my %bill_only = map { $_ => 1 } (
+ @ARGV ? @ARGV : ( map $_->custnum, qsearch('cust_main', {} ) )
+);
+
+#we're at now now (and later).
+my($time)= $opt_d ? str2time($opt_d) : $^T;
+
+# find packages w/ bill < time && cancel != '', and create corresponding
+# customer objects
+
+my($cust_main,%saw);
+foreach $cust_main (
+ map {
+ unless ( exists $saw{ $_->custnum } && defined $saw{ $_->custnum} ) {
+ $saw{ $_->custnum } = 0; # to avoid 'use of uninitialized value' errors
+ }
+ if (
+ ( $opt_a || ( ( $_->getfield('bill') || 0 ) <= $time ) )
+ && $bill_only{ $_->custnum }
+ && !$saw{ $_->custnum }++
+ ) {
+ qsearchs('cust_main',{'custnum'=> $_->custnum } );
+ } else {
+ ();
+ }
+ } ( qsearch('cust_pkg', { 'cancel' => '' }),
+ qsearch('cust_pkg', { 'cancel' => 0 }),
+ )
+) {
+
+ # and bill them
+
+ print "Billing customer #" . $cust_main->getfield('custnum') . "\n";
+
+ my($error);
+
+ $error=$cust_main->bill('time'=>$time);
+ warn "Error billing, customer #" . $cust_main->getfield('custnum') .
+ ":" . $error if $error;
+
+ if ($opt_p) {
+ $cust_main->apply_payments;
+ $cust_main->apply_credits;
+ }
+
+ if ($opt_c) {
+ $error=$cust_main->collect( 'invoice_time' => $time);
+ warn "Error collecting from customer #" . $cust_main->custnum. ":$error"
+ if $error;
+
+ #sleep 1;
+ }
+
+}
+
+# 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-bill [ -c [ -p ] ] [ -d 'date' ] user [ custnum custnum ... ]\n";
+}
+
+=head1 NAME
+
+freeside-bill - Command line (crontab, script) interface to customer billing.
+
+=head1 SYNOPSIS
+
+ freeside-bill [ -c [ -p ] [ -a ] ] [ -d 'date' ] user [ custnum custnum ... ]
+
+=head1 DESCRIPTION
+
+This script is deprecated in 1.4.0. You should use freeside-daily instead.
+
+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>.
+
+ -c: Turn on collecting (you probably want this).
+
+ -p: Apply unapplied payments and credits before collecting (you probably want
+ this too)
+
+ -a: Call collect even if there isn't a new invoice (probably a bad idea for
+ daily use)
+
+ -d: Pretend it's 'date'. Date is in any format Date::Parse is happy with,
+ but be careful.
+
+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<freeside-daily>, L<FS::cust_main>, config.html from the base documentation
+
+=cut
+
diff --git a/FS/bin/freeside-count-active-customers b/FS/bin/freeside-count-active-customers
new file mode 100755
index 000000000..759085a73
--- /dev/null
+++ b/FS/bin/freeside-count-active-customers
@@ -0,0 +1,17 @@
+#!/bin/sh
+
+domain=$1
+
+echo "\t
+select count(*) from cust_main where
+ 0 < ( SELECT COUNT(*) FROM cust_pkg
+ WHERE cust_pkg.custnum = cust_main.custnum
+ AND ( cust_pkg.cancel IS NULL
+ OR cust_pkg.cancel = 0
+ )
+ )
+ OR 0 = ( SELECT COUNT(*) FROM cust_pkg
+ WHERE cust_pkg.custnum = cust_main.custnum
+ );
+" | psql -U freeside -q $domain | head -1
+
diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily
new file mode 100755
index 000000000..603da12b8
--- /dev/null
+++ b/FS/bin/freeside-daily
@@ -0,0 +1,215 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Fcntl qw(:flock);
+use Date::Parse;
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup driver_name dbh datasrc);
+use FS::Record qw(qsearch qsearchs dbdef);
+use FS::Conf;
+use FS::cust_main;
+
+&untaint_argv; #what it sounds like (eww)
+use vars qw($opt_d $opt_v $opt_p $opt_a $opt_s $opt_y);
+getopts("p:a:d:vsy:");
+my $user = shift or die &usage;
+
+adminsuidsetup $user;
+
+$FS::cust_main::DEBUG = 1 if $opt_v;
+
+my %search = ();
+$search{'payby'} = $opt_p if $opt_p;
+$search{'agentnum'} = $opt_a if $opt_a;
+
+#we're at now now (and later).
+my($time)= $opt_d ? str2time($opt_d) : $^T;
+$time += $opt_y * 86400 if $opt_y;
+
+# select * from cust_main where
+my $where_pkg = <<"END";
+ 0 < ( select count(*) from cust_pkg
+ where cust_main.custnum = cust_pkg.custnum
+ and ( cancel is null or cancel = 0 )
+ and ( setup is null or setup = 0
+ or bill is null or bill <= $time
+ or ( expire is not null and expire <= $^T )
+ )
+ )
+END
+
+# or
+my $where_bill_event = <<"END";
+ 0 < ( select count(*) from cust_bill
+ where cust_main.custnum = cust_bill.custnum
+ and 0 < charged
+ - coalesce(
+ ( select sum(amount) from cust_bill_pay
+ where cust_bill.invnum = cust_bill_pay.invnum )
+ ,0
+ )
+ - coalesce(
+ ( select sum(amount) from cust_credit_bill
+ where cust_bill.invnum = cust_credit_bill.invnum )
+ ,0
+ )
+ and 0 < ( select count(*) from part_bill_event
+ where payby = cust_main.payby
+ and ( disabled is null or disabled = '' )
+ and seconds <= $time - cust_bill._date
+ and 0 = ( select count(*) from cust_bill_event
+ where cust_bill.invnum = cust_bill_event.invnum
+ and part_bill_event.eventpart = cust_bill_event.eventpart
+ and status = 'done'
+ )
+
+ )
+ )
+END
+
+my $extra_sql = ( scalar(%search) ? ' AND ' : ' WHERE ' ). "( $where_pkg OR $where_bill_event )";
+
+my @cust_main;
+if ( @ARGV ) {
+ @cust_main = map { qsearchs('cust_main', { custnum => $_, %search } ) } @ARGV
+} else {
+ @cust_main = qsearch('cust_main', \%search, '', $extra_sql );
+}
+;
+
+my($cust_main,%saw);
+foreach $cust_main ( @cust_main ) {
+
+ # $^T not $time because -d is for pre-printing invoices
+ foreach my $cust_pkg (
+ grep { $_->expire && $_->expire <= $^T } $cust_main->ncancelled_pkgs
+ ) {
+ my $error = $cust_pkg->cancel;
+ warn "Error cancelling expired pkg ". $cust_pkg->pkgnum. " for custnum ".
+ $cust_main->custnum. ": $error"
+ if $error;
+ }
+ # $^T not $time because -d is for pre-printing invoices
+ foreach my $cust_pkg (
+ grep { $_->part_pkg->is_prepaid
+ && $_->bill && $_->bill < $^T && ! $_->susp
+ }
+ $cust_main->ncancelled_pkgs
+ ) {
+ my $error = $cust_pkg->suspend;
+ warn "Error suspending package ". $cust_pkg->pkgnum.
+ " for custnum ". $cust_main->custnum.
+ ": $error"
+ if $error;
+ }
+
+ my $error = $cust_main->bill( 'time' => $time,
+ 'resetup' => $opt_s, );
+ warn "Error billing, custnum ". $cust_main->custnum. ": $error" if $error;
+
+ $cust_main->apply_payments;
+ $cust_main->apply_credits;
+
+ $error = $cust_main->collect( 'invoice_time' => $time );
+ warn "Error collecting, custnum". $cust_main->custnum. ": $error" if $error;
+
+}
+
+if ( driver_name eq 'Pg' ) {
+ dbh->{AutoCommit} = 1; #so we can vacuum
+ foreach my $table ( dbdef->tables ) {
+ my $sth = dbh->prepare("VACUUM ANALYZE $table") or die dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ }
+}
+
+my $conf = new FS::Conf;
+my $dest = $conf->config('dump-scpdest');
+if ( $dest ) {
+ datasrc =~ /dbname=([\w\.]+)$/ or die "unparsable datasrc ". datasrc;
+ my $database = $1;
+ eval "use Net::SCP qw(scp);";
+ if ( driver_name eq 'Pg' ) {
+ system("pg_dump $database >/var/tmp/$database.sql")
+ } else {
+ die "database dumps not yet supported for ". driver_name;
+ }
+ if ( $conf->config('dump-pgpid') ) {
+ eval 'use GnuPG';
+ my $gpg = new GnuPG;
+ $gpg->encrypt( plaintext => "/var/tmp/$database.sql",
+ output => "/var/tmp/$database.gpg",
+ recipient => $conf->config('dump-pgpid'),
+ );
+ chmod 0600, '/var/tmp/$database.gpg';
+ scp("/var/tmp/$database.gpg", $dest);
+ unlink "/var/tmp/$database.gpg" or die $!;
+ } else {
+ chmod 0600, '/var/tmp/$database.sql';
+ scp("/var/tmp/$database.sql", $dest);
+ }
+ unlink "/var/tmp/$database.sql" or die $!;
+}
+
+# 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' ] user [ custnum custnum ... ]\n";
+}
+
+=head1 NAME
+
+freeside-daily - Run daily billing and invoice collection events.
+
+=head1 SYNOPSIS
+
+ freeside-daily [ -d 'date' ] [ -y days ] [ -p 'payby' ] [ -a agentnum ] [ -s ] [ -v ] user [ custnum custnum ... ]
+
+=head1 DESCRIPTION
+
+Bills customers and runs invoice collection events. Should be run from
+crontab daily.
+
+This script replaces freeside-bill from 1.3.1.
+
+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 (I<CARD>, I<DCRD>, I<CHEK>, I<DCHK>, I<BILL>, I<COMP>, I<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 BUGS
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, config.html from the base documentation
+
+=cut
+
diff --git a/FS/bin/freeside-deloutsource b/FS/bin/freeside-deloutsource
new file mode 100644
index 000000000..561853539
--- /dev/null
+++ b/FS/bin/freeside-deloutsource
@@ -0,0 +1,11 @@
+#!/bin/sh
+
+domain=$1
+
+dropdb $domain && \
+rm -rf /usr/local/etc/freeside/conf.DBI:Pg:host=localhost\;dbname=$domain && \
+rm -rf /usr/local/etc/freeside/counters.DBI:Pg:host=localhost\;dbname=$domain && \
+rm -rf /usr/local/etc/freeside/cache.DBI:Pg:host=localhost\;dbname=$domain && \
+rm -rf /usr/local/etc/freeside/export.DBI:Pg:host=localhost\;dbname=$domain && \
+rm /usr/local/etc/freeside/dbdef.DBI:Pg:host=localhost\;dbname=$domain
+
diff --git a/FS/bin/freeside-deloutsourceuser b/FS/bin/freeside-deloutsourceuser
new file mode 100644
index 000000000..96871e50c
--- /dev/null
+++ b/FS/bin/freeside-deloutsourceuser
@@ -0,0 +1,6 @@
+#!/bin/sh
+
+username=$1
+
+freeside-deluser -h /usr/local/etc/freeside/htpasswd $username 2>/dev/null
+
diff --git a/FS/bin/freeside-deluser b/FS/bin/freeside-deluser
new file mode 100644
index 000000000..57d6ce165
--- /dev/null
+++ b/FS/bin/freeside-deluser
@@ -0,0 +1,64 @@
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw($opt_h);
+use Fcntl qw(:flock);
+use Getopt::Std;
+
+my $FREESIDE_CONF = "/usr/local/etc/freeside";
+
+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-email b/FS/bin/freeside-email
new file mode 100755
index 000000000..400dc2ac7
--- /dev/null
+++ b/FS/bin/freeside-email
@@ -0,0 +1,59 @@
+#!/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 VERSION
+
+$Id: freeside-email,v 1.2 2002-09-18 22:50:44 ivan Exp $
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+=cut
+
diff --git a/FS/bin/freeside-expiration-alerter b/FS/bin/freeside-expiration-alerter
new file mode 100755
index 000000000..691fd3aa5
--- /dev/null
+++ b/FS/bin/freeside-expiration-alerter
@@ -0,0 +1,226 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use Date::Format;
+use Time::Local;
+use Text::Template;
+use Getopt::Std;
+use Net::SMTP;
+use Mail::Header;
+use Mail::Internet;
+use FS::Conf;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_main;
+
+use vars qw($smtpmachine @body);
+
+#hush, perl!
+$FS::alerter::_template::first = "";
+$FS::alerter::_template::last = "";
+$FS::alerter::_template::company = "";
+$FS::alerter::_template::payby = "";
+$FS::alerter::_template::expdate = "";
+
+# Set the mail program and other variables
+my $mail_sender = "billing\@mydomain.tld"; # or invoice_from if available
+my $failure_recipient = "postmaster"; # or invoice_from if available
+my $warning_time = 30 * 24 * 60 * 60;
+my $urgent_time = 15 * 24 * 60 * 60;
+my $panic_time = 5 * 24 * 60 * 60;
+my $window_time = 24 * 60 * 60;
+
+&untaint_argv; #what it sounds like (eww)
+
+#we're at now now (and later).
+my($_date)= $^T;
+
+# Get the current month
+my ($sec,$min,$hour,$mday,$mon,$year) =
+ (localtime($_date) )[0,1,2,3,4,5];
+$mon++;
+
+# Login to the database
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+# Get the needed configuration files
+my $conf = new FS::Conf;
+$smtpmachine = $conf->config('smtpmachine');
+$mail_sender = $conf->config('invoice_from')
+ if $conf->exists('invoice_from');
+$failure_recipient = $conf->config('invoice_from')
+ if $conf->exists('invoice_from');
+
+
+my(@customers)=qsearch('cust_main',{});
+if (scalar(@customers) == 0)
+{
+ exit 1;
+}
+
+# Prepare for sending email
+
+$ENV{MAILADDRESS} = $mail_sender;
+my $header = new Mail::Header ( [
+ "From: Account Processor",
+ "To: $failure_recipient",
+ "Sender: $mail_sender",
+ "Reply-To: $mail_sender",
+ "Subject: Unnotified Billing Arrangement Expirations",
+] );
+
+my @alerter_template = $conf->config('alerter_template')
+ or die "cannot load config file alerter_template";
+
+my $alerter = new Text::Template (TYPE => 'ARRAY', SOURCE => [ map "$_\n", @alerter_template ])
+ or die "can't create new Text::Template object: Text::Template::ERROR";
+$alerter->compile() or die "can't compile template: Text::Template::ERROR";
+
+# Now I can start looping
+foreach my $customer (@customers)
+{
+ my $paydate = $customer->getfield('paydate');
+ next if $paydate =~ /^\s*$/; #skip empty expiration dates
+
+ my $custnum = $customer->getfield('custnum');
+ my $first = $customer->getfield('first');
+ my $last = $customer->getfield('last');
+ my $company = $customer->getfield('company');
+ my $payby = $customer->getfield('payby');
+ my $payinfo = $customer->getfield('payinfo');
+ my $daytime = $customer->getfield('daytime');
+ my $night = $customer->getfield('night');
+
+ my ($payyear,$paymonth,$payday) = split (/-/,$paydate);
+
+ my $expire_time = timelocal(0,0,0,$payday,--$paymonth,$payyear);
+
+ #credit cards expire at the end of the month/year of their exp date
+ if ($payby eq 'CARD' || $payby eq 'DCRD') {
+ ($paymonth < 11) ? $paymonth++ : ($paymonth=0, $payyear++);
+ $expire_time = timelocal(0,0,0,$payday,$paymonth,$payyear);
+ $expire_time--;
+ }
+
+ if (($expire_time < $_date + $warning_time &&
+ $expire_time > $_date + $warning_time - $window_time) ||
+ ($expire_time < $_date + $urgent_time &&
+ $expire_time > $_date + $urgent_time - $window_time) ||
+ ($expire_time < $_date + $panic_time &&
+ $expire_time > $_date + $panic_time - $window_time)) {
+
+
+
+ my @packages = $customer->ncancelled_pkgs;
+ if (scalar(@packages) != 0) {
+ my @invoicing_list = $customer->invoicing_list;
+ if ( grep { $_ ne 'POST' } @invoicing_list ) {
+ my $header = new Mail::Header ( [
+ "From: $mail_sender",
+ "To: ". join(', ', grep { $_ ne 'POST' } @invoicing_list ),
+ "Sender: $mail_sender",
+ "Reply-To: $mail_sender",
+ "Date: ". time2str("%a, %d %b %Y %X %z", time),
+ "Subject: Billing Arrangement Expiration",
+ ] );
+ $FS::alerter::_template::first = $first;
+ $FS::alerter::_template::last = $last;
+ $FS::alerter::_template::company = $company;
+ if ($payby eq 'CARD' || $payby eq 'DCRD') {
+ $FS::alerter::_template::payby = "credit card (" .
+ substr($payinfo, 0, 2) . "xxxxxxxxxx" .
+ substr($payinfo, -4) . ")";
+ }elsif ($payby eq 'COMP') {
+ $FS::alerter::_template::payby = "complimentary account";
+ }else{
+ $FS::alerter::_template::payby = "current method";
+ }
+ $FS::alerter::_template::expdate = $expire_time;
+
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ $alerter->fill_in( PACKAGE => 'FS::alerter::_template' ) ],
+ );
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or die "Can't send expiration email: $!";
+
+ } elsif ( ! @invoicing_list || grep { $_ eq 'POST' } @invoicing_list ) {
+ push @body, sprintf(qq{%5d %-32.32s %4s %10s %12s %12s},
+ $custnum,
+ $first . " " . $last . " " . $company,
+ $payby,
+ $paydate,
+ $daytime,
+ $night);
+ }
+ }
+ }
+}
+
+# Now I need to send EMAIL
+if (scalar(@body)) {
+ my $message = new Mail::Internet (
+ 'Header' => $header,
+ 'Body' => [ (@body) ],
+ );
+ $!=0;
+ $message->smtpsend( Host => $smtpmachine )
+ or $message->smtpsend( Host => $smtpmachine, Debug => 1 )
+ or die "can't send alerter failure email to $failure_recipient".
+ " via server $smtpmachine with SMTP: $!";
+}
+
+# subroutines
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ $ARGV[$_] =~ /^([\w\-\/]*)$/ || die "Illegal argument \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-expiration-alerter user\n";
+}
+
+=head1 NAME
+
+freeside-expiration-alerter - Emails notifications of credit card expirations.
+
+=head1 SYNOPSIS
+
+ freeside-expiration-alerter user
+
+=head1 DESCRIPTION
+
+Emails customers notice that their credit card or other billing arrangement
+is about to expire. Usually run as a cron job.
+
+user: From the mapsecrets file - see config.html from the base documentation
+
+=head1 VERSION
+
+$Id: freeside-expiration-alerter,v 1.5 2003-04-21 20:53:57 ivan Exp $
+
+=head1 BUGS
+
+Yes..... Use at your own risk. No guarantees or warrantees of any
+kind apply to this program. Parts of this program are hacked from
+other GNU licensed software created mainly by Ivan Kohler.
+
+This is released under the GNU Public License. See www.gnu.org
+for more information regarding this license.
+
+=head1 SEE ALSO
+
+L<FS::cust_main>, config.html from the base documentation
+
+=head1 AUTHOR
+
+Jeff Finucane <jeff@cmh.net>
+
+=cut
+
+
diff --git a/FS/bin/freeside-prepaidd b/FS/bin/freeside-prepaidd
new file mode 100644
index 000000000..e51a56350
--- /dev/null
+++ b/FS/bin/freeside-prepaidd
@@ -0,0 +1,75 @@
+#!/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( "/usr/local/etc/freeside/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 $error = $cust_pkg->suspend;
+ warn "Error suspended package ". $cust_pkg->pkgnum.
+ " for custnum ". $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 suspendes any prepaid customer packages which have
+passed their renewal date (next bill date).
+
+=head1 SEE ALSO
+
+=cut
+
+1;
diff --git a/FS/bin/freeside-queued b/FS/bin/freeside-queued
new file mode 100644
index 000000000..3a0a9b4e5
--- /dev/null
+++ b/FS/bin/freeside-queued
@@ -0,0 +1,253 @@
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw( $DEBUG $kids $max_kids %kids );
+use POSIX qw(:sys_wait_h);
+use IO::File;
+use FS::UID qw(adminsuidsetup forksuidsetup driver_name dbh myconnect);
+use FS::Daemon qw(daemonize1 drop_root logfile daemonize2 sigint sigterm);
+use FS::Record qw(qsearch qsearchs);
+use FS::queue;
+use FS::queue_depend;
+
+# no autoloading just yet
+use FS::cust_main;
+use FS::svc_acct;
+use Net::SSH 0.07;
+use FS::part_export;
+
+$DEBUG = 0;
+
+$max_kids = '10'; #guess it should be a config file...
+$kids = 0;
+
+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( "/usr/local/etc/freeside/queuelog.". $FS::UID::datasrc );
+
+warn "completing daemonization (detaching))\n" if $DEBUG;
+daemonize2();
+
+#--
+
+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;
+
+ #assuming mysql 4.1 w/subqueries now
+ #my $nodepend = driver_name eq 'mysql'
+ # ? ''
+ # : 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'.
+ # ' WHERE queue_depend.jobnum = queue.jobnum ) ';
+ my $nodepend = 'AND 0 = ( SELECT COUNT(*) FROM queue_depend'.
+ ' WHERE queue_depend.jobnum = queue.jobnum ) ';
+
+ my $job = qsearchs(
+ 'queue',
+ { 'status' => 'new' },
+ '',
+ driver_name eq 'mysql'
+ ? "$nodepend ORDER BY jobnum LIMIT 1 FOR UPDATE"
+ : "$nodepend ORDER BY jobnum FOR UPDATE LIMIT 1"
+ ) or do {
+ # if $oldAutoCommit {
+ dbh->commit or do {
+ warn "WARNING: database error, closing connection: ". dbh->errstr;
+ undef $FS::UID::dbh;
+ next;
+ };
+ # }
+ sleep 5; #connecting to db is expensive
+ next;
+ };
+
+ #assuming mysql 4.1 w/subqueries now
+ #if ( driver_name eq 'mysql'
+ # && qsearch('queue_depend', { 'jobnum' => $job->jobnum } ) ) {
+ # dbh->commit or die dbh->errstr; #if $oldAutoCommit;
+ # sleep 5; #would be better if mysql could do everything in query above
+ # next;
+ #}
+
+ my %hash = $job->hash;
+ $hash{'status'} = 'locked';
+ my $ljob = new FS::queue ( \%hash );
+ my $error = $ljob->replace($job);
+ if ( $error ) {
+ warn "WARNING: database error locking job, closing connection: ".
+ dbh->errstr;
+ undef $FS::UID::dbh;
+ next;
+ }
+
+ # if $oldAutoCommit {
+ dbh->commit or do {
+ warn "WARNING: database error, closing connection: ". dbh->errstr;
+ undef $FS::UID::dbh;
+ next;
+ };
+ # }
+
+ $FS::UID::AutoCommit = 1;
+ #}
+
+ my @args = $ljob->args;
+ splice @args, 0, 1, $ljob if $args[0] eq '_JOB';
+
+ defined( my $pid = fork ) or do {
+ warn "WARNING: can't fork: $!\n";
+ my %hash = $job->hash;
+ $hash{'status'} = 'failed';
+ $hash{'statustext'} = "[freeside-queued] can't fork: $!";
+ my $ljob = new FS::queue ( \%hash );
+ my $error = $ljob->replace($job);
+ die $error if $error;
+ next; #don't increment the kid counter
+ };
+
+ if ( $pid ) {
+ $kids++;
+ $kids{$pid} = 1;
+ } else { #kid time
+
+ #get new db handle
+ $FS::UID::dbh->{InactiveDestroy} = 1;
+
+ forksuidsetup($user);
+
+ #auto-use classes...
+ #if ( $ljob->job =~ /(FS::part_export::\w+)::/ ) {
+ if ( $ljob->job =~ /(FS::part_export::\w+)::/
+ || $ljob->job =~ /(FS::\w+)::/
+ )
+ {
+ my $class = $1;
+ eval "use $class;";
+ if ( $@ ) {
+ warn "job use $class failed";
+ my %hash = $ljob->hash;
+ $hash{'status'} = 'failed';
+ $hash{'statustext'} = $@;
+ my $fjob = new FS::queue( \%hash );
+ my $error = $fjob->replace($ljob);
+ die $error if $error;
+ exit; #end-of-kid
+ };
+ }
+
+ my $eval = "&". $ljob->job. '(@args);';
+ warn 'running "&'. $ljob->job. '('. join(', ', @args). ")\n" if $DEBUG;
+ eval $eval; #throw away return value? suppose so
+ if ( $@ ) {
+ warn "job $eval failed";
+ my %hash = $ljob->hash;
+ $hash{'status'} = 'failed';
+ $hash{'statustext'} = $@;
+ my $fjob = new FS::queue( \%hash );
+ my $error = $fjob->replace($ljob);
+ die $error if $error;
+ } else {
+ $ljob->delete;
+ }
+
+ exit;
+ #end-of-kid
+ }
+
+} continue {
+ if ( sigterm() ) {
+ warn "received TERM signal; exiting\n";
+ exit;
+ }
+ if ( sigint() ) {
+ warn "received INT signal; exiting\n";
+ exit;
+ }
+}
+
+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 user
+
+=head1 DESCRIPTION
+
+Job queue daemon. Should be running at all times.
+
+user: from the mapsecrets file - see config.html from the base documentation
+
+=head1 VERSION
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+=cut
+
diff --git a/FS/bin/freeside-radgroup b/FS/bin/freeside-radgroup
new file mode 100644
index 000000000..ed85626d2
--- /dev/null
+++ b/FS/bin/freeside-radgroup
@@ -0,0 +1,76 @@
+#!/usr/bin/perl -w
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch);
+use FS::cust_svc;
+use FS::svc_acct;
+
+&untaint_argv; #what it sounds like (eww)
+
+my($user, $action, $groupname, $svcpart) = @ARGV;
+
+adminsuidsetup $user;
+
+my @svc_acct = map { $_->svc_x } qsearch('cust_svc', { svcpart => $svcpart } );
+
+if ( lc($action) eq 'add' ) {
+ foreach my $svc_acct ( @svc_acct ) {
+ my @groups = $svc_acct->radius_groups;
+ next if grep { $_ eq $groupname } @groups;
+ push @groups, $groupname;
+ my %hash = $svc_acct->hash;
+ $hash{usergroup} = \@groups;
+ my $new = new FS::svc_acct \%hash;
+ my $error = $new->replace($svc_acct);
+ die $error if $error;
+ }
+} else {
+ die &usage;
+}
+
+# subroutines
+
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-radgroup user action groupname svcpart\n";
+}
+
+=head1 NAME
+
+freeside-radgroup - Command line utility to manipulate radius groups
+
+=head1 SYNOPSIS
+
+ freeside-addgroup user action groupname svcpart
+
+=head1 DESCRIPTION
+
+ B<user> is a freeside user as added with freeside-adduser.
+
+ B<command> is the action to take. Available actions are: I<add>
+
+ B<groupname> is the group to add (or remove, etc.)
+
+ B<svcpart> specifies which accounts will be updated.
+
+=head1 EXAMPLES
+
+freeside-radgroup freesideuser add groupname 3
+
+Adds I<groupname> to all accounts with service definition 3.
+
+=head1 BUGS
+
+=head1 SEE ALSO
+
+L<freeside-adduser>, L<FS::svc_acct>, L<FS::part_svc>
+
+=cut
+
diff --git a/FS/bin/freeside-reexport b/FS/bin/freeside-reexport
new file mode 100644
index 000000000..54af9dd80
--- /dev/null
+++ b/FS/bin/freeside-reexport
@@ -0,0 +1,71 @@
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw($opt_s $opt_u $opt_p);
+use Getopt::Std;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearch qsearchs);
+use FS::part_export;
+use FS::svc_acct;
+use FS::cust_svc;
+
+my $user = shift or die &usage;
+adminsuidsetup $user;
+
+my $export_x = shift or die &usage;
+my @part_export;
+if ( $export_x =~ /^(\d+)$/ ) {
+ @part_export = qsearchs('part_export', { exportnum=>$1 } )
+ or die "exportnum $export_x not found\n";
+} else {
+ @part_export = qsearch('part_export', { exporttype=>$export_x } )
+ or die "no exports of type $export_x found\n";
+}
+
+getopts('s:u:p:');
+
+my @svc_x = ();
+if ( $opt_s ) {
+ my $cust_svc = qsearchs('cust_svc', { svcnum=>$opt_s } )
+ or die "svcnum $opt_s not found\n";
+ push @svc_x, $cust_svc->svc_x;
+} elsif ( $opt_u ) {
+ my $svc_x = qsearchs('svc_acct', { username=>$opt_u } )
+ or die "username $opt_u not found\n";
+ push @svc_x, $svc_x;
+} elsif ( $opt_p ) {
+ push @svc_x, map { $_->svc_x } qsearch('cust_svc', { svcpart=>$opt_p } );
+ die "no services with svcpart $opt_p found\n" unless @svc_x;
+}
+
+foreach my $part_export ( @part_export ) {
+ foreach my $svc_x ( @svc_x ) {
+ my $error = $part_export->export_insert($svc_x);
+ die $error if $error;
+ }
+}
+
+
+sub usage {
+ die "Usage:\n\n freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ]\n";
+}
+
+=head1 NAME
+
+freeside-reexport - Command line tool to re-trigger export jobs for existing services
+
+=head1 SYNOPSIS
+
+ freeside-reexport user exportnum|exporttype [ -s svcnum | -u username | -p svcpart ]
+
+=head1 DESCRIPTION
+
+ Re-queues the export job for the specified exportnum or exporttype(s) and
+ specified service (selected by svcnum or username).
+
+=head1 SEE ALSO
+
+L<freeside-sqlradius-reset>, L<FS::part_export>
+
+=cut
+
diff --git a/FS/bin/freeside-selfservice-server b/FS/bin/freeside-selfservice-server
new file mode 100644
index 000000000..c73349a60
--- /dev/null
+++ b/FS/bin/freeside-selfservice-server
@@ -0,0 +1,222 @@
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw( $Debug %kids $kids $max_kids $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;
+
+use FS::Conf;
+use FS::cust_bill;
+use FS::cust_pkg;
+
+$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 = "/usr/local/etc/freeside/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
+
+adminsuidsetup $user;
+
+#logfile("/usr/local/etc/freeside/selfservice.". $FS::UID::datasrc); #MACHINE
+logfile("/usr/local/etc/freeside/selfservice.$machine.log");
+
+daemonize2();
+
+
+my $conf = new FS::Conf;
+
+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 );
+ 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;
+ $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};
+ }
+ }
+ #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-setinvoice b/FS/bin/freeside-setinvoice
new file mode 100644
index 000000000..708e2fa30
--- /dev/null
+++ b/FS/bin/freeside-setinvoice
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+
+use strict;
+use FS::UID qw(adminsuidsetup);
+use FS::Conf;
+use FS::Record qw(qsearch qsearchs);
+use FS::cust_main;
+use FS::svc_acct;
+
+&untaint_argv; #what it sounds like (eww)
+my $user = shift or die &usage;
+
+adminsuidsetup $user;
+
+foreach my $cust_main (
+ grep { ! scalar($_->invoicing_list) }
+ qsearch( 'cust_main', {} )
+) {
+ my @dest;
+ my @cust_pkg = $cust_main->ncancelled_pkgs;
+ foreach my $cust_pkg ( @cust_pkg ) {
+ foreach my $cust_svc ( $cust_pkg->cust_svc ) {
+ my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $cust_svc->svcnum } );
+ push @dest, $svc_acct->svcnum if $svc_acct;
+ }
+ }
+ push @dest, 'POST' unless @dest;
+ $cust_main->invoicing_list(\@dest);
+}
+
+sub untaint_argv {
+ foreach $_ ( $[ .. $#ARGV ) { #untaint @ARGV
+ $ARGV[$_] =~ /^(.*)$/ || die "Illegal arguement \"$ARGV[$_]\"";
+ $ARGV[$_]=$1;
+ }
+}
+
+sub usage {
+ die "Usage:\n\n freeside-setinvoice user\n";
+}
+
+
diff --git a/FS/bin/freeside-setup b/FS/bin/freeside-setup
new file mode 100755
index 000000000..a16e51749
--- /dev/null
+++ b/FS/bin/freeside-setup
@@ -0,0 +1,182 @@
+#!/usr/bin/perl -Tw
+
+#to delay loading dbdef until we're ready
+BEGIN { $FS::Schema::setup_hack = 1; }
+
+use strict;
+use vars qw($opt_s);
+use Getopt::Std;
+use Locale::Country;
+use Locale::SubCountry;
+use FS::UID qw(adminsuidsetup datasrc checkeuid getsecrets);
+use FS::Schema qw( dbdef_dist reload_dbdef );
+use FS::Record;
+use FS::cust_main_county;
+#use FS::raddb;
+use FS::part_bill_event;
+
+die "Not running uid freeside!" unless checkeuid();
+
+#my %attrib2db =
+# map { lc($FS::raddb::attrib{$_}) => $_ } keys %FS::raddb::attrib;
+
+getopts("s");
+my $user = shift or die &usage;
+getsecrets($user);
+
+#needs to match FS::Record
+my($dbdef_file) = "/usr/local/etc/freeside/dbdef.". datasrc;
+
+###
+
+#print "\nEnter the maximum username length: ";
+#my($username_len)=&getvalue;
+my $username_len = 32; #usernamemax config file
+
+#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
+###
+
+my $dbdef = dbdef_dist;
+
+#important
+$dbdef->save($dbdef_file);
+&FS::Schema::reload_dbdef($dbdef_file);
+
+###
+# create 'em
+###
+
+my $dbh = adminsuidsetup $user;
+
+#create tables
+$|=1;
+
+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);
+
+#cust_main_county
+foreach my $country ( sort map uc($_), all_country_codes ) {
+
+ my $subcountry = eval { new Locale::SubCountry($country) };
+ my @states = $subcountry ? $subcountry->all_codes : undef;
+
+ if ( !scalar(@states) || ( scalar(@states) == 1 && !defined($states[0]) ) ) {
+
+ my $cust_main_county = new FS::cust_main_county({
+ 'tax' => 0,
+ 'country' => $country,
+ });
+ my $error = $cust_main_county->insert;
+ die $error if $error;
+
+ } else {
+
+ if ( $states[0] =~ /^(\d+|\w)$/ ) {
+ @states = map $subcountry->full_name($_), @states
+ }
+
+ foreach my $state ( @states ) {
+
+ my $cust_main_county = new FS::cust_main_county({
+ 'state' => $state,
+ 'tax' => 0,
+ 'country' => $country,
+ });
+ my $error = $cust_main_county->insert;
+ die $error if $error;
+
+ }
+
+ }
+}
+
+#billing events
+foreach my $aref (
+ #[ 'COMP', 'Comp invoice', '$cust_bill->comp();', 30, 'comp' ],
+ [ 'CARD', 'Batch card', '$cust_bill->batch_card();', 40, 'batch-card' ],
+ [ 'BILL', 'Send invoice', '$cust_bill->send();', 50, 'send' ],
+ [ 'DCRD', 'Send invoice', '$cust_bill->send();', 50, 'send' ],
+ [ 'DCHK', 'Send invoice', '$cust_bill->send();', 50, 'send' ],
+) {
+
+ my $part_bill_event = new FS::part_bill_event({
+ 'payby' => $aref->[0],
+ 'event' => $aref->[1],
+ 'eventcode' => $aref->[2],
+ 'seconds' => 0,
+ 'weight' => $aref->[3],
+ 'plan' => $aref->[4],
+ });
+ my($error);
+ $error=$part_bill_event->insert;
+ die $error if $error;
+
+}
+
+$dbh->commit or die $dbh->errstr;
+$dbh->disconnect or die $dbh->errstr;
+
+#print "Freeside database initialized sucessfully\n";
+
+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 user\n";
+}
+
+1;
+
diff --git a/FS/bin/freeside-sqlradius-radacctd b/FS/bin/freeside-sqlradius-radacctd
new file mode 100644
index 000000000..e98eaa015
--- /dev/null
+++ b/FS/bin/freeside-sqlradius-radacctd
@@ -0,0 +1,150 @@
+#!/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::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( "/usr/local/etc/freeside/sqlradius-radacctd-log.". $FS::UID::datasrc );
+
+daemonize2();
+
+#--
+
+#don't just look for ->can('usage_sessions'), we're sqlradius-specific
+# (radiator is supposed to be setup with a radacct table)
+
+@part_export =
+ qsearch('part_export', { 'exporttype' => 'sqlradius' } );
+push @part_export,
+ qsearch('part_export', { 'exporttype' => 'sqlradius_withdomain' } );
+push @part_export,
+ qsearch('part_export', { 'exporttype' => 'radiator' } );
+
+@part_export = grep { ! $_->option('ignore_accounting') } @part_export;
+
+die "no sqlradius, sqlradius_withdomain or radiator 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_acct();
+ 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 svc_acct.seconds for each account.
+Runs as a daemon and updates the database in real-time.
+
+B<username> is a username added by freeside-adduser.
+
+=head1 RADIUS DATABASE CHANGES
+
+ALTER TABLE radacct ADD COLUMN FreesideStatus varchar(32) NULL;
+
+If you want to ignore the existing accountg records, also do:
+
+UPDATE radacct SET FreesideStatus = 'done' WHERE FreesideStatus IS NULL;
+
+=head1 SEE ALSO
+
+=cut
+
+1;
+
diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset
new file mode 100755
index 000000000..2ac5012d4
--- /dev/null
+++ b/FS/bin/freeside-sqlradius-reset
@@ -0,0 +1,88 @@
+#!/usr/bin/perl -w
+
+use strict;
+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 $machine = shift or die &usage;
+
+my @exports = ();
+if ( @ARGV ) {
+ foreach my $exportnum ( @ARGV ) {
+ foreach my $exporttype (qw( sqlradius sqlradius_withdomain )) {
+ push @exports, qsearch('part_export', { exportnum => $exportnum,
+ exporttype => $exporttype, } );
+ }
+ }
+ } else {
+ @exports = qsearch('part_export', { exporttype=>'sqlradius' } );
+ push @exports, qsearch('part_export', { exporttype=>'sqlradius_withdomain' } );
+}
+
+foreach my $export ( @exports ) {
+ my $icradius_dbh = DBI->connect(
+ 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;
+}
+
+foreach my $export ( @exports ) {
+
+ #my @svcparts = map { $_->svcpart } $export->export_svc;
+
+ my @svc_acct =
+ map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) }
+ map { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ grep { qsearch('cust_svc', { 'svcpart' => $_->svcpart } ) }
+ $export->export_svc;
+
+ foreach my $svc_acct ( @svc_acct ) {
+
+ $svc_acct->check; #set any fixed usergroup so it'll export even if all
+ #svc_acct records don't have the group yet
+
+ #false laziness with FS::svc_acct::insert (like it matters)
+ my $error = $export->export_insert($svc_acct);
+ 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 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.
+
+=head1 SEE ALSO
+
+L<freeside-reexport>, L<FS::part_export>, L<FS::part_export::sqlradius>
+
+=cut
+
+
+
diff --git a/FS/bin/freeside-sqlradius-seconds b/FS/bin/freeside-sqlradius-seconds
new file mode 100644
index 000000000..1c978fa8a
--- /dev/null
+++ b/FS/bin/freeside-sqlradius-seconds
@@ -0,0 +1,58 @@
+#!/usr/bin/perl -Tw
+
+use strict;
+use Date::Parse;
+use FS::UID qw(adminsuidsetup);
+use FS::Record qw(qsearchs);
+use FS::svc_acct;
+
+my $fs_user = shift or die &usage;
+adminsuidsetup( $fs_user );
+
+my $target_user = shift or die &usage;
+my $start = shift or die &usage;
+$start = str2time($start);
+my $stop = scalar(@ARGV) ? str2time(shift) : time;
+
+my $svc_acct = qsearchs( 'svc_acct', { 'username' => $target_user } );
+die "username $target_user not found\n" unless $svc_acct;
+
+print $svc_acct->seconds_since_sqlradacct( $start, $stop ). "\n";
+
+sub usage {
+ die "Usage:\n\n freeside-sqlradius-seconds freeside_username target_username start_date stop_date\n";
+}
+
+
+=head1 NAME
+
+freeside-sqlradius-seconds - Real-time radacct import daemon
+
+=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-upgrade b/FS/bin/freeside-upgrade
new file mode 100755
index 000000000..419384c2a
--- /dev/null
+++ b/FS/bin/freeside-upgrade
@@ -0,0 +1,131 @@
+#!/usr/bin/perl -w
+
+use strict;
+use vars qw($DEBUG $DRY_RUN);
+use Term::ReadKey;
+use DBIx::DBSchema 0.27;
+use FS::UID qw(adminsuidsetup checkeuid datasrc ); #getsecrets);
+use FS::Schema qw( dbdef dbdef_dist reload_dbdef );
+
+
+$DEBUG = 1;
+$DRY_RUN = 0;
+
+
+die "Not running uid freeside!" unless checkeuid();
+
+my $user = shift or die &usage;
+my $dbh = adminsuidsetup($user);
+
+#needs to match FS::Schema...
+my $dbdef_file = "/usr/local/etc/freeside/dbdef.". datasrc;
+
+dbdef_create($dbh, $dbdef_file);
+
+delete $FS::Schema::dbdef_cache{$dbdef_file}; #force an actual reload
+reload_dbdef($dbdef_file);
+
+
+foreach my $table ( dbdef_dist->tables ) {
+
+ if ( dbdef->table($table) ) {
+
+ warn "$table exists\n" if $DEBUG > 1;
+
+ foreach my $column ( dbdef_dist->table($table)->columns ) {
+ if ( dbdef->table($table)->column($column) ) {
+ warn " $table.$column exists\n" if $DEBUG > 2;
+ } else {
+
+ if ( $DEBUG ) {
+ print STDERR "column $table.$column does not exist. create?";
+ next unless yesno();
+ }
+
+ foreach my $statement (
+ dbdef_dist->table($table)->column($column)->sql_add_column( $dbh )
+ ) {
+ warn "$statement\n" if $DEBUG || $DRY_RUN;
+ unless ( $DRY_RUN ) {
+ $dbh->do( $statement)
+ or die "CREATE error: ". $dbh->errstr. "\nexecuting: $statement";
+ }
+ }
+
+ }
+
+ }
+
+ #should eventually check & create missing indices
+
+ #should eventually drop columns not in dbdef_dist...
+
+ } else {
+
+ if ( $DEBUG ) {
+ print STDERR "table $table does not exist. create?";
+ next unless yesno();
+ }
+
+ foreach my $statement (
+ dbdef_dist->table($table)->sql_create_table( $dbh )
+ ) {
+ warn "$statement\n" if $DEBUG || $DRY_RUN;
+ unless ( $DRY_RUN ) {
+ $dbh->do( $statement)
+ or die "CREATE error: ". $dbh->errstr. "\nexecuting: $statement";
+ }
+ }
+
+ }
+
+}
+
+# should eventually drop tables not in dbdef_dist too i guess...
+
+$dbh->commit or die $dbh->errstr;
+
+dbdef_create($dbh, $dbdef_file);
+
+$dbh->disconnect or die $dbh->errstr;
+
+###
+
+my $all = 0;
+sub yesno {
+ print STDERR ' [yes/no/all] ';
+ if ( $all ) {
+ warn "yes\n";
+ return 1;
+ } else {
+ while ( 1 ) {
+ ReadMode 4;
+ my $x = lc(ReadKey);
+ ReadMode 0;
+ if ( $x eq 'n' ) {
+ warn "no\n";
+ return 0;
+ } elsif ( $x eq 'y' ) {
+ warn "yes\n";
+ return 1;
+ } elsif ( $x eq 'a' ) {
+ warn "yes\n";
+ $all = 1;
+ return 1;
+ }
+ }
+ }
+}
+
+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 user\n";
+}
+
+1;
+