X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=45f0a412e223c5bdcc04d4e239a95692e58bb120;hb=29249857577d3e866a0f01d414ee1b32fb861359;hp=3af41bac6def176e3ce5ab55a074f2314ddae617;hpb=121a0e466d425648801b687a474acb985090d1c6;p=freeside.git diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 3af41bac6..45f0a412e 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -30,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; @@ -37,6 +38,7 @@ use FS::part_svc; use FS::svc_acct_pop; use FS::cust_main_invoice; use FS::svc_domain; +use FS::svc_pbx; use FS::raddb; use FS::queue; use FS::radius_usergroup; @@ -160,45 +162,71 @@ FS::svc_Common. The following fields are currently supported: =over 4 -=item svcnum - primary key (assigned automatcially for new accounts) +=item svcnum + +Primary key (assigned automatcially for new accounts) =item username -=item _password - generated if blank +=item _password + +generated if blank + +=item _password_encoding + +plain, crypt, ldap (or empty for autodetection) + +=item sec_phrase -=item _password_encoding - plain, crypt, ldap (or empty for autodetection) +security phrase -=item sec_phrase - security phrase +=item popnum -=item popnum - Point of presence (see L) +Point of presence (see L) =item uid =item gid -=item finger - GECOS +=item finger -=item dir - set automatically if blank (and uid is not) +GECOS + +=item dir + +set automatically if blank (and uid is not) =item shell -=item quota - (unimplementd) +=item quota + +=item slipip + +IP address + +=item seconds -=item slipip - IP address +=item upbytes -=item seconds - +=item downbyte -=item upbytes - +=item totalbytes -=item downbytes - +=item domsvc -=item totalbytes - +svcnum from svc_domain -=item domsvc - svcnum from svc_domain +=item pbxsvc -=item radius_I - I (reply) +Optional svcnum from svc_pbx -=item rc_I - I (check) +=item radius_I + +I (reply) + +=item rc_I + +I (check) =back @@ -274,6 +302,20 @@ sub table_info { disable_inventory => 1, }, + 'domsvc' => { + label => 'Domain', + type => 'select', + select_table => 'svc_domain', + select_key => 'svcnum', + select_label => 'domain', + disable_inventory => 1, + + }, + 'pbxsvc' => { label => 'PBX', + type => 'select-svc_pbx.html', + disable_inventory => 1, + disable_select => 1, #UI wonky, pry works otherwise + }, 'usergroup' => { label => 'RADIUS groups', type => 'radius_usergroup_selector', @@ -435,13 +477,7 @@ sub search_sql { $class->search_sql_field('username', $string ). ' ) '; } else { - ' ( '. - $class->search_sql_field('username', $string). - ( $string =~ /^\d+$/ - ? 'OR '. $class->search_sql_field('svcnum', $string) - : '' - ). - ' ) '; + $class->search_sql_field('username', $string); } } @@ -661,13 +697,16 @@ sub insert { } # set usage fields and thresholds if unset but set in a package def +# AND the package already has a last bill date (otherwise they get double added) 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 $cust_pkg && $cust_pkg->last_bill; + + my $part_pkg = $cust_pkg->part_pkg; return '' unless $part_pkg && $part_pkg->can('usage_valuehash'); my %values = $part_pkg->usage_valuehash; @@ -1016,7 +1055,8 @@ sub check { my $error = $self->ut_numbern('svcnum') #|| $self->ut_number('domsvc') - || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum' ) + || $self->ut_foreign_key( 'domsvc', 'svc_domain', 'svcnum' ) + || $self->ut_foreign_keyn('pbxsvc', 'svc_pbx', 'svcnum' ) || $self->ut_textn('sec_phrase') || $self->ut_snumbern('seconds') || $self->ut_snumbern('upbytes') @@ -1183,13 +1223,14 @@ sub check { # First, if _password is blank, generate one and set default encoding. if ( ! $recref->{_password} ) { - $self->set_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} ) { - $self->set_password($recref->{_password}); + $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' ) { @@ -1231,11 +1272,8 @@ sub check { $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}; + else { + return "invalid password encoding ('".$recref->{_password_encoding}."'"; } $self->SUPER::check; @@ -1296,73 +1334,81 @@ is >0), one will be generated randomly. =cut sub set_password { - my $self = shift; - my $pass = shift; - my ($encoding, $encryption); + my( $self, $pass ) = ( shift, shift ); + + warn "[$me] set_password (to $pass) called on $self: ". Dumper($self) + if $DEBUG; + my $failure = gettext('illegal_password'). " $passwordmin-$passwordmax ". + FS::Msgcat::_gettext('illegal_password_characters'). + ": ". $pass; - if($self->_password_encoding) { + my( $encoding, $encryption ) = ('', ''); + + if ( $self->_password_encoding ) { $encoding = $self->_password_encoding; # identify existing encryption method, try to use it. $encryption = $self->_password_encryption; - if(!$encryption) { + if (!$encryption) { # use the system default undef $encoding; } } - if(!$encoding) { + if ( !$encoding ) { # set encoding to system default - ($encoding, $encryption) = split(/-/, lc($conf->config('default-password-encoding'))); + ($encoding, $encryption) = + split(/-/, lc($conf->config('default-password-encoding'))); $encoding ||= 'legacy'; $self->_password_encoding($encoding); } - if($encoding eq 'legacy') { + 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 { + } 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})$/ ) { + } 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 '!!' ) { + } elsif ( $pass eq '*' || $pass eq '!' || $pass eq '!!' ) { $self->_password_encoding('crypt'); + } else { + return $failure; } - else { - # do nothing; check() will recognize this as an error - } - } + } + + $self->_password($pass); + return; + } - elsif($encoding eq 'crypt') { - if($encryption eq 'md5') { + + return $failure + if $passwordmin && length($pass) < $passwordmin + or $passwordmax && length($pass) > $passwordmax; + + if ( $encoding eq 'crypt' ) { + if ($encryption eq 'md5') { $pass = unix_md5_crypt($pass); - } - elsif($encryption eq 'des') { + } elsif ($encryption eq 'des') { $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]); } - } - elsif($encoding eq 'ldap') { - if($encryption eq 'md5') { + + } elsif ( $encoding eq 'ldap' ) { + if ($encryption eq 'md5') { $pass = md5_base64($pass); - } - elsif($encryption eq 'sha1') { + } elsif ($encryption eq 'sha1') { $pass = sha1_base64($pass); - } - elsif($encryption eq 'crypt') { + } elsif ($encryption eq 'crypt') { $pass = crypt($pass, $saltset[int(rand(64))].$saltset[int(rand(64))]); } # else $encryption eq 'plain', do nothing @@ -1630,30 +1676,20 @@ for the password. sub radius_password { my $self = shift; - my($pw_attrib, $password); + my $pw_attrib; 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; - + $pw_attrib = $radius_password; } else { - - $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; - $password = $self->_password; - + $pw_attrib = length($self->_password) <= 12 + ? $radius_password + : 'Crypt-Password'; } - ($pw_attrib, $password); + ($pw_attrib, $self->_password); } @@ -1946,26 +1982,13 @@ sub _op_usage { ( $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") @@ -2010,6 +2033,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 ) = @_; @@ -2074,36 +2152,28 @@ sub set_usage { #$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); + 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" @@ -2607,6 +2677,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