1 package FS::access_user;
4 use vars qw( @ISA $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 );
17 #kludge htpasswd for now (i hope this bootstraps okay)
18 FS::UID->install_callback( sub {
19 my $conf = new FS::Conf;
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 inherits from
45 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;
222 my $error = $new->SUPER::replace($old, @_);
225 $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
228 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
236 Checks all fields to make sure this is a valid internal access user. If there is
237 an error, returns the error, otherwise returns false. Called by the insert
242 # the check method should currently be supplied - FS::Record contains some
243 # data checking routines
249 $self->ut_numbern('usernum')
250 || $self->ut_alpha_lower('username')
251 || $self->ut_text('_password')
252 || $self->ut_text('last')
253 || $self->ut_text('first')
254 || $self->ut_enum('disabled', [ '', 'Y' ] )
256 return $error if $error;
263 Returns a name string for this user: "Last, First".
269 $self->get('last'). ', '. $self->first;
272 =item access_usergroup
276 sub access_usergroup {
278 qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
289 #=item access_groupnames
293 #sub access_groupnames {
299 Returns a list of agentnums this user can view (via group membership).
305 my $sth = dbh->prepare(
306 "SELECT DISTINCT agentnum FROM access_usergroup
307 JOIN access_groupagent USING ( groupnum )
309 ) or die dbh->errstr;
310 $sth->execute($self->usernum) or die $sth->errstr;
311 map { $_->[0] } @{ $sth->fetchall_arrayref };
316 Returns a hashref of agentnums this user can view.
322 scalar( { map { $_ => 1 } $self->agentnums } );
325 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
327 Returns an sql fragement to select only agentnums this user can view.
329 Options are passed as a hashref or a list. Available options are:
335 The frament will also allow the selection of null agentnums.
339 The fragment will also allow the selection of null agentnums if the current
340 user has the provided access right
344 Optional table name in which agentnum is being checked. Sometimes required to
345 resolve 'column reference "agentnum" is ambiguous' errors.
353 my %opt = ref($_[0]) ? %{$_[0]} : @_;
355 my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
357 # my @agentnums = map { "$agentnum = $_" } $self->agentnums;
359 push @agentnums, "$agentnum IN (". join(',', $self->agentnums). ')';
361 push @agentnums, "$agentnum IS NULL"
363 || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
365 return ' 1 = 0 ' unless scalar(@agentnums);
366 '( '. join( ' OR ', @agentnums ). ' )';
372 Returns true if the user can view the specified agent.
377 my( $self, $agentnum ) = @_;
378 my $sth = dbh->prepare(
379 "SELECT COUNT(*) FROM access_usergroup
380 JOIN access_groupagent USING ( groupnum )
381 WHERE usernum = ? AND agentnum = ?"
382 ) or die dbh->errstr;
383 $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
384 $sth->fetchrow_arrayref->[0];
389 Returns the list of agents this user can view (via group membership), as
398 'hashref' => { disabled=>'' },
399 'extra_sql' => ' AND '. $self->agentnums_sql,
403 =item access_right RIGHTNAME | LISTREF
405 Given a right name or a list reference of right names, returns true if this
406 user has this right, or, for a list, one of the rights (currently via group
407 membership, eventually also via user overrides).
412 my( $self, $rightname ) = @_;
414 $rightname = [ $rightname ] unless ref($rightname);
416 #some caching of ACL requests for low-hanging fruit perf improvement
417 #since we get a new $CurrentUser object each page view there shouldn't be any
418 #issues with stickiness
419 if ( $self->{_ACLcache} ) {
421 return grep $self->{_ACLcache}{$_}, @$rightname
422 unless grep !exists($self->{_ACLcache}{$_}), @$rightname;
425 $self->{_ACLcache} = {};
428 my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
430 my $sth = dbh->prepare("
431 SELECT groupnum FROM access_usergroup
432 LEFT JOIN access_group USING ( groupnum )
433 LEFT JOIN access_right
434 ON ( access_group.groupnum = access_right.rightobjnum )
436 AND righttype = 'FS::access_group'
439 ") or die dbh->errstr;
440 $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
441 my $row = $sth->fetchrow_arrayref;
443 #$row ? $row->[0] : '';
444 $self->{_ACLcache}{$rightname} = ( $row ? $row->[0] : '' );
454 L<FS::Record>, schema.html from the base documentation.