rt/lib/RT/User_Overlay.pm

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