1 package FS::access_user;
4 use base qw( FS::m2m_Common FS::option_Common );
5 use vars qw( $DEBUG $me $conf $htpasswd_file );
8 use FS::Record qw( qsearch qsearchs dbh );
9 use FS::access_user_pref;
10 use FS::access_usergroup;
18 $me = '[FS::access_user]';
20 #kludge htpasswd for now (i hope this bootstraps okay)
21 FS::UID->install_callback( sub {
23 $htpasswd_file = $conf->base_dir. '/htpasswd';
28 FS::access_user - Object methods for access_user records
34 $record = new FS::access_user \%hash;
35 $record = new FS::access_user { 'column' => 'value' };
37 $error = $record->insert;
39 $error = $new_record->replace($old_record);
41 $error = $record->delete;
43 $error = $record->check;
47 An FS::access_user object represents an internal access user. FS::access_user
48 inherits from FS::Record. The following fields are currently supported:
52 =item usernum - primary key
62 =item disabled - empty or 'Y'
72 Creates a new internal access user. To add the user to the database, see L<"insert">.
74 Note that this stores the hash reference, not a distinct copy of the hash it
75 points to. You can ask the object for a copy with the I<hash> method.
79 # the new method can be inherited from FS::Record, if a table method is defined
81 sub table { 'access_user'; }
83 sub _option_table { 'access_user_pref'; }
84 sub _option_namecol { 'prefname'; }
85 sub _option_valuecol { 'prefvalue'; }
89 Adds this record to the database. If there is an error, returns the error,
90 otherwise returns false.
97 my $error = $self->check;
98 return $error if $error;
100 local $SIG{HUP} = 'IGNORE';
101 local $SIG{INT} = 'IGNORE';
102 local $SIG{QUIT} = 'IGNORE';
103 local $SIG{TERM} = 'IGNORE';
104 local $SIG{TSTP} = 'IGNORE';
105 local $SIG{PIPE} = 'IGNORE';
107 my $oldAutoCommit = $FS::UID::AutoCommit;
108 local $FS::UID::AutoCommit = 0;
111 $error = $self->htpasswd_kludge();
113 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
117 $error = $self->SUPER::insert(@_);
120 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
122 #make sure it isn't a dup username? or you could nuke people's passwords
123 #blah. really just should do our own login w/cookies
124 #and auth out of the db in the first place
125 #my $hterror = $self->htpasswd_kludge('-D');
126 #$error .= " - additionally received error cleaning up htpasswd file: $hterror"
130 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
136 sub htpasswd_kludge {
139 return '' if $self->is_system_user;
141 unshift @_, '-c' unless -e $htpasswd_file;
143 system('htpasswd', '-b', @_,
154 return "htpasswd failed to execute: $!";
156 return sprintf("htpasswd died with signal %d, %s coredump",
157 ($? & 127), ($? & 128) ? 'with' : 'without' );
159 return sprintf("htpasswd exited with value %d", $? >> 8 );
167 Delete this record from the database.
174 local $SIG{HUP} = 'IGNORE';
175 local $SIG{INT} = 'IGNORE';
176 local $SIG{QUIT} = 'IGNORE';
177 local $SIG{TERM} = 'IGNORE';
178 local $SIG{TSTP} = 'IGNORE';
179 local $SIG{PIPE} = 'IGNORE';
181 my $oldAutoCommit = $FS::UID::AutoCommit;
182 local $FS::UID::AutoCommit = 0;
186 $self->delete_password_history
187 || $self->SUPER::delete(@_)
188 || $self->htpasswd_kludge('-D')
192 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
195 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
201 =item replace OLD_RECORD
203 Replaces the OLD_RECORD with this one in the database. If there is an error,
204 returns the error, otherwise returns false.
211 my $old = ( ref($_[0]) eq ref($new) )
215 local $SIG{HUP} = 'IGNORE';
216 local $SIG{INT} = 'IGNORE';
217 local $SIG{QUIT} = 'IGNORE';
218 local $SIG{TERM} = 'IGNORE';
219 local $SIG{TSTP} = 'IGNORE';
220 local $SIG{PIPE} = 'IGNORE';
222 my $oldAutoCommit = $FS::UID::AutoCommit;
223 local $FS::UID::AutoCommit = 0;
226 if ( $new->_password ne $old->_password ) {
227 my $error = $new->htpasswd_kludge();
229 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
232 } elsif ( $old->disabled && !$new->disabled
233 && $new->_password =~ /changeme/i ) {
234 return "Must change password when enabling this account";
237 my $error = $new->SUPER::replace($old, @_);
240 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
243 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
251 Checks all fields to make sure this is a valid internal access user. If there is
252 an error, returns the error, otherwise returns false. Called by the insert
257 # the check method should currently be supplied - FS::Record contains some
258 # data checking routines
264 $self->ut_numbern('usernum')
265 || $self->ut_alpha_lower('username')
266 || $self->ut_text('_password')
267 || $self->ut_text('last')
268 || $self->ut_text('first')
269 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
270 || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
271 || $self->ut_enum('disabled', [ '', 'Y' ] )
273 return $error if $error;
280 Returns a name string for this user: "Last, First".
286 return $self->username
287 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
288 return $self->get('last'). ', '. $self->first;
293 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
300 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
305 Returns the FS::sales object (see L<FS::sales>), if any, for this
312 qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
315 =item access_usergroup
317 Returns links to the the groups this user is a part of, as FS::access_usergroup
318 objects (see L<FS::access_usergroup>).
322 sub access_usergroup {
324 qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
335 #=item access_groupnames
339 #sub access_groupnames {
345 Returns the number of agents this user can view (via group membership).
352 'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup
353 JOIN access_groupagent USING ( groupnum )
361 Returns a list of agentnums this user can view (via group membership).
367 my $sth = dbh->prepare(
368 "SELECT DISTINCT agentnum FROM access_usergroup
369 JOIN access_groupagent USING ( groupnum )
371 ) or die dbh->errstr;
372 $sth->execute($self->usernum) or die $sth->errstr;
373 map { $_->[0] } @{ $sth->fetchall_arrayref };
378 Returns a hashref of agentnums this user can view.
384 scalar( { map { $_ => 1 } $self->agentnums } );
387 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
389 Returns an sql fragement to select only agentnums this user can view.
391 Options are passed as a hashref or a list. Available options are:
397 The frament will also allow the selection of null agentnums.
401 The fragment will also allow the selection of null agentnums if the current
402 user has the provided access right
406 Optional table name in which agentnum is being checked. Sometimes required to
407 resolve 'column reference "agentnum" is ambiguous' errors.
411 Optional column name in which agentnum is being checked.
413 e.g: column => 'COALESCE ( cust_main.agentnum, prospect_main.agentnum )'
417 All agents will be viewable if the current user has the provided access right.
418 Defaults to 'View customers of all agents'.
426 my %opt = ref($_[0]) ? %{$_[0]} : @_;
429 if ( $opt{column} ) {
430 $agentnum = $opt{column};
431 } elsif ( $opt{table} ) {
432 $agentnum = "$opt{table}.agentnum"
434 $agentnum = 'agentnum';
439 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
440 if ( $self->access_right($viewall_right) ) {
441 push @or, "$agentnum IS NOT NULL";
443 my @agentnums = $self->agentnums;
444 push @or, "$agentnum IN (". join(',', @agentnums). ')'
448 push @or, "$agentnum IS NULL"
450 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
452 return ' 1 = 0 ' unless scalar(@or);
453 '( '. join( ' OR ', @or ). ' )';
459 Returns true if the user can view the specified agent.
461 Also accepts optional hashref cache, to avoid redundant database calls.
466 my( $self, $agentnum, $cache ) = @_;
468 return $cache->{$self->usernum}->{$agentnum}
469 if $cache->{$self->usernum}->{$agentnum};
470 my $sth = dbh->prepare(
471 "SELECT COUNT(*) FROM access_usergroup
472 JOIN access_groupagent USING ( groupnum )
473 WHERE usernum = ? AND agentnum = ?"
474 ) or die dbh->errstr;
475 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
476 $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
478 return $cache->{$self->usernum}->{$agentnum};
481 =item agents [ HASHREF | OPTION => VALUE ... ]
483 Returns the list of agents this user can view (via group membership), as
484 FS::agent objects. Accepts the same options as the agentnums_sql method.
492 'hashref' => { disabled=>'' },
493 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
494 'order_by' => 'ORDER BY agent',
498 =item access_users [ HASHREF | OPTION => VALUE ... ]
500 Returns an array of FS::access_user objects, one for each non-disabled
501 access_user in the system that shares an agent (via group membership) with
502 the invoking object. Regardless of options and agents, will always at
503 least return the invoking user and any users who have viewall_right.
505 Accepts the following options:
511 Only return users who appear in the usernum field of this table
515 Include disabled users if true (defaults to false)
519 All users will be returned if the current user has the provided
520 access right, regardless of agents (other filters still apply.)
521 Defaults to 'View customers of all agents'
525 #Leaving undocumented until such time as this functionality is actually used
529 #Users with no agents will be returned.
533 #Users with no agents will be returned if the current user has the provided
538 my %opt = ref($_[0]) ? %{$_[0]} : @_;
539 my $table = $opt{'table'};
540 my $search = { 'table' => 'access_user' };
541 $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
542 $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
544 my @access_users = qsearch($search);
545 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
546 return @access_users if $self->access_right($viewall_right);
547 #filter for users with agents $self can view
549 my $agentnum_cache = {};
551 foreach my $access_user (@access_users) {
552 # you can always view yourself, regardless of agents,
553 # and you can always view someone who can view you,
554 # since they might have affected your customers
555 if ( ($self->usernum eq $access_user->usernum)
556 || $access_user->access_right($viewall_right)
558 push(@out,$access_user);
561 # if user has no agents, you need null or null_right to view
562 my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
565 ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
567 push(@out,$access_user);
571 # otherwise, you need an agent in common
572 foreach my $agent (@agents) {
573 if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
574 push(@out,$access_user);
582 =item access_users_hashref [ HASHREF | OPTION => VALUE ... ]
584 Accepts same options as L</access_users>. Returns a hashref of
585 users, with keys of usernum and values of username.
589 sub access_users_hashref {
591 my %access_users = map { $_->usernum => $_->username }
592 $self->access_users(@_);
593 return \%access_users;
596 =item access_right RIGHTNAME | LISTREF
598 Given a right name or a list reference of right names, returns true if this
599 user has this right, or, for a list, one of the rights (currently via group
600 membership, eventually also via user overrides).
605 my( $self, $rightname ) = @_;
607 $rightname = [ $rightname ] unless ref($rightname);
609 warn "$me access_right called on ". join(', ', @$rightname). "\n"
612 #some caching of ACL requests for low-hanging fruit perf improvement
613 #since we get a new $CurrentUser object each page view there shouldn't be any
614 #issues with stickiness
615 if ( $self->{_ACLcache} ) {
617 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
618 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
620 return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
623 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
628 warn "initializing ACL cache\n"
630 $self->{_ACLcache} = {};
634 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
636 my $sth = dbh->prepare("
637 SELECT groupnum FROM access_usergroup
638 LEFT JOIN access_group USING ( groupnum )
639 LEFT JOIN access_right
640 ON ( access_group.groupnum = access_right.rightobjnum )
642 AND righttype = 'FS::access_group'
645 ") or die dbh->errstr;
646 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
647 my $row = $sth->fetchrow_arrayref;
649 my $return = $row ? $row->[0] : '';
651 #just caching the single-rightname hits should be enough of a win for now
652 if ( scalar(@$rightname) == 1 ) {
653 $self->{_ACLcache}{${$rightname}[0]} = $return;
660 =item refund_rights PAYBY
662 Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
663 list of the refund rights associated with that $payby.
665 Returns empty list if $payby wasn't recognized.
673 push @rights, 'Post refund' if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
674 push @rights, 'Post check refund' if $payby eq 'BILL';
675 push @rights, 'Post cash refund ' if $payby eq 'CASH';
676 push @rights, 'Refund payment' if $payby =~ /^(CARD|CHEK)$/;
677 push @rights, 'Refund credit card payment' if $payby eq 'CARD';
678 push @rights, 'Refund Echeck payment' if $payby eq 'CHEK';
682 =item refund_access_right PAYBY
684 Returns true if user has L</access_right> for any L</refund_rights>
685 for the specified payby.
689 sub refund_access_right {
692 my @rights = $self->refund_rights($payby);
693 return '' unless @rights;
694 return $self->access_right(\@rights);
697 =item default_customer_view
699 Returns the default customer view for this user, from the
700 "default_customer_view" user preference, the "cust_main-default_view" config,
701 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
705 sub default_customer_view {
708 $self->option('default_customer_view')
709 || $conf->config('cust_main-default_view')
710 || 'basics'; #s/jumbo/basics/ starting with 3.0
714 =item spreadsheet_format [ OVERRIDE ]
716 Returns a hashref of this user's Excel spreadsheet download settings:
717 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
718 Excel::Writer::XLSX), and 'mime_type'. If OVERRIDE is 'XLS' or 'XLSX',
719 use that instead of the user's setting.
723 # is there a better place to put this?
727 class => 'Spreadsheet::WriteExcel',
728 mime_type => 'application/vnd.ms-excel',
731 extension => '.xlsx',
732 class => 'Excel::Writer::XLSX',
733 mime_type => # it's on wikipedia, it must be true
734 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
738 sub spreadsheet_format {
740 my $override = shift;
743 || $self->option('spreadsheet_format')
744 || $conf->config('spreadsheet_format')
752 Returns true if this user has the name of a known system account. These
753 users will not appear in the htpasswd file and can't have passwords set.
759 return grep { $_ eq $self->username } ( qw(
772 qsearch( 'sched_item', { 'usernum' => $self->usernum } );
781 return $self->{_locale} if exists($self->{_locale});
782 $self->{_locale} = $self->option('locale');
785 =item get_page_pref PATH, NAME, TABLENUM
787 Returns the user's page preference named NAME for the page at PATH. If the
788 page is a view or edit page or otherwise shows a single record at a time,
789 it should use TABLENUM to tell which record the preference is for.
795 my ($path, $prefname, $tablenum) = @_;
798 my $access_user_page_pref = qsearchs('access_user_page_pref', {
800 usernum => $self->usernum,
801 tablenum => $tablenum,
802 prefname => $prefname,
804 $access_user_page_pref ? $access_user_page_pref->prefvalue : '';
807 =item set_page_pref PATH, NAME, TABLENUM, VALUE
809 Sets the user's page preference named NAME for the page at PATH. Use TABLENUM
810 as for get_page_pref.
816 my ($path, $prefname, $tablenum, $prefvalue) = @_;
820 my $access_user_page_pref = qsearchs('access_user_page_pref', {
822 usernum => $self->usernum,
823 tablenum => $tablenum,
824 prefname => $prefname,
826 if ( $access_user_page_pref ) {
827 if ( $prefvalue eq $access_user_page_pref->get('prefvalue') ) {
830 if ( length($prefvalue) > 0 ) {
831 $access_user_page_pref->set('prefvalue', $prefvalue);
832 $error = $access_user_page_pref->replace;
833 $error .= " (updating $prefname)" if $error;
835 $error = $access_user_page_pref->delete;
836 $error .= " (removing $prefname)" if $error;
839 if ( length($prefvalue) > 0 ) {
840 $access_user_page_pref = FS::access_user_page_pref->new({
842 usernum => $self->usernum,
843 tablenum => $tablenum,
844 prefname => $prefname,
845 prefvalue => $prefvalue,
847 $error = $access_user_page_pref->insert;
848 $error .= " (creating $prefname)" if $error;
861 qsearch('saved_search', { 'usernum' => $self->usernum });
866 Fetch the prefvalue column from L<FS::access_user_pref> for prefname NAME
868 Returns undef when no value has been saved, or when record has expired
873 my ( $self, $prefname ) = @_;
874 croak 'prefname parameter requrired' unless $prefname;
876 my $pref_row = $self->get_pref_row( $prefname )
880 if $pref_row->expiration
881 && $pref_row->expiration < time();
883 $pref_row->prefvalue;
886 =item get_pref_row NAME
888 Fetch the row object from L<FS::access_user_pref> for prefname NAME
890 returns undef when no row has been created
895 my ( $self, $prefname ) = @_;
896 croak 'prefname parameter required' unless $prefname;
899 access_user_pref => {
900 usernum => $self->usernum,
901 prefname => $prefname,
906 =item set_pref NAME, VALUE, [EXPIRATION_EPOCH]
908 Add or update user preference in L<FS::access_user_pref> table
910 Passing an undefined VALUE will delete the user preference
918 my ( $prefname, $prefvalue, $expiration ) = @_;
920 return $self->delete_pref( $prefname )
921 unless defined $prefvalue;
923 if ( my $pref_row = $self->get_pref_row( $prefname )) {
925 if $pref_row->prefvalue eq $prefvalue;
927 $pref_row->prefvalue( $prefvalue );
928 $pref_row->expiration( $expiration || '');
930 if ( my $error = $pref_row->replace ) { croak $error }
935 my $pref_row = FS::access_user_pref->new({
936 usernum => $self->usernum,
937 prefname => $prefname,
938 prefvalue => $prefvalue,
939 expiration => $expiration,
941 if ( my $error = $pref_row->insert ) { croak $error }
946 =item delete_pref NAME
948 Delete user preference from L<FS::access_user_pref> table
953 my ( $self, $prefname ) = @_;
955 my $pref_row = $self->get_pref_row( $prefname )
958 if ( my $error = $pref_row->delete ) { croak $error }
967 L<FS::Record>, schema.html from the base documentation.