FS/FS/access_user.pm

   1 package FS::access_user;
   2
   3 use strict;
   4 use base qw( FS::m2m_Common FS::option_Common );
   5 use vars qw( $DEBUG $me $conf $htpasswd_file );
   6 use FS::UID;
   7 use FS::Conf;
   8 use FS::Record qw( qsearch qsearchs dbh );
   9 use FS::access_user_pref;
  10 use FS::access_usergroup;
  11 use FS::agent;
  12 use FS::cust_main;
  13 use FS::sales;
  14 use FS::sched_item;
  15
  16 $DEBUG = 0;
  17 $me = '[FS::access_user]';
  18
  19 #kludge htpasswd for now (i hope this bootstraps okay)
  20 FS::UID->install_callback( sub {
  21   $conf = new FS::Conf;
  22   $htpasswd_file = $conf->base_dir. '/htpasswd';
  23 } );
  24
  25 =head1 NAME
  26
  27 FS::access_user - Object methods for access_user records
  28
  29 =head1 SYNOPSIS
  30
  31   use FS::access_user;
  32
  33   $record = new FS::access_user \%hash;
  34   $record = new FS::access_user { 'column' => 'value' };
  35
  36   $error = $record->insert;
  37
  38   $error = $new_record->replace($old_record);
  39
  40   $error = $record->delete;
  41
  42   $error = $record->check;
  43
  44 =head1 DESCRIPTION
  45
  46 An FS::access_user object represents an internal access user.  FS::access_user
  47 inherits from FS::Record.  The following fields are currently supported:
  48
  49 =over 4
  50
  51 =item usernum - primary key
  52
  53 =item username -
  54
  55 =item _password -
  56
  57 =item last -
  58
  59 =item first -
  60
  61 =item disabled - empty or 'Y'
  62
  63 =back
  64
  65 =head1 METHODS
  66
  67 =over 4
  68
  69 =item new HASHREF
  70
  71 Creates a new internal access user.  To add the user to the database, see L<"insert">.
  72
  73 Note that this stores the hash reference, not a distinct copy of the hash it
  74 points to.  You can ask the object for a copy with the I<hash> method.
  75
  76 =cut
  77
  78 # the new method can be inherited from FS::Record, if a table method is defined
  79
  80 sub table { 'access_user'; }
  81
  82 sub _option_table    { 'access_user_pref'; }
  83 sub _option_namecol  { 'prefname'; }
  84 sub _option_valuecol { 'prefvalue'; }
  85
  86 =item insert
  87
  88 Adds this record to the database.  If there is an error, returns the error,
  89 otherwise returns false.
  90
  91 =cut
  92
  93 sub insert {
  94   my $self = shift;
  95
  96   my $error = $self->check;
  97   return $error if $error;
  98
  99   local $SIG{HUP} = 'IGNORE';
 100   local $SIG{INT} = 'IGNORE';
 101   local $SIG{QUIT} = 'IGNORE';
 102   local $SIG{TERM} = 'IGNORE';
 103   local $SIG{TSTP} = 'IGNORE';
 104   local $SIG{PIPE} = 'IGNORE';
 105
 106   my $oldAutoCommit = $FS::UID::AutoCommit;
 107   local $FS::UID::AutoCommit = 0;
 108   my $dbh = dbh;
 109
 110   $error = $self->htpasswd_kludge();
 111   if ( $error ) {
 112     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 113     return $error;
 114   }
 115
 116   $error = $self->SUPER::insert(@_);
 117
 118   if ( $error ) {
 119     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 120
 121     #make sure it isn't a dup username?  or you could nuke people's passwords
 122     #blah.  really just should do our own login w/cookies
 123     #and auth out of the db in the first place
 124     #my $hterror = $self->htpasswd_kludge('-D');
 125     #$error .= " - additionally received error cleaning up htpasswd file: $hterror"
 126     return $error;
 127
 128   } else {
 129     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 130     '';
 131   }
 132
 133 }
 134
 135 sub htpasswd_kludge {
 136   my $self = shift;
 137
 138   return '' if $self->is_system_user;
 139
 140   unshift @_, '-c' unless -e $htpasswd_file;
 141   if (
 142        system('htpasswd', '-b', @_,
 143                           $htpasswd_file,
 144                           $self->username,
 145                           $self->_password,
 146              ) == 0
 147      )
 148   {
 149     return '';
 150   } else {
 151     return 'htpasswd exited unsucessfully';
 152   }
 153 }
 154
 155 =item delete
 156
 157 Delete this record from the database.
 158
 159 =cut
 160
 161 sub delete {
 162   my $self = shift;
 163
 164   local $SIG{HUP} = 'IGNORE';
 165   local $SIG{INT} = 'IGNORE';
 166   local $SIG{QUIT} = 'IGNORE';
 167   local $SIG{TERM} = 'IGNORE';
 168   local $SIG{TSTP} = 'IGNORE';
 169   local $SIG{PIPE} = 'IGNORE';
 170
 171   my $oldAutoCommit = $FS::UID::AutoCommit;
 172   local $FS::UID::AutoCommit = 0;
 173   my $dbh = dbh;
 174
 175   my $error =
 176        $self->SUPER::delete(@_)
 177     || $self->htpasswd_kludge('-D')
 178   ;
 179
 180   if ( $error ) {
 181     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 182     return $error;
 183   } else {
 184     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 185     '';
 186   }
 187
 188 }
 189
 190 =item replace OLD_RECORD
 191
 192 Replaces the OLD_RECORD with this one in the database.  If there is an error,
 193 returns the error, otherwise returns false.
 194
 195 =cut
 196
 197 sub replace {
 198   my $new = shift;
 199
 200   my $old = ( ref($_[0]) eq ref($new) )
 201               ? shift
 202               : $new->replace_old;
 203
 204   local $SIG{HUP} = 'IGNORE';
 205   local $SIG{INT} = 'IGNORE';
 206   local $SIG{QUIT} = 'IGNORE';
 207   local $SIG{TERM} = 'IGNORE';
 208   local $SIG{TSTP} = 'IGNORE';
 209   local $SIG{PIPE} = 'IGNORE';
 210
 211   my $oldAutoCommit = $FS::UID::AutoCommit;
 212   local $FS::UID::AutoCommit = 0;
 213   my $dbh = dbh;
 214
 215   if ( $new->_password ne $old->_password ) {
 216     my $error = $new->htpasswd_kludge();
 217     if ( $error ) {
 218       $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 219       return $error;
 220     }
 221   } elsif ( $old->disabled && !$new->disabled
 222               && $new->_password =~ /changeme/i ) {
 223     return "Must change password when enabling this account";
 224   }
 225
 226   my $error = $new->SUPER::replace($old, @_);
 227
 228   if ( $error ) {
 229     $dbh->rollback or die $dbh->errstr if $oldAutoCommit;
 230     return $error;
 231   } else {
 232     $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 233     '';
 234   }
 235
 236 }
 237
 238 =item check
 239
 240 Checks all fields to make sure this is a valid internal access user.  If there is
 241 an error, returns the error, otherwise returns false.  Called by the insert
 242 and replace methods.
 243
 244 =cut
 245
 246 # the check method should currently be supplied - FS::Record contains some
 247 # data checking routines
 248
 249 sub check {
 250   my $self = shift;
 251
 252   my $error =
 253     $self->ut_numbern('usernum')
 254     || $self->ut_alpha_lower('username')
 255     || $self->ut_text('_password')
 256     || $self->ut_text('last')
 257     || $self->ut_text('first')
 258     || $self->ut_foreign_keyn('user_custnum', 'cust_main', 'custnum')
 259     || $self->ut_foreign_keyn('report_salesnum', 'sales', 'salesnum')
 260     || $self->ut_enum('disabled', [ '', 'Y' ] )
 261   ;
 262   return $error if $error;
 263
 264   $self->SUPER::check;
 265 }
 266
 267 =item name
 268
 269 Returns a name string for this user: "Last, First".
 270
 271 =cut
 272
 273 sub name {
 274   my $self = shift;
 275   return $self->username
 276     if $self->get('last') eq 'Lastname' && $self->first eq 'Firstname';
 277   return $self->get('last'). ', '. $self->first;
 278 }
 279
 280 =item user_cust_main
 281
 282 Returns the FS::cust_main object (see L<FS::cust_main>), if any, for this
 283 user.
 284
 285 =cut
 286
 287 sub user_cust_main {
 288   my $self = shift;
 289   qsearchs( 'cust_main', { 'custnum' => $self->user_custnum } );
 290 }
 291
 292 =item report_sales
 293
 294 Returns the FS::sales object (see L<FS::sales>), if any, for this
 295 user.
 296
 297 =cut
 298
 299 sub report_sales {
 300   my $self = shift;
 301   qsearchs( 'sales', { 'salesnum' => $self->report_salesnum } );
 302 }
 303
 304 =item access_usergroup
 305
 306 Returns links to the the groups this user is a part of, as FS::access_usergroup
 307 objects (see L<FS::access_usergroup>).
 308
 309 =cut
 310
 311 sub access_usergroup {
 312   my $self = shift;
 313   qsearch( 'access_usergroup', { 'usernum' => $self->usernum } );
 314 }
 315
 316 #=item access_groups
 317 #
 318 #=cut
 319 #
 320 #sub access_groups {
 321 #
 322 #}
 323 #
 324 #=item access_groupnames
 325 #
 326 #=cut
 327 #
 328 #sub access_groupnames {
 329 #
 330 #}
 331
 332 =item num_agents
 333
 334 Returns the number of agents this user can view (via group membership).
 335
 336 =cut
 337
 338 sub num_agents {
 339   my $self = shift;
 340   $self->scalar_sql(
 341     'SELECT COUNT(DISTINCT agentnum) FROM access_usergroup
 342                                      JOIN access_groupagent USING ( groupnum )
 343        WHERE usernum = ?',
 344     $self->usernum,
 345   );
 346 }
 347
 348 =item agentnums
 349
 350 Returns a list of agentnums this user can view (via group membership).
 351
 352 =cut
 353
 354 sub agentnums {
 355   my $self = shift;
 356   my $sth = dbh->prepare(
 357     "SELECT DISTINCT agentnum FROM access_usergroup
 358                               JOIN access_groupagent USING ( groupnum )
 359        WHERE usernum = ?"
 360   ) or die dbh->errstr;
 361   $sth->execute($self->usernum) or die $sth->errstr;
 362   map { $_->[0] } @{ $sth->fetchall_arrayref };
 363 }
 364
 365 =item agentnums_href
 366
 367 Returns a hashref of agentnums this user can view.
 368
 369 =cut
 370
 371 sub agentnums_href {
 372   my $self = shift;
 373   scalar( { map { $_ => 1 } $self->agentnums } );
 374 }
 375
 376 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
 377
 378 Returns an sql fragement to select only agentnums this user can view.
 379
 380 Options are passed as a hashref or a list.  Available options are:
 381
 382 =over 4
 383
 384 =item null
 385
 386 The frament will also allow the selection of null agentnums.
 387
 388 =item null_right
 389
 390 The fragment will also allow the selection of null agentnums if the current
 391 user has the provided access right
 392
 393 =item table
 394
 395 Optional table name in which agentnum is being checked.  Sometimes required to
 396 resolve 'column reference "agentnum" is ambiguous' errors.
 397
 398 =item viewall_right
 399
 400 All agents will be viewable if the current user has the provided access right.
 401 Defaults to 'View customers of all agents'.
 402
 403 =back
 404
 405 =cut
 406
 407 sub agentnums_sql {
 408   my( $self ) = shift;
 409   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 410
 411   my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
 412
 413   my @or = ();
 414
 415   my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
 416   if ( $self->access_right($viewall_right) ) {
 417     push @or, "$agentnum IS NOT NULL";
 418   } else {
 419     my @agentnums = $self->agentnums;
 420     push @or, "$agentnum IN (". join(',', @agentnums). ')'
 421       if @agentnums;
 422   }
 423
 424   push @or, "$agentnum IS NULL"
 425     if $opt{'null'}
 426     || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
 427
 428   return ' 1 = 0 ' unless scalar(@or);
 429   '( '. join( ' OR ', @or ). ' )';
 430
 431 }
 432
 433 =item agentnum
 434
 435 Returns true if the user can view the specified agent.
 436
 437 Also accepts optional hashref cache, to avoid redundant database calls.
 438
 439 =cut
 440
 441 sub agentnum {
 442   my( $self, $agentnum, $cache ) = @_;
 443   $cache ||= {};
 444   return $cache->{$self->usernum}->{$agentnum}
 445     if $cache->{$self->usernum}->{$agentnum};
 446   my $sth = dbh->prepare(
 447     "SELECT COUNT(*) FROM access_usergroup
 448                      JOIN access_groupagent USING ( groupnum )
 449        WHERE usernum = ? AND agentnum = ?"
 450   ) or die dbh->errstr;
 451   $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
 452   $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
 453   $sth->finish;
 454   return $cache->{$self->usernum}->{$agentnum};
 455 }
 456
 457 =item agents [ HASHREF | OPTION => VALUE ... ]
 458
 459 Returns the list of agents this user can view (via group membership), as
 460 FS::agent objects.  Accepts the same options as the agentnums_sql method.
 461
 462 =cut
 463
 464 sub agents {
 465   my $self = shift;
 466   qsearch({
 467     'table'     => 'agent',
 468     'hashref'   => { disabled=>'' },
 469     'extra_sql' => ' AND '. $self->agentnums_sql(@_),
 470     'order_by'  => 'ORDER BY agent',
 471   });
 472 }
 473
 474 =item access_users [ HASHREF | OPTION => VALUE ... ]
 475
 476 Returns an array of FS::access_user objects, one for each non-disabled
 477 access_user in the system that shares an agent (via group membership) with
 478 the invoking object.  Regardless of options and agents, will always at
 479 least return the invoking user and any users who have viewall_right.
 480
 481 Accepts the following options:
 482
 483 =over 4
 484
 485 =item table
 486
 487 Only return users who appear in the usernum field of this table
 488
 489 =item disabled
 490
 491 Include disabled users if true (defaults to false)
 492
 493 =item viewall_right
 494
 495 All users will be returned if the current user has the provided
 496 access right, regardless of agents (other filters still apply.)
 497 Defaults to 'View customers of all agents'
 498
 499 =cut
 500
 501 #Leaving undocumented until such time as this functionality is actually used
 502 #
 503 #=item null
 504 #
 505 #Users with no agents will be returned.
 506 #
 507 #=item null_right
 508 #
 509 #Users with no agents will be returned if the current user has the provided
 510 #access right.
 511
 512 sub access_users {
 513   my $self = shift;
 514   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 515   my $table = $opt{'table'};
 516   my $search = { 'table' => 'access_user' };
 517   $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
 518   $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
 519     if $table;
 520   my @access_users = qsearch($search);
 521   my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
 522   return @access_users if $self->access_right($viewall_right);
 523   #filter for users with agents $self can view
 524   my @out;
 525   my $agentnum_cache = {};
 526 ACCESS_USER:
 527   foreach my $access_user (@access_users) {
 528     # you can always view yourself, regardless of agents,
 529     # and you can always view someone who can view you,
 530     # since they might have affected your customers
 531     if ( ($self->usernum eq $access_user->usernum)
 532          || $access_user->access_right($viewall_right)
 533     ) {
 534       push(@out,$access_user);
 535       next;
 536     }
 537     # if user has no agents, you need null or null_right to view
 538     my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
 539     if (!@agents) {
 540       if ( $opt{'null'} ||
 541            ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
 542       ) {
 543         push(@out,$access_user);
 544       }
 545       next;
 546     }
 547     # otherwise, you need an agent in common
 548     foreach my $agent (@agents) {
 549       if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
 550         push(@out,$access_user);
 551         next ACCESS_USER;
 552       }
 553     }
 554   }
 555   return @out;
 556 }
 557
 558 =item access_users_hashref  [ HASHREF | OPTION => VALUE ... ]
 559
 560 Accepts same options as L</access_users>.  Returns a hashref of
 561 users, with keys of usernum and values of username.
 562
 563 =cut
 564
 565 sub access_users_hashref {
 566   my $self = shift;
 567   my %access_users = map { $_->usernum => $_->username }
 568                        $self->access_users(@_);
 569   return \%access_users;
 570 }
 571
 572 =item access_right RIGHTNAME | LISTREF
 573
 574 Given a right name or a list reference of right names, returns true if this
 575 user has this right, or, for a list, one of the rights (currently via group
 576 membership, eventually also via user overrides).
 577
 578 =cut
 579
 580 sub access_right {
 581   my( $self, $rightname ) = @_;
 582
 583   $rightname = [ $rightname ] unless ref($rightname);
 584
 585   warn "$me access_right called on ". join(', ', @$rightname). "\n"
 586     if $DEBUG;
 587
 588   #some caching of ACL requests for low-hanging fruit perf improvement
 589   #since we get a new $CurrentUser object each page view there shouldn't be any
 590   #issues with stickiness
 591   if ( $self->{_ACLcache} ) {
 592
 593     unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
 594       warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
 595         if $DEBUG;
 596       return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
 597     }
 598
 599     warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
 600       if $DEBUG;
 601
 602   } else {
 603
 604     warn "initializing ACL cache\n"
 605       if $DEBUG;
 606     $self->{_ACLcache} = {};
 607
 608   }
 609
 610   my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
 611
 612   my $sth = dbh->prepare("
 613     SELECT groupnum FROM access_usergroup
 614                     LEFT JOIN access_group USING ( groupnum )
 615                     LEFT JOIN access_right
 616                          ON ( access_group.groupnum = access_right.rightobjnum )
 617       WHERE usernum = ?
 618         AND righttype = 'FS::access_group'
 619         AND $has_right
 620       LIMIT 1
 621   ") or die dbh->errstr;
 622   $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
 623   my $row = $sth->fetchrow_arrayref;
 624
 625   my $return = $row ? $row->[0] : '';
 626
 627   #just caching the single-rightname hits should be enough of a win for now
 628   if ( scalar(@$rightname) == 1 ) {
 629     $self->{_ACLcache}{${$rightname}[0]} = $return;
 630   }
 631
 632   $return;
 633
 634 }
 635
 636 =item default_customer_view
 637
 638 Returns the default customer view for this user, from the
 639 "default_customer_view" user preference, the "cust_main-default_view" config,
 640 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
 641
 642 =cut
 643
 644 sub default_customer_view {
 645   my $self = shift;
 646
 647   $self->option('default_customer_view')
 648     || $conf->config('cust_main-default_view')
 649     || 'basics'; #s/jumbo/basics/ starting with 3.0
 650
 651 }
 652
 653 =item spreadsheet_format [ OVERRIDE ]
 654
 655 Returns a hashref of this user's Excel spreadsheet download settings:
 656 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
 657 Excel::Writer::XLSX), and 'mime_type'.  If OVERRIDE is 'XLS' or 'XLSX',
 658 use that instead of the user's setting.
 659
 660 =cut
 661
 662 # is there a better place to put this?
 663 my %formats = (
 664   XLS => {
 665     extension => '.xls',
 666     class => 'Spreadsheet::WriteExcel',
 667     mime_type => 'application/vnd.ms-excel',
 668   },
 669   XLSX => {
 670     extension => '.xlsx',
 671     class => 'Excel::Writer::XLSX',
 672     mime_type => # it's on wikipedia, it must be true
 673       'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
 674   }
 675 );
 676
 677 sub spreadsheet_format {
 678   my $self = shift;
 679   my $override = shift;
 680
 681   my $f =  $override
 682         || $self->option('spreadsheet_format')
 683         || $conf->config('spreadsheet_format')
 684         || 'XLS';
 685
 686   $formats{$f};
 687 }
 688
 689 =item is_system_user
 690
 691 Returns true if this user has the name of a known system account.  These
 692 users will not appear in the htpasswd file and can't have passwords set.
 693
 694 =cut
 695
 696 sub is_system_user {
 697   my $self = shift;
 698   return grep { $_ eq $self->username } ( qw(
 699     fs_queue
 700     fs_daily
 701     fs_selfservice
 702     fs_signup
 703     fs_bootstrap
 704     fs_selfserv
 705     fs_api
 706 ) );
 707 }
 708
 709 sub sched_item {
 710   my $self = shift;
 711   qsearch( 'sched_item', { 'usernum' => $self->usernum } );
 712 }
 713
 714 =back
 715
 716 =head1 BUGS
 717
 718 =head1 SEE ALSO
 719
 720 L<FS::Record>, schema.html from the base documentation.
 721
 722 =cut
 723
 724 1;
 725