X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=8b5c7b9c9c14bf8b9a9d63fe2bf44095282a3409;hb=f920fdb29a19105c9102d29e532f8cbb40dd1171;hp=9d8de785d9a0917a2d1b464e72a759fa47f8b17d;hpb=fbd1b259fbe38748efa33de41b46153b485ba795;p=freeside.git
diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 9d8de785d..8b5c7b9c9 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
@@ -20,12 +20,14 @@ use Fcntl qw(:flock);
use Date::Format;
use Crypt::PasswdMD5 1.2;
use Data::Dumper;
+use Text::Template;
use Authen::Passphrase;
use FS::UID qw( datasrc driver_name );
use FS::Conf;
use FS::Record qw( qsearch qsearchs fields dbh dbdef );
use FS::Msgcat qw(gettext);
use FS::UI::bytecount;
+use FS::part_pkg;
use FS::svc_Common;
use FS::cust_svc;
use FS::part_svc;
@@ -47,7 +49,7 @@ $DEBUG = 0;
$me = '[FS::svc_acct]';
#ask FS::UID to run this stuff for us later
-$FS::UID::callback{'FS::svc_acct'} = sub {
+FS::UID->install_callback( sub {
$conf = new FS::Conf;
$dir_prefix = $conf->config('home');
@shells = $conf->config('shells');
@@ -63,6 +65,7 @@ $FS::UID::callback{'FS::svc_acct'} = 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;
@@ -86,7 +89,8 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
$radius_password = $conf->config('radius-password') || 'Password';
$radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address';
@pw_set = ( 'A'..'Z' ) if $conf->exists('password-generated-allcaps');
-};
+}
+);
@saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
@pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
@@ -211,9 +215,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!,
@@ -240,23 +244,22 @@ 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',
- select_list => [ $conf->config('shells') ],
+ 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,
disable_select => 1,
},
- 'finger' => 'Real name (GECOS)',
+ 'finger' => 'Real name', # (GECOS)',
'domsvc' => {
label => 'Domain',
- #def_label => 'svcnum from svc_domain',
type => 'select',
select_table => 'svc_domain',
select_key => 'svcnum',
@@ -275,6 +278,7 @@ sub table_info {
type => 'text',
disable_inventory => 1,
disable_select => 1,
+ disable_part_svc_column => 1,
},
'upbytes' => { label => 'Upload',
type => 'text',
@@ -282,6 +286,7 @@ sub table_info {
disable_select => 1,
'format' => \&FS::UI::bytecount::display_bytecount,
'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
},
'downbytes' => { label => 'Download',
type => 'text',
@@ -289,6 +294,7 @@ sub table_info {
disable_select => 1,
'format' => \&FS::UI::bytecount::display_bytecount,
'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
},
'totalbytes'=> { label => 'Total up and download',
type => 'text',
@@ -296,11 +302,13 @@ sub table_info {
disable_select => 1,
'format' => \&FS::UI::bytecount::display_bytecount,
'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
},
'seconds_threshold' => { label => 'Seconds threshold',
type => 'text',
disable_inventory => 1,
disable_select => 1,
+ disable_part_svc_column => 1,
},
'upbytes_threshold' => { label => 'Upload threshold',
type => 'text',
@@ -308,6 +316,7 @@ sub table_info {
disable_select => 1,
'format' => \&FS::UI::bytecount::display_bytecount,
'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
},
'downbytes_threshold' => { label => 'Download threshold',
type => 'text',
@@ -315,6 +324,7 @@ sub table_info {
disable_select => 1,
'format' => \&FS::UI::bytecount::display_bytecount,
'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
},
'totalbytes_threshold'=> { label => 'Total up and download threshold',
type => 'text',
@@ -322,6 +332,7 @@ sub table_info {
disable_select => 1,
'format' => \&FS::UI::bytecount::display_bytecount,
'parse' => \&FS::UI::bytecount::parse_bytecount,
+ disable_part_svc_column => 1,
},
'last_login'=> {
label => 'Last login',
@@ -337,6 +348,8 @@ sub table_info {
sub table { 'svc_acct'; }
+sub table_dupcheck_fields { ( 'username', 'domsvc' ); }
+
sub _fieldhandlers {
{
#false laziness with edit/svc_acct.cgi
@@ -433,8 +446,26 @@ sub label {
$self->email(@_);
}
+=item label_long [ END_TIMESTAMP [ START_TIMESTAMP ] ]
+
+Returns a longer string label for this acccount ("Real Name "
+if available, or "username@domain").
+
+END_TIMESTAMP and START_TIMESTAMP can optionally be passed when dealing with
+history records.
+
=cut
+sub label_long {
+ my $self = shift;
+ 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 ... ]
Adds this account to the database. If there is an error, returns the error,
@@ -499,10 +530,24 @@ sub insert {
$self->svcpart($cust_svc->svcpart);
}
- $error = $self->_check_duplicate;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
+ # 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;
@@ -817,15 +862,6 @@ sub replace {
}
- if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
- $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
- $error = $new->_check_duplicate;
- if ( $error ) {
- $dbh->rollback if $oldAutoCommit;
- return $error;
- }
- }
-
$error = $new->SUPER::replace($old, @_);
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
@@ -989,11 +1025,11 @@ sub check {
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;
}
@@ -1018,6 +1054,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;
@@ -1134,10 +1173,10 @@ sub check {
if ( $recref->{_password} =~
#/^(\$\w+\$.*|[\w\+\/]{13}|_[\w\+\/]{19}|\*)$/
- /^(!!?)?(\$\w+\$.*|[\w\+\/]{13}|_[\w\+\/]{19}|\*)$/
+ /^(!!?)?(\$\w+\$.*|[\w\+\/\.]{13}|_[\w\+\/\.]{19}|\*)$/
) {
- $recref->{_password} = $1.$2;
+ $recref->{_password} = ( defined($1) ? $1 : '' ). $2;
} else {
return 'Illegal (crypt-encoded) password: '. $recref->{_password};
@@ -1227,7 +1266,7 @@ sub _check_system {
=item _check_duplicate
-Internal function to check for duplicates usernames, username@domain pairs and
+Internal method to check for duplicates usernames, username@domain pairs and
uids.
If the I configuration value is set to B or
@@ -1244,20 +1283,7 @@ sub _check_duplicate {
my $global_unique = $conf->config('global_unique-username') || 'none';
return '' if $global_unique eq 'disabled';
- warn "$me locking svc_acct table for duplicate search" if $DEBUG;
- if ( driver_name =~ /^Pg/i ) {
- dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE")
- or die dbh->errstr;
- } elsif ( driver_name =~ /^mysql/i ) {
- dbh->do("SELECT * FROM duplicate_lock
- WHERE lockname = 'svc_acct'
- FOR UPDATE"
- ) or die dbh->errstr;
- } else {
- die "unknown database ". driver_name.
- "; don't know how to lock for duplicate search";
- }
- warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG;
+ $self->lock_table;
my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
unless ( $part_svc ) {
@@ -1683,7 +1709,7 @@ my %op2condition = (
$self->$column - $amount <= 0;
},
'+' => sub { my($self, $column, $amount) = @_;
- $self->$column + $amount > 0;
+ ($self->$column || 0) + $amount > 0;
},
);
my %op2warncondition = (
@@ -1692,7 +1718,7 @@ my %op2warncondition = (
$self->$column - $amount <= $self->$threshold + 0;
},
'+' => sub { my($self, $column, $amount) = @_;
- $self->$column + $amount > 0;
+ ($self->$column || 0) + $amount > 0;
},
);
@@ -1801,7 +1827,7 @@ sub _op_usage {
}
sub set_usage {
- my( $self, $valueref ) = @_;
+ my( $self, $valueref, %options ) = @_;
warn "$me set_usage called for svcnum ". $self->svcnum.
' ('. $self->email. "): ".
@@ -1822,6 +1848,11 @@ sub set_usage {
my $reset = 0;
my %handyhash = ();
+ if ( $options{null} ) {
+ %handyhash = ( map { ( $_ => 'NULL', $_."_threshold" => 'NULL' ) }
+ qw( seconds upbytes downbytes totalbytes )
+ );
+ }
foreach my $field (keys %$valueref){
$reset = 1 if $valueref->{$field};
$self->setfield($field, $valueref->{$field});
@@ -1840,8 +1871,8 @@ sub set_usage {
#die $error if $error; #services not explicity changed via the UI
my $sql = "UPDATE svc_acct SET " .
- join (',', map { "$_ = ?" } (keys %handyhash) ).
- " WHERE svcnum = ?";
+ join (',', map { "$_ = $handyhash{$_}" } (keys %handyhash) ).
+ " WHERE svcnum = ". $self->svcnum;
warn "$me $sql\n"
if $DEBUG;
@@ -1849,7 +1880,7 @@ sub set_usage {
if (scalar(keys %handyhash)) {
my $sth = $dbh->prepare( $sql )
or die "Error preparing $sql: ". $dbh->errstr;
- my $rv = $sth->execute((values %handyhash), $self->svcnum);
+ my $rv = $sth->execute();
die "Error executing $sql: ". $sth->errstr
unless defined($rv);
die "Can't update usage for svcnum ". $self->svcnum