FS/FS/access_user.pm

   1 package FS::access_user;
   2
   3 use strict;
   4 use vars qw( @ISA $htpasswd_file );
   5 use FS::UID;
   6 use FS::Conf;
   7 use FS::Record qw( qsearch qsearchs dbh );
   8 use FS::m2m_Common;
   9 use FS::option_Common;
  10 use FS::access_usergroup;
  11 use FS::agent;
  12
  13 @ISA = qw( FS::m2m_Common FS::option_Common FS::Record );
  14 #@ISA = qw( FS::m2m_Common FS::option_Common );
  15
  16 #kludge htpasswd for now (i hope this bootstraps okay)
  17 FS::UID->install_callback( sub {
  18   my $conf = new FS::Conf;
  19   $htpasswd_file = $conf->base_dir. '/htpasswd';
  20 } );
  21
  22 =head1 NAME
  23
  24 FS::access_user - Object methods for access_user records
  25
  26 =head1 SYNOPSIS
  27
  28   use FS::access_user;
  29
  30   $record = new FS::access_user \%hash;
  31   $record = new FS::access_user { 'column' => 'value' };
  32
  33   $error = $record->insert;
  34
  35   $error = $new_record->replace($old_record);
  36
  37   $error = $record->delete;
  38
  39   $error = $record->check;
  40
  41 =head1 DESCRIPTION
  42
  43 An FS::access_user object represents an internal access user.  FS::access_user inherits from
  44 FS::Record.  The following fields are currently supported:
  45
  46 =over 4
  47
  48 =item usernum - primary key
  49
  50 =item username -
  51
  52 =item _password -
  53
  54 =item last -
  55
  56 =item first -
  57
  58 =item disabled - empty or 'Y'
  59
  60 =back
  61
  62 =head1 METHODS
  63
  64 =over 4
  65
  66 =item new HASHREF
  67
  68 Creates a new internal access user.  To add the user to the database, see L<"insert">.
  69
  70 Note that this stores the hash reference, not a distinct copy of the hash it
  71 points to.  You can ask the object for a copy with the I<hash> method.
  72
  73 =cut
  74
  75 # the new method can be inherited from FS::Record, if a table method is defined
  76
  77 sub table { 'access_user'; }
  78
  79 sub _option_table    { 'access_user_pref'; }
  80 sub _option_namecol  { 'prefname'; }
  81 sub _option_valuecol { 'prefvalue'; }
  82
  83 =item insert
  84
  85 Adds this record to the database.  If there is an error, returns the error,
  86 otherwise returns false.
  87
  88 =cut
  89
  90 sub insert {
  91   my $self = shift;
  92
  93   my $error = $self->check;
  94   return $error if $error;
  95
  96   local $SIG{HUP} = 'IGNORE';
  97   local $SIG{INT} = 'IGNORE';
  98   local $SIG{QUIT} = 'IGNORE';
  99   local $SIG{TERM} = 'IGNORE';
 100   local $SIG{TSTP} = 'IGNORE';
 101   local $SIG{PIPE} = 'IGNORE';
 102
 103   my $oldAutoCommit = $FS::UID::AutoCommit;
 104   local $FS::UID::AutoCommit = 0;
 105   my $dbh = dbh;
 106
 107   $error = $self->htpasswd_kludge();
 108   if ( $error ) {
 109     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 110     return $error;
 111   }
 112
 113   $error = $self->SUPER::insert(@_);
 114
 115   if ( $error ) {
 116     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 117
 118     #make sure it isn't a dup username?  or you could nuke people's passwords
 119     #blah.  really just should do our own login w/cookies
 120     #and auth out of the db in the first place
 121     #my $hterror = $self->htpasswd_kludge('-D');
 122     #$error .= " - additionally received error cleaning up htpasswd file: $hterror"
 123     return $error;
 124
 125   } else {
 126     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 127     '';
 128   }
 129
 130 }
 131
 132 sub htpasswd_kludge {
 133   my $self = shift;
 134
 135   #awful kludge to skip setting htpasswd for fs_* users
 136   return '' if $self->username =~ /^fs_/;
 137
 138   unshift @_, '-c' unless -e $htpasswd_file;
 139   if (
 140        system('htpasswd', '-b', @_,
 141                           $htpasswd_file,
 142                           $self->username,
 143                           $self->_password,
 144              ) == 0
 145      )
 146   {
 147     return '';
 148   } else {
 149     return 'htpasswd exited unsucessfully';
 150   }
 151 }
 152
 153 =item delete
 154
 155 Delete this record from the database.
 156
 157 =cut
 158
 159 sub delete {
 160   my $self = shift;
 161
 162   local $SIG{HUP} = 'IGNORE';
 163   local $SIG{INT} = 'IGNORE';
 164   local $SIG{QUIT} = 'IGNORE';
 165   local $SIG{TERM} = 'IGNORE';
 166   local $SIG{TSTP} = 'IGNORE';
 167   local $SIG{PIPE} = 'IGNORE';
 168
 169   my $oldAutoCommit = $FS::UID::AutoCommit;
 170   local $FS::UID::AutoCommit = 0;
 171   my $dbh = dbh;
 172
 173   my $error =
 174        $self->SUPER::delete(@_)
 175     || $self->htpasswd_kludge('-D')
 176   ;
 177
 178   if ( $error ) {
 179     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 180     return $error;
 181   } else {
 182     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 183     '';
 184   }
 185
 186 }
 187
 188 =item replace OLD_RECORD
 189
 190 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 191 returns the error, otherwise returns false.
 192
 193 =cut
 194
 195 sub replace {
 196   my $new = shift;
 197
 198   my $old = ( ref($_[0]) eq ref($new) )
 199               ? shift
 200               : $new->replace_old;
 201
 202   local $SIG{HUP} = 'IGNORE';
 203   local $SIG{INT} = 'IGNORE';
 204   local $SIG{QUIT} = 'IGNORE';
 205   local $SIG{TERM} = 'IGNORE';
 206   local $SIG{TSTP} = 'IGNORE';
 207   local $SIG{PIPE} = 'IGNORE';
 208
 209   my $oldAutoCommit = $FS::UID::AutoCommit;
 210   local $FS::UID::AutoCommit = 0;
 211   my $dbh = dbh;
 212
 213   if ( $new->_password ne $old->_password ) {
 214     my $error = $new->htpasswd_kludge();
 215     if ( $error ) {
 216       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 217       return $error;
 218     }
 219   }
 220
 221   my $error = $new->SUPER::replace($old, @_);
 222
 223   if ( $error ) {
 224     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 225     return $error;
 226   } else {
 227     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 228     '';
 229   }
 230
 231 }
 232
 233 =item check
 234
 235 Checks all fields to make sure this is a valid internal access user.  If there is
 236 an error, returns the error, otherwise returns false.  Called by the insert
 237 and replace methods.
 238
 239 =cut
 240
 241 # the check method should currently be supplied - FS::Record contains some
 242 # data checking routines
 243
 244 sub check {
 245   my $self = shift;
 246
 247   my $error =
 248     $self->ut_numbern('usernum')
 249     || $self->ut_alpha_lower('username')
 250     || $self->ut_text('_password')
 251     || $self->ut_text('last')
 252     || $self->ut_text('first')
 253     || $self->ut_enum('disabled', [ '', 'Y' ] )
 254   ;
 255   return $error if $error;
 256
 257   $self->SUPER::check;
 258 }
 259
 260 =item name
 261
 262 Returns a name string for this user: "Last, First".
 263
 264 =cut
 265
 266 sub name {
 267   my $self = shift;
 268   $self->get('last'). ', '. $self->first;
 269 }
 270
 271 =item access_usergroup
 272
 273 =cut
 274
 275 sub access_usergroup {
 276   my $self = shift;
 277   qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
 278 }
 279
 280 #=item access_groups
 281 #
 282 #=cut
 283 #
 284 #sub access_groups {
 285 #
 286 #}
 287 #
 288 #=item access_groupnames
 289 #
 290 #=cut
 291 #
 292 #sub access_groupnames {
 293 #
 294 #}
 295
 296 =item agentnums
 297
 298 Returns a list of agentnums this user can view (via group membership).
 299
 300 =cut
 301
 302 sub agentnums {
 303   my $self = shift;
 304   my $sth = dbh->prepare(
 305     "SELECT DISTINCT agentnum FROM access_usergroup
 306                               JOIN access_groupagent USING ( groupnum )
 307        WHERE usernum = ?"
 308   ) or die dbh->errstr;
 309   $sth->execute($self->usernum) or die $sth->errstr;
 310   map { $_->[0] } @{ $sth->fetchall_arrayref };
 311 }
 312
 313 =item agentnums_href
 314
 315 Returns a hashref of agentnums this user can view.
 316
 317 =cut
 318
 319 sub agentnums_href {
 320   my $self = shift;
 321   scalar( { map { $_ => 1 } $self->agentnums } );
 322 }
 323
 324 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
 325
 326 Returns an sql fragement to select only agentnums this user can view.
 327
 328 Options are passed as a hashref or a list.  Available options are:
 329
 330 =over 4
 331
 332 =item null
 333
 334 The frament will also allow the selection of null agentnums.
 335
 336 =item null_right
 337
 338 The fragment will also allow the selection of null agentnums if the current
 339 user has the provided access right
 340
 341 =item table
 342
 343 Optional table name in which agentnum is being checked.  Sometimes required to
 344 resolve 'column reference "agentnum" is ambiguous' errors.
 345
 346 =back
 347
 348 =cut
 349
 350 sub agentnums_sql {
 351   my( $self ) = shift;
 352   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 353
 354   my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
 355
 356   my @agentnums = map { "$agentnum = $_" } $self->agentnums;
 357
 358   push @agentnums, "$agentnum IS NULL"
 359     if $opt{'null'}
 360     || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
 361
 362   return ' 1 = 0 ' unless scalar(@agentnums);
 363   '( '. join( ' OR ', @agentnums ). ' )';
 364 }
 365
 366 =item agentnum
 367
 368 Returns true if the user can view the specified agent.
 369
 370 =cut
 371
 372 sub agentnum {
 373   my( $self, $agentnum ) = @_;
 374   my $sth = dbh->prepare(
 375     "SELECT COUNT(*) FROM access_usergroup
 376                      JOIN access_groupagent USING ( groupnum )
 377        WHERE usernum = ? AND agentnum = ?"
 378   ) or die dbh->errstr;
 379   $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
 380   $sth->fetchrow_arrayref->[0];
 381 }
 382
 383 =item agents
 384
 385 Returns the list of agents this user can view (via group membership), as
 386 FS::agent objects.
 387
 388 =cut
 389
 390 sub agents {
 391   my $self = shift;
 392   qsearch({
 393     'table'     => 'agent',
 394     'hashref'   => { disabled=>'' },
 395     'extra_sql' => ' AND '. $self->agentnums_sql,
 396   });
 397 }
 398
 399 =item access_right
 400
 401 Given a right name, returns true if this user has this right (currently via
 402 group membership, eventually also via user overrides).
 403
 404 =cut
 405
 406 sub access_right {
 407   my( $self, $rightname ) = @_;
 408
 409   #some caching of ACL requests for low-hanging fruit perf improvement
 410   #since we get a new $CurrentUser object each page view there shouldn't be any
 411   #issues with stickiness
 412   if ( $self->{_ACLcache} ) {
 413     return $self->{_ACLcache}{$rightname}
 414       if exists($self->{_ACLcache}{$rightname});
 415   } else {
 416     $self->{_ACLcache} = {};
 417   }
 418
 419   my $sth = dbh->prepare("
 420     SELECT groupnum FROM access_usergroup
 421                     LEFT JOIN access_group USING ( groupnum )
 422                     LEFT JOIN access_right
 423                          ON ( access_group.groupnum = access_right.rightobjnum )
 424       WHERE usernum = ?
 425         AND righttype = 'FS::access_group'
 426         AND rightname = ?
 427       LIMIT 1
 428   ") or die dbh->errstr;
 429   $sth->execute($self->usernum, $rightname) or die $sth->errstr;
 430   my $row = $sth->fetchrow_arrayref;
 431
 432   #$row ? $row->[0] : '';
 433   $self->{_ACLcache}{$rightname} = ( $row ? $row->[0] : '' );
 434
 435 }
 436
 437 =back
 438
 439 =head1 BUGS
 440
 441 =head1 SEE ALSO
 442
 443 L<FS::Record>, schema.html from the base documentation.
 444
 445 =cut
 446
 447 1;
 448