rt/lib/RT/User_Overlay.pm

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