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;
15 $me = '[FS::access_user]';
17 #kludge htpasswd for now (i hope this bootstraps okay)
18 FS::UID->install_callback( sub {
20 $htpasswd_file = $conf->base_dir. '/htpasswd';
25 FS::access_user - Object methods for access_user records
31 $record = new FS::access_user \%hash;
32 $record = new FS::access_user { 'column' => 'value' };
34 $error = $record->insert;
36 $error = $new_record->replace($old_record);
38 $error = $record->delete;
40 $error = $record->check;
44 An FS::access_user object represents an internal access user. FS::access_user
45 inherits from FS::Record. The following fields are currently supported:
49 =item usernum - primary key
59 =item disabled - empty or 'Y'
69 Creates a new internal access user. To add the user to the database, see L<"insert">.
71 Note that this stores the hash reference, not a distinct copy of the hash it
72 points to. You can ask the object for a copy with the I<hash> method.
76 # the new method can be inherited from FS::Record, if a table method is defined
78 sub table { 'access_user'; }
80 sub _option_table { 'access_user_pref'; }
81 sub _option_namecol { 'prefname'; }
82 sub _option_valuecol { 'prefvalue'; }
86 Adds this record to the database. If there is an error, returns the error,
87 otherwise returns false.
94 my $error = $self->check;
95 return $error if $error;
97 local $SIG{HUP} = 'IGNORE';
98 local $SIG{INT} = 'IGNORE';
99 local $SIG{QUIT} = 'IGNORE';
100 local $SIG{TERM} = 'IGNORE';
101 local $SIG{TSTP} = 'IGNORE';
102 local $SIG{PIPE} = 'IGNORE';
104 my $oldAutoCommit = $FS::UID::AutoCommit;
105 local $FS::UID::AutoCommit = 0;
108 $error = $self->htpasswd_kludge();
110 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
114 $error = $self->SUPER::insert(@_);
117 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
119 #make sure it isn't a dup username? or you could nuke people's passwords
120 #blah. really just should do our own login w/cookies
121 #and auth out of the db in the first place
122 #my $hterror = $self->htpasswd_kludge('-D');
123 #$error .= " - additionally received error cleaning up htpasswd file: $hterror"
127 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
133 sub htpasswd_kludge {
136 #awful kludge to skip setting htpasswd for fs_* users
137 return '' if $self->username =~ /^fs_/;
139 unshift @_, '-c' unless -e $htpasswd_file;
141 system('htpasswd', '-b', @_,
150 return 'htpasswd exited unsucessfully';
156 Delete this record from the database.
163 local $SIG{HUP} = 'IGNORE';
164 local $SIG{INT} = 'IGNORE';
165 local $SIG{QUIT} = 'IGNORE';
166 local $SIG{TERM} = 'IGNORE';
167 local $SIG{TSTP} = 'IGNORE';
168 local $SIG{PIPE} = 'IGNORE';
170 my $oldAutoCommit = $FS::UID::AutoCommit;
171 local $FS::UID::AutoCommit = 0;
175 $self->SUPER::delete(@_)
176 || $self->htpasswd_kludge('-D')
180 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
183 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
189 =item replace OLD_RECORD
191 Replaces the OLD_RECORD with this one in the database. If there is an error,
192 returns the error, otherwise returns false.
199 my $old = ( ref($_[0]) eq ref($new) )
203 local $SIG{HUP} = 'IGNORE';
204 local $SIG{INT} = 'IGNORE';
205 local $SIG{QUIT} = 'IGNORE';
206 local $SIG{TERM} = 'IGNORE';
207 local $SIG{TSTP} = 'IGNORE';
208 local $SIG{PIPE} = 'IGNORE';
210 my $oldAutoCommit = $FS::UID::AutoCommit;
211 local $FS::UID::AutoCommit = 0;
214 if ( $new->_password ne $old->_password ) {
215 my $error = $new->htpasswd_kludge();
217 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
220 } elsif ( $old->disabled && !$new->disabled
221 && $new->_password =~ /changeme/i ) {
222 return "Must change password when enabling this account";
225 my $error = $new->SUPER::replace($old, @_);
228 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
231 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
239 Checks all fields to make sure this is a valid internal access user. If there is
240 an error, returns the error, otherwise returns false. Called by the insert
245 # the check method should currently be supplied - FS::Record contains some
246 # data checking routines
252 $self->ut_numbern('usernum')
253 || $self->ut_alpha_lower('username')
254 || $self->ut_text('_password')
255 || $self->ut_text('last')
256 || $self->ut_text('first')
257 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
258 || $self->ut_enum('disabled', [ '', 'Y' ] )
260 return $error if $error;
267 Returns a name string for this user: "Last, First".
273 return $self->username
274 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
275 return $self->get('last'). ', '. $self->first;
280 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
287 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
290 =item access_usergroup
292 Returns links to the the groups this user is a part of, as FS::access_usergroup
293 objects (see L<FS::access_usergroup>).
297 sub access_usergroup {
299 qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
310 #=item access_groupnames
314 #sub access_groupnames {
320 Returns a list of agentnums this user can view (via group membership).
326 my $sth = dbh->prepare(
327 "SELECT DISTINCT agentnum FROM access_usergroup
328 JOIN access_groupagent USING ( groupnum )
330 ) or die dbh->errstr;
331 $sth->execute($self->usernum) or die $sth->errstr;
332 map { $_->[0] } @{ $sth->fetchall_arrayref };
337 Returns a hashref of agentnums this user can view.
343 scalar( { map { $_ => 1 } $self->agentnums } );
346 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
348 Returns an sql fragement to select only agentnums this user can view.
350 Options are passed as a hashref or a list. Available options are:
356 The frament will also allow the selection of null agentnums.
360 The fragment will also allow the selection of null agentnums if the current
361 user has the provided access right
365 Optional table name in which agentnum is being checked. Sometimes required to
366 resolve 'column reference "agentnum" is ambiguous' errors.
370 All agents will be viewable if the current user has the provided access right.
371 Defaults to 'View customers of all agents'.
379 my %opt = ref($_[0]) ? %{$_[0]} : @_;
381 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
385 my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
386 if ( $self->access_right($viewall_right) ) {
387 push @or, "$agentnum IS NOT NULL";
389 push @or, "$agentnum IN (". join(',', $self->agentnums). ')';
392 push @or, "$agentnum IS NULL"
394 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
396 return ' 1 = 0 ' unless scalar(@or);
397 '( '. join( ' OR ', @or ). ' )';
403 Returns true if the user can view the specified agent.
408 my( $self, $agentnum ) = @_;
409 my $sth = dbh->prepare(
410 "SELECT COUNT(*) FROM access_usergroup
411 JOIN access_groupagent USING ( groupnum )
412 WHERE usernum = ? AND agentnum = ?"
413 ) or die dbh->errstr;
414 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
415 $sth->fetchrow_arrayref->[0];
418 =item agents [ HASHREF | OPTION => VALUE ... ]
420 Returns the list of agents this user can view (via group membership), as
421 FS::agent objects. Accepts the same options as the agentnums_sql method.
429 'hashref' => { disabled=>'' },
430 'extra_sql' => ' AND '. $self->agentnums_sql(@_),
434 =item access_right RIGHTNAME | LISTREF
436 Given a right name or a list reference of right names, returns true if this
437 user has this right, or, for a list, one of the rights (currently via group
438 membership, eventually also via user overrides).
443 my( $self, $rightname ) = @_;
445 $rightname = [ $rightname ] unless ref($rightname);
447 warn "$me access_right called on ". join(', ', @$rightname). "\n"
450 #some caching of ACL requests for low-hanging fruit perf improvement
451 #since we get a new $CurrentUser object each page view there shouldn't be any
452 #issues with stickiness
453 if ( $self->{_ACLcache} ) {
455 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
456 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
458 return grep $self->{_ACLcache}{$_}, @$rightname
461 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
466 warn "initializing ACL cache\n"
468 $self->{_ACLcache} = {};
472 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
474 my $sth = dbh->prepare("
475 SELECT groupnum FROM access_usergroup
476 LEFT JOIN access_group USING ( groupnum )
477 LEFT JOIN access_right
478 ON ( access_group.groupnum = access_right.rightobjnum )
480 AND righttype = 'FS::access_group'
483 ") or die dbh->errstr;
484 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
485 my $row = $sth->fetchrow_arrayref;
487 my $return = $row ? $row->[0] : '';
489 #just caching the single-rightname hits should be enough of a win for now
490 if ( scalar(@$rightname) == 1 ) {
491 $self->{_ACLcache}{${$rightname}[0]} = $return;
498 =item default_customer_view
500 Returns the default customer view for this user, from the
501 "default_customer_view" user preference, the "cust_main-default_view" config,
502 or the hardcoded default, "jumbo" (may change to "basics" in the near future).
506 sub default_customer_view {
509 $self->option('default_customer_view')
510 || $conf->config('cust_main-default_view')
511 || 'jumbo'; #'basics' in 1.9.1?
521 L<FS::Record>, schema.html from the base documentation.