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
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('ModifyUser');
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('ModifyUser');
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
1532 # {{{ sub Rights testing
1533
1534 =head1 Rights testing
1535
1536
1537 =begin testing
1538
1539 my $root = RT::User->new($RT::SystemUser);
1540 $root->Load('root');
1541 ok($root->Id, "Found the root user");
1542 my $rootq = RT::Queue->new($root);
1543 $rootq->Load(1);
1544 ok($rootq->Id, "Loaded the first queue");
1545
1546 ok ($rootq->CurrentUser->HasRight(Right=> 'CreateTicket', Object => $rootq), "Root can create tickets");
1547
1548 my $new_user = RT::User->new($RT::SystemUser);
1549 my ($id, $msg) = $new_user->Create(Name => 'ACLTest'.$$);
1550
1551 ok ($id, "Created a new user for acl test $msg");
1552
1553 my $q = RT::Queue->new($new_user);
1554 $q->Load(1);
1555 ok($q->Id, "Loaded the first queue");
1556
1557
1558 ok (!$q->CurrentUser->HasRight(Right => 'CreateTicket', Object => $q), "Some random user doesn't have the right to create tickets");
1559 ok (my ($gval, $gmsg) = $new_user->PrincipalObj->GrantRight( Right => 'CreateTicket', Object => $q), "Granted the random user the right to create tickets");
1560 ok ($gval, "Grant succeeded - $gmsg");
1561
1562
1563 ok ($q->CurrentUser->HasRight(Right => 'CreateTicket', Object => $q), "The user can create tickets after we grant him the right");
1564 ok (my ($gval, $gmsg) = $new_user->PrincipalObj->RevokeRight( Right => 'CreateTicket', Object => $q), "revoked the random user the right to create tickets");
1565 ok ($gval, "Revocation succeeded - $gmsg");
1566 ok (!$q->CurrentUser->HasRight(Right => 'CreateTicket', Object => $q), "The user can't create tickets anymore");
1567
1568
1569
1570
1571
1572 # Create a ticket in the queue
1573 my $new_tick = RT::Ticket->new($RT::SystemUser);
1574 my ($tickid, $tickmsg) = $new_tick->Create(Subject=> 'ACL Test', Queue => 'General');
1575 ok($tickid, "Created ticket: $tickid");
1576 # Make sure the user doesn't have the right to modify tickets in the queue
1577 ok (!$new_user->HasRight( Object => $new_tick, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1578 # Create a new group
1579 my $group = RT::Group->new($RT::SystemUser);
1580 $group->CreateUserDefinedGroup(Name => 'ACLTest'.$$);
1581 ok($group->Id, "Created a new group Ok");
1582 # Grant a group the right to modify tickets in a queue
1583 ok(my ($gv,$gm) = $group->PrincipalObj->GrantRight( Object => $q, Right => 'ModifyTicket'),"Granted the group the right to modify tickets");
1584 ok($gv,"Grant succeeed - $gm");
1585 # Add the user to the group
1586 ok( my ($aid, $amsg) = $group->AddMember($new_user->PrincipalId), "Added the member to the group");
1587 ok ($aid, "Member added to group: $amsg");
1588 # Make sure the user does have the right to modify tickets in the queue
1589 ok ($new_user->HasRight( Object => $new_tick, Right => 'ModifyTicket'), "User can modify the ticket with group membership");
1590
1591
1592 # Remove the user from the group
1593 ok( my ($did, $dmsg) = $group->DeleteMember($new_user->PrincipalId), "Deleted the member from the group");
1594 ok ($did,"Deleted the group member: $dmsg");
1595 # Make sure the user doesn't have the right to modify tickets in the queue
1596 ok (!$new_user->HasRight( Object => $new_tick, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1597
1598
1599 my $q_as_system = RT::Queue->new($RT::SystemUser);
1600 $q_as_system->Load(1);
1601 ok($q_as_system->Id, "Loaded the first queue");
1602
1603 # Create a ticket in the queue
1604 my $new_tick2 = RT::Ticket->new($RT::SystemUser);
1605 my ($tick2id, $tickmsg) = $new_tick2->Create(Subject=> 'ACL Test 2', Queue =>$q_as_system->Id);
1606 ok($tick2id, "Created ticket: $tick2id");
1607 is($new_tick2->QueueObj->id, $q_as_system->Id, "Created a new ticket in queue 1");
1608
1609
1610 # make sure that the user can't do this without subgroup membership
1611 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1612
1613 # Create a subgroup
1614 my $subgroup = RT::Group->new($RT::SystemUser);
1615 $subgroup->CreateUserDefinedGroup(Name => 'Subgrouptest',$$);
1616 ok($subgroup->Id, "Created a new group ".$subgroup->Id."Ok");
1617 #Add the subgroup as a subgroup of the group
1618 my ($said, $samsg) =  $group->AddMember($subgroup->PrincipalId);
1619 ok ($said, "Added the subgroup as a member of the group");
1620 # Add the user to a subgroup of the group
1621
1622 my ($usaid, $usamsg) =  $subgroup->AddMember($new_user->PrincipalId);
1623 ok($usaid,"Added the user ".$new_user->Id."to the subgroup");
1624 # Make sure the user does have the right to modify tickets in the queue
1625 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket with subgroup membership");
1626
1627 #  {{{ Deal with making sure that members of subgroups of a disabled group don't have rights
1628
1629 my ($id, $msg);
1630 ($id, $msg) =  $group->SetDisabled(1);
1631 ok ($id,$msg);
1632 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket when the group ".$group->Id. " is disabled");
1633  ($id, $msg) =  $group->SetDisabled(0);
1634 ok($id,$msg);
1635 # Test what happens when we disable the group the user is a member of directly
1636
1637 ($id, $msg) =  $subgroup->SetDisabled(1);
1638  ok ($id,$msg);
1639 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket when the group ".$subgroup->Id. " is disabled");
1640  ($id, $msg) =  $subgroup->SetDisabled(0);
1641  ok ($id,$msg);
1642 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket without group membership");
1643
1644 # }}}
1645
1646
1647 my ($usrid, $usrmsg) =  $subgroup->DeleteMember($new_user->PrincipalId);
1648 ok($usrid,"removed the user from the group - $usrmsg");
1649 # Make sure the user doesn't have the right to modify tickets in the queue
1650 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1651
1652 #revoke the right to modify tickets in a queue
1653 ok(($gv,$gm) = $group->PrincipalObj->RevokeRight( Object => $q, Right => 'ModifyTicket'),"Granted the group the right to modify tickets");
1654 ok($gv,"revoke succeeed - $gm");
1655
1656 # {{{ Test the user's right to modify a ticket as a _queue_ admincc for a right granted at the _queue_ level
1657
1658 # Grant queue admin cc the right to modify ticket in the queue
1659 ok(my ($qv,$qm) = $q_as_system->AdminCc->PrincipalObj->GrantRight( Object => $q_as_system, Right => 'ModifyTicket'),"Granted the queue adminccs the right to modify tickets");
1660 ok($qv, "Granted the right successfully - $qm");
1661
1662 # Add the user as a queue admincc
1663 ok ((my $add_id, $add_msg) = $q_as_system->AddWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Added the new user as a queue admincc");
1664 ok ($add_id, "the user is now a queue admincc - $add_msg");
1665
1666 # Make sure the user does have the right to modify tickets in the queue
1667 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket as an admincc");
1668 # Remove the user from the role  group
1669 ok ((my $del_id, $del_msg) = $q_as_system->DeleteWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Deleted the new user as a queue admincc");
1670
1671 # Make sure the user doesn't have the right to modify tickets in the queue
1672 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1673
1674 # }}}
1675
1676 # {{{ Test the user's right to modify a ticket as a _ticket_ admincc with the right granted at the _queue_ level
1677
1678 # Add the user as a ticket admincc
1679 ok ((my $uadd_id, $uadd_msg) = $new_tick2->AddWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Added the new user as a queue admincc");
1680 ok ($add_id, "the user is now a queue admincc - $add_msg");
1681
1682 # Make sure the user does have the right to modify tickets in the queue
1683 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket as an admincc");
1684
1685 # Remove the user from the role  group
1686 ok ((my $del_id, $del_msg) = $new_tick2->DeleteWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Deleted the new user as a queue admincc");
1687
1688 # Make sure the user doesn't have the right to modify tickets in the queue
1689 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1690
1691
1692 # Revoke the right to modify ticket in the queue
1693 ok(my ($rqv,$rqm) = $q_as_system->AdminCc->PrincipalObj->RevokeRight( Object => $q_as_system, Right => 'ModifyTicket'),"Revokeed the queue adminccs the right to modify tickets");
1694 ok($rqv, "Revoked the right successfully - $rqm");
1695
1696 # }}}
1697
1698
1699
1700 # {{{ Test the user's right to modify a ticket as a _queue_ admincc for a right granted at the _system_ level
1701
1702 # Before we start Make sure the user does not have the right to modify tickets in the queue
1703 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can not modify the ticket without it being granted");
1704 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can not modify tickets in the queue without it being granted");
1705
1706 # Grant queue admin cc the right to modify ticket in the queue
1707 ok(my ($qv,$qm) = $q_as_system->AdminCc->PrincipalObj->GrantRight( Object => $RT::System, Right => 'ModifyTicket'),"Granted the queue adminccs the right to modify tickets");
1708 ok($qv, "Granted the right successfully - $qm");
1709
1710 # Make sure the user can't modify the ticket before they're added as a watcher
1711 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can not modify the ticket without being an admincc");
1712 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can not modify tickets in the queue without being an admincc");
1713
1714 # Add the user as a queue admincc
1715 ok ((my $add_id, $add_msg) = $q_as_system->AddWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Added the new user as a queue admincc");
1716 ok ($add_id, "the user is now a queue admincc - $add_msg");
1717
1718 # Make sure the user does have the right to modify tickets in the queue
1719 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket as an admincc");
1720 ok ($new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can modify tickets in the queue as an admincc");
1721 # Remove the user from the role  group
1722 ok ((my $del_id, $del_msg) = $q_as_system->DeleteWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Deleted the new user as a queue admincc");
1723
1724 # Make sure the user doesn't have the right to modify tickets in the queue
1725 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1726 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can't modify tickets in the queue without group membership");
1727
1728 # }}}
1729
1730 # {{{ Test the user's right to modify a ticket as a _ticket_ admincc with the right granted at the _queue_ level
1731
1732 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can not modify the ticket without being an admincc");
1733 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can not modify tickets in the queue obj without being an admincc");
1734
1735
1736 # Add the user as a ticket admincc
1737 ok ((my $uadd_id, $uadd_msg) = $new_tick2->AddWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Added the new user as a queue admincc");
1738 ok ($add_id, "the user is now a queue admincc - $add_msg");
1739
1740 # Make sure the user does have the right to modify tickets in the queue
1741 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket as an admincc");
1742 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can not modify tickets in the queue obj being only a ticket admincc");
1743
1744 # Remove the user from the role  group
1745 ok ((my $del_id, $del_msg) = $new_tick2->DeleteWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Deleted the new user as a queue admincc");
1746
1747 # Make sure the user doesn't have the right to modify tickets in the queue
1748 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without being an admincc");
1749 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can not modify tickets in the queue obj without being an admincc");
1750
1751
1752 # Revoke the right to modify ticket in the queue
1753 ok(my ($rqv,$rqm) = $q_as_system->AdminCc->PrincipalObj->RevokeRight( Object => $RT::System, Right => 'ModifyTicket'),"Revokeed the queue adminccs the right to modify tickets");
1754 ok($rqv, "Revoked the right successfully - $rqm");
1755
1756 # }}}
1757
1758
1759
1760
1761 # Grant "privileged users" the system right to create users
1762 # Create a privileged user.
1763 # have that user create another user
1764 # Revoke the right for privileged users to create users
1765 # have the privileged user try to create another user and fail the ACL check
1766
1767 =end testing
1768
1769 =cut
1770
1771 # }}}
1772
1773
1774 # {{{ sub HasRight
1775
1776 =head2 HasRight
1777
1778 Shim around PrincipalObj->HasRight. See L<RT::Principal>.
1779
1780 =cut
1781
1782 sub HasRight {
1783     my $self = shift;
1784     return $self->PrincipalObj->HasRight(@_);
1785 }
1786
1787 =head2 CurrentUserCanModify RIGHT
1788
1789 If the user has rights for this object, either because
1790 he has 'AdminUsers' or (if he\'s trying to edit himself and the right isn\'t an
1791 admin right) 'ModifySelf', return 1. otherwise, return undef.
1792
1793 =cut
1794
1795 sub CurrentUserCanModify {
1796     my $self  = shift;
1797     my $right = shift;
1798
1799     if ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1800         return (1);
1801     }
1802
1803     #If the field is marked as an "administrators only" field,
1804     # don\'t let the user touch it.
1805     elsif ( $self->_Accessible( $right, 'admin' ) ) {
1806         return (undef);
1807     }
1808
1809     #If the current user is trying to modify themselves
1810     elsif ( ( $self->id == $self->CurrentUser->id )
1811         and ( $self->CurrentUser->HasRight(Right => 'ModifySelf', Object => $RT::System) ) )
1812     {
1813         return (1);
1814     }
1815
1816     #If we don\'t have a good reason to grant them rights to modify
1817     # by now, they lose
1818     else {
1819         return (undef);
1820     }
1821
1822 }
1823
1824 =head2 CurrentUserHasRight
1825
1826 Takes a single argument. returns 1 if $Self->CurrentUser
1827 has the requested right. returns undef otherwise
1828
1829 =cut
1830
1831 sub CurrentUserHasRight {
1832     my $self  = shift;
1833     my $right = shift;
1834
1835     return ( $self->CurrentUser->HasRight(Right => $right, Object => $RT::System) );
1836 }
1837
1838 sub _PrefName {
1839     my $name = shift;
1840     if (ref $name) {
1841         $name = ref($name).'-'.$name->Id;
1842     }
1843
1844     return 'Pref-'.$name;
1845 }
1846
1847 =head2 Preferences NAME/OBJ DEFAULT
1848
1849 Obtain user preferences associated with given object or name.
1850 Returns DEFAULT if no preferences found.  If DEFAULT is a hashref,
1851 override the entries with user preferences.
1852
1853 =cut
1854
1855 sub Preferences {
1856     my $self  = shift;
1857     my $name = _PrefName (shift);
1858     my $default = shift;
1859
1860     my $attr = RT::Attribute->new( $self->CurrentUser );
1861     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1862
1863     my $content = $attr->Id ? $attr->Content : undef;
1864     unless ( ref $content eq 'HASH' ) {
1865         return defined $content ? $content : $default;
1866     }
1867
1868     if (ref $default eq 'HASH') {
1869         for (keys %$default) {
1870             exists $content->{$_} or $content->{$_} = $default->{$_};
1871         }
1872     }
1873     elsif (defined $default) {
1874         $RT::Logger->error("Preferences $name for user".$self->Id." is hash but default is not");
1875     }
1876     return $content;
1877 }
1878
1879 =head2 SetPreferences NAME/OBJ VALUE
1880
1881 Set user preferences associated with given object or name.
1882
1883 =cut
1884
1885 sub SetPreferences {
1886     my $self = shift;
1887     my $name = _PrefName( shift );
1888     my $value = shift;
1889
1890     return (0, $self->loc("No permission to set preferences"))
1891         unless $self->CurrentUserCanModify('Preferences');
1892
1893     my $attr = RT::Attribute->new( $self->CurrentUser );
1894     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1895     if ( $attr->Id ) {
1896         return $attr->SetContent( $value );
1897     }
1898     else {
1899         return $self->AddAttribute( Name => $name, Content => $value );
1900     }
1901 }
1902
1903 =head2 WatchedQueues ROLE_LIST
1904
1905 Returns a RT::Queues object containing every queue watched by the user.
1906
1907 Takes a list of roles which is some subset of ('Cc', 'AdminCc').  Defaults to:
1908
1909 $user->WatchedQueues('Cc', 'AdminCc');
1910
1911 =cut
1912
1913 sub WatchedQueues {
1914
1915     my $self = shift;
1916     my @roles = @_ || ('Cc', 'AdminCc');
1917
1918     $RT::Logger->debug('WatcheQueues got user ' . $self->Name);
1919
1920     my $watched_queues = RT::Queues->new($self->CurrentUser);
1921
1922     my $group_alias = $watched_queues->Join(
1923                                              ALIAS1 => 'main',
1924                                              FIELD1 => 'id',
1925                                              TABLE2 => 'Groups',
1926                                              FIELD2 => 'Instance',
1927                                            );
1928
1929     $watched_queues->Limit(
1930                             ALIAS => $group_alias,
1931                             FIELD => 'Domain',
1932                             VALUE => 'RT::Queue-Role',
1933                             ENTRYAGGREGATOR => 'AND',
1934                           );
1935     if (grep { $_ eq 'Cc' } @roles) {
1936         $watched_queues->Limit(
1937                                 SUBCLAUSE => 'LimitToWatchers',
1938                                 ALIAS => $group_alias,
1939                                 FIELD => 'Type',
1940                                 VALUE => 'Cc',
1941                                 ENTRYAGGREGATOR => 'OR',
1942                               );
1943     }
1944     if (grep { $_ eq 'AdminCc' } @roles) {
1945         $watched_queues->Limit(
1946                                 SUBCLAUSE => 'LimitToWatchers',
1947                                 ALIAS => $group_alias,
1948                                 FIELD => 'Type',
1949                                 VALUE => 'AdminCc',
1950                                 ENTRYAGGREGATOR => 'OR',
1951                               );
1952     }
1953
1954     my $queues_alias = $watched_queues->Join(
1955                                               ALIAS1 => $group_alias,
1956                                               FIELD1 => 'id',
1957                                               TABLE2 => 'CachedGroupMembers',
1958                                               FIELD2 => 'GroupId',
1959                                             );
1960     $watched_queues->Limit(
1961                             ALIAS => $queues_alias,
1962                             FIELD => 'MemberId',
1963                             VALUE => $self->PrincipalId,
1964                           );
1965
1966     $RT::Logger->debug("WatchedQueues got " . $watched_queues->Count . " queues");
1967
1968     return $watched_queues;
1969
1970 }
1971
1972 =head2 _CleanupInvalidDelegations { InsideTransaction => undef }
1973
1974 Revokes all ACE entries delegated by this user which are inconsistent
1975 with their current delegation rights.  Does not perform permission
1976 checks.  Should only ever be called from inside the RT library.
1977
1978 If called from inside a transaction, specify a true value for the
1979 InsideTransaction parameter.
1980
1981 Returns a true value if the deletion succeeded; returns a false value
1982 and logs an internal error if the deletion fails (should not happen).
1983
1984 =cut
1985
1986 # XXX Currently there is a _CleanupInvalidDelegations method in both
1987 # RT::User and RT::Group.  If the recursive cleanup call for groups is
1988 # ever unrolled and merged, this code will probably want to be
1989 # factored out into RT::Principal.
1990
1991 sub _CleanupInvalidDelegations {
1992     my $self = shift;
1993     my %args = ( InsideTransaction => undef,
1994           @_ );
1995
1996     unless ( $self->Id ) {
1997     $RT::Logger->warning("User not loaded.");
1998     return (undef);
1999     }
2000
2001     my $in_trans = $args{InsideTransaction};
2002
2003     return(1) if ($self->HasRight(Right => 'DelegateRights',
2004                   Object => $RT::System));
2005
2006     # Look up all delegation rights currently posessed by this user.
2007     my $deleg_acl = RT::ACL->new($RT::SystemUser);
2008     $deleg_acl->LimitToPrincipal(Type => 'User',
2009                  Id => $self->PrincipalId,
2010                  IncludeGroupMembership => 1);
2011     $deleg_acl->Limit( FIELD => 'RightName',
2012                OPERATOR => '=',
2013                VALUE => 'DelegateRights' );
2014     my @allowed_deleg_objects = map {$_->Object()}
2015     @{$deleg_acl->ItemsArrayRef()};
2016
2017     # Look up all rights delegated by this principal which are
2018     # inconsistent with the allowed delegation objects.
2019     my $acl_to_del = RT::ACL->new($RT::SystemUser);
2020     $acl_to_del->DelegatedBy(Id => $self->Id);
2021     foreach (@allowed_deleg_objects) {
2022     $acl_to_del->LimitNotObject($_);
2023     }
2024
2025     # Delete all disallowed delegations
2026     while ( my $ace = $acl_to_del->Next() ) {
2027     my $ret = $ace->_Delete(InsideTransaction => 1);
2028     unless ($ret) {
2029         $RT::Handle->Rollback() unless $in_trans;
2030         $RT::Logger->warning("Couldn't delete delegated ACL entry ".$ace->Id);
2031         return (undef);
2032     }
2033     }
2034
2035     $RT::Handle->Commit() unless $in_trans;
2036     return (1);
2037 }
2038
2039 sub _Set {
2040     my $self = shift;
2041
2042     my %args = (
2043         Field => undef,
2044         Value => undef,
2045     TransactionType   => 'Set',
2046     RecordTransaction => 1,
2047         @_
2048     );
2049
2050     # Nobody is allowed to futz with RT_System or Nobody
2051
2052     if ( ($self->Id == $RT::SystemUser->Id )  ||
2053          ($self->Id == $RT::Nobody->Id)) {
2054         return ( 0, $self->loc("Can not modify system users") );
2055     }
2056     unless ( $self->CurrentUserCanModify( $args{'Field'} ) ) {
2057         return ( 0, $self->loc("Permission Denied") );
2058     }
2059
2060     my $Old = $self->SUPER::_Value("$args{'Field'}");
2061
2062     my ($ret, $msg) = $self->SUPER::_Set( Field => $args{'Field'},
2063                       Value => $args{'Value'} );
2064
2065     #If we can't actually set the field to the value, don't record
2066     # a transaction. instead, get out of here.
2067     if ( $ret == 0 ) { return ( 0, $msg ); }
2068
2069     if ( $args{'RecordTransaction'} == 1 ) {
2070
2071         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
2072                                                Type => $args{'TransactionType'},
2073                                                Field     => $args{'Field'},
2074                                                NewValue  => $args{'Value'},
2075                                                OldValue  => $Old,
2076                                                TimeTaken => $args{'TimeTaken'},
2077         );
2078         return ( $Trans, scalar $TransObj->BriefDescription );
2079     }
2080     else {
2081         return ( $ret, $msg );
2082     }
2083 }
2084
2085 =head2 _Value
2086
2087 Takes the name of a table column.
2088 Returns its value as a string, if the user passes an ACL check
2089
2090 =cut
2091
2092 sub _Value {
2093
2094     my $self  = shift;
2095     my $field = shift;
2096
2097     #If the current user doesn't have ACLs, don't let em at it.
2098
2099     my @PublicFields = qw( Name EmailAddress Organization Disabled
2100       RealName NickName Gecos ExternalAuthId
2101       AuthSystem ExternalContactInfoId
2102       ContactInfoSystem );
2103
2104     #if the field is public, return it.
2105     if ( $self->_Accessible( $field, 'public' ) ) {
2106         return ( $self->SUPER::_Value($field) );
2107
2108     }
2109
2110     #If the user wants to see their own values, let them
2111     # TODO figure ouyt a better way to deal with this
2112    elsif ( defined($self->Id) && $self->CurrentUser->Id == $self->Id ) {
2113         return ( $self->SUPER::_Value($field) );
2114     }
2115
2116     #If the user has the admin users right, return the field
2117     elsif ( $self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
2118         return ( $self->SUPER::_Value($field) );
2119     }
2120     else {
2121         return (undef);
2122     }
2123
2124 }
2125
2126 =head2 FriendlyName
2127
2128 Return the friendly name
2129
2130 =cut
2131
2132 sub FriendlyName {
2133     my $self = shift;
2134     return $self->RealName if defined($self->RealName);
2135     return $self->Name if defined($self->Name);
2136     return "";
2137 }
2138
2139 =head2 PreferredKey
2140
2141 Returns the preferred key of the user. If none is set, then this will query
2142 GPG and set the preferred key to the maximally trusted key found (and then
2143 return it). Returns C<undef> if no preferred key can be found.
2144
2145 =cut
2146
2147 sub PreferredKey
2148 {
2149     my $self = shift;
2150     return undef unless RT->Config->Get('GnuPG')->{'Enable'};
2151     my $prefkey = $self->FirstAttribute('PreferredKey');
2152     return $prefkey->Content if $prefkey;
2153
2154     # we don't have a preferred key for this user, so now we must query GPG
2155     require RT::Crypt::GnuPG;
2156     my %res = RT::Crypt::GnuPG::GetKeysForEncryption($self->EmailAddress);
2157     return undef unless defined $res{'info'};
2158     my @keys = @{ $res{'info'} };
2159     return undef if @keys == 0;
2160
2161     if (@keys == 1) {
2162         $prefkey = $keys[0]->{'Fingerprint'};
2163     }
2164     else {
2165         # prefer the maximally trusted key
2166         @keys = sort { $b->{'TrustLevel'} <=> $a->{'TrustLevel'} } @keys;
2167         $prefkey = $keys[0]->{'Fingerprint'};
2168     }
2169
2170     $self->SetAttribute(Name => 'PreferredKey', Content => $prefkey);
2171     return $prefkey;
2172 }
2173
2174 sub PrivateKey {
2175     my $self = shift;
2176
2177     my $key = $self->FirstAttribute('PrivateKey') or return undef;
2178     return $key->Content;
2179 }
2180
2181 sub SetPrivateKey {
2182     my $self = shift;
2183     my $key = shift;
2184     # XXX: ACL
2185     unless ( $key ) {
2186         my ($status, $msg) = $self->DeleteAttribute('PrivateKey');
2187         unless ( $status ) {
2188             $RT::Logger->error( "Couldn't delete attribute: $msg" );
2189             return ($status, $self->loc("Couldn't unset private key"));
2190         }
2191         return ($status, $self->loc("Unset private key"));
2192     }
2193
2194     # check that it's really private key
2195     {
2196         my %tmp = RT::Crypt::GnuPG::GetKeysForSigning( $key );
2197         return (0, $self->loc("No such key or it's not suitable for signing"))
2198             if $tmp{'exit_code'} || !$tmp{'info'};
2199     }
2200
2201     my ($status, $msg) = $self->SetAttribute(
2202         Name => 'PrivateKey',
2203         Content => $key,
2204     );
2205     return ($status, $self->loc("Couldn't set private key"))
2206         unless $status;
2207     return ($status, $self->loc("Unset private key"));
2208 }
2209
2210 sub BasicColumns {
2211     (
2212     [ Name => 'User Id' ],
2213     [ EmailAddress => 'Email' ],
2214     [ RealName => 'Name' ],
2215     [ Organization => 'Organization' ],
2216     );
2217 }
2218
2219 1;
2220
2221