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