X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=efe66505e5f4cca184aef73830937ef1d195fa98;hb=d32d0810e0beba37f3c5b13d4b99d883da5080c0;hp=e5be29473635c82bffca3ffb0955c57f99d25d4d;hpb=e13421f071b4a7b872e6d40205ca736125cb294d;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index e5be29473..efe66505e 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -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'); @@ -428,7 +436,13 @@ sub search_sql { $class->search_sql_field('username', $string ). ' ) '; } else { - $class->search_sql_field('username', $string); + ' ( '. + $class->search_sql_field('username', $string). + ( $string =~ /^\d+$/ + ? 'OR '. $class->search_sql_field('svcnum', $string) + : '' + ). + ' ) '; } } @@ -517,42 +531,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; #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'); - } - - } - } - my @jobnums; - $error = $self->SUPER::insert( + my $error = $self->SUPER::insert( 'jobnums' => \@jobnums, 'child_objects' => $self->child_objects, %options, @@ -681,6 +661,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 @@ -1177,6 +1182,17 @@ sub check { $self->ut_textn($_); } + # First, if _password is blank, generate one and set default encoding. + if ( ! $recref->{_password} ) { + $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} ) { + $self->set_password($recref->{_password}); + } + + # Next, check _password to ensure compliance with the encoding. if ( $recref->{_password_encoding} eq 'ldap' ) { if ( $recref->{_password} =~ /^(\{[\w\-]+\})(!?.{0,64})$/ ) { @@ -1199,11 +1215,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 { @@ -1218,51 +1231,148 @@ sub check { if ( $password_noexclamation ) { $recref->{_password} =~ /\!/ and return gettext('illegal_password'); } + } + elsif ( $recref->{_password_encoding} eq 'legacy' ) { + # this happens when set_password fails + return gettext('illegal_password'). " $passwordmin-$passwordmax ". + FS::Msgcat::_gettext('illegal_password_characters'). + ": ". $recref->{_password}; + } + $self->SUPER::check; - } else { +} + + +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; +} + +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; +} - #carp "warning: _password_encoding unspecified\n"; + +=item set_password - #generate a password if it is blank - unless ( length( $recref->{_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. - $recref->{_password} = - join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) ); - $recref->{_password_encoding} = 'plain'; +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); - } 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}; - } + 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 { + # do nothing; check() will recognize this as an error + } + } + } + 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 @@ -1440,6 +1550,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; } @@ -1473,11 +1606,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; @@ -1772,6 +1909,38 @@ 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) && @@ -1903,6 +2072,16 @@ 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 }); + #call exports + my $error = $new->replace($self); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error replacing: $error"; + } + if ( $reset ) { my $error; @@ -2429,6 +2608,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 @@ -2684,6 +3001,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,