$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
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;
$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');
$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;
$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', '(', ')', '#', '!', '.', ',' );
label => 'Shell',
def_label=> 'Shell (set to blank for no shell tracking)',
type =>'select',
- select_list => [ $conf->config('shells') ],
+ #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 => 'text',
disable_inventory => 1,
disable_select => 1,
+ disable_part_svc_column => 1,
},
'upbytes' => { label => 'Upload',
type => 'text',
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',
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',
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',
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',
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',
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',
sub table { 'svc_acct'; }
+sub table_dupcheck_fields { ( 'username', 'domsvc' ); }
+
sub _fieldhandlers {
{
#false laziness with edit/svc_acct.cgi
$self->email(@_);
}
+=item label_long [ END_TIMESTAMP [ START_TIMESTAMP ] ]
+
+Returns a longer string label for this acccount ("Real Name <username@domain>"
+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,
$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;
}
- 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;
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;
}
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;
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';
+ return 'Illegal (crypt-encoded) password: '. $recref->{_password};
}
} elsif ( $recref->{_password_encoding} eq 'plain' ) {
=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<global_unique-username> configuration value is set to B<username> or
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 ) {
foreach my $dup_user ( @dup_user ) {
my $dup_svcpart = $dup_user->cust_svc->svcpart;
if ( exists($conflict_user_svcpart{$dup_svcpart}) ) {
- return "duplicate username: conflicts with svcnum ". $dup_user->svcnum.
+ return "duplicate username ". $self->username.
+ ": conflicts with svcnum ". $dup_user->svcnum.
" via exportnum ". $conflict_user_svcpart{$dup_svcpart};
}
}
foreach my $dup_userdomain ( @dup_userdomain ) {
my $dup_svcpart = $dup_userdomain->cust_svc->svcpart;
if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
- return "duplicate username\@domain: conflicts with svcnum ".
- $dup_userdomain->svcnum. " via exportnum ".
- $conflict_userdomain_svcpart{$dup_svcpart};
+ return "duplicate username\@domain ". $self->email.
+ ": conflicts with svcnum ". $dup_userdomain->svcnum.
+ " via exportnum ". $conflict_userdomain_svcpart{$dup_svcpart};
}
}
my $dup_svcpart = $dup_uid->cust_svc->svcpart;
if ( exists($conflict_user_svcpart{$dup_svcpart})
|| exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
- return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum.
- " via exportnum ". $conflict_user_svcpart{$dup_svcpart}
- || $conflict_userdomain_svcpart{$dup_svcpart};
+ return "duplicate uid ". $self->uid.
+ ": conflicts with svcnum ". $dup_uid->svcnum.
+ " via exportnum ".
+ ( $conflict_user_svcpart{$dup_svcpart}
+ || $conflict_userdomain_svcpart{$dup_svcpart} );
}
}
( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
} grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
- my $password = $self->_password;
- my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; $check{$pw_attrib} = $password;
+
+ my($pw_attrib, $password) = $self->radius_password;
+ $check{$pw_attrib} = $password;
my $cust_svc = $self->cust_svc;
die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n"
}
+=item radius_password
+
+Returns a key/value pair containing the RADIUS attribute name and value
+for the password.
+
+=cut
+
+sub radius_password {
+ my $self = shift;
+
+ my($pw_attrib, $password);
+ if ( $self->_password_encoding eq 'ldap' ) {
+
+ $pw_attrib = 'Password-With-Header';
+ $password = $self->_password;
+
+ } elsif ( $self->_password_encoding eq 'crypt' ) {
+
+ $pw_attrib = 'Crypt-Password';
+ $password = $self->_password;
+
+ } elsif ( $self->_password_encoding eq 'plain' ) {
+
+ $pw_attrib = $radius_password; #Cleartext-Password? man rlm_pap
+ $password = $self->_password;
+
+ } else {
+
+ $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password';
+ $password = $self->_password;
+
+ }
+
+ ($pw_attrib, $password);
+
+}
+
=item snapshot
This method instructs the object to "snapshot" or freeze RADIUS check and
}
sub set_usage {
- my( $self, $valueref ) = @_;
+ my( $self, $valueref, %options ) = @_;
warn "$me set_usage called for svcnum ". $self->svcnum.
' ('. $self->email. "): ".
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});
#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;
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