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 =head3 SetPassword
 920
 921 Takes a string. Checks the string's length and sets this user's password
 922 to that string.
 923
 924 =cut
 925
 926 sub SetPassword {
 927     my $self     = shift;
 928     my $password = shift;
 929
 930     unless ( $self->CurrentUserCanModify('Password') ) {
 931         return ( 0, $self->loc('Password: Permission Denied') );
 932     }
 933
 934     if ( !$password ) {
 935         return ( 0, $self->loc("No password set") );
 936     }
 937     elsif ( length($password) < RT->Config->Get('MinimumPasswordLength') ) {
 938         return ( 0, $self->loc("Password needs to be at least [_1] characters long", RT->Config->Get('MinimumPasswordLength')) );
 939     }
 940     else {
 941         my $new = !$self->HasPassword;
 942         $password = $self->_GeneratePassword($password);
 943         my ( $val, $msg ) = $self->SUPER::SetPassword($password);
 944         if ($val) {
 945             return ( 1, $self->loc("Password set") ) if $new;
 946             return ( 1, $self->loc("Password changed") );
 947         }
 948         else {
 949             return ( $val, $msg );
 950         }
 951     }
 952
 953 }
 954
 955 =head3 _GeneratePassword PASSWORD
 956
 957 returns an MD5 hash of the password passed in, in hexadecimal encoding.
 958
 959 =cut
 960
 961 sub _GeneratePassword {
 962     my $self = shift;
 963     my $password = shift;
 964
 965     my $md5 = Digest::MD5->new();
 966     $md5->add(encode_utf8($password));
 967     return ($md5->hexdigest);
 968
 969 }
 970
 971 =head3 _GeneratePasswordBase64 PASSWORD
 972
 973 returns an MD5 hash of the password passed in, in base64 encoding
 974 (obsoleted now).
 975
 976 =cut
 977
 978 sub _GeneratePasswordBase64 {
 979     my $self = shift;
 980     my $password = shift;
 981
 982     my $md5 = Digest::MD5->new();
 983     $md5->add(encode_utf8($password));
 984     return ($md5->b64digest);
 985
 986 }
 987
 988 =head3 HasPassword
 989
 990 Returns true if the user has a valid password, otherwise returns false.
 991
 992 =cut
 993
 994 sub HasPassword {
 995     my $self = shift;
 996     my $pwd = $self->__Value('Password');
 997     return undef if !defined $pwd
 998                     || $pwd eq ''
 999                     || $pwd eq '*NO-PASSWORD*';
1000     return 1;
1001 }
1002
1003 =head3 IsPassword
1004
1005 Returns true if the passed in value is this user's password.
1006 Returns undef otherwise.
1007
1008 =cut
1009
1010 sub IsPassword {
1011     my $self  = shift;
1012     my $value = shift;
1013
1014     #TODO there isn't any apparent way to legitimately ACL this
1015
1016     # RT does not allow null passwords
1017     if ( ( !defined($value) ) or ( $value eq '' ) ) {
1018         return (undef);
1019     }
1020
1021    if ( $self->PrincipalObj->Disabled ) {
1022         $RT::Logger->info(
1023             "Disabled user " . $self->Name . " tried to log in" );
1024         return (undef);
1025     }
1026
1027     unless ($self->HasPassword) {
1028         return(undef);
1029      }
1030
1031     # generate an md5 password
1032     if ($self->_GeneratePassword($value) eq $self->__Value('Password')) {
1033         return(1);
1034     }
1035
1036     #  if it's a historical password we say ok.
1037     if ($self->__Value('Password') eq crypt($value, $self->__Value('Password'))
1038         or $self->_GeneratePasswordBase64($value) eq $self->__Value('Password'))
1039     {
1040         # ...but upgrade the legacy password inplace.
1041         $self->SUPER::SetPassword( $self->_GeneratePassword($value) );
1042         return(1);
1043     }
1044
1045     # no password check has succeeded. get out
1046
1047     return (undef);
1048 }
1049
1050 =head3 AuthToken
1051
1052 Returns an authentication string associated with the user. This
1053 string can be used to generate passwordless URLs to integrate
1054 RT with services and programms like callendar managers, rss
1055 readers and other.
1056
1057 =cut
1058
1059 sub AuthToken {
1060     my $self = shift;
1061     my $secret = $self->FirstAttribute("AuthToken");
1062     return $secret->Content if $secret;
1063
1064     my $id = $self->id;
1065     $self = RT::User->new( $RT::SystemUser );
1066     $self->Load( $id );
1067     $secret = substr(Digest::MD5::md5_hex(time . {} . rand()),0,16);
1068     my ($status, $msg) = $self->SetAttribute( Name => "AuthToken", Content => $secret );
1069     unless ( $status ) {
1070         $RT::Logger->error( "Couldn't set auth token: $msg" );
1071         return undef;
1072     }
1073     return $secret;
1074 }
1075
1076 =head3 GenerateAuthToken
1077
1078 Generate a random authentication string for the user.
1079
1080 =cut
1081
1082 sub GenerateAuthToken {
1083     my $self = shift;
1084     my $token = substr(Digest::MD5::md5_hex(time . {} . rand()),0,16);
1085     return $self->SetAttribute( Name => "AuthToken", Content => $token );
1086 }
1087
1088 =head3 GenerateAuthString
1089
1090 Takes a string and returns back a hex hash string. Later you can use
1091 this pair to make sure it's generated by this user using L</ValidateAuthString>
1092
1093 =cut
1094
1095 sub GenerateAuthString {
1096     my $self = shift;
1097     my $protect = shift;
1098
1099     my $str = $self->AuthToken . $protect;
1100     utf8::encode($str);
1101
1102     return substr(Digest::MD5::md5_hex($str),0,16);
1103 }
1104
1105 =head3 ValidateAuthString
1106
1107 Takes auth string and protected string. Returns true is protected string
1108 has been protected by user's L</AuthToken>. See also L</GenerateAuthString>.
1109
1110 =cut
1111
1112 sub ValidateAuthString {
1113     my $self = shift;
1114     my $auth_string = shift;
1115     my $protected = shift;
1116
1117     my $str = $self->AuthToken . $protected;
1118     utf8::encode( $str );
1119
1120     return $auth_string eq substr(Digest::MD5::md5_hex($str),0,16);
1121 }
1122
1123 =head2 SetDisabled
1124
1125 Toggles the user's disabled flag.
1126 If this flag is
1127 set, all password checks for this user will fail. All ACL checks for this
1128 user will fail. The user will appear in no user listings.
1129
1130 =cut
1131
1132 sub SetDisabled {
1133     my $self = shift;
1134     my $val = shift;
1135     unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1136         return (0, $self->loc('Permission Denied'));
1137     }
1138
1139     $RT::Handle->BeginTransaction();
1140     my $set_err = $self->PrincipalObj->SetDisabled($val);
1141     unless ($set_err) {
1142         $RT::Handle->Rollback();
1143         $RT::Logger->warning(sprintf("Couldn't %s user %s", ($val == 1) ? "disable" : "enable", $self->PrincipalObj->Id));
1144         return (undef);
1145     }
1146     $self->_NewTransaction( Type => ($val == 1) ? "Disabled" : "Enabled" );
1147
1148     $RT::Handle->Commit();
1149
1150     if ( $val == 1 ) {
1151         return (1, $self->loc("User disabled"));
1152     } else {
1153         return (1, $self->loc("User enabled"));
1154     }
1155
1156 }
1157
1158 =head2 Disabled
1159
1160 Returns true if user is disabled or false otherwise
1161
1162 =cut
1163
1164 sub Disabled {
1165     my $self = shift;
1166     return $self->PrincipalObj->Disabled(@_);
1167 }
1168
1169 =head2 PrincipalObj
1170
1171 Returns the principal object for this user. returns an empty RT::Principal
1172 if there's no principal object matching this user.
1173 The response is cached. PrincipalObj should never ever change.
1174
1175 =cut
1176
1177 sub PrincipalObj {
1178     my $self = shift;
1179
1180     unless ( $self->id ) {
1181         $RT::Logger->error("Couldn't get principal for not loaded object");
1182         return undef;
1183     }
1184
1185     my $obj = RT::Principal->new( $self->CurrentUser );
1186     $obj->LoadById( $self->id );
1187     unless ( $obj->id ) {
1188         $RT::Logger->crit( 'No principal for user #'. $self->id );
1189         return undef;
1190     } elsif ( $obj->PrincipalType ne 'User' ) {
1191         $RT::Logger->crit( 'User #'. $self->id .' has principal of '. $obj->PrincipalType .' type' );
1192         return undef;
1193     }
1194     return $obj;
1195 }
1196
1197
1198 =head2 PrincipalId
1199
1200 Returns this user's PrincipalId
1201
1202 =cut
1203
1204 sub PrincipalId {
1205     my $self = shift;
1206     return $self->Id;
1207 }
1208
1209 =head2 HasGroupRight
1210
1211 Takes a paramhash which can contain
1212 these items:
1213     GroupObj => RT::Group or Group => integer
1214     Right => 'Right'
1215
1216
1217 Returns 1 if this user has the right specified in the paramhash for the Group
1218 passed in.
1219
1220 Returns undef if they don't.
1221
1222 =cut
1223
1224 sub HasGroupRight {
1225     my $self = shift;
1226     my %args = (
1227         GroupObj    => undef,
1228         Group       => undef,
1229         Right       => undef,
1230         @_
1231     );
1232
1233
1234     if ( defined $args{'Group'} ) {
1235         $args{'GroupObj'} = RT::Group->new( $self->CurrentUser );
1236         $args{'GroupObj'}->Load( $args{'Group'} );
1237     }
1238
1239     # Validate and load up the GroupId
1240     unless ( ( defined $args{'GroupObj'} ) and ( $args{'GroupObj'}->Id ) ) {
1241         return undef;
1242     }
1243
1244     # Figure out whether a user has the right we're asking about.
1245     my $retval = $self->HasRight(
1246         Object => $args{'GroupObj'},
1247         Right     => $args{'Right'},
1248     );
1249
1250     return ($retval);
1251 }
1252
1253 =head2 OwnGroups
1254
1255 Returns a group collection object containing the groups of which this
1256 user is a member.
1257
1258 =cut
1259
1260 sub OwnGroups {
1261     my $self = shift;
1262     my $groups = RT::Groups->new($self->CurrentUser);
1263     $groups->LimitToUserDefinedGroups;
1264     $groups->WithMember(PrincipalId => $self->Id,
1265             Recursively => 1);
1266     return $groups;
1267 }
1268
1269 =head2 HasRight
1270
1271 Shim around PrincipalObj->HasRight. See L<RT::Principal>.
1272
1273 =cut
1274
1275 sub HasRight {
1276     my $self = shift;
1277     return $self->PrincipalObj->HasRight(@_);
1278 }
1279
1280 =head2 CurrentUserCanModify RIGHT
1281
1282 If the user has rights for this object, either because
1283 he has 'AdminUsers' or (if he\'s trying to edit himself and the right isn\'t an
1284 admin right) 'ModifySelf', return 1. otherwise, return undef.
1285
1286 =cut
1287
1288 sub CurrentUserCanModify {
1289     my $self  = shift;
1290     my $right = shift;
1291
1292     if ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1293         return (1);
1294     }
1295
1296     #If the field is marked as an "administrators only" field,
1297     # don\'t let the user touch it.
1298     elsif ( $self->_Accessible( $right, 'admin' ) ) {
1299         return (undef);
1300     }
1301
1302     #If the current user is trying to modify themselves
1303     elsif ( ( $self->id == $self->CurrentUser->id )
1304         and ( $self->CurrentUser->HasRight(Right => 'ModifySelf', Object => $RT::System) ) )
1305     {
1306         return (1);
1307     }
1308
1309     #If we don\'t have a good reason to grant them rights to modify
1310     # by now, they lose
1311     else {
1312         return (undef);
1313     }
1314
1315 }
1316
1317 =head2 CurrentUserHasRight
1318
1319 Takes a single argument. returns 1 if $Self->CurrentUser
1320 has the requested right. returns undef otherwise
1321
1322 =cut
1323
1324 sub CurrentUserHasRight {
1325     my $self  = shift;
1326     my $right = shift;
1327
1328     return ( $self->CurrentUser->HasRight(Right => $right, Object => $RT::System) );
1329 }
1330
1331 sub _PrefName {
1332     my $name = shift;
1333     if (ref $name) {
1334         $name = ref($name).'-'.$name->Id;
1335     }
1336
1337     return 'Pref-'.$name;
1338 }
1339
1340 =head2 Preferences NAME/OBJ DEFAULT
1341
1342 Obtain user preferences associated with given object or name.
1343 Returns DEFAULT if no preferences found.  If DEFAULT is a hashref,
1344 override the entries with user preferences.
1345
1346 =cut
1347
1348 sub Preferences {
1349     my $self  = shift;
1350     my $name = _PrefName (shift);
1351     my $default = shift;
1352
1353     my $attr = RT::Attribute->new( $self->CurrentUser );
1354     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1355
1356     my $content = $attr->Id ? $attr->Content : undef;
1357     unless ( ref $content eq 'HASH' ) {
1358         return defined $content ? $content : $default;
1359     }
1360
1361     if (ref $default eq 'HASH') {
1362         for (keys %$default) {
1363             exists $content->{$_} or $content->{$_} = $default->{$_};
1364         }
1365     }
1366     elsif (defined $default) {
1367         $RT::Logger->error("Preferences $name for user".$self->Id." is hash but default is not");
1368     }
1369     return $content;
1370 }
1371
1372 =head2 SetPreferences NAME/OBJ VALUE
1373
1374 Set user preferences associated with given object or name.
1375
1376 =cut
1377
1378 sub SetPreferences {
1379     my $self = shift;
1380     my $name = _PrefName( shift );
1381     my $value = shift;
1382
1383     return (0, $self->loc("No permission to set preferences"))
1384         unless $self->CurrentUserCanModify('Preferences');
1385
1386     my $attr = RT::Attribute->new( $self->CurrentUser );
1387     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1388     if ( $attr->Id ) {
1389         return $attr->SetContent( $value );
1390     }
1391     else {
1392         return $self->AddAttribute( Name => $name, Content => $value );
1393     }
1394 }
1395
1396 =head2 WatchedQueues ROLE_LIST
1397
1398 Returns a RT::Queues object containing every queue watched by the user.
1399
1400 Takes a list of roles which is some subset of ('Cc', 'AdminCc').  Defaults to:
1401
1402 $user->WatchedQueues('Cc', 'AdminCc');
1403
1404 =cut
1405
1406 sub WatchedQueues {
1407
1408     my $self = shift;
1409     my @roles = @_ || ('Cc', 'AdminCc');
1410
1411     $RT::Logger->debug('WatcheQueues got user ' . $self->Name);
1412
1413     my $watched_queues = RT::Queues->new($self->CurrentUser);
1414
1415     my $group_alias = $watched_queues->Join(
1416                                              ALIAS1 => 'main',
1417                                              FIELD1 => 'id',
1418                                              TABLE2 => 'Groups',
1419                                              FIELD2 => 'Instance',
1420                                            );
1421
1422     $watched_queues->Limit(
1423                             ALIAS => $group_alias,
1424                             FIELD => 'Domain',
1425                             VALUE => 'RT::Queue-Role',
1426                             ENTRYAGGREGATOR => 'AND',
1427                           );
1428     if (grep { $_ eq 'Cc' } @roles) {
1429         $watched_queues->Limit(
1430                                 SUBCLAUSE => 'LimitToWatchers',
1431                                 ALIAS => $group_alias,
1432                                 FIELD => 'Type',
1433                                 VALUE => 'Cc',
1434                                 ENTRYAGGREGATOR => 'OR',
1435                               );
1436     }
1437     if (grep { $_ eq 'AdminCc' } @roles) {
1438         $watched_queues->Limit(
1439                                 SUBCLAUSE => 'LimitToWatchers',
1440                                 ALIAS => $group_alias,
1441                                 FIELD => 'Type',
1442                                 VALUE => 'AdminCc',
1443                                 ENTRYAGGREGATOR => 'OR',
1444                               );
1445     }
1446
1447     my $queues_alias = $watched_queues->Join(
1448                                               ALIAS1 => $group_alias,
1449                                               FIELD1 => 'id',
1450                                               TABLE2 => 'CachedGroupMembers',
1451                                               FIELD2 => 'GroupId',
1452                                             );
1453     $watched_queues->Limit(
1454                             ALIAS => $queues_alias,
1455                             FIELD => 'MemberId',
1456                             VALUE => $self->PrincipalId,
1457                           );
1458
1459     $RT::Logger->debug("WatchedQueues got " . $watched_queues->Count . " queues");
1460
1461     return $watched_queues;
1462
1463 }
1464
1465 =head2 _CleanupInvalidDelegations { InsideTransaction => undef }
1466
1467 Revokes all ACE entries delegated by this user which are inconsistent
1468 with their current delegation rights.  Does not perform permission
1469 checks.  Should only ever be called from inside the RT library.
1470
1471 If called from inside a transaction, specify a true value for the
1472 InsideTransaction parameter.
1473
1474 Returns a true value if the deletion succeeded; returns a false value
1475 and logs an internal error if the deletion fails (should not happen).
1476
1477 =cut
1478
1479 # XXX Currently there is a _CleanupInvalidDelegations method in both
1480 # RT::User and RT::Group.  If the recursive cleanup call for groups is
1481 # ever unrolled and merged, this code will probably want to be
1482 # factored out into RT::Principal.
1483
1484 sub _CleanupInvalidDelegations {
1485     my $self = shift;
1486     my %args = ( InsideTransaction => undef,
1487           @_ );
1488
1489     unless ( $self->Id ) {
1490     $RT::Logger->warning("User not loaded.");
1491     return (undef);
1492     }
1493
1494     my $in_trans = $args{InsideTransaction};
1495
1496     return(1) if ($self->HasRight(Right => 'DelegateRights',
1497                   Object => $RT::System));
1498
1499     # Look up all delegation rights currently posessed by this user.
1500     my $deleg_acl = RT::ACL->new($RT::SystemUser);
1501     $deleg_acl->LimitToPrincipal(Type => 'User',
1502                  Id => $self->PrincipalId,
1503                  IncludeGroupMembership => 1);
1504     $deleg_acl->Limit( FIELD => 'RightName',
1505                OPERATOR => '=',
1506                VALUE => 'DelegateRights' );
1507     my @allowed_deleg_objects = map {$_->Object()}
1508     @{$deleg_acl->ItemsArrayRef()};
1509
1510     # Look up all rights delegated by this principal which are
1511     # inconsistent with the allowed delegation objects.
1512     my $acl_to_del = RT::ACL->new($RT::SystemUser);
1513     $acl_to_del->DelegatedBy(Id => $self->Id);
1514     foreach (@allowed_deleg_objects) {
1515     $acl_to_del->LimitNotObject($_);
1516     }
1517
1518     # Delete all disallowed delegations
1519     while ( my $ace = $acl_to_del->Next() ) {
1520     my $ret = $ace->_Delete(InsideTransaction => 1);
1521     unless ($ret) {
1522         $RT::Handle->Rollback() unless $in_trans;
1523         $RT::Logger->warning("Couldn't delete delegated ACL entry ".$ace->Id);
1524         return (undef);
1525     }
1526     }
1527
1528     $RT::Handle->Commit() unless $in_trans;
1529     return (1);
1530 }
1531
1532 sub _Set {
1533     my $self = shift;
1534
1535     my %args = (
1536         Field => undef,
1537         Value => undef,
1538     TransactionType   => 'Set',
1539     RecordTransaction => 1,
1540         @_
1541     );
1542
1543     # Nobody is allowed to futz with RT_System or Nobody
1544
1545     if ( ($self->Id == $RT::SystemUser->Id )  ||
1546          ($self->Id == $RT::Nobody->Id)) {
1547         return ( 0, $self->loc("Can not modify system users") );
1548     }
1549     unless ( $self->CurrentUserCanModify( $args{'Field'} ) ) {
1550         return ( 0, $self->loc("Permission Denied") );
1551     }
1552
1553     my $Old = $self->SUPER::_Value("$args{'Field'}");
1554
1555     my ($ret, $msg) = $self->SUPER::_Set( Field => $args{'Field'},
1556                       Value => $args{'Value'} );
1557
1558     #If we can't actually set the field to the value, don't record
1559     # a transaction. instead, get out of here.
1560     if ( $ret == 0 ) { return ( 0, $msg ); }
1561
1562     if ( $args{'RecordTransaction'} == 1 ) {
1563
1564         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1565                                                Type => $args{'TransactionType'},
1566                                                Field     => $args{'Field'},
1567                                                NewValue  => $args{'Value'},
1568                                                OldValue  => $Old,
1569                                                TimeTaken => $args{'TimeTaken'},
1570         );
1571         return ( $Trans, scalar $TransObj->BriefDescription );
1572     }
1573     else {
1574         return ( $ret, $msg );
1575     }
1576 }
1577
1578 =head2 _Value
1579
1580 Takes the name of a table column.
1581 Returns its value as a string, if the user passes an ACL check
1582
1583 =cut
1584
1585 sub _Value {
1586
1587     my $self  = shift;
1588     my $field = shift;
1589
1590     #If the current user doesn't have ACLs, don't let em at it.
1591
1592     my @PublicFields = qw( Name EmailAddress Organization Disabled
1593       RealName NickName Gecos ExternalAuthId
1594       AuthSystem ExternalContactInfoId
1595       ContactInfoSystem );
1596
1597     #if the field is public, return it.
1598     if ( $self->_Accessible( $field, 'public' ) ) {
1599         return ( $self->SUPER::_Value($field) );
1600
1601     }
1602
1603     #If the user wants to see their own values, let them
1604     # TODO figure ouyt a better way to deal with this
1605    elsif ( defined($self->Id) && $self->CurrentUser->Id == $self->Id ) {
1606         return ( $self->SUPER::_Value($field) );
1607     }
1608
1609     #If the user has the admin users right, return the field
1610     elsif ( $self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1611         return ( $self->SUPER::_Value($field) );
1612     }
1613     else {
1614         return (undef);
1615     }
1616
1617 }
1618
1619 =head2 FriendlyName
1620
1621 Return the friendly name
1622
1623 =cut
1624
1625 sub FriendlyName {
1626     my $self = shift;
1627     return $self->RealName if defined($self->RealName);
1628     return $self->Name if defined($self->Name);
1629     return "";
1630 }
1631
1632 =head2 PreferredKey
1633
1634 Returns the preferred key of the user. If none is set, then this will query
1635 GPG and set the preferred key to the maximally trusted key found (and then
1636 return it). Returns C<undef> if no preferred key can be found.
1637
1638 =cut
1639
1640 sub PreferredKey
1641 {
1642     my $self = shift;
1643     return undef unless RT->Config->Get('GnuPG')->{'Enable'};
1644     my $prefkey = $self->FirstAttribute('PreferredKey');
1645     return $prefkey->Content if $prefkey;
1646
1647     # we don't have a preferred key for this user, so now we must query GPG
1648     require RT::Crypt::GnuPG;
1649     my %res = RT::Crypt::GnuPG::GetKeysForEncryption($self->EmailAddress);
1650     return undef unless defined $res{'info'};
1651     my @keys = @{ $res{'info'} };
1652     return undef if @keys == 0;
1653
1654     if (@keys == 1) {
1655         $prefkey = $keys[0]->{'Fingerprint'};
1656     }
1657     else {
1658         # prefer the maximally trusted key
1659         @keys = sort { $b->{'TrustLevel'} <=> $a->{'TrustLevel'} } @keys;
1660         $prefkey = $keys[0]->{'Fingerprint'};
1661     }
1662
1663     $self->SetAttribute(Name => 'PreferredKey', Content => $prefkey);
1664     return $prefkey;
1665 }
1666
1667 sub PrivateKey {
1668     my $self = shift;
1669
1670     my $key = $self->FirstAttribute('PrivateKey') or return undef;
1671     return $key->Content;
1672 }
1673
1674 sub SetPrivateKey {
1675     my $self = shift;
1676     my $key = shift;
1677     # XXX: ACL
1678     unless ( $key ) {
1679         my ($status, $msg) = $self->DeleteAttribute('PrivateKey');
1680         unless ( $status ) {
1681             $RT::Logger->error( "Couldn't delete attribute: $msg" );
1682             return ($status, $self->loc("Couldn't unset private key"));
1683         }
1684         return ($status, $self->loc("Unset private key"));
1685     }
1686
1687     # check that it's really private key
1688     {
1689         my %tmp = RT::Crypt::GnuPG::GetKeysForSigning( $key );
1690         return (0, $self->loc("No such key or it's not suitable for signing"))
1691             if $tmp{'exit_code'} || !$tmp{'info'};
1692     }
1693
1694     my ($status, $msg) = $self->SetAttribute(
1695         Name => 'PrivateKey',
1696         Content => $key,
1697     );
1698     return ($status, $self->loc("Couldn't set private key"))
1699         unless $status;
1700     return ($status, $self->loc("Unset private key"));
1701 }
1702
1703 sub BasicColumns {
1704     (
1705     [ Name => 'User Id' ],
1706     [ EmailAddress => 'Email' ],
1707     [ RealName => 'Name' ],
1708     [ Organization => 'Organization' ],
1709     );
1710 }
1711
1712 1;
1713
1714