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 refund_rights PAYBY
 637
 638 Accepts payment $payby (BILL,CASH,MCRD,MCHK,CARD,CHEK) and returns a
 639 list of the refund rights associated with that $payby.
 640
 641 Returns empty list if $payby wasn't recognized.
 642
 643 =cut
 644
 645 sub refund_rights {
 646   my $self = shift;
 647   my $payby = shift;
 648   my @rights = ();
 649   push @rights, 'Post refund'                if $payby =~ /^(BILL|CASH|MCRD|MCHK)$/;
 650   push @rights, 'Post check refund'          if $payby eq 'BILL';
 651   push @rights, 'Post cash refund '          if $payby eq 'CASH';
 652   push @rights, 'Refund payment'             if $payby =~ /^(CARD|CHEK)$/;
 653   push @rights, 'Refund credit card payment' if $payby eq 'CARD';
 654   push @rights, 'Refund Echeck payment'      if $payby eq 'CHEK';
 655   return @rights;
 656 }
 657
 658 =item refund_access_right PAYBY
 659
 660 Returns true if user has L</access_right> for any L</refund_rights>
 661 for the specified payby.
 662
 663 =cut
 664
 665 sub refund_access_right {
 666   my $self = shift;
 667   my $payby = shift;
 668   my @rights = $self->refund_rights($payby);
 669   return '' unless @rights;
 670   return $self->access_right(\@rights);
 671 }
 672
 673 =item default_customer_view
 674
 675 Returns the default customer view for this user, from the
 676 "default_customer_view" user preference, the "cust_main-default_view" config,
 677 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
 678
 679 =cut
 680
 681 sub default_customer_view {
 682   my $self = shift;
 683
 684   $self->option('default_customer_view')
 685     || $conf->config('cust_main-default_view')
 686     || 'basics'; #s/jumbo/basics/ starting with 3.0
 687
 688 }
 689
 690 =item spreadsheet_format [ OVERRIDE ]
 691
 692 Returns a hashref of this user's Excel spreadsheet download settings:
 693 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
 694 Excel::Writer::XLSX), and 'mime_type'.  If OVERRIDE is 'XLS' or 'XLSX',
 695 use that instead of the user's setting.
 696
 697 =cut
 698
 699 # is there a better place to put this?
 700 my %formats = (
 701   XLS => {
 702     extension => '.xls',
 703     class => 'Spreadsheet::WriteExcel',
 704     mime_type => 'application/vnd.ms-excel',
 705   },
 706   XLSX => {
 707     extension => '.xlsx',
 708     class => 'Excel::Writer::XLSX',
 709     mime_type => # it's on wikipedia, it must be true
 710       'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
 711   }
 712 );
 713
 714 sub spreadsheet_format {
 715   my $self = shift;
 716   my $override = shift;
 717
 718   my $f =  $override
 719         || $self->option('spreadsheet_format')
 720         || $conf->config('spreadsheet_format')
 721         || 'XLS';
 722
 723   $formats{$f};
 724 }
 725
 726 =item is_system_user
 727
 728 Returns true if this user has the name of a known system account.  These
 729 users will not appear in the htpasswd file and can't have passwords set.
 730
 731 =cut
 732
 733 sub is_system_user {
 734   my $self = shift;
 735   return grep { $_ eq $self->username } ( qw(
 736     fs_queue
 737     fs_daily
 738     fs_selfservice
 739     fs_signup
 740     fs_bootstrap
 741     fs_selfserv
 742     fs_api
 743 ) );
 744 }
 745
 746 sub sched_item {
 747   my $self = shift;
 748   qsearch( 'sched_item', { 'usernum' => $self->usernum } );
 749 }
 750
 751 =back
 752
 753 =head1 BUGS
 754
 755 =head1 SEE ALSO
 756
 757 L<FS::Record>, schema.html from the base documentation.
 758
 759 =cut
 760
 761 1;
 762