rt/lib/RT/User_Overlay.pm

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