X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Faccess_user.pm;h=f23aa77f909910c7ce866cf0816586d54bbc6b44;hp=250e432dd98aec6346a90b691ed1b09f013274bc;hb=dc83512c36dc6bea2585abada4f88d714c600e55;hpb=2e2fb0fc3619ce3afc268bcaa3e34f1e712e57c5 diff --git a/FS/FS/access_user.pm b/FS/FS/access_user.pm index 250e432dd..f23aa77f9 100644 --- a/FS/FS/access_user.pm +++ b/FS/FS/access_user.pm @@ -1,23 +1,21 @@ package FS::access_user; +use base qw( FS::Password_Mixin + FS::m2m_Common + FS::option_Common ); use strict; -use vars qw( @ISA $htpasswd_file ); +use vars qw( $DEBUG $me ); use FS::UID; +use FS::Auth; use FS::Conf; use FS::Record qw( qsearch qsearchs dbh ); -use FS::m2m_Common; -use FS::option_Common; -use FS::access_usergroup; use FS::agent; +use FS::cust_main; +use FS::sales; +use Carp qw( croak ); -@ISA = qw( FS::m2m_Common FS::option_Common FS::Record ); -#@ISA = qw( FS::m2m_Common FS::option_Common ); - -#kludge htpasswd for now (i hope this bootstraps okay) -FS::UID->install_callback( sub { - my $conf = new FS::Conf; - $htpasswd_file = $conf->base_dir. '/htpasswd'; -} ); +$DEBUG = 0; +$me = '[FS::access_user]'; =head1 NAME @@ -40,22 +38,42 @@ FS::access_user - Object methods for access_user records =head1 DESCRIPTION -An FS::access_user object represents an internal access user. FS::access_user inherits from -FS::Record. The following fields are currently supported: +An FS::access_user object represents an internal access user. FS::access_user +inherits from FS::Record. The following fields are currently supported: =over 4 -=item usernum - primary key +=item usernum + +primary key + +=item username + +=item _password + +=item _password_encoding + +Empty or bcrypt + +=item last + +Last name -=item username - +=item first -=item _password - +First name -=item last - +=item user_custnum -=item first - +Master customer for this employee (for commissions) -=item disabled - empty or 'Y' +=item report_salesnum + +Default sales person for this employee (for reports) + +=item disabled + +Empty or 'Y' =back @@ -90,6 +108,9 @@ otherwise returns false. sub insert { my $self = shift; + my $error = $self->check; + return $error if $error; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -101,13 +122,15 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = $self->htpasswd_kludge(); if ( $error ) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; return $error; } $error = $self->SUPER::insert(@_); + if ( $self->_password ) { + $error ||= $self->insert_password_history; + } if ( $error ) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; @@ -119,27 +142,6 @@ sub insert { } -sub htpasswd_kludge { - my $self = shift; - - #awful kludge to skip setting htpasswd for fs_* users - return '' if $self->username =~ /^fs_/; - - unshift @_, '-c' unless -e $htpasswd_file; - if ( - system('htpasswd', '-b', @_, - $htpasswd_file, - $self->username, - $self->_password, - ) == 0 - ) - { - return ''; - } else { - return 'htpasswd exited unsucessfully'; - } -} - =item delete Delete this record from the database. @@ -160,10 +162,8 @@ sub delete { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error = - $self->SUPER::delete(@_) - || $self->htpasswd_kludge('-D') - ; + my $error = $self->delete_password_history + || $self->SUPER::delete(@_); if ( $error ) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; @@ -200,15 +200,16 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - if ( $new->_password ne $old->_password ) { - my $error = $new->htpasswd_kludge(); - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - return $error; - } - } + return "Must change password when enabling this account" + if $old->disabled && !$new->disabled + && ( $new->_password =~ /changeme/i + || $new->_password eq 'notyet' + ); my $error = $new->SUPER::replace($old, @_); + if ( $old->_password ne $new->_password ) { + $error ||= $new->insert_password_history; + } if ( $error ) { $dbh->rollback or die $dbh->errstr if $oldAutoCommit; @@ -236,10 +237,12 @@ sub check { my $error = $self->ut_numbern('usernum') - || $self->ut_alpha('username') - || $self->ut_text('_password') - || $self->ut_text('last') - || $self->ut_text('first') + || $self->ut_alpha_lower('username') + || $self->ut_textn('_password') + || $self->ut_textn('last') + || $self->ut_textn('first') + || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum') + || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum') || $self->ut_enum('disabled', [ '', 'Y' ] ) ; return $error if $error; @@ -255,33 +258,56 @@ Returns a name string for this user: "Last, First". sub name { my $self = shift; - $self->get('last'). ', '. $self->first; + return $self->username + if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname' + or $self->get('last') eq '' && $self->first eq ''; + return $self->get('last'). ', '. $self->first; } -=item access_usergroup +=item user_cust_main + +Returns the FS::cust_main object (see L), if any, for this +user. =cut -sub access_usergroup { +sub user_cust_main { my $self = shift; - qsearch( 'access_usergroup', { 'usernum' => $self->usernum } ); + qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } ); } -#=item access_groups -# -#=cut -# -#sub access_groups { -# -#} -# -#=item access_groupnames -# -#=cut -# -#sub access_groupnames { -# -#} +=item report_sales + +Returns the FS::sales object (see L), if any, for this +user. + +=cut + +sub report_sales { + my $self = shift; + qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } ); +} + +=item access_usergroup + +Returns links to the the groups this user is a part of, as FS::access_usergroup +objects (see L). + +=item num_agents + +Returns the number of agents this user can view (via group membership). + +=cut + +sub num_agents { + my $self = shift; + $self->scalar_sql( + 'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup + JOIN access_groupagent USING ( groupnum ) + WHERE usernum = ?', + $self->usernum, + ); +} =item agentnums @@ -333,6 +359,11 @@ user has the provided access right Optional table name in which agentnum is being checked. Sometimes required to resolve 'column reference "agentnum" is ambiguous' errors. +=item viewall_right + +All agents will be viewable if the current user has the provided access right. +Defaults to 'View customers of all agents'. + =back =cut @@ -343,37 +374,54 @@ sub agentnums_sql { my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum'; - my @agentnums = map { "$agentnum = $_" } $self->agentnums; + my @or = (); + + my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents'; + if ( $self->access_right($viewall_right) ) { + push @or, "$agentnum IS NOT NULL"; + } else { + my @agentnums = $self->agentnums; + push @or, "$agentnum IN (". join(',', @agentnums). ')' + if @agentnums; + } - push @agentnums, "$agentnum IS NULL" + push @or, "$agentnum IS NULL" if $opt{'null'} || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) ); - return ' 1 = 0 ' unless scalar(@agentnums); - '( '. join( ' OR ', @agentnums ). ' )'; + return ' 1 = 0 ' unless scalar(@or); + '( '. join( ' OR ', @or ). ' )'; + } =item agentnum Returns true if the user can view the specified agent. +Also accepts optional hashref cache, to avoid redundant database calls. + =cut sub agentnum { - my( $self, $agentnum ) = @_; + my( $self, $agentnum, $cache ) = @_; + $cache ||= {}; + return $cache->{$self->usernum}->{$agentnum} + if $cache->{$self->usernum}->{$agentnum}; my $sth = dbh->prepare( "SELECT COUNT(*) FROM access_usergroup JOIN access_groupagent USING ( groupnum ) WHERE usernum = ? AND agentnum = ?" ) or die dbh->errstr; $sth->execute($self->usernum, $agentnum) or die $sth->errstr; - $sth->fetchrow_arrayref->[0]; + $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0]; + $sth->finish; + return $cache->{$self->usernum}->{$agentnum}; } -=item agents +=item agents [ HASHREF | OPTION => VALUE ... ] Returns the list of agents this user can view (via group membership), as -FS::agent objects. +FS::agent objects. Accepts the same options as the agentnums_sql method. =cut @@ -382,19 +430,149 @@ sub agents { qsearch({ 'table' => 'agent', 'hashref' => { disabled=>'' }, - 'extra_sql' => ' AND '. $self->agentnums_sql, + 'extra_sql' => ' AND '. $self->agentnums_sql(@_), + 'order_by' => 'ORDER BY agent', }); } -=item access_right +=item access_users [ HASHREF | OPTION => VALUE ... ] + +Returns an array of FS::access_user objects, one for each non-disabled +access_user in the system that shares an agent (via group membership) with +the invoking object. Regardless of options and agents, will always at +least return the invoking user and any users who have viewall_right. + +Accepts the following options: + +=over 4 + +=item table + +Only return users who appear in the usernum field of this table + +=item disabled + +Include disabled users if true (defaults to false) + +=item viewall_right + +All users will be returned if the current user has the provided +access right, regardless of agents (other filters still apply.) +Defaults to 'View customers of all agents' + +=cut + +#Leaving undocumented until such time as this functionality is actually used +# +#=item null +# +#Users with no agents will be returned. +# +#=item null_right +# +#Users with no agents will be returned if the current user has the provided +#access right. + +sub access_users { + my $self = shift; + my %opt = ref($_[0]) ? %{$_[0]} : @_; + my $table = $opt{'table'}; + my $search = { 'table' => 'access_user' }; + $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' }; + $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)" + if $table; + my @access_users = qsearch($search); + my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents'; + return @access_users if $self->access_right($viewall_right); + #filter for users with agents $self can view + my @out; + my $agentnum_cache = {}; +ACCESS_USER: + foreach my $access_user (@access_users) { + # you can always view yourself, regardless of agents, + # and you can always view someone who can view you, + # since they might have affected your customers + if ( ($self->usernum eq $access_user->usernum) + || $access_user->access_right($viewall_right) + ) { + push(@out,$access_user); + next; + } + # if user has no agents, you need null or null_right to view + my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above + if (!@agents) { + if ( $opt{'null'} || + ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) ) + ) { + push(@out,$access_user); + } + next; + } + # otherwise, you need an agent in common + foreach my $agent (@agents) { + if ($self->agentnum($agent->agentnum,$agentnum_cache)) { + push(@out,$access_user); + next ACCESS_USER; + } + } + } + return @out; +} + +=item access_users_hashref [ HASHREF | OPTION => VALUE ... ] -Given a right name, returns true if this user has this right (currently via -group membership, eventually also via user overrides). +Accepts same options as L. Returns a hashref of +users, with keys of usernum and values of username. + +=cut + +sub access_users_hashref { + my $self = shift; + my %access_users = map { $_->usernum => $_->username } + $self->access_users(@_); + return \%access_users; +} + +=item access_right RIGHTNAME | LISTREF + +Given a right name or a list reference of right names, returns true if this +user has this right, or, for a list, one of the rights (currently via group +membership, eventually also via user overrides). =cut sub access_right { my( $self, $rightname ) = @_; + + $rightname = [ $rightname ] unless ref($rightname); + + warn "$me access_right called on ". join(', ', @$rightname). "\n" + if $DEBUG; + + #some caching of ACL requests for low-hanging fruit perf improvement + #since we get a new $CurrentUser object each page view there shouldn't be any + #issues with stickiness + if ( $self->{_ACLcache} ) { + + unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) { + warn "$me ACL cache hit for ". join(', ', @$rightname). "\n" + if $DEBUG; + return scalar( grep $self->{_ACLcache}{$_}, @$rightname ); + } + + warn "$me ACL cache miss for ". join(', ', @$rightname). "\n" + if $DEBUG; + + } else { + + warn "initializing ACL cache\n" + if $DEBUG; + $self->{_ACLcache} = {}; + + } + + my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') '; + my $sth = dbh->prepare(" SELECT groupnum FROM access_usergroup LEFT JOIN access_group USING ( groupnum ) @@ -402,11 +580,336 @@ sub access_right { ON ( access_group.groupnum = access_right.rightobjnum ) WHERE usernum = ? AND righttype = 'FS::access_group' - AND rightname = ? + AND $has_right + LIMIT 1 ") or die dbh->errstr; - $sth->execute($self->usernum, $rightname) or die $sth->errstr; + $sth->execute($self->usernum, @$rightname) or die $sth->errstr; my $row = $sth->fetchrow_arrayref; - $row ? $row->[0] : ''; + + my $return = $row ? $row->[0] : ''; + + #just caching the single-rightname hits should be enough of a win for now + if ( scalar(@$rightname) == 1 ) { + $self->{_ACLcache}{${$rightname}[0]} = $return; + } + + $return; + +} + +=item refund_rights PAYBY + +Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a +list of the refund rights associated with that $payby. + +Returns empty list if $payby wasn't recognized. + +=cut + +sub refund_rights { + my $self = shift; + my $payby = shift; + my @rights = (); + push @rights, 'Post refund' if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/; + push @rights, 'Post check refund' if $payby eq 'BILL'; + push @rights, 'Post cash refund ' if $payby eq 'CASH'; + push @rights, 'Refund payment' if $payby =~ /^(CARD|CHEK)$/; + push @rights, 'Refund credit card payment' if $payby eq 'CARD'; + push @rights, 'Refund Echeck payment' if $payby eq 'CHEK'; + return @rights; +} + +=item refund_access_right PAYBY + +Returns true if user has L for any L +for the specified payby. + +=cut + +sub refund_access_right { + my $self = shift; + my $payby = shift; + my @rights = $self->refund_rights($payby); + return '' unless @rights; + return $self->access_right(\@rights); +} + +=item default_customer_view + +Returns the default customer view for this user, from the +"default_customer_view" user preference, the "cust_main-default_view" config, +or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0). + +=cut + +sub default_customer_view { + my $self = shift; + + $self->option('default_customer_view') + || FS::Conf->new->config('cust_main-default_view') + || 'basics'; #s/jumbo/basics/ starting with 3.0 + +} + +=item spreadsheet_format [ OVERRIDE ] + +Returns a hashref of this user's Excel spreadsheet download settings: +'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or +Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX', +use that instead of the user's setting. + +=cut + +# is there a better place to put this? +my %formats = ( + XLS => { + extension => '.xls', + class => 'Spreadsheet::WriteExcel', + mime_type => 'application/vnd.ms-excel', + }, + XLSX => { + extension => '.xlsx', + class => 'Excel::Writer::XLSX', + mime_type => # it's on wikipedia, it must be true + 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', + } +); + +sub spreadsheet_format { + my $self = shift; + my $override = shift; + + my $f = $override + || $self->option('spreadsheet_format') + || FS::Conf->new->config('spreadsheet_format') + || 'XLS'; + + $formats{$f}; +} + +=item is_system_user + +Returns true if this user has the name of a known system account. These +users cannot log into the web interface and can't have passwords set. + +=cut + +sub is_system_user { + my $self = shift; + return grep { $_ eq $self->username } ( qw( + fs_queue + fs_daily + fs_selfservice + fs_signup + fs_bootstrap + fs_selfserv + fs_api + ) ); +} + +=item change_password NEW_PASSWORD + +Changes the user's password to NEW_PASSWORD. This does not check password +policy rules (see C) and will return an error only if +editing the user's record fails for some reason. + +If NEW_PASSWORD is the same as the existing password, this does nothing. + +=cut + +sub change_password { + #my( $self, $password ) = @_; + #FS::Auth->auth_class->change_password( $self, $password ); + FS::Auth->auth_class->change_password( @_ ); +} + +=item change_password_fields NEW_PASSWORD + +=cut + +sub change_password_fields { + #my( $self, $password ) = @_; + #FS::Auth->auth_class->change_password_fields( $self, $password ); + FS::Auth->auth_class->change_password_fields( @_ ); +} + +=item locale + +=cut + +sub locale { + my $self = shift; + return $self->{_locale} if exists($self->{_locale}); + $self->{_locale} = $self->option('locale'); +} + +=item get_page_pref PATH, NAME, TABLENUM + +Returns the user's page preference named NAME for the page at PATH. If the +page is a view or edit page or otherwise shows a single record at a time, +it should use TABLENUM to tell which record the preference is for. + +=cut + +sub get_page_pref { + my $self = shift; + my ($path, $prefname, $tablenum) = @_; + $tablenum ||= ''; + + my $access_user_page_pref = qsearchs('access_user_page_pref', { + path => $path, + usernum => $self->usernum, + tablenum => $tablenum, + prefname => $prefname, + }); + $access_user_page_pref ? $access_user_page_pref->prefvalue : ''; +} + +=item set_page_pref PATH, NAME, TABLENUM, VALUE + +Sets the user's page preference named NAME for the page at PATH. Use TABLENUM +as for get_page_pref. + +=cut + +sub set_page_pref { + my $self = shift; + my ($path, $prefname, $tablenum, $prefvalue) = @_; + $tablenum ||= ''; + + my $error; + my $access_user_page_pref = qsearchs('access_user_page_pref', { + path => $path, + usernum => $self->usernum, + tablenum => $tablenum, + prefname => $prefname, + }); + if ( $access_user_page_pref ) { + if ( $prefvalue eq $access_user_page_pref->get('prefvalue') ) { + return ''; + } + if ( length($prefvalue) > 0 ) { + $access_user_page_pref->set('prefvalue', $prefvalue); + $error = $access_user_page_pref->replace; + $error .= " (updating $prefname)" if $error; + } else { + $error = $access_user_page_pref->delete; + $error .= " (removing $prefname)" if $error; + } + } else { + if ( length($prefvalue) > 0 ) { + $access_user_page_pref = FS::access_user_page_pref->new({ + path => $path, + usernum => $self->usernum, + tablenum => $tablenum, + prefname => $prefname, + prefvalue => $prefvalue, + }); + $error = $access_user_page_pref->insert; + $error .= " (creating $prefname)" if $error; + } else { + return ''; + } + } + + return $error; +} + +=item get_pref NAME + +Fetch the prefvalue column from L for prefname NAME + +Returns undef when no value has been saved, or when record has expired + +=cut + +sub get_pref { + my ( $self, $prefname ) = @_; + croak 'prefname parameter requrired' unless $prefname; + + my $pref_row = $self->get_pref_row( $prefname ) + or return undef; + + return undef + if $pref_row->expiration + && $pref_row->expiration < time(); + + $pref_row->prefvalue; +} + +=item get_pref_row NAME + +Fetch the row object from L for prefname NAME + +returns undef when no row has been created + +=cut + +sub get_pref_row { + my ( $self, $prefname ) = @_; + croak 'prefname parameter required' unless $prefname; + + qsearchs( + access_user_pref => { + usernum => $self->usernum, + prefname => $prefname, + } + ); +} + +=item set_pref NAME, VALUE, [EXPIRATION_EPOCH] + +Add or update user preference in L table + +Passing an undefined VALUE will delete the user preference + +Returns VALUE + +=cut + +sub set_pref { + my $self = shift; + my ( $prefname, $prefvalue, $expiration ) = @_; + + return $self->delete_pref( $prefname ) + unless defined $prefvalue; + + if ( my $pref_row = $self->get_pref_row( $prefname )) { + return $prefvalue + if $pref_row->prefvalue eq $prefvalue; + + $pref_row->prefvalue( $prefvalue ); + $pref_row->expiration( $expiration || ''); + + if ( my $error = $pref_row->replace ) { croak $error } + + return $prefvalue; + } + + my $pref_row = FS::access_user_pref->new({ + usernum => $self->usernum, + prefname => $prefname, + prefvalue => $prefvalue, + expiration => $expiration, + }); + if ( my $error = $pref_row->insert ) { croak $error } + + $prefvalue; +} + +=item delete_pref NAME + +Delete user preference from L table + +=cut + +sub delete_pref { + my ( $self, $prefname ) = @_; + + my $pref_row = $self->get_pref_row( $prefname ) + or return; + + if ( my $error = $pref_row->delete ) { croak $error } } =back