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 agentnums
 333
 334 Returns a list of agentnums this user can view (via group membership).
 335
 336 =cut
 337
 338 sub agentnums {
 339   my $self = shift;
 340   my $sth = dbh->prepare(
 341     "SELECT DISTINCT agentnum FROM access_usergroup
 342                               JOIN access_groupagent USING ( groupnum )
 343        WHERE usernum = ?"
 344   ) or die dbh->errstr;
 345   $sth->execute($self->usernum) or die $sth->errstr;
 346   map { $_->[0] } @{ $sth->fetchall_arrayref };
 347 }
 348
 349 =item agentnums_href
 350
 351 Returns a hashref of agentnums this user can view.
 352
 353 =cut
 354
 355 sub agentnums_href {
 356   my $self = shift;
 357   scalar( { map { $_ => 1 } $self->agentnums } );
 358 }
 359
 360 =item agentnums_sql [ HASHREF | OPTION => VALUE ... ]
 361
 362 Returns an sql fragement to select only agentnums this user can view.
 363
 364 Options are passed as a hashref or a list.  Available options are:
 365
 366 =over 4
 367
 368 =item null
 369
 370 The frament will also allow the selection of null agentnums.
 371
 372 =item null_right
 373
 374 The fragment will also allow the selection of null agentnums if the current
 375 user has the provided access right
 376
 377 =item table
 378
 379 Optional table name in which agentnum is being checked.  Sometimes required to
 380 resolve 'column reference "agentnum" is ambiguous' errors.
 381
 382 =item viewall_right
 383
 384 All agents will be viewable if the current user has the provided access right.
 385 Defaults to 'View customers of all agents'.
 386
 387 =back
 388
 389 =cut
 390
 391 sub agentnums_sql {
 392   my( $self ) = shift;
 393   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 394
 395   my $agentnum = $opt{'table'} ? $opt{'table'}.'.agentnum' : 'agentnum';
 396
 397   my @or = ();
 398
 399   my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
 400   if ( $self->access_right($viewall_right) ) {
 401     push @or, "$agentnum IS NOT NULL";
 402   } else {
 403     my @agentnums = $self->agentnums;
 404     push @or, "$agentnum IN (". join(',', @agentnums). ')'
 405       if @agentnums;
 406   }
 407
 408   push @or, "$agentnum IS NULL"
 409     if $opt{'null'}
 410     || ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) );
 411
 412   return ' 1 = 0 ' unless scalar(@or);
 413   '( '. join( ' OR ', @or ). ' )';
 414
 415 }
 416
 417 =item agentnum
 418
 419 Returns true if the user can view the specified agent.
 420
 421 Also accepts optional hashref cache, to avoid redundant database calls.
 422
 423 =cut
 424
 425 sub agentnum {
 426   my( $self, $agentnum, $cache ) = @_;
 427   $cache ||= {};
 428   return $cache->{$self->usernum}->{$agentnum}
 429     if $cache->{$self->usernum}->{$agentnum};
 430   my $sth = dbh->prepare(
 431     "SELECT COUNT(*) FROM access_usergroup
 432                      JOIN access_groupagent USING ( groupnum )
 433        WHERE usernum = ? AND agentnum = ?"
 434   ) or die dbh->errstr;
 435   $sth->execute($self->usernum, $agentnum) or die $sth->errstr;
 436   $cache->{$self->usernum}->{$agentnum} = $sth->fetchrow_arrayref->[0];
 437   $sth->finish;
 438   return $cache->{$self->usernum}->{$agentnum};
 439 }
 440
 441 =item agents [ HASHREF | OPTION => VALUE ... ]
 442
 443 Returns the list of agents this user can view (via group membership), as
 444 FS::agent objects.  Accepts the same options as the agentnums_sql method.
 445
 446 =cut
 447
 448 sub agents {
 449   my $self = shift;
 450   qsearch({
 451     'table'     => 'agent',
 452     'hashref'   => { disabled=>'' },
 453     'extra_sql' => ' AND '. $self->agentnums_sql(@_),
 454     'order_by'  => 'ORDER BY agent',
 455   });
 456 }
 457
 458 =item access_users [ HASHREF | OPTION => VALUE ... ]
 459
 460 Returns an array of FS::access_user objects, one for each non-disabled
 461 access_user in the system that shares an agent (via group membership) with
 462 the invoking object.  Regardless of options and agents, will always at
 463 least return the invoking user and any users who have viewall_right.
 464
 465 Accepts the following options:
 466
 467 =over 4
 468
 469 =item table
 470
 471 Only return users who appear in the usernum field of this table
 472
 473 =item disabled
 474
 475 Include disabled users if true (defaults to false)
 476
 477 =item viewall_right
 478
 479 All users will be returned if the current user has the provided
 480 access right, regardless of agents (other filters still apply.)
 481 Defaults to 'View customers of all agents'
 482
 483 =cut
 484
 485 #Leaving undocumented until such time as this functionality is actually used
 486 #
 487 #=item null
 488 #
 489 #Users with no agents will be returned.
 490 #
 491 #=item null_right
 492 #
 493 #Users with no agents will be returned if the current user has the provided
 494 #access right.
 495
 496 sub access_users {
 497   my $self = shift;
 498   my %opt = ref($_[0]) ? %{$_[0]} : @_;
 499   my $table = $opt{'table'};
 500   my $search = { 'table' => 'access_user' };
 501   $search->{'hashref'} = $opt{'disabled'} ? {} : { 'disabled' => '' };
 502   $search->{'addl_from'} = "INNER JOIN $table ON (access_user.usernum = $table.usernum)"
 503     if $table;
 504   my @access_users = qsearch($search);
 505   my $viewall_right = $opt{'viewall_right'} || 'View customers of all agents';
 506   return @access_users if $self->access_right($viewall_right);
 507   #filter for users with agents $self can view
 508   my @out;
 509   my $agentnum_cache = {};
 510 ACCESS_USER:
 511   foreach my $access_user (@access_users) {
 512     # you can always view yourself, regardless of agents,
 513     # and you can always view someone who can view you,
 514     # since they might have affected your customers
 515     if ( ($self->usernum eq $access_user->usernum)
 516          || $access_user->access_right($viewall_right)
 517     ) {
 518       push(@out,$access_user);
 519       next;
 520     }
 521     # if user has no agents, you need null or null_right to view
 522     my @agents = $access_user->agents('viewall_right'=>'NONE'); #handled viewall_right above
 523     if (!@agents) {
 524       if ( $opt{'null'} ||
 525            ( $opt{'null_right'} && $self->access_right($opt{'null_right'}) )
 526       ) {
 527         push(@out,$access_user);
 528       }
 529       next;
 530     }
 531     # otherwise, you need an agent in common
 532     foreach my $agent (@agents) {
 533       if ($self->agentnum($agent->agentnum,$agentnum_cache)) {
 534         push(@out,$access_user);
 535         next ACCESS_USER;
 536       }
 537     }
 538   }
 539   return @out;
 540 }
 541
 542 =item access_users_hashref  [ HASHREF | OPTION => VALUE ... ]
 543
 544 Accepts same options as L</access_users>.  Returns a hashref of
 545 users, with keys of usernum and values of username.
 546
 547 =cut
 548
 549 sub access_users_hashref {
 550   my $self = shift;
 551   my %access_users = map { $_->usernum => $_->username }
 552                        $self->access_users(@_);
 553   return \%access_users;
 554 }
 555
 556 =item access_right RIGHTNAME | LISTREF
 557
 558 Given a right name or a list reference of right names, returns true if this
 559 user has this right, or, for a list, one of the rights (currently via group
 560 membership, eventually also via user overrides).
 561
 562 =cut
 563
 564 sub access_right {
 565   my( $self, $rightname ) = @_;
 566
 567   $rightname = [ $rightname ] unless ref($rightname);
 568
 569   warn "$me access_right called on ". join(', ', @$rightname). "\n"
 570     if $DEBUG;
 571
 572   #some caching of ACL requests for low-hanging fruit perf improvement
 573   #since we get a new $CurrentUser object each page view there shouldn't be any
 574   #issues with stickiness
 575   if ( $self->{_ACLcache} ) {
 576
 577     unless ( grep !exists($self->{_ACLcache}{$_}), @$rightname ) {
 578       warn "$me ACL cache hit for ". join(', ', @$rightname). "\n"
 579         if $DEBUG;
 580       return scalar( grep $self->{_ACLcache}{$_}, @$rightname );
 581     }
 582
 583     warn "$me ACL cache miss for ". join(', ', @$rightname). "\n"
 584       if $DEBUG;
 585
 586   } else {
 587
 588     warn "initializing ACL cache\n"
 589       if $DEBUG;
 590     $self->{_ACLcache} = {};
 591
 592   }
 593
 594   my $has_right = ' rightname IN ('. join(',', map '?', @$rightname ). ') ';
 595
 596   my $sth = dbh->prepare("
 597     SELECT groupnum FROM access_usergroup
 598                     LEFT JOIN access_group USING ( groupnum )
 599                     LEFT JOIN access_right
 600                          ON ( access_group.groupnum = access_right.rightobjnum )
 601       WHERE usernum = ?
 602         AND righttype = 'FS::access_group'
 603         AND $has_right
 604       LIMIT 1
 605   ") or die dbh->errstr;
 606   $sth->execute($self->usernum, @$rightname) or die $sth->errstr;
 607   my $row = $sth->fetchrow_arrayref;
 608
 609   my $return = $row ? $row->[0] : '';
 610
 611   #just caching the single-rightname hits should be enough of a win for now
 612   if ( scalar(@$rightname) == 1 ) {
 613     $self->{_ACLcache}{${$rightname}[0]} = $return;
 614   }
 615
 616   $return;
 617
 618 }
 619
 620 =item default_customer_view
 621
 622 Returns the default customer view for this user, from the
 623 "default_customer_view" user preference, the "cust_main-default_view" config,
 624 or the hardcoded default, "basics" (formerly "jumbo" prior to 3.0).
 625
 626 =cut
 627
 628 sub default_customer_view {
 629   my $self = shift;
 630
 631   $self->option('default_customer_view')
 632     || $conf->config('cust_main-default_view')
 633     || 'basics'; #s/jumbo/basics/ starting with 3.0
 634
 635 }
 636
 637 =item spreadsheet_format [ OVERRIDE ]
 638
 639 Returns a hashref of this user's Excel spreadsheet download settings:
 640 'extension' (xls or xlsx), 'class' (Spreadsheet::WriteExcel or
 641 Excel::Writer::XLSX), and 'mime_type'.  If OVERRIDE is 'XLS' or 'XLSX',
 642 use that instead of the user's setting.
 643
 644 =cut
 645
 646 # is there a better place to put this?
 647 my %formats = (
 648   XLS => {
 649     extension => '.xls',
 650     class => 'Spreadsheet::WriteExcel',
 651     mime_type => 'application/vnd.ms-excel',
 652   },
 653   XLSX => {
 654     extension => '.xlsx',
 655     class => 'Excel::Writer::XLSX',
 656     mime_type => # it's on wikipedia, it must be true
 657       'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
 658   }
 659 );
 660
 661 sub spreadsheet_format {
 662   my $self = shift;
 663   my $override = shift;
 664
 665   my $f =  $override
 666         || $self->option('spreadsheet_format')
 667         || $conf->config('spreadsheet_format')
 668         || 'XLS';
 669
 670   $formats{$f};
 671 }
 672
 673 =item is_system_user
 674
 675 Returns true if this user has the name of a known system account.  These
 676 users will not appear in the htpasswd file and can't have passwords set.
 677
 678 =cut
 679
 680 sub is_system_user {
 681   my $self = shift;
 682   return grep { $_ eq $self->username } ( qw(
 683     fs_queue
 684     fs_daily
 685     fs_selfservice
 686     fs_signup
 687     fs_bootstrap
 688     fs_selfserv
 689     fs_api
 690 ) );
 691 }
 692
 693 sub sched_item {
 694   my $self = shift;
 695   qsearch( 'sched_item', { 'usernum' => $self->usernum } );
 696 }
 697
 698 =back
 699
 700 =head1 BUGS
 701
 702 =head1 SEE ALSO
 703
 704 L<FS::Record>, schema.html from the base documentation.
 705
 706 =cut
 707
 708 1;
 709