X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=3e264e6a30e782015282c18a897c78047fc5b569;hb=8c6abf72b58d9f24c659f3543d0a3071d9907824;hp=7bcd0e7d21709ac7237965fb330dafd126f39467;hpb=3868d5117cbfeb2d1f75ffe3d5dc96aa63f1e809;p=freeside.git
diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 7bcd0e7d2..3e264e6a3 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -6,7 +6,7 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles
$usernamemax $passwordmin $passwordmax
$username_ampersand $username_letter $username_letterfirst
$username_noperiod $username_nounderscore $username_nodash
- $username_uppercase $username_percent
+ $username_uppercase $username_percent $username_colon
$password_noampersand $password_noexclamation
$warning_template $warning_from $warning_subject $warning_mimetype
$warning_cc
@@ -15,10 +15,13 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles
$dirhash
@saltset @pw_set );
use Scalar::Util qw( blessed );
+use Math::BigInt;
use Carp;
use Fcntl qw(:flock);
use Date::Format;
use Crypt::PasswdMD5 1.2;
+use Digest::SHA1 'sha1_base64';
+use Digest::MD5 'md5_base64';
use Data::Dumper;
use Text::Template;
use Authen::Passphrase;
@@ -27,6 +30,7 @@ use FS::Conf;
use FS::Record qw( qsearch qsearchs fields dbh dbdef );
use FS::Msgcat qw(gettext);
use FS::UI::bytecount;
+use FS::UI::Web;
use FS::part_pkg;
use FS::svc_Common;
use FS::cust_svc;
@@ -55,7 +59,11 @@ FS::UID->install_callback( sub {
@shells = $conf->config('shells');
$usernamemin = $conf->config('usernamemin') || 2;
$usernamemax = $conf->config('usernamemax');
- $passwordmin = $conf->config('passwordmin') || 6;
+ $passwordmin = $conf->config('passwordmin'); # || 6;
+ #blank->6, keep 0
+ $passwordmin = ( defined($passwordmin) && $passwordmin =~ /\d+/ )
+ ? $passwordmin
+ : 6;
$passwordmax = $conf->config('passwordmax') || 8;
$username_letter = $conf->exists('username-letter');
$username_letterfirst = $conf->exists('username-letterfirst');
@@ -65,6 +73,7 @@ FS::UID->install_callback( sub {
$username_uppercase = $conf->exists('username-uppercase');
$username_ampersand = $conf->exists('username-ampersand');
$username_percent = $conf->exists('username-percent');
+ $username_colon = $conf->exists('username-colon');
$password_noampersand = $conf->exists('password-noexclamation');
$password_noexclamation = $conf->exists('password-noexclamation');
$dirhash = $conf->config('dirhash') || 0;
@@ -214,9 +223,9 @@ sub table_info {
'fields' => {
'dir' => 'Home directory',
'uid' => {
- label => 'UID',
- def_label => 'UID (set to fixed and blank for no UIDs)',
- type => 'text',
+ label => 'UID',
+ def_info => 'set to fixed and blank for no UIDs',
+ type => 'text',
},
'slipip' => 'IP address',
# 'popnum' => qq!POP number!,
@@ -243,15 +252,14 @@ sub table_info {
},
'_password' => 'Password',
'gid' => {
- label => 'GID',
- def_label => 'GID (when blank, defaults to UID)',
- type => 'text',
+ label => 'GID',
+ def_info => 'when blank, defaults to UID',
+ type => 'text',
},
'shell' => {
- #desc =>'Shell (all service definitions should have a default or fixed shell that is present in the shells configuration file, set to blank for no shell tracking)',
label => 'Shell',
- def_label=> 'Shell (set to blank for no shell tracking)',
- type =>'select',
+ def_info => 'set to blank for no shell tracking',
+ type => 'select',
#select_list => [ $conf->config('shells') ],
select_list => [ $conf ? $conf->config('shells') : () ],
disable_inventory => 1,
@@ -260,7 +268,6 @@ sub table_info {
'finger' => 'Real name', # (GECOS)',
'domsvc' => {
label => 'Domain',
- #def_label => 'svcnum from svc_domain',
type => 'select',
select_table => 'svc_domain',
select_key => 'svcnum',
@@ -459,9 +466,12 @@ history records.
sub label_long {
my $self = shift;
- ( $self->finger =~ /\S/ )
- ? $self->finger. ' <'.$self->label(@_).'>'
- : $self->label(@_);
+ my $label = $self->label(@_);
+ my $finger = $self->finger;
+ return $label unless $finger =~ /\S/;
+ my $maxlen = 40 - length($label) - length($self->cust_svc->part_svc->svc);
+ $finger = substr($finger, 0, $maxlen-3).'...' if length($finger) > $maxlen;
+ "$finger <$label>";
}
=item insert [ , OPTION => VALUE ... ]
@@ -515,41 +525,8 @@ sub insert {
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $error = $self->check;
- return $error if $error;
-
- if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) {
- my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
- unless ( $cust_svc ) {
- $dbh->rollback if $oldAutoCommit;
- return "no cust_svc record found for svcnum ". $self->svcnum;
- }
- $self->pkgnum($cust_svc->pkgnum);
- $self->svcpart($cust_svc->svcpart);
- }
-
- # set usage fields and thresholds if unset but set in a package def
- if ( $self->pkgnum ) {
- my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
- my $part_pkg = $cust_pkg->part_pkg if $cust_pkg;
- if ( $part_pkg && $part_pkg->can('usage_valuehash') ) {
-
- my %values = $part_pkg->usage_valuehash;
- my $multiplier = $conf->exists('svc_acct-usage_threshold')
- ? 1 - $conf->config('svc_acct-usage_threshold')/100
- : 0.20;
-
- foreach ( keys %values ) {
- next if $self->getfield($_);
- $self->setfield( $_, $values{$_} );
- $self->setfield( $_. '_threshold', int( $values{$_} * $multiplier ) );
- }
-
- }
- }
-
my @jobnums;
- $error = $self->SUPER::insert(
+ my $error = $self->SUPER::insert(
'jobnums' => \@jobnums,
'child_objects' => $self->child_objects,
%options,
@@ -678,6 +655,31 @@ sub insert {
''; #no error
}
+# set usage fields and thresholds if unset but set in a package def
+sub preinsert_hook_first {
+ my $self = shift;
+
+ return '' unless $self->pkgnum;
+
+ my $cust_pkg = qsearchs( 'cust_pkg', { 'pkgnum' => $self->pkgnum } );
+ my $part_pkg = $cust_pkg->part_pkg if $cust_pkg;
+ return '' unless $part_pkg && $part_pkg->can('usage_valuehash');
+
+ my %values = $part_pkg->usage_valuehash;
+ my $multiplier = $conf->exists('svc_acct-usage_threshold')
+ ? 1 - $conf->config('svc_acct-usage_threshold')/100
+ : 0.20; #doesn't matter
+
+ foreach ( keys %values ) {
+ next if $self->getfield($_);
+ $self->setfield( $_, $values{$_} );
+ $self->setfield( $_. '_threshold', int( $values{$_} * $multiplier ) )
+ if $conf->exists('svc_acct-usage_threshold');
+ }
+
+ ''; #no error
+}
+
=item delete
Deletes this account from the database. If there is an error, returns the
@@ -1021,13 +1023,28 @@ sub check {
;
return $error if $error;
+ my $cust_pkg;
+ local $username_letter = $username_letter;
+ if ($self->svcnum) {
+ my $cust_svc = $self->cust_svc
+ or return "no cust_svc record found for svcnum ". $self->svcnum;
+ my $cust_pkg = $cust_svc->cust_pkg;
+ }
+ if ($self->pkgnum) {
+ $cust_pkg = qsearchs('cust_pkg', { 'pkgnum' => $self->pkgnum } );#complain?
+ }
+ if ($cust_pkg) {
+ $username_letter =
+ $conf->exists('username-letter', $cust_pkg->cust_main->agentnum);
+ }
+
my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
if ( $username_uppercase ) {
- $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/i
+ $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:]{$usernamemin,$ulen})$/i
or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
$recref->{username} = $1;
} else {
- $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/
+ $recref->{username} =~ /^([a-z0-9_\-\.\&\%\:]{$usernamemin,$ulen})$/
or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
$recref->{username} = $1;
}
@@ -1052,6 +1069,9 @@ sub check {
unless ( $username_percent ) {
$recref->{username} =~ /\%/ and return gettext('illegal_username');
}
+ unless ( $username_colon ) {
+ $recref->{username} =~ /\:/ and return gettext('illegal_username');
+ }
$recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
$recref->{popnum} = $1;
@@ -1156,6 +1176,18 @@ sub check {
$self->ut_textn($_);
}
+ # First, if _password is blank, generate one and set default encoding.
+ if ( ! $recref->{_password} ) {
+ $error = $self->set_password('');
+ }
+ # But if there's a _password but no encoding, assume it's plaintext and
+ # set it to default encoding.
+ elsif ( ! $recref->{_password_encoding} ) {
+ $error = $self->set_password($recref->{_password});
+ }
+ return $error if $error;
+
+ # Next, check _password to ensure compliance with the encoding.
if ( $recref->{_password_encoding} eq 'ldap' ) {
if ( $recref->{_password} =~ /^(\{[\w\-]+\})(!?.{0,64})$/ ) {
@@ -1178,11 +1210,8 @@ sub check {
}
} elsif ( $recref->{_password_encoding} eq 'plain' ) {
-
- #generate a password if it is blank
- $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
- unless length( $recref->{_password} );
-
+ # Password randomization is now in set_password.
+ # Strip whitespace characters, check length requirements, etc.
if ( $recref->{_password} =~ /^([^\t\n]{$passwordmin,$passwordmax})$/ ) {
$recref->{_password} = $1;
} else {
@@ -1197,51 +1226,152 @@ sub check {
if ( $password_noexclamation ) {
$recref->{_password} =~ /\!/ and return gettext('illegal_password');
}
+ }
+ else {
+ return "invalid password encoding ('".$recref->{_password_encoding}."'";
+ }
+ $self->SUPER::check;
- } else {
+}
- #carp "warning: _password_encoding unspecified\n";
- #generate a password if it is blank
- unless ( length( $recref->{_password} ) ) {
+sub _password_encryption {
+ my $self = shift;
+ my $encoding = lc($self->_password_encoding);
+ return if !$encoding;
+ return 'plain' if $encoding eq 'plain';
+ if($encoding eq 'crypt') {
+ my $pass = $self->_password;
+ $pass =~ s/^\*SUSPENDED\* //;
+ $pass =~ s/^!!?//;
+ return 'md5' if $pass =~ /^\$1\$/;
+ #return 'blowfish' if $self->_password =~ /^\$2\$/;
+ return 'des' if length($pass) == 13;
+ return;
+ }
+ if($encoding eq 'ldap') {
+ uc($self->_password) =~ /^\{([\w-]+)\}/;
+ return 'crypt' if $1 eq 'CRYPT' or $1 eq 'DES';
+ return 'plain' if $1 eq 'PLAIN' or $1 eq 'CLEARTEXT';
+ return 'md5' if $1 eq 'MD5';
+ return 'sha1' if $1 eq 'SHA' or $1 eq 'SHA-1';
+
+ return;
+ }
+ return;
+}
- $recref->{_password} =
- join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
- $recref->{_password_encoding} = 'plain';
+sub get_cleartext_password {
+ my $self = shift;
+ if($self->_password_encryption eq 'plain') {
+ if($self->_password_encoding eq 'ldap') {
+ $self->_password =~ /\{\w+\}(.*)$/;
+ return $1;
+ }
+ else {
+ return $self->_password;
+ }
+ }
+ return;
+}
- } else {
-
- #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
- if ( $recref->{_password} =~ /^((\*SUSPENDED\* |!!?)?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
- $recref->{_password} = $1.$3;
- $recref->{_password_encoding} = 'plain';
- } elsif ( $recref->{_password} =~
- /^((\*SUSPENDED\* |!!?)?)([\w\.\/\$\;\+]{13,64})$/
- ) {
- $recref->{_password} = $1.$3;
- $recref->{_password_encoding} = 'crypt';
- } elsif ( $recref->{_password} eq '*' ) {
- $recref->{_password} = '*';
- $recref->{_password_encoding} = 'crypt';
- } elsif ( $recref->{_password} eq '!' ) {
- $recref->{_password_encoding} = 'crypt';
- $recref->{_password} = '!';
- } elsif ( $recref->{_password} eq '!!' ) {
- $recref->{_password} = '!!';
- $recref->{_password_encoding} = 'crypt';
- } else {
- #return "Illegal password";
- return gettext('illegal_password'). " $passwordmin-$passwordmax ".
- FS::Msgcat::_gettext('illegal_password_characters').
- ": ". $recref->{_password};
- }
+
+=item set_password
+
+Set the cleartext password for the account. If _password_encoding is set, the
+new password will be encoded according to the existing method (including
+encryption mode, if it can be determined). Otherwise,
+config('default-password-encoding') is used.
+If no password is supplied (or a zero-length password when minimum password length
+is >0), one will be generated randomly.
+
+=cut
+
+sub set_password {
+ my $self = shift;
+ my $pass = shift;
+ my ($encoding, $encryption);
+ my $failure = gettext('illegal_password'). " $passwordmin-$passwordmax ".
+ FS::Msgcat::_gettext('illegal_password_characters').
+ ": ". $pass;
+
+ if(($passwordmin and length($pass) < $passwordmin) or
+ ($passwordmax and length($pass) > $passwordmax)) {
+ return $failure;
+ }
+
+ if($self->_password_encoding) {
+ $encoding = $self->_password_encoding;
+ # identify existing encryption method, try to use it.
+ $encryption = $self->_password_encryption;
+ if(!$encryption) {
+ # use the system default
+ undef $encoding;
}
+ }
+ if(!$encoding) {
+ # set encoding to system default
+ ($encoding, $encryption) = split(/-/, lc($conf->config('default-password-encoding')));
+ $encoding ||= 'legacy';
+ $self->_password_encoding($encoding);
}
- $self->SUPER::check;
+ if($encoding eq 'legacy') {
+ # The legacy behavior from check():
+ # If the password is blank, randomize it and set encoding to 'plain'.
+ if(!defined($pass) or (length($pass) == 0 and $passwordmin)) {
+ $pass = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
+ $self->_password_encoding('plain');
+ }
+ else {
+ # Prefix + valid-length password
+ if ( $pass =~ /^((\*SUSPENDED\* |!!?)?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
+ $pass = $1.$3;
+ $self->_password_encoding('plain');
+ }
+ # Prefix + crypt string
+ elsif ( $pass =~ /^((\*SUSPENDED\* |!!?)?)([\w\.\/\$\;\+]{13,64})$/ ) {
+ $pass = $1.$3;
+ $self->_password_encoding('crypt');
+ }
+ # Various disabled crypt passwords
+ elsif ( $pass eq '*' or
+ $pass eq '!' or
+ $pass eq '!!' ) {
+ $self->_password_encoding('crypt');
+ }
+ else {
+ return $failure;
+ }
+ }
+ }
+ elsif($encoding eq 'crypt') {
+ if($encryption eq 'md5') {
+ $pass = unix_md5_crypt($pass);
+ }
+ elsif($encryption eq 'des') {
+ $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]);
+ }
+ }
+ elsif($encoding eq 'ldap') {
+ if($encryption eq 'md5') {
+ $pass = md5_base64($pass);
+ }
+ elsif($encryption eq 'sha1') {
+ $pass = sha1_base64($pass);
+ }
+ elsif($encryption eq 'crypt') {
+ $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]);
+ }
+ # else $encryption eq 'plain', do nothing
+ $pass = '{'.uc($encryption).'}'.$pass;
+ }
+ # else encoding eq 'plain'
+ $self->_password($pass);
+ return;
}
=item _check_system
@@ -1419,6 +1549,29 @@ sub radius_reply {
$reply{'Session-Timeout'} = $self->seconds;
}
+ if ( $conf->exists('radius-chillispot-max') ) {
+ #http://dev.coova.org/svn/coova-chilli/doc/dictionary.chillispot
+
+ #hmm. just because sqlradius.pm says so?
+ my %whatis = (
+ 'input' => 'up',
+ 'output' => 'down',
+ 'total' => 'total',
+ );
+
+ foreach my $what (qw( input output total )) {
+ my $is = $whatis{$what}.'bytes';
+ if ( $self->$is() =~ /\d/ ) {
+ my $big = new Math::BigInt $self->$is();
+ $big = new Math::BigInt '0' if $big->is_neg();
+ my $att = "Chillispot-Max-\u$what";
+ $reply{"$att-Octets"} = $big->copy->band(0xffffffff)->bstr;
+ $reply{"$att-Gigawords"} = $big->copy->brsft(32)->bstr;
+ }
+ }
+
+ }
+
%reply;
}
@@ -1452,11 +1605,15 @@ sub radius_check {
$check{$pw_attrib} = $password;
my $cust_svc = $self->cust_svc;
- die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n"
- unless $cust_svc;
- my $cust_pkg = $cust_svc->cust_pkg;
- if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) {
- $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html
+ if ( $cust_svc ) {
+ my $cust_pkg = $cust_svc->cust_pkg;
+ if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) {
+ $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html
+ }
+ } else {
+ warn "WARNING: no cust_svc record for svc_acct.svcnum ". $self->svcnum.
+ "; can't set Expiration\n"
+ unless $cust_svc;
}
%check;
@@ -1704,7 +1861,7 @@ my %op2condition = (
$self->$column - $amount <= 0;
},
'+' => sub { my($self, $column, $amount) = @_;
- $self->$column + $amount > 0;
+ ($self->$column || 0) + $amount > 0;
},
);
my %op2warncondition = (
@@ -1713,7 +1870,7 @@ my %op2warncondition = (
$self->$column - $amount <= $self->$threshold + 0;
},
'+' => sub { my($self, $column, $amount) = @_;
- $self->$column + $amount > 0;
+ ($self->$column || 0) + $amount > 0;
},
);
@@ -1751,32 +1908,51 @@ sub _op_usage {
die "Can't update $column for svcnum". $self->svcnum
if $rv == 0;
+ #$self->snapshot; #not necessary, we retain the old values
+ #create an object with the updated usage values
+ my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
+ #call exports
+ my $error = $new->replace($self);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error replacing: $error";
+ }
+
+ #overlimit_action eq 'cancel' handling
+ my $cust_pkg = $self->cust_svc->cust_pkg;
+ if ( $cust_pkg
+ && $cust_pkg->part_pkg->option('overlimit_action', 1) eq 'cancel'
+ && $op eq '-' && &{$op2condition{$op}}($self, $column, $amount)
+ )
+ {
+
+ my $error = $cust_pkg->cancel; #XXX should have a reason
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error cancelling: $error";
+ }
+
+ #nothing else is relevant if we're cancelling, so commit & return success
+ warn "$me update successful; committing\n"
+ if $DEBUG;
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ return '';
+
+ }
+
my $action = $op2action{$op};
if ( &{$op2condition{$op}}($self, $column, $amount) &&
( $action eq 'suspend' && !$self->overlimit
|| $action eq 'unsuspend' && $self->overlimit )
) {
- foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
- if ($part_export->option('overlimit_groups')) {
- my ($new,$old);
- my $other = new FS::svc_acct $self->hashref;
- my $groups = &{ $self->_fieldhandlers->{'usergroup'} }
- ($self, $part_export->option('overlimit_groups'));
- $other->usergroup( $groups );
- if ($action eq 'suspend'){
- $new = $other; $old = $self;
- }else{
- $new = $self; $old = $other;
- }
- my $error = $part_export->export_replace($new, $old);
- $error ||= $self->overlimit($action);
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return "Error replacing radius groups in export, ${op}: $error";
- }
- }
+
+ my $error = $self->_op_overlimit($action);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
}
+
}
if ( $conf->exists("svc_acct-usage_$action")
@@ -1821,6 +1997,61 @@ sub _op_usage {
}
+sub _op_overlimit {
+ my( $self, $action ) = @_;
+
+ local $SIG{HUP} = 'IGNORE';
+ local $SIG{INT} = 'IGNORE';
+ local $SIG{QUIT} = 'IGNORE';
+ local $SIG{TERM} = 'IGNORE';
+ local $SIG{TSTP} = 'IGNORE';
+ local $SIG{PIPE} = 'IGNORE';
+
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $cust_pkg = $self->cust_svc->cust_pkg;
+
+ my $conf_overlimit =
+ $cust_pkg
+ ? $conf->config('overlimit_groups', $cust_pkg->cust_main->agentnum )
+ : $conf->config('overlimit_groups');
+
+ foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
+
+ my $groups = $conf_overlimit || $part_export->option('overlimit_groups');
+ next unless $groups;
+
+ my $gref = &{ $self->_fieldhandlers->{'usergroup'} }( $self, $groups );
+
+ my $other = new FS::svc_acct $self->hashref;
+ $other->usergroup( $gref );
+
+ my($new,$old);
+ if ($action eq 'suspend') {
+ $new = $other;
+ $old = $self;
+ } else { # $action eq 'unsuspend'
+ $new = $self;
+ $old = $other;
+ }
+
+ my $error = $part_export->export_replace($new, $old)
+ || $self->overlimit($action);
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error replacing radius groups: $error";
+ }
+
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+
+}
+
sub set_usage {
my( $self, $valueref, %options ) = @_;
@@ -1882,29 +2113,31 @@ sub set_usage {
if $rv == 0;
}
+ #$self->snapshot; #not necessary, we retain the old values
+ #create an object with the updated usage values
+ my $new = qsearchs('svc_acct', { 'svcnum' => $self->svcnum });
+ local($FS::Record::nowarn_identical) = 1;
+ my $error = $new->replace($self); #call exports
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "Error replacing: $error";
+ }
+
if ( $reset ) {
- my $error;
-
- if ($self->overlimit) {
- $error = $self->overlimit('unsuspend');
- foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
- if ($part_export->option('overlimit_groups')) {
- my $old = new FS::svc_acct $self->hashref;
- my $groups = &{ $self->_fieldhandlers->{'usergroup'} }
- ($self, $part_export->option('overlimit_groups'));
- $old->usergroup( $groups );
- $error ||= $part_export->export_replace($self, $old);
- }
- }
- }
- if ( $conf->exists("svc_acct-usage_unsuspend")) {
- $error ||= $self->cust_svc->cust_pkg->unsuspend;
- }
+ my $error = '';
+
+ $error = $self->_op_overlimit('unsuspend')
+ if $self->overlimit;;
+
+ $error ||= $self->cust_svc->cust_pkg->unsuspend
+ if $conf->exists("svc_acct-usage_unsuspend");
+
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return "Error unsuspending: $error";
}
+
}
warn "$me update successful; committing\n"
@@ -2408,6 +2641,144 @@ sub virtual_maildir {
=back
+=head1 CLASS METHODS
+
+=over 4
+
+=item search HASHREF
+
+Class method which returns a qsearch hash expression to search for parameters
+specified in HASHREF. Valid parameters are
+
+=over 4
+
+=item domain
+
+=item domsvc
+
+=item unlinked
+
+=item agentnum
+
+=item pkgpart
+
+Arrayref of pkgparts
+
+=item pkgpart
+
+=item where
+
+Arrayref of additional WHERE clauses, will be ANDed together.
+
+=item order_by
+
+=item cust_fields
+
+=back
+
+=cut
+
+sub search {
+ my ($class, $params) = @_;
+
+ my @where = ();
+
+ # domain
+ if ( $params->{'domain'} ) {
+ my $svc_domain = qsearchs('svc_domain', { 'domain'=>$params->{'domain'} } );
+ #preserve previous behavior & bubble up an error if $svc_domain not found?
+ push @where, 'domsvc = '. $svc_domain->svcnum if $svc_domain;
+ }
+
+ # domsvc
+ if ( $params->{'domsvc'} =~ /^(\d+)$/ ) {
+ push @where, "domsvc = $1";
+ }
+
+ #unlinked
+ push @where, 'pkgnum IS NULL' if $params->{'unlinked'};
+
+ #agentnum
+ if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
+ push @where, "agentnum = $1";
+ }
+
+ #custnum
+ if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
+ push @where, "custnum = $1";
+ }
+
+ #pkgpart
+ if ( $params->{'pkgpart'} && scalar(@{ $params->{'pkgpart'} }) ) {
+ #XXX untaint or sql quote
+ push @where,
+ 'cust_pkg.pkgpart IN ('. join(',', @{ $params->{'pkgpart'} } ). ')';
+ }
+
+ # popnum
+ if ( $params->{'popnum'} =~ /^(\d+)$/ ) {
+ push @where, "popnum = $1";
+ }
+
+ # svcpart
+ if ( $params->{'svcpart'} =~ /^(\d+)$/ ) {
+ push @where, "svcpart = $1";
+ }
+
+
+ # here is the agent virtualization
+ #if ($params->{CurrentUser}) {
+ # my $access_user =
+ # qsearchs('access_user', { username => $params->{CurrentUser} });
+ #
+ # if ($access_user) {
+ # push @where, $access_user->agentnums_sql('table'=>'cust_main');
+ # }else{
+ # push @where, "1=0";
+ # }
+ #} else {
+ push @where, $FS::CurrentUser::CurrentUser->agentnums_sql(
+ 'table' => 'cust_main',
+ 'null_right' => 'View/link unlinked services',
+ );
+ #}
+
+ push @where, @{ $params->{'where'} } if $params->{'where'};
+
+ my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
+
+ my $addl_from = ' LEFT JOIN cust_svc USING ( svcnum ) '.
+ ' LEFT JOIN part_svc USING ( svcpart ) '.
+ ' LEFT JOIN cust_pkg USING ( pkgnum ) '.
+ ' LEFT JOIN cust_main USING ( custnum ) ';
+
+ my $count_query = "SELECT COUNT(*) FROM svc_acct $addl_from $extra_sql";
+ #if ( keys %svc_acct ) {
+ # $count_query .= ' WHERE '.
+ # join(' AND ', map "$_ = ". dbh->quote($svc_acct{$_}),
+ # keys %svc_acct
+ # );
+ #}
+
+ my $sql_query = {
+ 'table' => 'svc_acct',
+ 'hashref' => {}, # \%svc_acct,
+ 'select' => join(', ',
+ 'svc_acct.*',
+ 'part_svc.svc',
+ 'cust_main.custnum',
+ FS::UI::Web::cust_sql_fields($params->{'cust_fields'}),
+ ),
+ 'addl_from' => $addl_from,
+ 'extra_sql' => $extra_sql,
+ 'order_by' => $params->{'order_by'},
+ 'count_query' => $count_query,
+ };
+
+}
+
+=back
+
=head1 SUBROUTINES
=over 4
@@ -2663,6 +3034,8 @@ probably live somewhere else...
insertion of RADIUS group stuff in insert could be done with child_objects now
(would probably clean up export of them too)
+_op_usage and set_usage bypass the history... maybe they shouldn't
+
=head1 SEE ALSO
L, edit/part_svc.cgi from an installed web interface,