rt/lib/RT/User_Overlay.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
   6 #                                          <jesse@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 =head1 NAME
  50
  51   RT::User - RT User object
  52
  53 =head1 SYNOPSIS
  54
  55   use RT::User;
  56
  57 =head1 DESCRIPTION
  58
  59
  60 =head1 METHODS
  61
  62
  63
  64 =cut
  65
  66
  67 package RT::User;
  68
  69 use strict;
  70 no warnings qw(redefine);
  71
  72 use Digest::MD5;
  73 use RT::Principals;
  74 use RT::ACE;
  75 use RT::Interface::Email;
  76 use Encode;
  77
  78 sub _OverlayAccessible {
  79     {
  80
  81         Name                    => { public => 1,  admin => 1 },
  82           Password              => { read   => 0 },
  83           EmailAddress          => { public => 1 },
  84           Organization          => { public => 1,  admin => 1 },
  85           RealName              => { public => 1 },
  86           NickName              => { public => 1 },
  87           Lang                  => { public => 1 },
  88           EmailEncoding         => { public => 1 },
  89           WebEncoding           => { public => 1 },
  90           ExternalContactInfoId => { public => 1,  admin => 1 },
  91           ContactInfoSystem     => { public => 1,  admin => 1 },
  92           ExternalAuthId        => { public => 1,  admin => 1 },
  93           AuthSystem            => { public => 1,  admin => 1 },
  94           Gecos                 => { public => 1,  admin => 1 },
  95           PGPKey                => { public => 1,  admin => 1 },
  96
  97     }
  98 }
  99
 100
 101
 102 =head2 Create { PARAMHASH }
 103
 104
 105
 106 =cut
 107
 108
 109 sub Create {
 110     my $self = shift;
 111     my %args = (
 112         Privileged => 0,
 113         Disabled => 0,
 114         EmailAddress => '',
 115         _RecordTransaction => 1,
 116         @_    # get the real argumentlist
 117     );
 118
 119     # remove the value so it does not cripple SUPER::Create
 120     my $record_transaction = delete $args{'_RecordTransaction'};
 121
 122     #Check the ACL
 123     unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
 124         return ( 0, $self->loc('Permission Denied') );
 125     }
 126
 127
 128     unless ($self->CanonicalizeUserInfo(\%args)) {
 129         return ( 0, $self->loc("Could not set user info") );
 130     }
 131
 132     $args{'EmailAddress'} = $self->CanonicalizeEmailAddress($args{'EmailAddress'});
 133
 134     # if the user doesn't have a name defined, set it to the email address
 135     $args{'Name'} = $args{'EmailAddress'} unless ($args{'Name'});
 136
 137
 138
 139     my $privileged = delete $args{'Privileged'};
 140
 141
 142     if ($args{'CryptedPassword'} ) {
 143         $args{'Password'} = $args{'CryptedPassword'};
 144         delete $args{'CryptedPassword'};
 145     }
 146     elsif ( !$args{'Password'} ) {
 147         $args{'Password'} = '*NO-PASSWORD*';
 148     }
 149     elsif ( length( $args{'Password'} ) < RT->Config->Get('MinimumPasswordLength') ) {
 150         return ( 0, $self->loc("Password needs to be at least [_1] characters long",RT->Config->Get('MinimumPasswordLength')) );
 151     }
 152
 153     else {
 154         $args{'Password'} = $self->_GeneratePassword($args{'Password'});
 155     }
 156
 157     #TODO Specify some sensible defaults.
 158
 159     unless ( $args{'Name'} ) {
 160         return ( 0, $self->loc("Must specify 'Name' attribute") );
 161     }
 162
 163     #SANITY CHECK THE NAME AND ABORT IF IT'S TAKEN
 164     if ($RT::SystemUser) {   #This only works if RT::SystemUser has been defined
 165         my $TempUser = RT::User->new($RT::SystemUser);
 166         $TempUser->Load( $args{'Name'} );
 167         return ( 0, $self->loc('Name in use') ) if ( $TempUser->Id );
 168
 169         my ($val, $message) = $self->ValidateEmailAddress( $args{'EmailAddress'} );
 170         return (0, $message) unless ( $val );
 171     }
 172     else {
 173         $RT::Logger->warning( "$self couldn't check for pre-existing users");
 174     }
 175
 176
 177     $RT::Handle->BeginTransaction();
 178     # Groups deal with principal ids, rather than user ids.
 179     # When creating this user, set up a principal Id for it.
 180     my $principal = RT::Principal->new($self->CurrentUser);
 181     my $principal_id = $principal->Create(PrincipalType => 'User',
 182                                 Disabled => $args{'Disabled'},
 183                                 ObjectId => '0');
 184     # If we couldn't create a principal Id, get the fuck out.
 185     unless ($principal_id) {
 186         $RT::Handle->Rollback();
 187         $RT::Logger->crit("Couldn't create a Principal on new user create.");
 188         $RT::Logger->crit("Strange things are afoot at the circle K");
 189         return ( 0, $self->loc('Could not create user') );
 190     }
 191
 192     $principal->__Set(Field => 'ObjectId', Value => $principal_id);
 193     delete $args{'Disabled'};
 194
 195     $self->SUPER::Create(id => $principal_id , %args);
 196     my $id = $self->Id;
 197
 198     #If the create failed.
 199     unless ($id) {
 200         $RT::Handle->Rollback();
 201         $RT::Logger->error("Could not create a new user - " .join('-', %args));
 202
 203         return ( 0, $self->loc('Could not create user') );
 204     }
 205
 206     my $aclstash = RT::Group->new($self->CurrentUser);
 207     my $stash_id = $aclstash->_CreateACLEquivalenceGroup($principal);
 208
 209     unless ($stash_id) {
 210         $RT::Handle->Rollback();
 211         $RT::Logger->crit("Couldn't stash the user in groupmembers");
 212         return ( 0, $self->loc('Could not create user') );
 213     }
 214
 215
 216     my $everyone = RT::Group->new($self->CurrentUser);
 217     $everyone->LoadSystemInternalGroup('Everyone');
 218     unless ($everyone->id) {
 219         $RT::Logger->crit("Could not load Everyone group on user creation.");
 220         $RT::Handle->Rollback();
 221         return ( 0, $self->loc('Could not create user') );
 222     }
 223
 224
 225     my ($everyone_id, $everyone_msg) = $everyone->_AddMember( InsideTransaction => 1, PrincipalId => $self->PrincipalId);
 226     unless ($everyone_id) {
 227         $RT::Logger->crit("Could not add user to Everyone group on user creation.");
 228         $RT::Logger->crit($everyone_msg);
 229         $RT::Handle->Rollback();
 230         return ( 0, $self->loc('Could not create user') );
 231     }
 232
 233
 234     my $access_class = RT::Group->new($self->CurrentUser);
 235     if ($privileged)  {
 236         $access_class->LoadSystemInternalGroup('Privileged');
 237     } else {
 238         $access_class->LoadSystemInternalGroup('Unprivileged');
 239     }
 240
 241     unless ($access_class->id) {
 242         $RT::Logger->crit("Could not load Privileged or Unprivileged group on user creation");
 243         $RT::Handle->Rollback();
 244         return ( 0, $self->loc('Could not create user') );
 245     }
 246
 247
 248     my ($ac_id, $ac_msg) = $access_class->_AddMember( InsideTransaction => 1, PrincipalId => $self->PrincipalId);
 249
 250     unless ($ac_id) {
 251         $RT::Logger->crit("Could not add user to Privileged or Unprivileged group on user creation. Aborted");
 252         $RT::Logger->crit($ac_msg);
 253         $RT::Handle->Rollback();
 254         return ( 0, $self->loc('Could not create user') );
 255     }
 256
 257
 258     if ( $record_transaction ) {
 259     $self->_NewTransaction( Type => "Create" );
 260     }
 261
 262     $RT::Handle->Commit;
 263
 264     return ( $id, $self->loc('User created') );
 265 }
 266
 267 =head2 SetPrivileged BOOL
 268
 269 If passed a true value, makes this user a member of the "Privileged"  PseudoGroup.
 270 Otherwise, makes this user a member of the "Unprivileged" pseudogroup.
 271
 272 Returns a standard RT tuple of (val, msg);
 273
 274
 275 =cut
 276
 277 sub SetPrivileged {
 278     my $self = shift;
 279     my $val = shift;
 280
 281     #Check the ACL
 282     unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
 283         return ( 0, $self->loc('Permission Denied') );
 284     }
 285
 286     my $priv = RT::Group->new($self->CurrentUser);
 287     $priv->LoadSystemInternalGroup('Privileged');
 288     unless ($priv->Id) {
 289         $RT::Logger->crit("Could not find Privileged pseudogroup");
 290         return(0,$self->loc("Failed to find 'Privileged' users pseudogroup."));
 291     }
 292
 293     my $unpriv = RT::Group->new($self->CurrentUser);
 294     $unpriv->LoadSystemInternalGroup('Unprivileged');
 295     unless ($unpriv->Id) {
 296         $RT::Logger->crit("Could not find unprivileged pseudogroup");
 297         return(0,$self->loc("Failed to find 'Unprivileged' users pseudogroup"));
 298     }
 299
 300     my $principal = $self->PrincipalId;
 301     if ($val) {
 302         if ($priv->HasMember($principal)) {
 303             #$RT::Logger->debug("That user is already privileged");
 304             return (0,$self->loc("That user is already privileged"));
 305         }
 306         if ($unpriv->HasMember($principal)) {
 307             $unpriv->_DeleteMember($principal);
 308         } else {
 309         # if we had layered transactions, life would be good
 310         # sadly, we have to just go ahead, even if something
 311         # bogus happened
 312             $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
 313                 "unprivileged. something is drastically wrong.");
 314         }
 315         my ($status, $msg) = $priv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
 316         if ($status) {
 317             return (1, $self->loc("That user is now privileged"));
 318         } else {
 319             return (0, $msg);
 320         }
 321     }
 322     else {
 323         if ($unpriv->HasMember($principal)) {
 324             #$RT::Logger->debug("That user is already unprivileged");
 325             return (0,$self->loc("That user is already unprivileged"));
 326         }
 327         if ($priv->HasMember($principal)) {
 328             $priv->_DeleteMember( $principal );
 329         } else {
 330         # if we had layered transactions, life would be good
 331         # sadly, we have to just go ahead, even if something
 332         # bogus happened
 333             $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
 334                 "unprivileged. something is drastically wrong.");
 335         }
 336         my ($status, $msg) = $unpriv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
 337         if ($status) {
 338             return (1, $self->loc("That user is now unprivileged"));
 339         } else {
 340             return (0, $msg);
 341         }
 342     }
 343 }
 344
 345 =head2 Privileged
 346
 347 Returns true if this user is privileged. Returns undef otherwise.
 348
 349 =cut
 350
 351 sub Privileged {
 352     my $self = shift;
 353     my $priv = RT::Group->new($self->CurrentUser);
 354     $priv->LoadSystemInternalGroup('Privileged');
 355     if ( $priv->HasMember( $self->PrincipalId ) ) {
 356         return(1);
 357     }
 358     else {
 359         return(undef);
 360     }
 361 }
 362
 363 #create a user without validating _any_ data.
 364
 365 #To be used only on database init.
 366 # We can't localize here because it's before we _have_ a loc framework
 367
 368 sub _BootstrapCreate {
 369     my $self = shift;
 370     my %args = (@_);
 371
 372     $args{'Password'} = '*NO-PASSWORD*';
 373
 374
 375     $RT::Handle->BeginTransaction();
 376
 377     # Groups deal with principal ids, rather than user ids.
 378     # When creating this user, set up a principal Id for it.
 379     my $principal = RT::Principal->new($self->CurrentUser);
 380     my $principal_id = $principal->Create(PrincipalType => 'User', ObjectId => '0');
 381     $principal->__Set(Field => 'ObjectId', Value => $principal_id);
 382
 383     # If we couldn't create a principal Id, get the fuck out.
 384     unless ($principal_id) {
 385         $RT::Handle->Rollback();
 386         $RT::Logger->crit("Couldn't create a Principal on new user create. Strange things are afoot at the circle K");
 387         return ( 0, 'Could not create user' );
 388     }
 389     $self->SUPER::Create(id => $principal_id, %args);
 390     my $id = $self->Id;
 391     #If the create failed.
 392       unless ($id) {
 393       $RT::Handle->Rollback();
 394       return ( 0, 'Could not create user' ) ; #never loc this
 395     }
 396
 397     my $aclstash = RT::Group->new($self->CurrentUser);
 398     my $stash_id  = $aclstash->_CreateACLEquivalenceGroup($principal);
 399
 400     unless ($stash_id) {
 401         $RT::Handle->Rollback();
 402         $RT::Logger->crit("Couldn't stash the user in groupmembers");
 403         return ( 0, $self->loc('Could not create user') );
 404     }
 405
 406
 407     $RT::Handle->Commit();
 408
 409     return ( $id, 'User created' );
 410 }
 411
 412 sub Delete {
 413     my $self = shift;
 414
 415     return ( 0, $self->loc('Deleting this object would violate referential integrity') );
 416
 417 }
 418
 419 =head2 Load
 420
 421 Load a user object from the database. Takes a single argument.
 422 If the argument is numerical, load by the column 'id'. If a user
 423 object or its subclass passed then loads the same user by id.
 424 Otherwise, load by the "Name" column which is the user's textual
 425 username.
 426
 427 =cut
 428
 429 sub Load {
 430     my $self = shift;
 431     my $identifier = shift || return undef;
 432
 433     if ( $identifier !~ /\D/ ) {
 434         return $self->SUPER::LoadById( $identifier );
 435     }
 436     elsif ( UNIVERSAL::isa( $identifier, 'RT::User' ) ) {
 437         return $self->SUPER::LoadById( $identifier->Id );
 438     }
 439     else {
 440         return $self->LoadByCol( "Name", $identifier );
 441     }
 442 }
 443
 444 =head2 LoadByEmail
 445
 446 Tries to load this user object from the database by the user's email address.
 447
 448 =cut
 449
 450 sub LoadByEmail {
 451     my $self    = shift;
 452     my $address = shift;
 453
 454     # Never load an empty address as an email address.
 455     unless ($address) {
 456         return (undef);
 457     }
 458
 459     $address = $self->CanonicalizeEmailAddress($address);
 460
 461     #$RT::Logger->debug("Trying to load an email address: $address");
 462     return $self->LoadByCol( "EmailAddress", $address );
 463 }
 464
 465 =head2 LoadOrCreateByEmail ADDRESS
 466
 467 Attempts to find a user who has the provided email address. If that fails, creates an unprivileged user with
 468 the provided email address and loads them. Address can be provided either as L<Email::Address> object
 469 or string which is parsed using the module.
 470
 471 Returns a tuple of the user's id and a status message.
 472 0 will be returned in place of the user's id in case of failure.
 473
 474 =cut
 475
 476 sub LoadOrCreateByEmail {
 477     my $self = shift;
 478     my $email = shift;
 479
 480     my ($message, $name);
 481     if ( UNIVERSAL::isa( $email => 'Email::Address' ) ) {
 482         ($email, $name) = ($email->address, $email->phrase);
 483     } else {
 484         ($email, $name) = RT::Interface::Email::ParseAddressFromHeader( $email );
 485     }
 486
 487     $self->LoadByEmail( $email );
 488     $self->Load( $email ) unless $self->Id;
 489     $message = $self->loc('User loaded');
 490
 491     unless( $self->Id ) {
 492         my $val;
 493         ($val, $message) = $self->Create(
 494             Name         => $email,
 495             EmailAddress => $email,
 496             RealName     => $name,
 497             Privileged   => 0,
 498             Comments     => 'Autocreated when added as a watcher',
 499         );
 500         unless ( $val ) {
 501             # Deal with the race condition of two account creations at once
 502             $self->LoadByEmail( $email );
 503             unless ( $self->Id ) {
 504                 sleep 5;
 505                 $self->LoadByEmail( $email );
 506             }
 507             if ( $self->Id ) {
 508                 $RT::Logger->error("Recovered from creation failure due to race condition");
 509                 $message = $self->loc("User loaded");
 510             }
 511             else {
 512                 $RT::Logger->crit("Failed to create user ". $email .": " .$message);
 513             }
 514         }
 515     }
 516     return (0, $message) unless $self->id;
 517     return ($self->Id, $message);
 518 }
 519
 520 =head2 ValidateEmailAddress ADDRESS
 521
 522 Returns true if the email address entered is not in use by another user or is
 523 undef or ''. Returns false if it's in use.
 524
 525 =cut
 526
 527 sub ValidateEmailAddress {
 528     my $self  = shift;
 529     my $Value = shift;
 530
 531     # if the email address is null, it's always valid
 532     return (1) if ( !$Value || $Value eq "" );
 533
 534     if ( RT->Config->Get('ValidateUserEmailAddresses') ) {
 535         # We only allow one valid email address
 536         my @addresses = Email::Address->parse($Value);
 537         return ( 0, $self->loc('Invalid syntax for email address') ) unless ( ( scalar (@addresses) == 1 ) && ( $addresses[0]->address ) );
 538     }
 539
 540
 541     my $TempUser = RT::User->new($RT::SystemUser);
 542     $TempUser->LoadByEmail($Value);
 543
 544     if ( $TempUser->id && ( !$self->id || $TempUser->id != $self->id ) )
 545     {    # if we found a user with that address
 546             # it's invalid to set this user's address to it
 547         return ( 0, $self->loc('Email address in use') );
 548     }
 549     else {    #it's a valid email address
 550         return (1);
 551     }
 552 }
 553
 554 =head2 SetEmailAddress
 555
 556 Check to make sure someone else isn't using this email address already
 557 so that a better email address can be returned
 558
 559 =cut
 560
 561 sub SetEmailAddress {
 562     my $self = shift;
 563     my $Value = shift;
 564
 565     my ($val, $message) = $self->ValidateEmailAddress( $Value );
 566     if ( $val ) {
 567         return $self->_Set( Field => 'EmailAddress', Value => $Value );
 568     } else {
 569         return ( 0, $message )
 570     }
 571
 572 }
 573
 574 =head2 EmailFrequency
 575
 576 Takes optional Ticket argument in paramhash. Returns 'no email',
 577 'squelched', 'daily', 'weekly' or empty string depending on
 578 user preferences.
 579
 580 =over 4
 581
 582 =item 'no email' - user has no email, so can not recieve notifications.
 583
 584 =item 'squelched' - returned only when Ticket argument is provided and
 585 notifications to the user has been supressed for this ticket.
 586
 587 =item 'daily' - retruned when user recieve daily messages digest instead
 588 of immediate delivery.
 589
 590 =item 'weekly' - previous, but weekly.
 591
 592 =item empty string returned otherwise.
 593
 594 =back
 595
 596 =cut
 597
 598 sub EmailFrequency {
 599     my $self = shift;
 600     my %args = (
 601         Ticket => undef,
 602         @_
 603     );
 604     return '' unless $self->id && $self->id != $RT::Nobody->id
 605         && $self->id != $RT::SystemUser->id;
 606     return 'no email' unless my $email = $self->EmailAddress;
 607     return 'squelched' if $args{'Ticket'} &&
 608         grep lc $email eq lc $_->Content, $args{'Ticket'}->SquelchMailTo;
 609     my $frequency = RT->Config->Get( 'EmailFrequency', $self ) || '';
 610     return 'daily' if $frequency =~ /daily/i;
 611     return 'weekly' if $frequency =~ /weekly/i;
 612     return '';
 613 }
 614
 615 =head2 CanonicalizeEmailAddress ADDRESS
 616
 617 CanonicalizeEmailAddress converts email addresses into canonical form.
 618 it takes one email address in and returns the proper canonical
 619 form. You can dump whatever your proper local config is in here.  Note
 620 that it may be called as a static method; in this case the first argument
 621 is class name not an object.
 622
 623 =cut
 624
 625 sub CanonicalizeEmailAddress {
 626     my $self = shift;
 627     my $email = shift;
 628     # Example: the following rule would treat all email
 629     # coming from a subdomain as coming from second level domain
 630     # foo.com
 631     if ( my $match   = RT->Config->Get('CanonicalizeEmailAddressMatch') and
 632          my $replace = RT->Config->Get('CanonicalizeEmailAddressReplace') )
 633     {
 634         $email =~ s/$match/$replace/gi;
 635     }
 636     return ($email);
 637 }
 638
 639 =head2 CanonicalizeUserInfo HASH of ARGS
 640
 641 CanonicalizeUserInfo can convert all User->Create options.
 642 it takes a hashref of all the params sent to User->Create and
 643 returns that same hash, by default nothing is done.
 644
 645 This function is intended to allow users to have their info looked up via
 646 an outside source and modified upon creation.
 647
 648 =cut
 649
 650 sub CanonicalizeUserInfo {
 651     my $self = shift;
 652     my $args = shift;
 653     my $success = 1;
 654
 655     return ($success);
 656 }
 657
 658
 659 =head2 Password and authentication related functions
 660
 661 =head3 SetRandomPassword
 662
 663 Takes no arguments. Returns a status code and a new password or an error message.
 664 If the status is 1, the second value returned is the new password.
 665 If the status is anything else, the new value returned is the error code.
 666
 667 =cut
 668
 669 sub SetRandomPassword {
 670     my $self = shift;
 671
 672     unless ( $self->CurrentUserCanModify('Password') ) {
 673         return ( 0, $self->loc("Permission Denied") );
 674     }
 675
 676
 677     my $min = ( RT->Config->Get('MinimumPasswordLength') > 6 ?  RT->Config->Get('MinimumPasswordLength') : 6);
 678     my $max = ( RT->Config->Get('MinimumPasswordLength') > 8 ?  RT->Config->Get('MinimumPasswordLength') : 8);
 679
 680     my $pass = $self->GenerateRandomPassword( $min, $max) ;
 681
 682     # If we have "notify user on
 683
 684     my ( $val, $msg ) = $self->SetPassword($pass);
 685
 686     #If we got an error return the error.
 687     return ( 0, $msg ) unless ($val);
 688
 689     #Otherwise, we changed the password, lets return it.
 690     return ( 1, $pass );
 691
 692 }
 693
 694 =head3 ResetPassword
 695
 696 Returns status, [ERROR or new password].  Resets this user\'s password to
 697 a randomly generated pronouncable password and emails them, using a
 698 global template called "RT_PasswordChange", which can be overridden
 699 with global templates "RT_PasswordChange_Privileged" or "RT_PasswordChange_NonPrivileged"
 700 for privileged and Non-privileged users respectively.
 701
 702 =cut
 703
 704 sub ResetPassword {
 705     my $self = shift;
 706
 707     unless ( $self->CurrentUserCanModify('Password') ) {
 708         return ( 0, $self->loc("Permission Denied") );
 709     }
 710     my ( $status, $pass ) = $self->SetRandomPassword();
 711
 712     unless ($status) {
 713         return ( 0, "$pass" );
 714     }
 715
 716     my $ret = RT::Interface::Email::SendEmailUsingTemplate(
 717         To        => $self->EmailAddress,
 718         Template  => 'PasswordChange',
 719         Arguments => {
 720             NewPassword => $pass,
 721         },
 722         );
 723
 724     if ($ret) {
 725         return ( 1, $self->loc('New password notification sent') );
 726     }
 727     else {
 728         return ( 0, $self->loc('Notification could not be sent') );
 729     }
 730
 731 }
 732
 733 =head3 GenerateRandomPassword MIN_LEN and MAX_LEN
 734
 735 Returns a random password between MIN_LEN and MAX_LEN characters long.
 736
 737 =cut
 738
 739 sub GenerateRandomPassword {
 740     my $self       = shift;
 741     my $min_length = shift;
 742     my $max_length = shift;
 743
 744     #This code derived from mpw.pl, a bit of code with a sordid history
 745     # Its notes:
 746
 747     # Perl cleaned up a bit by Jesse Vincent 1/14/2001.
 748     # Converted to perl from C by Marc Horowitz, 1/20/2000.
 749     # Converted to C from Multics PL/I by Bill Sommerfeld, 4/21/86.
 750     # Original PL/I version provided by Jerry Saltzer.
 751
 752     my ( $frequency, $start_freq, $total_sum, $row_sums );
 753
 754     #When munging characters, we need to know where to start counting letters from
 755     my $a = ord('a');
 756
 757     # frequency of English digraphs (from D Edwards 1/27/66)
 758     $frequency = [
 759         [
 760             4, 20, 28, 52, 2,  11,  28, 4,  32, 4, 6, 62, 23, 167,
 761             2, 14, 0,  83, 76, 127, 7,  25, 8,  1, 9, 1
 762         ],    # aa - az
 763         [
 764             13, 0, 0, 0,  55, 0, 0,  0, 8, 2, 0,  22, 0, 0,
 765             11, 0, 0, 15, 4,  2, 13, 0, 0, 0, 15, 0
 766         ],    # ba - bz
 767         [
 768             32, 0, 7, 1,  69, 0,  0,  33, 17, 0, 10, 9, 1, 0,
 769             50, 3, 0, 10, 0,  28, 11, 0,  0,  0, 3,  0
 770         ],    # ca - cz
 771         [
 772             40, 16, 9, 5,  65, 18, 3,  9, 56, 0, 1, 4, 15, 6,
 773             16, 4,  0, 21, 18, 53, 19, 5, 15, 0, 3, 0
 774         ],    # da - dz
 775         [
 776             84, 20, 55, 125, 51, 40, 19, 16,  50,  1,
 777             4,  55, 54, 146, 35, 37, 6,  191, 149, 65,
 778             9,  26, 21, 12,  5,  0
 779         ],    # ea - ez
 780         [
 781             19, 3, 5, 1,  19, 21, 1, 3, 30, 2, 0, 11, 1, 0,
 782             51, 0, 0, 26, 8,  47, 6, 3, 3,  0, 2, 0
 783         ],    # fa - fz
 784         [
 785             20, 4, 3, 2,  35, 1,  3, 15, 18, 0, 0, 5, 1, 4,
 786             21, 1, 1, 20, 9,  21, 9, 0,  5,  0, 1, 0
 787         ],    # ga - gz
 788         [
 789             101, 1, 3, 0, 270, 5,  1, 6, 57, 0, 0, 0, 3, 2,
 790             44,  1, 0, 3, 10,  18, 6, 0, 5,  0, 3, 0
 791         ],    # ha - hz
 792         [
 793             40, 7,  51, 23, 25, 9,   11, 3,  0, 0, 2, 38, 25, 202,
 794             56, 12, 1,  46, 79, 117, 1,  22, 0, 4, 0, 3
 795         ],    # ia - iz
 796         [
 797             3, 0, 0, 0, 5, 0, 0, 0, 1, 0, 0, 0, 0, 0,
 798             4, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0
 799         ],    # ja - jz
 800         [
 801             1, 0, 0, 0, 11, 0, 0, 0, 13, 0, 0, 0, 0, 2,
 802             0, 0, 0, 0, 6,  2, 1, 0, 2,  0, 1, 0
 803         ],    # ka - kz
 804         [
 805             44, 2, 5, 12, 62, 7,  5, 2, 42, 1, 1,  53, 2, 2,
 806             25, 1, 1, 2,  16, 23, 9, 0, 1,  0, 33, 0
 807         ],    # la - lz
 808         [
 809             52, 14, 1, 0, 64, 0, 0, 3, 37, 0, 0, 0, 7, 1,
 810             17, 18, 1, 2, 12, 3, 8, 0, 1,  0, 2, 0
 811         ],    # ma - mz
 812         [
 813             42, 10, 47, 122, 63, 19, 106, 12, 30, 1,
 814             6,  6,  9,  7,   54, 7,  1,   7,  44, 124,
 815             6,  1,  15, 0,   12, 0
 816         ],    # na - nz
 817         [
 818             7,  12, 14, 17, 5,  95, 3,  5,  14, 0, 0, 19, 41, 134,
 819             13, 23, 0,  91, 23, 42, 55, 16, 28, 0, 4, 1
 820         ],    # oa - oz
 821         [
 822             19, 1, 0, 0,  37, 0, 0, 4, 8, 0, 0, 15, 1, 0,
 823             27, 9, 0, 33, 14, 7, 6, 0, 0, 0, 0, 0
 824         ],    # pa - pz
 825         [
 826             0, 0, 0, 0, 0, 0, 0,  0, 0, 0, 0, 0, 0, 0,
 827             0, 0, 0, 0, 0, 0, 17, 0, 0, 0, 0, 0
 828         ],    # qa - qz
 829         [
 830             83, 8, 16, 23, 169, 4,  8, 8,  77, 1, 10, 5, 26, 16,
 831             60, 4, 0,  24, 37,  55, 6, 11, 4,  0, 28, 0
 832         ],    # ra - rz
 833         [
 834             65, 9,  17, 9, 73, 13,  1,  47, 75, 3, 0, 7, 11, 12,
 835             56, 17, 6,  9, 48, 116, 35, 1,  28, 0, 4, 0
 836         ],    # sa - sz
 837         [
 838             57, 22, 3,  1, 76, 5, 2, 330, 126, 1,
 839             0,  14, 10, 6, 79, 7, 0, 49,  50,  56,
 840             21, 2,  27, 0, 24, 0
 841         ],    # ta - tz
 842         [
 843             11, 5,  9, 6,  9,  1,  6, 0, 9, 0, 1, 19, 5, 31,
 844             1,  15, 0, 47, 39, 31, 0, 3, 0, 0, 0, 0
 845         ],    # ua - uz
 846         [
 847             7, 0, 0, 0, 72, 0, 0, 0, 28, 0, 0, 0, 0, 0,
 848             5, 0, 0, 0, 0,  0, 0, 0, 0,  0, 3, 0
 849         ],    # va - vz
 850         [
 851             36, 1, 1, 0, 38, 0, 0, 33, 36, 0, 0, 4, 1, 8,
 852             15, 0, 0, 0, 4,  2, 0, 0,  1,  0, 0, 0
 853         ],    # wa - wz
 854         [
 855             1, 0, 2, 0, 0, 1, 0, 0, 3, 0, 0, 0, 0, 0,
 856             1, 5, 0, 0, 0, 3, 0, 0, 1, 0, 0, 0
 857         ],    # xa - xz
 858         [
 859             14, 5, 4, 2, 7,  12, 12, 6, 10, 0, 0, 3, 7, 5,
 860             17, 3, 0, 4, 16, 30, 0,  0, 5,  0, 0, 0
 861         ],    # ya - yz
 862         [
 863             1, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 864             0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
 865         ]
 866     ];    # za - zz
 867
 868     #We need to know the totals for each row
 869     $row_sums = [
 870         map {
 871             my $sum = 0;
 872             map { $sum += $_ } @$_;
 873             $sum;
 874           } @$frequency
 875     ];
 876
 877     #Frequency with which a given letter starts a word.
 878     $start_freq = [
 879         1299, 425, 725, 271, 375, 470, 93, 223, 1009, 24,
 880         20,   355, 379, 319, 823, 618, 21, 317, 962,  1991,
 881         271,  104, 516, 6,   16,  14
 882     ];
 883
 884     $total_sum = 0;
 885     map { $total_sum += $_ } @$start_freq;
 886
 887     my $length = $min_length + int( rand( $max_length - $min_length ) );
 888
 889     my $char = $self->_GenerateRandomNextChar( $total_sum, $start_freq );
 890     my @word = ( $char + $a );
 891     for ( 2 .. $length ) {
 892         $char =
 893           $self->_GenerateRandomNextChar( $row_sums->[$char],
 894             $frequency->[$char] );
 895         push ( @word, $char + $a );
 896     }
 897
 898     #Return the password
 899     return pack( "C*", @word );
 900
 901 }
 902
 903 #A private helper function for RandomPassword
 904 # Takes a row summary and a frequency chart for the next character to be searched
 905 sub _GenerateRandomNextChar {
 906     my $self = shift;
 907     my ( $all, $freq ) = @_;
 908     my ( $pos, $i );
 909
 910     for ( $pos = int( rand($all) ), $i = 0 ;
 911         $pos >= $freq->[$i] ;
 912         $pos -= $freq->[$i], $i++ )
 913     {
 914     }
 915
 916     return ($i);
 917 }
 918
 919 sub SafeSetPassword {
 920     my $self = shift;
 921     my %args = (
 922         Current      => undef,
 923         New          => undef,
 924         Confirmation => undef,
 925         @_,
 926     );
 927     return (1) unless defined $args{'New'} && length $args{'New'};
 928
 929     my %cond = $self->CurrentUserRequireToSetPassword;
 930
 931     unless ( $cond{'CanSet'} ) {
 932         return (0, $self->loc('You can not set password.') .' '. $cond{'Reason'} );
 933     }
 934
 935     my $error = '';
 936     if ( $cond{'RequireCurrent'} && !$self->CurrentUser->IsPassword($args{'Current'}) ) {
 937         if ( defined $args{'Current'} && length $args{'Current'} ) {
 938             $error = $self->loc("Please enter your current password correctly.");
 939         }
 940         else {
 941             $error = $self->loc("Please enter your current password.");
 942         }
 943     } elsif ( $args{'New'} ne $args{'Confirmation'} ) {
 944         $error = $self->loc("Passwords do not match.");
 945     }
 946
 947     if ( $error ) {
 948         $error .= ' '. $self->loc('Password has not been set.');
 949         return (0, $error);
 950     }
 951
 952     return $self->SetPassword( $args{'New'} );
 953 }
 954
 955 =head3 SetPassword
 956
 957 Takes a string. Checks the string's length and sets this user's password
 958 to that string.
 959
 960 =cut
 961
 962 sub SetPassword {
 963     my $self     = shift;
 964     my $password = shift;
 965
 966     unless ( $self->CurrentUserCanModify('Password') ) {
 967         return ( 0, $self->loc('Password: Permission Denied') );
 968     }
 969
 970     if ( !$password ) {
 971         return ( 0, $self->loc("No password set") );
 972     }
 973     elsif ( length($password) < RT->Config->Get('MinimumPasswordLength') ) {
 974         return ( 0, $self->loc("Password needs to be at least [_1] characters long", RT->Config->Get('MinimumPasswordLength')) );
 975     }
 976     else {
 977         my $new = !$self->HasPassword;
 978         $password = $self->_GeneratePassword($password);
 979         my ( $val, $msg ) = $self->SUPER::SetPassword($password);
 980         if ($val) {
 981             return ( 1, $self->loc("Password set") ) if $new;
 982             return ( 1, $self->loc("Password changed") );
 983         }
 984         else {
 985             return ( $val, $msg );
 986         }
 987     }
 988
 989 }
 990
 991 =head3 _GeneratePassword PASSWORD
 992
 993 returns an MD5 hash of the password passed in, in hexadecimal encoding.
 994
 995 =cut
 996
 997 sub _GeneratePassword {
 998     my $self = shift;
 999     my $password = shift;
1000
1001     my $md5 = Digest::MD5->new();
1002     $md5->add(encode_utf8($password));
1003     return ($md5->hexdigest);
1004
1005 }
1006
1007 =head3 _GeneratePasswordBase64 PASSWORD
1008
1009 returns an MD5 hash of the password passed in, in base64 encoding
1010 (obsoleted now).
1011
1012 =cut
1013
1014 sub _GeneratePasswordBase64 {
1015     my $self = shift;
1016     my $password = shift;
1017
1018     my $md5 = Digest::MD5->new();
1019     $md5->add(encode_utf8($password));
1020     return ($md5->b64digest);
1021
1022 }
1023
1024 =head3 HasPassword
1025
1026 Returns true if the user has a valid password, otherwise returns false.
1027
1028 =cut
1029
1030 sub HasPassword {
1031     my $self = shift;
1032     my $pwd = $self->__Value('Password');
1033     return undef if !defined $pwd
1034                     || $pwd eq ''
1035                     || $pwd eq '*NO-PASSWORD*';
1036     return 1;
1037 }
1038
1039 =head3 IsPassword
1040
1041 Returns true if the passed in value is this user's password.
1042 Returns undef otherwise.
1043
1044 =cut
1045
1046 sub IsPassword {
1047     my $self  = shift;
1048     my $value = shift;
1049
1050     #TODO there isn't any apparent way to legitimately ACL this
1051
1052     # RT does not allow null passwords
1053     if ( ( !defined($value) ) or ( $value eq '' ) ) {
1054         return (undef);
1055     }
1056
1057    if ( $self->PrincipalObj->Disabled ) {
1058         $RT::Logger->info(
1059             "Disabled user " . $self->Name . " tried to log in" );
1060         return (undef);
1061     }
1062
1063     unless ($self->HasPassword) {
1064         return(undef);
1065      }
1066
1067     # generate an md5 password
1068     if ($self->_GeneratePassword($value) eq $self->__Value('Password')) {
1069         return(1);
1070     }
1071
1072     #  if it's a historical password we say ok.
1073     if ($self->__Value('Password') eq crypt(encode_utf8($value), $self->__Value('Password'))
1074         or $self->_GeneratePasswordBase64($value) eq $self->__Value('Password'))
1075     {
1076         # ...but upgrade the legacy password inplace.
1077         $self->SUPER::SetPassword( $self->_GeneratePassword($value) );
1078         return(1);
1079     }
1080
1081     # no password check has succeeded. get out
1082
1083     return (undef);
1084 }
1085
1086 sub CurrentUserRequireToSetPassword {
1087     my $self = shift;
1088
1089     my %res = (
1090         CanSet => 1,
1091         Reason => '',
1092         RequireCurrent => 1,
1093     );
1094
1095     if ( RT->Config->Get('WebExternalAuth')
1096         && !RT->Config->Get('WebFallbackToInternalAuth')
1097     ) {
1098         $res{'CanSet'} = 0;
1099         $res{'Reason'} = $self->loc("External authentication enabled.");
1100     }
1101     elsif ( !$self->CurrentUser->HasPassword ) {
1102         if ( $self->CurrentUser->id == ($self->id||0) ) {
1103             # don't require current password if user has no
1104             $res{'RequireCurrent'} = 0;
1105         }
1106         else {
1107             $res{'CanSet'} = 0;
1108             $res{'Reason'} = $self->loc("Your password is not set.");
1109         }
1110     }
1111
1112     return %res;
1113 }
1114
1115 =head3 AuthToken
1116
1117 Returns an authentication string associated with the user. This
1118 string can be used to generate passwordless URLs to integrate
1119 RT with services and programms like callendar managers, rss
1120 readers and other.
1121
1122 =cut
1123
1124 sub AuthToken {
1125     my $self = shift;
1126     my $secret = $self->FirstAttribute("AuthToken");
1127     return $secret->Content if $secret;
1128
1129     my $id = $self->id;
1130     $self = RT::User->new( $RT::SystemUser );
1131     $self->Load( $id );
1132     $secret = substr(Digest::MD5::md5_hex(time . {} . rand()),0,16);
1133     my ($status, $msg) = $self->SetAttribute( Name => "AuthToken", Content => $secret );
1134     unless ( $status ) {
1135         $RT::Logger->error( "Couldn't set auth token: $msg" );
1136         return undef;
1137     }
1138     return $secret;
1139 }
1140
1141 =head3 GenerateAuthToken
1142
1143 Generate a random authentication string for the user.
1144
1145 =cut
1146
1147 sub GenerateAuthToken {
1148     my $self = shift;
1149     my $token = substr(Digest::MD5::md5_hex(time . {} . rand()),0,16);
1150     return $self->SetAttribute( Name => "AuthToken", Content => $token );
1151 }
1152
1153 =head3 GenerateAuthString
1154
1155 Takes a string and returns back a hex hash string. Later you can use
1156 this pair to make sure it's generated by this user using L</ValidateAuthString>
1157
1158 =cut
1159
1160 sub GenerateAuthString {
1161     my $self = shift;
1162     my $protect = shift;
1163
1164     my $str = $self->AuthToken . $protect;
1165     utf8::encode($str);
1166
1167     return substr(Digest::MD5::md5_hex($str),0,16);
1168 }
1169
1170 =head3 ValidateAuthString
1171
1172 Takes auth string and protected string. Returns true is protected string
1173 has been protected by user's L</AuthToken>. See also L</GenerateAuthString>.
1174
1175 =cut
1176
1177 sub ValidateAuthString {
1178     my $self = shift;
1179     my $auth_string = shift;
1180     my $protected = shift;
1181
1182     my $str = $self->AuthToken . $protected;
1183     utf8::encode( $str );
1184
1185     return $auth_string eq substr(Digest::MD5::md5_hex($str),0,16);
1186 }
1187
1188 =head2 SetDisabled
1189
1190 Toggles the user's disabled flag.
1191 If this flag is
1192 set, all password checks for this user will fail. All ACL checks for this
1193 user will fail. The user will appear in no user listings.
1194
1195 =cut
1196
1197 sub SetDisabled {
1198     my $self = shift;
1199     my $val = shift;
1200     unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1201         return (0, $self->loc('Permission Denied'));
1202     }
1203
1204     $RT::Handle->BeginTransaction();
1205     my $set_err = $self->PrincipalObj->SetDisabled($val);
1206     unless ($set_err) {
1207         $RT::Handle->Rollback();
1208         $RT::Logger->warning(sprintf("Couldn't %s user %s", ($val == 1) ? "disable" : "enable", $self->PrincipalObj->Id));
1209         return (undef);
1210     }
1211     $self->_NewTransaction( Type => ($val == 1) ? "Disabled" : "Enabled" );
1212
1213     $RT::Handle->Commit();
1214
1215     if ( $val == 1 ) {
1216         return (1, $self->loc("User disabled"));
1217     } else {
1218         return (1, $self->loc("User enabled"));
1219     }
1220
1221 }
1222
1223 =head2 Disabled
1224
1225 Returns true if user is disabled or false otherwise
1226
1227 =cut
1228
1229 sub Disabled {
1230     my $self = shift;
1231     return $self->PrincipalObj->Disabled(@_);
1232 }
1233
1234 =head2 PrincipalObj
1235
1236 Returns the principal object for this user. returns an empty RT::Principal
1237 if there's no principal object matching this user.
1238 The response is cached. PrincipalObj should never ever change.
1239
1240 =cut
1241
1242 sub PrincipalObj {
1243     my $self = shift;
1244
1245     unless ( $self->id ) {
1246         $RT::Logger->error("Couldn't get principal for not loaded object");
1247         return undef;
1248     }
1249
1250     my $obj = RT::Principal->new( $self->CurrentUser );
1251     $obj->LoadById( $self->id );
1252     unless ( $obj->id ) {
1253         $RT::Logger->crit( 'No principal for user #'. $self->id );
1254         return undef;
1255     } elsif ( $obj->PrincipalType ne 'User' ) {
1256         $RT::Logger->crit( 'User #'. $self->id .' has principal of '. $obj->PrincipalType .' type' );
1257         return undef;
1258     }
1259     return $obj;
1260 }
1261
1262
1263 =head2 PrincipalId
1264
1265 Returns this user's PrincipalId
1266
1267 =cut
1268
1269 sub PrincipalId {
1270     my $self = shift;
1271     return $self->Id;
1272 }
1273
1274 =head2 HasGroupRight
1275
1276 Takes a paramhash which can contain
1277 these items:
1278     GroupObj => RT::Group or Group => integer
1279     Right => 'Right'
1280
1281
1282 Returns 1 if this user has the right specified in the paramhash for the Group
1283 passed in.
1284
1285 Returns undef if they don't.
1286
1287 =cut
1288
1289 sub HasGroupRight {
1290     my $self = shift;
1291     my %args = (
1292         GroupObj    => undef,
1293         Group       => undef,
1294         Right       => undef,
1295         @_
1296     );
1297
1298
1299     if ( defined $args{'Group'} ) {
1300         $args{'GroupObj'} = RT::Group->new( $self->CurrentUser );
1301         $args{'GroupObj'}->Load( $args{'Group'} );
1302     }
1303
1304     # Validate and load up the GroupId
1305     unless ( ( defined $args{'GroupObj'} ) and ( $args{'GroupObj'}->Id ) ) {
1306         return undef;
1307     }
1308
1309     # Figure out whether a user has the right we're asking about.
1310     my $retval = $self->HasRight(
1311         Object => $args{'GroupObj'},
1312         Right     => $args{'Right'},
1313     );
1314
1315     return ($retval);
1316 }
1317
1318 =head2 OwnGroups
1319
1320 Returns a group collection object containing the groups of which this
1321 user is a member.
1322
1323 =cut
1324
1325 sub OwnGroups {
1326     my $self = shift;
1327     my $groups = RT::Groups->new($self->CurrentUser);
1328     $groups->LimitToUserDefinedGroups;
1329     $groups->WithMember(PrincipalId => $self->Id,
1330             Recursively => 1);
1331     return $groups;
1332 }
1333
1334 =head2 HasRight
1335
1336 Shim around PrincipalObj->HasRight. See L<RT::Principal>.
1337
1338 =cut
1339
1340 sub HasRight {
1341     my $self = shift;
1342     return $self->PrincipalObj->HasRight(@_);
1343 }
1344
1345 =head2 CurrentUserCanModify RIGHT
1346
1347 If the user has rights for this object, either because
1348 he has 'AdminUsers' or (if he\'s trying to edit himself and the right isn\'t an
1349 admin right) 'ModifySelf', return 1. otherwise, return undef.
1350
1351 =cut
1352
1353 sub CurrentUserCanModify {
1354     my $self  = shift;
1355     my $right = shift;
1356
1357     if ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1358         return (1);
1359     }
1360
1361     #If the field is marked as an "administrators only" field,
1362     # don\'t let the user touch it.
1363     elsif ( $self->_Accessible( $right, 'admin' ) ) {
1364         return (undef);
1365     }
1366
1367     #If the current user is trying to modify themselves
1368     elsif ( ( $self->id == $self->CurrentUser->id )
1369         and ( $self->CurrentUser->HasRight(Right => 'ModifySelf', Object => $RT::System) ) )
1370     {
1371         return (1);
1372     }
1373
1374     #If we don\'t have a good reason to grant them rights to modify
1375     # by now, they lose
1376     else {
1377         return (undef);
1378     }
1379
1380 }
1381
1382 =head2 CurrentUserHasRight
1383
1384 Takes a single argument. returns 1 if $Self->CurrentUser
1385 has the requested right. returns undef otherwise
1386
1387 =cut
1388
1389 sub CurrentUserHasRight {
1390     my $self  = shift;
1391     my $right = shift;
1392
1393     return ( $self->CurrentUser->HasRight(Right => $right, Object => $RT::System) );
1394 }
1395
1396 sub _PrefName {
1397     my $name = shift;
1398     if (ref $name) {
1399         $name = ref($name).'-'.$name->Id;
1400     }
1401
1402     return 'Pref-'.$name;
1403 }
1404
1405 =head2 Preferences NAME/OBJ DEFAULT
1406
1407 Obtain user preferences associated with given object or name.
1408 Returns DEFAULT if no preferences found.  If DEFAULT is a hashref,
1409 override the entries with user preferences.
1410
1411 =cut
1412
1413 sub Preferences {
1414     my $self  = shift;
1415     my $name = _PrefName (shift);
1416     my $default = shift;
1417
1418     my $attr = RT::Attribute->new( $self->CurrentUser );
1419     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1420
1421     my $content = $attr->Id ? $attr->Content : undef;
1422     unless ( ref $content eq 'HASH' ) {
1423         return defined $content ? $content : $default;
1424     }
1425
1426     if (ref $default eq 'HASH') {
1427         for (keys %$default) {
1428             exists $content->{$_} or $content->{$_} = $default->{$_};
1429         }
1430     }
1431     elsif (defined $default) {
1432         $RT::Logger->error("Preferences $name for user".$self->Id." is hash but default is not");
1433     }
1434     return $content;
1435 }
1436
1437 =head2 SetPreferences NAME/OBJ VALUE
1438
1439 Set user preferences associated with given object or name.
1440
1441 =cut
1442
1443 sub SetPreferences {
1444     my $self = shift;
1445     my $name = _PrefName( shift );
1446     my $value = shift;
1447
1448     return (0, $self->loc("No permission to set preferences"))
1449         unless $self->CurrentUserCanModify('Preferences');
1450
1451     my $attr = RT::Attribute->new( $self->CurrentUser );
1452     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1453     if ( $attr->Id ) {
1454         return $attr->SetContent( $value );
1455     }
1456     else {
1457         return $self->AddAttribute( Name => $name, Content => $value );
1458     }
1459 }
1460
1461 =head2 WatchedQueues ROLE_LIST
1462
1463 Returns a RT::Queues object containing every queue watched by the user.
1464
1465 Takes a list of roles which is some subset of ('Cc', 'AdminCc').  Defaults to:
1466
1467 $user->WatchedQueues('Cc', 'AdminCc');
1468
1469 =cut
1470
1471 sub WatchedQueues {
1472
1473     my $self = shift;
1474     my @roles = @_ || ('Cc', 'AdminCc');
1475
1476     $RT::Logger->debug('WatcheQueues got user ' . $self->Name);
1477
1478     my $watched_queues = RT::Queues->new($self->CurrentUser);
1479
1480     my $group_alias = $watched_queues->Join(
1481                                              ALIAS1 => 'main',
1482                                              FIELD1 => 'id',
1483                                              TABLE2 => 'Groups',
1484                                              FIELD2 => 'Instance',
1485                                            );
1486
1487     $watched_queues->Limit(
1488                             ALIAS => $group_alias,
1489                             FIELD => 'Domain',
1490                             VALUE => 'RT::Queue-Role',
1491                             ENTRYAGGREGATOR => 'AND',
1492                           );
1493     if (grep { $_ eq 'Cc' } @roles) {
1494         $watched_queues->Limit(
1495                                 SUBCLAUSE => 'LimitToWatchers',
1496                                 ALIAS => $group_alias,
1497                                 FIELD => 'Type',
1498                                 VALUE => 'Cc',
1499                                 ENTRYAGGREGATOR => 'OR',
1500                               );
1501     }
1502     if (grep { $_ eq 'AdminCc' } @roles) {
1503         $watched_queues->Limit(
1504                                 SUBCLAUSE => 'LimitToWatchers',
1505                                 ALIAS => $group_alias,
1506                                 FIELD => 'Type',
1507                                 VALUE => 'AdminCc',
1508                                 ENTRYAGGREGATOR => 'OR',
1509                               );
1510     }
1511
1512     my $queues_alias = $watched_queues->Join(
1513                                               ALIAS1 => $group_alias,
1514                                               FIELD1 => 'id',
1515                                               TABLE2 => 'CachedGroupMembers',
1516                                               FIELD2 => 'GroupId',
1517                                             );
1518     $watched_queues->Limit(
1519                             ALIAS => $queues_alias,
1520                             FIELD => 'MemberId',
1521                             VALUE => $self->PrincipalId,
1522                           );
1523
1524     $RT::Logger->debug("WatchedQueues got " . $watched_queues->Count . " queues");
1525
1526     return $watched_queues;
1527
1528 }
1529
1530 =head2 _CleanupInvalidDelegations { InsideTransaction => undef }
1531
1532 Revokes all ACE entries delegated by this user which are inconsistent
1533 with their current delegation rights.  Does not perform permission
1534 checks.  Should only ever be called from inside the RT library.
1535
1536 If called from inside a transaction, specify a true value for the
1537 InsideTransaction parameter.
1538
1539 Returns a true value if the deletion succeeded; returns a false value
1540 and logs an internal error if the deletion fails (should not happen).
1541
1542 =cut
1543
1544 # XXX Currently there is a _CleanupInvalidDelegations method in both
1545 # RT::User and RT::Group.  If the recursive cleanup call for groups is
1546 # ever unrolled and merged, this code will probably want to be
1547 # factored out into RT::Principal.
1548
1549 sub _CleanupInvalidDelegations {
1550     my $self = shift;
1551     my %args = ( InsideTransaction => undef,
1552           @_ );
1553
1554     unless ( $self->Id ) {
1555     $RT::Logger->warning("User not loaded.");
1556     return (undef);
1557     }
1558
1559     my $in_trans = $args{InsideTransaction};
1560
1561     return(1) if ($self->HasRight(Right => 'DelegateRights',
1562                   Object => $RT::System));
1563
1564     # Look up all delegation rights currently posessed by this user.
1565     my $deleg_acl = RT::ACL->new($RT::SystemUser);
1566     $deleg_acl->LimitToPrincipal(Type => 'User',
1567                  Id => $self->PrincipalId,
1568                  IncludeGroupMembership => 1);
1569     $deleg_acl->Limit( FIELD => 'RightName',
1570                OPERATOR => '=',
1571                VALUE => 'DelegateRights' );
1572     my @allowed_deleg_objects = map {$_->Object()}
1573     @{$deleg_acl->ItemsArrayRef()};
1574
1575     # Look up all rights delegated by this principal which are
1576     # inconsistent with the allowed delegation objects.
1577     my $acl_to_del = RT::ACL->new($RT::SystemUser);
1578     $acl_to_del->DelegatedBy(Id => $self->Id);
1579     foreach (@allowed_deleg_objects) {
1580     $acl_to_del->LimitNotObject($_);
1581     }
1582
1583     # Delete all disallowed delegations
1584     while ( my $ace = $acl_to_del->Next() ) {
1585     my $ret = $ace->_Delete(InsideTransaction => 1);
1586     unless ($ret) {
1587         $RT::Handle->Rollback() unless $in_trans;
1588         $RT::Logger->warning("Couldn't delete delegated ACL entry ".$ace->Id);
1589         return (undef);
1590     }
1591     }
1592
1593     $RT::Handle->Commit() unless $in_trans;
1594     return (1);
1595 }
1596
1597 sub _Set {
1598     my $self = shift;
1599
1600     my %args = (
1601         Field => undef,
1602         Value => undef,
1603     TransactionType   => 'Set',
1604     RecordTransaction => 1,
1605         @_
1606     );
1607
1608     # Nobody is allowed to futz with RT_System or Nobody
1609
1610     if ( ($self->Id == $RT::SystemUser->Id )  ||
1611          ($self->Id == $RT::Nobody->Id)) {
1612         return ( 0, $self->loc("Can not modify system users") );
1613     }
1614     unless ( $self->CurrentUserCanModify( $args{'Field'} ) ) {
1615         return ( 0, $self->loc("Permission Denied") );
1616     }
1617
1618     my $Old = $self->SUPER::_Value("$args{'Field'}");
1619
1620     my ($ret, $msg) = $self->SUPER::_Set( Field => $args{'Field'},
1621                       Value => $args{'Value'} );
1622
1623     #If we can't actually set the field to the value, don't record
1624     # a transaction. instead, get out of here.
1625     if ( $ret == 0 ) { return ( 0, $msg ); }
1626
1627     if ( $args{'RecordTransaction'} == 1 ) {
1628
1629         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1630                                                Type => $args{'TransactionType'},
1631                                                Field     => $args{'Field'},
1632                                                NewValue  => $args{'Value'},
1633                                                OldValue  => $Old,
1634                                                TimeTaken => $args{'TimeTaken'},
1635         );
1636         return ( $Trans, scalar $TransObj->BriefDescription );
1637     }
1638     else {
1639         return ( $ret, $msg );
1640     }
1641 }
1642
1643 =head2 _Value
1644
1645 Takes the name of a table column.
1646 Returns its value as a string, if the user passes an ACL check
1647
1648 =cut
1649
1650 sub _Value {
1651
1652     my $self  = shift;
1653     my $field = shift;
1654
1655     #If the current user doesn't have ACLs, don't let em at it.
1656
1657     my @PublicFields = qw( Name EmailAddress Organization Disabled
1658       RealName NickName Gecos ExternalAuthId
1659       AuthSystem ExternalContactInfoId
1660       ContactInfoSystem );
1661
1662     #if the field is public, return it.
1663     if ( $self->_Accessible( $field, 'public' ) ) {
1664         return ( $self->SUPER::_Value($field) );
1665
1666     }
1667
1668     #If the user wants to see their own values, let them
1669     # TODO figure ouyt a better way to deal with this
1670    elsif ( defined($self->Id) && $self->CurrentUser->Id == $self->Id ) {
1671         return ( $self->SUPER::_Value($field) );
1672     }
1673
1674     #If the user has the admin users right, return the field
1675     elsif ( $self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1676         return ( $self->SUPER::_Value($field) );
1677     }
1678     else {
1679         return (undef);
1680     }
1681
1682 }
1683
1684 =head2 FriendlyName
1685
1686 Return the friendly name
1687
1688 =cut
1689
1690 sub FriendlyName {
1691     my $self = shift;
1692     return $self->RealName if defined($self->RealName);
1693     return $self->Name if defined($self->Name);
1694     return "";
1695 }
1696
1697 =head2 PreferredKey
1698
1699 Returns the preferred key of the user. If none is set, then this will query
1700 GPG and set the preferred key to the maximally trusted key found (and then
1701 return it). Returns C<undef> if no preferred key can be found.
1702
1703 =cut
1704
1705 sub PreferredKey
1706 {
1707     my $self = shift;
1708     return undef unless RT->Config->Get('GnuPG')->{'Enable'};
1709     my $prefkey = $self->FirstAttribute('PreferredKey');
1710     return $prefkey->Content if $prefkey;
1711
1712     # we don't have a preferred key for this user, so now we must query GPG
1713     require RT::Crypt::GnuPG;
1714     my %res = RT::Crypt::GnuPG::GetKeysForEncryption($self->EmailAddress);
1715     return undef unless defined $res{'info'};
1716     my @keys = @{ $res{'info'} };
1717     return undef if @keys == 0;
1718
1719     if (@keys == 1) {
1720         $prefkey = $keys[0]->{'Fingerprint'};
1721     }
1722     else {
1723         # prefer the maximally trusted key
1724         @keys = sort { $b->{'TrustLevel'} <=> $a->{'TrustLevel'} } @keys;
1725         $prefkey = $keys[0]->{'Fingerprint'};
1726     }
1727
1728     $self->SetAttribute(Name => 'PreferredKey', Content => $prefkey);
1729     return $prefkey;
1730 }
1731
1732 sub PrivateKey {
1733     my $self = shift;
1734
1735     my $key = $self->FirstAttribute('PrivateKey') or return undef;
1736     return $key->Content;
1737 }
1738
1739 sub SetPrivateKey {
1740     my $self = shift;
1741     my $key = shift;
1742     # XXX: ACL
1743     unless ( $key ) {
1744         my ($status, $msg) = $self->DeleteAttribute('PrivateKey');
1745         unless ( $status ) {
1746             $RT::Logger->error( "Couldn't delete attribute: $msg" );
1747             return ($status, $self->loc("Couldn't unset private key"));
1748         }
1749         return ($status, $self->loc("Unset private key"));
1750     }
1751
1752     # check that it's really private key
1753     {
1754         my %tmp = RT::Crypt::GnuPG::GetKeysForSigning( $key );
1755         return (0, $self->loc("No such key or it's not suitable for signing"))
1756             if $tmp{'exit_code'} || !$tmp{'info'};
1757     }
1758
1759     my ($status, $msg) = $self->SetAttribute(
1760         Name => 'PrivateKey',
1761         Content => $key,
1762     );
1763     return ($status, $self->loc("Couldn't set private key"))
1764         unless $status;
1765     return ($status, $self->loc("Unset private key"));
1766 }
1767
1768 sub BasicColumns {
1769     (
1770     [ Name => 'User Id' ],
1771     [ EmailAddress => 'Email' ],
1772     [ RealName => 'Name' ],
1773     [ Organization => 'Organization' ],
1774     );
1775 }
1776
1777 1;
1778
1779