summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--FS/FS/Record.pm11
-rw-r--r--FS/FS/UID.pm7
-rw-r--r--FS/FS/cust_main.pm101
-rwxr-xr-xbin/fs-setup9
-rwxr-xr-xbin/generate-prepay5
-rw-r--r--fs_sesmon/fs_session_server39
-rwxr-xr-xfs_signup/fs_signup_server24
-rw-r--r--htdocs/docs/session.html2
-rw-r--r--htdocs/docs/signup.html2
-rw-r--r--htdocs/docs/upgrade6.html4
10 files changed, 154 insertions, 50 deletions
diff --git a/FS/FS/Record.pm b/FS/FS/Record.pm
index 282c5ff16..dd8cc542c 100644
--- a/FS/FS/Record.pm
+++ b/FS/FS/Record.pm
@@ -176,7 +176,7 @@ sub qsearch {
my $statement = "SELECT $select FROM $table";
if ( @fields ) {
- $statement .= " WHERE ". join(' AND ', map {
+ $statement .= ' WHERE '. join(' AND ', map {
if ( ! defined( $record->{$_} ) || $record->{$_} eq '' ) {
if ( driver_name eq 'Pg' ) {
"$_ IS NULL";
@@ -191,11 +191,13 @@ sub qsearch {
$statement .= " $extra_sql" if defined($extra_sql);
warn $statement if $DEBUG;
- my $sth = $dbh->prepare_cached($statement) or croak $dbh->errstr;
+ my $sth = $dbh->prepare_cached($statement)
+ or croak "$dbh->errstr doing $statement";
$sth->execute( map $record->{$_},
grep defined( $record->{$_} ) && $record->{$_} ne '', @fields
) or croak $dbh->errstr;
+ $dbh->commit or croak $dbh->errstr if $FS::UID::AutoCommit;
if ( eval 'scalar(@FS::'. $table. '::ISA);' ) {
if ( eval 'FS::'. $table. '->can(\'new\')' eq \&new ) {
@@ -387,6 +389,7 @@ sub insert {
local $SIG{PIPE} = 'IGNORE';
$sth->execute or return $sth->errstr;
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
'';
}
@@ -436,6 +439,7 @@ sub delete {
my $rc = $sth->execute or return $sth->errstr;
#not portable #return "Record not found, statement:\n$statement" if $rc eq "0E0";
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
undef $self; #no need to keep object!
@@ -507,6 +511,7 @@ sub replace {
my $rc = $sth->execute or return $sth->errstr;
#not portable #return "Record not found (or records identical)." if $rc eq "0E0";
+ dbh->commit or croak dbh->errstr if $FS::UID::AutoCommit;
'';
@@ -908,7 +913,7 @@ sub DESTROY { return; }
=head1 VERSION
-$Id: Record.pm,v 1.11 2000-12-06 10:21:13 ivan Exp $
+$Id: Record.pm,v 1.12 2001-02-03 14:03:49 ivan Exp $
=head1 BUGS
diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm
index 88d733829..5cb5572af 100644
--- a/FS/FS/UID.pm
+++ b/FS/FS/UID.pm
@@ -4,6 +4,7 @@ use strict;
use vars qw(
@ISA @EXPORT_OK $cgi $dbh $freeside_uid $user
$conf_dir $secrets $datasrc $db_user $db_pass %callback $driver_name
+ $AutoCommit
);
use subs qw(
getsecrets cgisetotaker
@@ -21,6 +22,8 @@ $freeside_uid = scalar(getpwnam('freeside'));
$conf_dir = "/usr/local/etc/freeside/";
+$AutoCommit = 1; #ours, not DBI
+
=head1 NAME
FS::UID - Subroutines for database login and assorted other stuff
@@ -76,7 +79,7 @@ sub adminsuidsetup {
croak "Not running uid freeside!" unless checkeuid();
getsecrets;
$dbh = DBI->connect($datasrc,$db_user,$db_pass, {
- 'AutoCommit' => 'true',
+ 'AutoCommit' => 'false',
'ChopBlanks' => 'true',
} ) or die "DBI->connect error: $DBI::errstr\n";
@@ -256,7 +259,7 @@ coderef into the hash %FS::UID::callback :
=head1 VERSION
-$Id: UID.pm,v 1.3 2000-06-23 12:25:59 ivan Exp $
+$Id: UID.pm,v 1.4 2001-02-03 14:03:49 ivan Exp $
=head1 BUGS
diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
index e50ea7198..7b75bea1e 100644
--- a/FS/FS/cust_main.pm
+++ b/FS/FS/cust_main.pm
@@ -15,7 +15,7 @@ use Date::Format;
use Mail::Internet;
use Mail::Header;
use Business::CreditCard;
-use FS::UID qw( getotaker );
+use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearchs qsearch );
use FS::cust_pkg;
use FS::cust_bill;
@@ -183,17 +183,24 @@ sub table { 'cust_main'; }
Adds this customer to the database. If there is an error, returns the error,
otherwise returns false.
+There is a special insert mode in which you pass a data structure to the insert
+method containing FS::cust_pkg and FS::svc_I<tablename> objects. When
+running under a transactional database, all records are inserted atomicly, or
+the transaction is rolled back. There should be a better explanation of this,
+but until then, here's an example:
+
+ use Tie::RefHash;
+ tie %hash, 'Tie::RefHash'; #this part is important
+ %hash = {
+ $cust_pkg => [ $svc_acct ],
+ };
+ $cust_main->insert( \%hash );
+
=cut
sub insert {
my $self = shift;
- my $flag = 0;
- if ( $self->payby eq 'PREPAY' ) {
- $self->payby('BILL');
- $flag = 1;
- }
-
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $SIG{QUIT} = 'IGNORE';
@@ -201,30 +208,78 @@ sub insert {
local $SIG{TSTP} = 'IGNORE';
local $SIG{PIPE} = 'IGNORE';
- my $error = $self->SUPER::insert;
- return $error if $error;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
- if ( $flag ) {
- my $prepay_credit =
- qsearchs('prepay_credit', { 'identifier' => $self->payinfo } );
+ my $amount = 0;
+ my $seconds = 0;
+ if ( $self->payby eq 'PREPAY' ) {
+ $self->payby('BILL');
+ my $prepay_credit = qsearchs(
+ 'prepay_credit',
+ { 'identifier' => $self->payinfo },
+ '',
+ 'FOR UPDATE'
+ );
warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo
unless $prepay_credit;
- my $amount = $prepay_credit->amount;
+ $amount = $prepay_credit->amount;
+ $seconds = $prepay_credit->seconds;
my $error = $prepay_credit->delete;
if ( $error ) {
- warn "WARNING: can't delete prepay_credit: ". $self->payinfo;
- } else {
- my $cust_credit = new FS::cust_credit {
- 'custnum' => $self->custnum,
- 'amount' => $amount,
- };
- my $error = $cust_credit->insert;
- warn "WARNING: error inserting cust_credit for prepay_credit: $error"
- if $error;
+ $dbh->rollback;
+ return $error;
+ }
+ }
+
+ my $error = $self->SUPER::insert;
+ if ( $error ) {
+ $dbh->rollback;
+ return $error;
+ }
+
+ if ( @_ ) {
+ my $cust_pkgs = shift;
+ foreach my $cust_pkg ( keys %$cust_pkgs ) {
+ $cust_pkg->custnum( $self->custnum );
+ $error = $cust_pkg->insert;
+ if ( $error ) {
+ $dbh->rollback;
+ return $error;
+ }
+ foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) {
+ $svc_something->pkgnum( $cust_pkg->pkgnum );
+ if ( $seconds && $svc_something->isa('FS::svc_acct') ) {
+ $svc_something->seconds( $svc_something->seconds + $seconds );
+ $seconds = 0;
+ }
+ $error = $svc_something->insert;
+ if ( $error ) {
+ $dbh->rollback;
+ return $error;
+ }
+ }
}
+ }
+
+ if ( $seconds ) {
+ $dbh->rollback;
+ return "No svc_acct record to apply pre-paid time";
+ }
+ if ( $amount ) {
+ my $cust_credit = new FS::cust_credit {
+ 'custnum' => $self->custnum,
+ 'amount' => $amount,
+ };
+ $error = $cust_credit->insert;
+ if ( $error ) {
+ $dbh->rollback;
+ return $error;
+ }
}
+ $dbh->commit or die $dbh->errstr;
'';
}
@@ -999,7 +1054,7 @@ sub check_invoicing_list {
=head1 VERSION
-$Id: cust_main.pm,v 1.9 2001-01-31 07:21:00 ivan Exp $
+$Id: cust_main.pm,v 1.10 2001-02-03 14:03:50 ivan Exp $
=head1 BUGS
diff --git a/bin/fs-setup b/bin/fs-setup
index 2c31ff667..1df46d342 100755
--- a/bin/fs-setup
+++ b/bin/fs-setup
@@ -1,6 +1,6 @@
#!/usr/bin/perl -Tw
#
-# $Id: fs-setup,v 1.32 2000-12-04 00:13:02 ivan Exp $
+# $Id: fs-setup,v 1.33 2001-02-03 14:03:50 ivan Exp $
#
# ivan@sisd.com 97-nov-8,9
#
@@ -32,7 +32,10 @@
# fix radius attributes ivan@sisd.com 98-sep-27
#
# $Log: fs-setup,v $
-# Revision 1.32 2000-12-04 00:13:02 ivan
+# Revision 1.33 2001-02-03 14:03:50 ivan
+# time-based prepaid cards, session monitor. woop!
+#
+# Revision 1.32 2000/12/04 00:13:02 ivan
# fix nas.last type
#
# Revision 1.31 2000/12/01 18:34:53 ivan
@@ -658,6 +661,7 @@ sub tables_hash_hack {
'shell', 'varchar', 'NULL', $char_d,
'quota', 'varchar', 'NULL', $char_d,
'slipip', 'varchar', 'NULL', 15, #four TINYINTs, bah.
+ 'seconds', 'int', 'NULL', '', #uhhhh
],
'primary_key' => 'svcnum',
'unique' => [ [] ],
@@ -739,6 +743,7 @@ sub tables_hash_hack {
'prepaynum', 'int', '', '',
'identifier', 'varchar', '', $char_d,
'amount', @money_type,
+ 'seconds', 'int', 'NULL', '',
],
'primary_key' => 'prepaynum',
'unique' => [ ['identifier'] ],
diff --git a/bin/generate-prepay b/bin/generate-prepay
index 6fb615ab1..cb4ba7fc6 100755
--- a/bin/generate-prepay
+++ b/bin/generate-prepay
@@ -11,6 +11,8 @@ my $user = shift or die &usage;
my $amount = shift or die &usage;
+my $seconds = shift or die &usage;
+
my $num_digits = shift or die &usage;
my $num_entries = shift or die &usage;
@@ -20,6 +22,7 @@ for ( 1 .. $num_entries ) {
my $prepay_credit = new FS::prepay_credit {
'identifier' => $identifier,
'amount' => $amount,
+ 'seconds' => $seconds,
};
my $error = $prepay_credit->insert;
die $error if $error;
@@ -27,6 +30,6 @@ for ( 1 .. $num_entries ) {
}
sub usage {
- die "Usage:\n\n generate-prepay user amount num_digits num_entries";
+ die "Usage:\n\n generate-prepay user amount seconds num_digits num_entries";
}
diff --git a/fs_sesmon/fs_session_server b/fs_sesmon/fs_session_server
index 0930a3c00..00229f8dc 100644
--- a/fs_sesmon/fs_session_server
+++ b/fs_sesmon/fs_session_server
@@ -7,7 +7,7 @@ use strict;
use vars qw( $opt $Debug );
use IO::Handle;
use Net::SSH qw(sshopen2);
-use FS::UID qw(adminsuidsetup);
+use FS::UID qw(adminsuidsetup dbh);
use FS::Record qw( qsearchs ); #qsearch );
#use FS::cust_main_county;
#use FS::cust_main;
@@ -83,6 +83,7 @@ sub login {
return "Incorrect password"
if exists($href->{'password'})
&& $href->{'password'} ne $svc_acct->_password;
+ return "Time limit exceeded" unless $svc_acct->seconds;
my $session = new FS::session {
'portnum' => $href->{'portnum'},
'svcnum' => $svc_acct->svcnum,
@@ -95,20 +96,42 @@ sub logout {
my $href = shift;
$href->{'username'} =~ /^([a-z0-9_\-\.]+)$/ or return "Illegal username";
my $username = $1;
- my $svc_acct = qsearchs('svc_acct', { 'username' => $username } )
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+ my $svc_acct =
+ qsearchs('svc_acct', { 'username' => $username }, '', 'FOR UPDATE' )
or return "Unknown user";
return "Incorrect password"
if exists($href->{'password'})
&& $href->{'password'} ne $svc_acct->_password;
my $session = qsearchs( 'session', {
- 'portnum' => $href->{'portnum'},
- 'svcnum' => $svc_acct->svcnum,
- 'logout' => '',
- } );
- return "No currently open sessions found for that user/port!" unless $session;
+ 'portnum' => $href->{'portnum'},
+ 'svcnum' => $svc_acct->svcnum,
+ 'logout' => '',
+ },
+ '', 'FOR UPDATE'
+ );
+ unless ( $session ) {
+ $dbh->rollback;
+ return "No currently open sessions found for that user/port!";
+ }
my $nsession = new FS::session ( { $session->hash } );
warn "$nsession replacing $session";
- $nsession->replace($session);
+ my $error = $nsession->replace($session);
+ if ( $error ) {
+ $dbh->rollback;
+ return "can't logout: $error";
+ }
+ my $time = $nsession->logout - $nsession->login;
+ my $new_svc_acct = new FS::svc_acct ( { $svc_acct->hash } );
+ my $seconds = $new_svc_acct->seconds;
+ $seconds -= $time;
+ $seconds = 0 if $seconds < 0;
+ $new_svc_acct->seconds( $seconds );
+ $error = $new_svc_acct->replace( $svc_acct );
+ warn "can't debit time: $error\n"; #don't want to rollback, though
+ $dbh->commit or die $dbh->errstr;
+ ''
}
sub usage {
diff --git a/fs_signup/fs_signup_server b/fs_signup/fs_signup_server
index b5fc23c28..86455a477 100755
--- a/fs_signup/fs_signup_server
+++ b/fs_signup/fs_signup_server
@@ -5,6 +5,7 @@
use strict;
use IO::Handle;
+use Tie::RefHash;
use FS::SSH qw(sshopen2);
use FS::UID qw(adminsuidsetup);
use FS::Record qw( qsearch qsearchs );
@@ -160,16 +161,19 @@ while (1) {
$error ||= $svc_acct->check;
- $error ||= $cust_main->insert;
- if ( $cust_pkg && ! $error ) { #in this case, $cust_pkg should always
- #be definied, but....
- $cust_pkg->custnum( $cust_main->custnum );
- $error ||= $cust_pkg->insert;
- warn "WARNING: $error on pre-checked cust_pkg record!" if $error;
- $svc_acct->pkgnum( $cust_pkg->pkgnum );
- $error ||= $svc_acct->insert;
- warn "WARNING: $error on pre-checked svc_acct record!" if $error;
- }
+ use Tie::RefHash;
+ tie my %hash, 'Tie::RefHash';
+ %hash = { $cust_pkg => [ $svc_acct ] };
+ $error ||= $cust_main->insert( \%hash );
+ #if ( $cust_pkg && ! $error ) { #in this case, $cust_pkg should always
+ # #be definied, but....
+ # $cust_pkg->custnum( $cust_main->custnum );
+ # $error ||= $cust_pkg->insert;
+ # warn "WARNING: $error on pre-checked cust_pkg record!" if $error;
+ # $svc_acct->pkgnum( $cust_pkg->pkgnum );
+ # $error ||= $svc_acct->insert;
+ # warn "WARNING: $error on pre-checked svc_acct record!" if $error;
+ #}
warn "[fs_signup_server] Sending results...\n" if $Debug;
print $writer $error, "\n";
diff --git a/htdocs/docs/session.html b/htdocs/docs/session.html
index 3e88d568b..bd8edbab4 100644
--- a/htdocs/docs/session.html
+++ b/htdocs/docs/session.html
@@ -44,5 +44,7 @@ Then:
<li>Sesstion start - The command(s) specified in the <a href="config.html#session-start">session-start</a> configuration file are executed on the Freeside machine. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.
<li>Session end - The command(s) specified in the <a href="config.html#session-stop">session-stop</a> configuration file are executed on the Freeside machine. The contents of the file are treated as a double-quoted perl string, with the following variables available: <code>$ip</code>, <code>$nasip</code> and <code>$nasfqdn</code>, which are the IP address of the starting session, and the IP address and fully-qualified domain name of the NAS this session is on.
</ul>
+<h2>Dropping expired users</h2>
+Run <pre>bin/freeside-session-kill username</pre> periodically from cron.
</body>
</html>
diff --git a/htdocs/docs/signup.html b/htdocs/docs/signup.html
index 6f1e03930..a40b1f963 100644
--- a/htdocs/docs/signup.html
+++ b/htdocs/docs/signup.html
@@ -52,6 +52,6 @@ Optional:
<li>$email_name - first and last name
</ul>
(an example file is included as <b>fs_signup/cck.template</b>). See the <a href="http://help.netscape.com/products/client/mc/acctproc4.html">Netscape documentation</a> for more information.
- <li>If there are any entries in the <i>prepay_credit</i> table, a user can enter a string matching the <b>identifier</i> column to receive the credit specified in the <b>amount</b> column, after which that <b>identifier</b> is no longer valid. This can be used to implement pre-paid "calling card" type signups. The <i>bin/generate-prepay</i> script can be used to populate the <i>prepay_credit</i> table.
+ <li>If there are any entries in the <i>prepay_credit</i> table, a user can enter a string matching the <b>identifier</i> column to receive the credit specified in the <b>amount</b> column, and/or the time specified in the <b>seconds</b> column (for use with the <a href="session.html">session monitor</a>), after which that <b>identifier</b> is no longer valid. This can be used to implement pre-paid "calling card" type signups. The <i>bin/generate-prepay</i> script can be used to populate the <i>prepay_credit</i> table.
</ul>
</body>
diff --git a/htdocs/docs/upgrade6.html b/htdocs/docs/upgrade6.html
index 8240b6c32..8e70b5586 100644
--- a/htdocs/docs/upgrade6.html
+++ b/htdocs/docs/upgrade6.html
@@ -34,6 +34,10 @@ ALTER TABLE part_svc ADD svc_www__recnum_flag char(1) NULL;
ALTER TABLE part_svc ADD svc_www__usersvc varchar(80) NULL;
ALTER TABLE part_svc ADD svc_www__uesrsvc_flag char(1) NULL;
ALTER TABLE svc_acct CHANGE _password _password varchar(50) NULL;
+ALTER TABLE svc_acct ADD seconds integer NULL;
+ALTER TABLE part_svc ADD svc_acct__seconds integer NULL;
+ALTER TABLE part_svc ADD svc_acct__seconds_flag char(1) NULL;
+ALTER TABLE prepay_credit ADD seconds integer NULL;
</pre>
<li>Copy or symlink htdocs to the new copy.