1 package FS::access_user;
4 use vars qw( @ISA $DEBUG $me $conf $htpasswd_file );
7 use FS::Record qw( qsearch qsearchs dbh );
10 use FS::access_user_pref;
11 use FS::access_usergroup;
15 @ISA = qw( FS::m2m_Common FS::option_Common FS::Record );
16 #@ISA = qw( FS::m2m_Common FS::option_Common );
19 $me = '[FS::access_user]';
21 #kludge htpasswd for now (i hope this bootstraps okay)
22 FS::UID->install_callback( sub {
24 $htpasswd_file = $conf->base_dir. '/htpasswd';
29 FS::access_user - Object methods for access_user records
35 $record = new FS::access_user \%hash;
36 $record = new FS::access_user { 'column' => 'value' };
38 $error = $record->insert;
40 $error = $new_record->replace($old_record);
42 $error = $record->delete;
44 $error = $record->check;
48 An FS::access_user object represents an internal access user. FS::access_user
49 inherits from FS::Record. The following fields are currently supported:
53 =item usernum - primary key
63 =item disabled - empty or 'Y'
73 Creates a new internal access user. To add the user to the database, see L<"insert">.
75 Note that this stores the hash reference, not a distinct copy of the hash it
76 points to. You can ask the object for a copy with the I<hash> method.
80 # the new method can be inherited from FS::Record, if a table method is defined
82 sub table { 'access_user'; }
84 sub _option_table { 'access_user_pref'; }
85 sub _option_namecol { 'prefname'; }
86 sub _option_valuecol { 'prefvalue'; }
90 Adds this record to the database. If there is an error, returns the error,
91 otherwise returns false.
98 my $error = $self->check;
99 return $error if $error;
101 local $SIG{HUP} = 'IGNORE';
102 local $SIG{INT} = 'IGNORE';
103 local $SIG{QUIT} = 'IGNORE';
104 local $SIG{TERM} = 'IGNORE';
105 local $SIG{TSTP} = 'IGNORE';
106 local $SIG{PIPE} = 'IGNORE';
108 my $oldAutoCommit = $FS::UID::AutoCommit;
109 local $FS::UID::AutoCommit = 0;
112 $error = $self->htpasswd_kludge();
114 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
118 $error = $self->SUPER::insert(@_);
121 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
123 #make sure it isn't a dup username? or you could nuke people's passwords
124 #blah. really just should do our own login w/cookies
125 #and auth out of the db in the first place
126 #my $hterror = $self->htpasswd_kludge('-D');
127 #$error .= " - additionally received error cleaning up htpasswd file: $hterror"
131 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
137 sub htpasswd_kludge {
140 #awful kludge to skip setting htpasswd for fs_* users
141 return '' if $self->username =~ /^fs_/;
143 unshift @_, '-c' unless -e $htpasswd_file;
145 system('htpasswd', '-b', @_,
154 return 'htpasswd exited unsucessfully';
160 Delete this record from the database.
167 local $SIG{HUP} = 'IGNORE';
168 local $SIG{INT} = 'IGNORE';
169 local $SIG{QUIT} = 'IGNORE';
170 local $SIG{TERM} = 'IGNORE';
171 local $SIG{TSTP} = 'IGNORE';
172 local $SIG{PIPE} = 'IGNORE';
174 my $oldAutoCommit = $FS::UID::AutoCommit;
175 local $FS::UID::AutoCommit = 0;
179 $self->SUPER::delete(@_)
180 || $self->htpasswd_kludge('-D')
184 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
187 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
193 =item replace OLD_RECORD
195 Replaces the OLD_RECORD with this one in the database. If there is an error,
196 returns the error, otherwise returns false.
203 my $old = ( ref($_[0]) eq ref($new) )
207 local $SIG{HUP} = 'IGNORE';
208 local $SIG{INT} = 'IGNORE';
209 local $SIG{QUIT} = 'IGNORE';
210 local $SIG{TERM} = 'IGNORE';
211 local $SIG{TSTP} = 'IGNORE';
212 local $SIG{PIPE} = 'IGNORE';
214 my $oldAutoCommit = $FS::UID::AutoCommit;
215 local $FS::UID::AutoCommit = 0;
218 if ( $new->_password ne $old->_password ) {
219 my $error = $new->htpasswd_kludge();
221 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
224 } elsif ( $old->disabled && !$new->disabled
225 && $new->_password =~ /changeme/i ) {
226 return "Must change password when enabling this account";
229 my $error = $new->SUPER::replace($old, @_);
232 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
235 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
243 Checks all fields to make sure this is a valid internal access user. If there is
244 an error, returns the error, otherwise returns false. Called by the insert
249 # the check method should currently be supplied - FS::Record contains some
250 # data checking routines
256 $self->ut_numbern('usernum')
257 || $self->ut_alpha_lower('username')
258 || $self->ut_text('_password')
259 || $self->ut_text('last')
260 || $self->ut_text('first')
261 || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
262 || $self->ut_enum('disabled', [ '', 'Y' ] )
264 return $error if $error;
271 Returns a name string for this user: "Last, First".
277 return $self->username
278 if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
279 return $self->get('last'). ', '. $self->first;
284 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
291 qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
294 =item access_usergroup
296 Returns links to the the groups this user is a part of, as FS::access_usergroup
297 objects (see L<FS::access_usergroup>).
301 sub access_usergroup {
303 qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
314 #=item access_groupnames
318 #sub access_groupnames {
324 Returns a list of agentnums this user can view (via group membership).
330 my $sth = dbh->prepare(
331 "SELECT DISTINCT agentnum FROM access_usergroup
332 JOIN access_groupagent USING ( groupnum )
334 ) or die dbh->errstr;
335 $sth->execute($self->usernum) or die $sth->errstr;
336 map { $_->[0] } @{ $sth->fetchall_arrayref };
341 Returns a hashref of agentnums this user can view.
347 scalar( { map { $_ => 1 } $self->agentnums } );
350 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
352 Returns an sql fragement to select only agentnums this user can view.
354 Options are passed as a hashref or a list. Available options are:
360 The frament will also allow the selection of null agentnums.
364 The fragment will also allow the selection of null agentnums if the current
365 user has the provided access right
369 Optional table name in which agentnum is being checked. Sometimes required to
370 resolve 'column reference "agentnum" is ambiguous' errors.
378 my %opt = ref($_[0]) ? %{$_[0]} : @_;
380 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
382 # my @agentnums = map { "$agentnum = $_" } $self->agentnums;
384 push @agentnums, "$agentnum IN (". join(',', $self->agentnums). ')';
386 push @agentnums, "$agentnum IS NULL"
388 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
390 return ' 1 = 0 ' unless scalar(@agentnums);
391 '( '. join( ' OR ', @agentnums ). ' )';
397 Returns true if the user can view the specified agent.
402 my( $self, $agentnum ) = @_;
403 my $sth = dbh->prepare(
404 "SELECT COUNT(*) FROM access_usergroup
405 JOIN access_groupagent USING ( groupnum )
406 WHERE usernum = ? AND agentnum = ?"
407 ) or die dbh->errstr;
408 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
409 $sth->fetchrow_arrayref->[0];
414 Returns the list of agents this user can view (via group membership), as
423 'hashref' => { disabled=>'' },
424 'extra_sql' => ' AND '. $self->agentnums_sql,
428 =item access_right RIGHTNAME | LISTREF
430 Given a right name or a list reference of right names, returns true if this
431 user has this right, or, for a list, one of the rights (currently via group
432 membership, eventually also via user overrides).
437 my( $self, $rightname ) = @_;
439 $rightname = [ $rightname ] unless ref($rightname);
441 warn "$me access_right called on ". join(', ', @$rightname). "\n"
444 #some caching of ACL requests for low-hanging fruit perf improvement
445 #since we get a new $CurrentUser object each page view there shouldn't be any
446 #issues with stickiness
447 if ( $self->{_ACLcache} ) {
449 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
450 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
452 return grep $self->{_ACLcache}{$_}, @$rightname
455 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
460 warn "initializing ACL cache\n"
462 $self->{_ACLcache} = {};
466 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
468 my $sth = dbh->prepare("
469 SELECT groupnum FROM access_usergroup
470 LEFT JOIN access_group USING ( groupnum )
471 LEFT JOIN access_right
472 ON ( access_group.groupnum = access_right.rightobjnum )
474 AND righttype = 'FS::access_group'
477 ") or die dbh->errstr;
478 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
479 my $row = $sth->fetchrow_arrayref;
481 my $return = $row ? $row->[0] : '';
483 #just caching the single-rightname hits should be enough of a win for now
484 if ( scalar(@$rightname) == 1 ) {
485 $self->{_ACLcache}{${$rightname}[0]} = $return;
492 =item default_customer_view
494 Returns the default customer view for this user, from the
495 "default_customer_view" user preference, the "cust_main-default_view" config,
496 or the hardcoded default, "jumbo" (may change to "basics" in the near future).
500 sub default_customer_view {
503 $self->option('default_customer_view')
504 || $conf->config('cust_main-default_view')
505 || 'jumbo'; #'basics' in 1.9.1?
515 L<FS::Record>, schema.html from the base documentation.