X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=955547b731f6de3c575760c5087de800ce8acf84;hb=e9b930f5813d6df9e13d89c36ca0d7fc7973d2bc;hp=4343df5cc8d9d2422f9e3b0c14706041905cbbf9;hpb=5aca4fae645817eb3cc07660b3597411763e3de3;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 4343df5cc..955547b73 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 @@ -14,17 +14,20 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles $radius_password $radius_ip $dirhash @saltset @pw_set ); +use Scalar::Util qw( blessed ); use Carp; 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; @@ -46,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'); @@ -62,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; @@ -85,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', '(', ')', '#', '!', '.', ',' ); @@ -248,11 +253,12 @@ sub table_info { 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', @@ -274,6 +280,7 @@ sub table_info { type => 'text', disable_inventory => 1, disable_select => 1, + disable_part_svc_column => 1, }, 'upbytes' => { label => 'Upload', type => 'text', @@ -281,6 +288,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', @@ -288,6 +296,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', @@ -295,11 +304,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', @@ -307,6 +318,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', @@ -314,6 +326,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', @@ -321,6 +334,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', @@ -336,6 +350,8 @@ sub table_info { sub table { 'svc_acct'; } +sub table_dupcheck_fields { ( 'username', 'domsvc' ); } + sub _fieldhandlers { { #false laziness with edit/svc_acct.cgi @@ -432,8 +448,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, @@ -498,10 +532,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; @@ -734,14 +782,15 @@ contain an arrayref of group names. See L. =cut sub replace { - my ( $new, $old ) = ( shift, shift ); - my $error; + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + warn "$me replacing $old with $new\n" if $DEBUG; - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'svc_acct', { 'svcnum' => $new->svcnum } ); - } + my $error; return "can't modify system account" if $old->_check_system; @@ -815,15 +864,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; @@ -987,11 +1027,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; } @@ -1016,6 +1056,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; @@ -1132,13 +1175,13 @@ 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'; + return 'Illegal (crypt-encoded) password: '. $recref->{_password}; } } elsif ( $recref->{_password_encoding} eq 'plain' ) { @@ -1225,7 +1268,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 @@ -1242,20 +1285,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 ) { @@ -1319,7 +1349,8 @@ sub _check_duplicate { 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}; } } @@ -1327,9 +1358,9 @@ sub _check_duplicate { 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}; } } @@ -1337,9 +1368,11 @@ sub _check_duplicate { 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} ); } } @@ -1421,8 +1454,9 @@ sub radius_check { ( $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" @@ -1436,6 +1470,43 @@ sub radius_check { } +=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 @@ -1640,7 +1711,7 @@ my %op2condition = ( $self->$column - $amount <= 0; }, '+' => sub { my($self, $column, $amount) = @_; - $self->$column + $amount > 0; + ($self->$column || 0) + $amount > 0; }, ); my %op2warncondition = ( @@ -1649,7 +1720,7 @@ my %op2warncondition = ( $self->$column - $amount <= $self->$threshold + 0; }, '+' => sub { my($self, $column, $amount) = @_; - $self->$column + $amount > 0; + ($self->$column || 0) + $amount > 0; }, ); @@ -1758,7 +1829,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. "): ". @@ -1779,6 +1850,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}); @@ -1797,8 +1873,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; @@ -1806,7 +1882,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