1 package FS::access_user;
4 use vars qw( @ISA $DEBUG $me $htpasswd_file );
7 use FS::Record qw( qsearch qsearchs dbh );
10 use FS::access_user_pref;
11 use FS::access_usergroup;
14 @ISA = qw( FS::m2m_Common FS::option_Common FS::Record );
15 #@ISA = qw( FS::m2m_Common FS::option_Common );
18 $me = '[FS::access_user]';
20 #kludge htpasswd for now (i hope this bootstraps okay)
21 FS::UID->install_callback( sub {
22 my $conf = new FS::Conf;
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 inherits from
48 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 #awful kludge to skip setting htpasswd for fs_* users
140 return '' if $self->username =~ /^fs_/;
142 unshift @_, '-c' unless -e $htpasswd_file;
144 system('htpasswd', '-b', @_,
153 return 'htpasswd exited unsucessfully';
159 Delete this record from the database.
166 local $SIG{HUP} = 'IGNORE';
167 local $SIG{INT} = 'IGNORE';
168 local $SIG{QUIT} = 'IGNORE';
169 local $SIG{TERM} = 'IGNORE';
170 local $SIG{TSTP} = 'IGNORE';
171 local $SIG{PIPE} = 'IGNORE';
173 my $oldAutoCommit = $FS::UID::AutoCommit;
174 local $FS::UID::AutoCommit = 0;
178 $self->SUPER::delete(@_)
179 || $self->htpasswd_kludge('-D')
183 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
186 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
192 =item replace OLD_RECORD
194 Replaces the OLD_RECORD with this one in the database. If there is an error,
195 returns the error, otherwise returns false.
202 my $old = ( ref($_[0]) eq ref($new) )
206 local $SIG{HUP} = 'IGNORE';
207 local $SIG{INT} = 'IGNORE';
208 local $SIG{QUIT} = 'IGNORE';
209 local $SIG{TERM} = 'IGNORE';
210 local $SIG{TSTP} = 'IGNORE';
211 local $SIG{PIPE} = 'IGNORE';
213 my $oldAutoCommit = $FS::UID::AutoCommit;
214 local $FS::UID::AutoCommit = 0;
217 if ( $new->_password ne $old->_password ) {
218 my $error = $new->htpasswd_kludge();
220 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
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_enum('disabled', [ '', 'Y' ] )
259 return $error if $error;
266 Returns a name string for this user: "Last, First".
272 $self->get('last'). ', '. $self->first;
275 =item access_usergroup
279 sub access_usergroup {
281 qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
292 #=item access_groupnames
296 #sub access_groupnames {
302 Returns a list of agentnums this user can view (via group membership).
308 my $sth = dbh->prepare(
309 "SELECT DISTINCT agentnum FROM access_usergroup
310 JOIN access_groupagent USING ( groupnum )
312 ) or die dbh->errstr;
313 $sth->execute($self->usernum) or die $sth->errstr;
314 map { $_->[0] } @{ $sth->fetchall_arrayref };
319 Returns a hashref of agentnums this user can view.
325 scalar( { map { $_ => 1 } $self->agentnums } );
328 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
330 Returns an sql fragement to select only agentnums this user can view.
332 Options are passed as a hashref or a list. Available options are:
338 The frament will also allow the selection of null agentnums.
342 The fragment will also allow the selection of null agentnums if the current
343 user has the provided access right
347 Optional table name in which agentnum is being checked. Sometimes required to
348 resolve 'column reference "agentnum" is ambiguous' errors.
356 my %opt = ref($_[0]) ? %{$_[0]} : @_;
358 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
360 # my @agentnums = map { "$agentnum = $_" } $self->agentnums;
362 push @agentnums, "$agentnum IN (". join(',', $self->agentnums). ')';
364 push @agentnums, "$agentnum IS NULL"
366 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
368 return ' 1 = 0 ' unless scalar(@agentnums);
369 '( '. join( ' OR ', @agentnums ). ' )';
375 Returns true if the user can view the specified agent.
380 my( $self, $agentnum ) = @_;
381 my $sth = dbh->prepare(
382 "SELECT COUNT(*) FROM access_usergroup
383 JOIN access_groupagent USING ( groupnum )
384 WHERE usernum = ? AND agentnum = ?"
385 ) or die dbh->errstr;
386 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
387 $sth->fetchrow_arrayref->[0];
392 Returns the list of agents this user can view (via group membership), as
401 'hashref' => { disabled=>'' },
402 'extra_sql' => ' AND '. $self->agentnums_sql,
406 =item access_right RIGHTNAME | LISTREF
408 Given a right name or a list reference of right names, returns true if this
409 user has this right, or, for a list, one of the rights (currently via group
410 membership, eventually also via user overrides).
415 my( $self, $rightname ) = @_;
417 $rightname = [ $rightname ] unless ref($rightname);
419 warn "$me access_right called on ". join(', ', @$rightname). "\n"
422 #some caching of ACL requests for low-hanging fruit perf improvement
423 #since we get a new $CurrentUser object each page view there shouldn't be any
424 #issues with stickiness
425 if ( $self->{_ACLcache} ) {
427 unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
428 warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
430 return grep $self->{_ACLcache}{$_}, @$rightname
433 warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
438 warn "initializing ACL cache\n"
440 $self->{_ACLcache} = {};
444 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
446 my $sth = dbh->prepare("
447 SELECT groupnum FROM access_usergroup
448 LEFT JOIN access_group USING ( groupnum )
449 LEFT JOIN access_right
450 ON ( access_group.groupnum = access_right.rightobjnum )
452 AND righttype = 'FS::access_group'
455 ") or die dbh->errstr;
456 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
457 my $row = $sth->fetchrow_arrayref;
459 my $return = $row ? $row->[0] : '';
461 #just caching the single-rightname hits should be enough of a win for now
462 if ( scalar(@$rightname) == 1 ) {
463 $self->{_ACLcache}{${$rightname}[0]} = $return;
476 L<FS::Record>, schema.html from the base documentation.