rt/lib/RT/User_Overlay.pm

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