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 # {{{ sub Rights testing
1318
1319 =head1 Rights testing
1320
1321
1322 =begin testing
1323
1324 my $root = RT::User->new($RT::SystemUser);
1325 $root->Load('root');
1326 ok($root->Id, "Found the root user");
1327 my $rootq = RT::Queue->new($root);
1328 $rootq->Load(1);
1329 ok($rootq->Id, "Loaded the first queue");
1330
1331 ok ($rootq->CurrentUser->HasRight(Right=> 'CreateTicket', Object => $rootq), "Root can create tickets");
1332
1333 my $new_user = RT::User->new($RT::SystemUser);
1334 my ($id, $msg) = $new_user->Create(Name => 'ACLTest'.$$);
1335
1336 ok ($id, "Created a new user for acl test $msg");
1337
1338 my $q = RT::Queue->new($new_user);
1339 $q->Load(1);
1340 ok($q->Id, "Loaded the first queue");
1341
1342
1343 ok (!$q->CurrentUser->HasRight(Right => 'CreateTicket', Object => $q), "Some random user doesn't have the right to create tickets");
1344 ok (my ($gval, $gmsg) = $new_user->PrincipalObj->GrantRight( Right => 'CreateTicket', Object => $q), "Granted the random user the right to create tickets");
1345 ok ($gval, "Grant succeeded - $gmsg");
1346
1347
1348 ok ($q->CurrentUser->HasRight(Right => 'CreateTicket', Object => $q), "The user can create tickets after we grant him the right");
1349 ok (my ($gval, $gmsg) = $new_user->PrincipalObj->RevokeRight( Right => 'CreateTicket', Object => $q), "revoked the random user the right to create tickets");
1350 ok ($gval, "Revocation succeeded - $gmsg");
1351 ok (!$q->CurrentUser->HasRight(Right => 'CreateTicket', Object => $q), "The user can't create tickets anymore");
1352
1353
1354
1355
1356
1357 # Create a ticket in the queue
1358 my $new_tick = RT::Ticket->new($RT::SystemUser);
1359 my ($tickid, $tickmsg) = $new_tick->Create(Subject=> 'ACL Test', Queue => 'General');
1360 ok($tickid, "Created ticket: $tickid");
1361 # Make sure the user doesn't have the right to modify tickets in the queue
1362 ok (!$new_user->HasRight( Object => $new_tick, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1363 # Create a new group
1364 my $group = RT::Group->new($RT::SystemUser);
1365 $group->CreateUserDefinedGroup(Name => 'ACLTest'.$$);
1366 ok($group->Id, "Created a new group Ok");
1367 # Grant a group the right to modify tickets in a queue
1368 ok(my ($gv,$gm) = $group->PrincipalObj->GrantRight( Object => $q, Right => 'ModifyTicket'),"Granted the group the right to modify tickets");
1369 ok($gv,"Grant succeeed - $gm");
1370 # Add the user to the group
1371 ok( my ($aid, $amsg) = $group->AddMember($new_user->PrincipalId), "Added the member to the group");
1372 ok ($aid, "Member added to group: $amsg");
1373 # Make sure the user does have the right to modify tickets in the queue
1374 ok ($new_user->HasRight( Object => $new_tick, Right => 'ModifyTicket'), "User can modify the ticket with group membership");
1375
1376
1377 # Remove the user from the group
1378 ok( my ($did, $dmsg) = $group->DeleteMember($new_user->PrincipalId), "Deleted the member from the group");
1379 ok ($did,"Deleted the group member: $dmsg");
1380 # Make sure the user doesn't have the right to modify tickets in the queue
1381 ok (!$new_user->HasRight( Object => $new_tick, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1382
1383
1384 my $q_as_system = RT::Queue->new($RT::SystemUser);
1385 $q_as_system->Load(1);
1386 ok($q_as_system->Id, "Loaded the first queue");
1387
1388 # Create a ticket in the queue
1389 my $new_tick2 = RT::Ticket->new($RT::SystemUser);
1390 my ($tick2id, $tickmsg) = $new_tick2->Create(Subject=> 'ACL Test 2', Queue =>$q_as_system->Id);
1391 ok($tick2id, "Created ticket: $tick2id");
1392 is($new_tick2->QueueObj->id, $q_as_system->Id, "Created a new ticket in queue 1");
1393
1394
1395 # make sure that the user can't do this without subgroup membership
1396 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1397
1398 # Create a subgroup
1399 my $subgroup = RT::Group->new($RT::SystemUser);
1400 $subgroup->CreateUserDefinedGroup(Name => 'Subgrouptest',$$);
1401 ok($subgroup->Id, "Created a new group ".$subgroup->Id."Ok");
1402 #Add the subgroup as a subgroup of the group
1403 my ($said, $samsg) =  $group->AddMember($subgroup->PrincipalId);
1404 ok ($said, "Added the subgroup as a member of the group");
1405 # Add the user to a subgroup of the group
1406
1407 my ($usaid, $usamsg) =  $subgroup->AddMember($new_user->PrincipalId);
1408 ok($usaid,"Added the user ".$new_user->Id."to the subgroup");
1409 # Make sure the user does have the right to modify tickets in the queue
1410 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket with subgroup membership");
1411
1412 #  {{{ Deal with making sure that members of subgroups of a disabled group don't have rights
1413
1414 my ($id, $msg);
1415 ($id, $msg) =  $group->SetDisabled(1);
1416 ok ($id,$msg);
1417 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket when the group ".$group->Id. " is disabled");
1418  ($id, $msg) =  $group->SetDisabled(0);
1419 ok($id,$msg);
1420 # Test what happens when we disable the group the user is a member of directly
1421
1422 ($id, $msg) =  $subgroup->SetDisabled(1);
1423  ok ($id,$msg);
1424 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket when the group ".$subgroup->Id. " is disabled");
1425  ($id, $msg) =  $subgroup->SetDisabled(0);
1426  ok ($id,$msg);
1427 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket without group membership");
1428
1429 # }}}
1430
1431
1432 my ($usrid, $usrmsg) =  $subgroup->DeleteMember($new_user->PrincipalId);
1433 ok($usrid,"removed the user from the group - $usrmsg");
1434 # Make sure the user doesn't have the right to modify tickets in the queue
1435 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1436
1437 #revoke the right to modify tickets in a queue
1438 ok(($gv,$gm) = $group->PrincipalObj->RevokeRight( Object => $q, Right => 'ModifyTicket'),"Granted the group the right to modify tickets");
1439 ok($gv,"revoke succeeed - $gm");
1440
1441 # {{{ Test the user's right to modify a ticket as a _queue_ admincc for a right granted at the _queue_ level
1442
1443 # Grant queue admin cc the right to modify ticket in the queue
1444 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");
1445 ok($qv, "Granted the right successfully - $qm");
1446
1447 # Add the user as a queue admincc
1448 ok ((my $add_id, $add_msg) = $q_as_system->AddWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Added the new user as a queue admincc");
1449 ok ($add_id, "the user is now a queue admincc - $add_msg");
1450
1451 # Make sure the user does have the right to modify tickets in the queue
1452 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket as an admincc");
1453 # Remove the user from the role  group
1454 ok ((my $del_id, $del_msg) = $q_as_system->DeleteWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Deleted the new user as a queue admincc");
1455
1456 # Make sure the user doesn't have the right to modify tickets in the queue
1457 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1458
1459 # }}}
1460
1461 # {{{ Test the user's right to modify a ticket as a _ticket_ admincc with the right granted at the _queue_ level
1462
1463 # Add the user as a ticket admincc
1464 ok ((my $uadd_id, $uadd_msg) = $new_tick2->AddWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Added the new user as a queue admincc");
1465 ok ($add_id, "the user is now a queue admincc - $add_msg");
1466
1467 # Make sure the user does have the right to modify tickets in the queue
1468 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket as an admincc");
1469
1470 # Remove the user from the role  group
1471 ok ((my $del_id, $del_msg) = $new_tick2->DeleteWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Deleted the new user as a queue admincc");
1472
1473 # Make sure the user doesn't have the right to modify tickets in the queue
1474 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1475
1476
1477 # Revoke the right to modify ticket in the queue
1478 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");
1479 ok($rqv, "Revoked the right successfully - $rqm");
1480
1481 # }}}
1482
1483
1484
1485 # {{{ Test the user's right to modify a ticket as a _queue_ admincc for a right granted at the _system_ level
1486
1487 # Before we start Make sure the user does not have the right to modify tickets in the queue
1488 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can not modify the ticket without it being granted");
1489 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can not modify tickets in the queue without it being granted");
1490
1491 # Grant queue admin cc the right to modify ticket in the queue
1492 ok(my ($qv,$qm) = $q_as_system->AdminCc->PrincipalObj->GrantRight( Object => $RT::System, Right => 'ModifyTicket'),"Granted the queue adminccs the right to modify tickets");
1493 ok($qv, "Granted the right successfully - $qm");
1494
1495 # Make sure the user can't modify the ticket before they're added as a watcher
1496 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can not modify the ticket without being an admincc");
1497 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can not modify tickets in the queue without being an admincc");
1498
1499 # Add the user as a queue admincc
1500 ok ((my $add_id, $add_msg) = $q_as_system->AddWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Added the new user as a queue admincc");
1501 ok ($add_id, "the user is now a queue admincc - $add_msg");
1502
1503 # Make sure the user does have the right to modify tickets in the queue
1504 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket as an admincc");
1505 ok ($new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can modify tickets in the queue as an admincc");
1506 # Remove the user from the role  group
1507 ok ((my $del_id, $del_msg) = $q_as_system->DeleteWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Deleted the new user as a queue admincc");
1508
1509 # Make sure the user doesn't have the right to modify tickets in the queue
1510 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without group membership");
1511 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can't modify tickets in the queue without group membership");
1512
1513 # }}}
1514
1515 # {{{ Test the user's right to modify a ticket as a _ticket_ admincc with the right granted at the _queue_ level
1516
1517 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can not modify the ticket without being an admincc");
1518 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can not modify tickets in the queue obj without being an admincc");
1519
1520
1521 # Add the user as a ticket admincc
1522 ok ((my $uadd_id, $uadd_msg) = $new_tick2->AddWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Added the new user as a queue admincc");
1523 ok ($add_id, "the user is now a queue admincc - $add_msg");
1524
1525 # Make sure the user does have the right to modify tickets in the queue
1526 ok ($new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can modify the ticket as an admincc");
1527 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can not modify tickets in the queue obj being only a ticket admincc");
1528
1529 # Remove the user from the role  group
1530 ok ((my $del_id, $del_msg) = $new_tick2->DeleteWatcher(Type => 'AdminCc', PrincipalId => $new_user->PrincipalId)  , "Deleted the new user as a queue admincc");
1531
1532 # Make sure the user doesn't have the right to modify tickets in the queue
1533 ok (!$new_user->HasRight( Object => $new_tick2, Right => 'ModifyTicket'), "User can't modify the ticket without being an admincc");
1534 ok (!$new_user->HasRight( Object => $new_tick2->QueueObj, Right => 'ModifyTicket'), "User can not modify tickets in the queue obj without being an admincc");
1535
1536
1537 # Revoke the right to modify ticket in the queue
1538 ok(my ($rqv,$rqm) = $q_as_system->AdminCc->PrincipalObj->RevokeRight( Object => $RT::System, Right => 'ModifyTicket'),"Revokeed the queue adminccs the right to modify tickets");
1539 ok($rqv, "Revoked the right successfully - $rqm");
1540
1541 # }}}
1542
1543
1544
1545
1546 # Grant "privileged users" the system right to create users
1547 # Create a privileged user.
1548 # have that user create another user
1549 # Revoke the right for privileged users to create users
1550 # have the privileged user try to create another user and fail the ACL check
1551
1552 =end testing
1553
1554 =cut
1555
1556 # }}}
1557
1558
1559 # {{{ sub HasRight
1560
1561 =head2 HasRight
1562
1563 Shim around PrincipalObj->HasRight. See RT::Principal
1564
1565 =cut
1566
1567 sub HasRight {
1568
1569     my $self = shift;
1570     return $self->PrincipalObj->HasRight(@_);
1571 }
1572
1573 # }}}
1574
1575 # {{{ sub CurrentUserCanModify
1576
1577 =head2 CurrentUserCanModify RIGHT
1578
1579 If the user has rights for this object, either because
1580 he has 'AdminUsers' or (if he\'s trying to edit himself and the right isn\'t an
1581 admin right) 'ModifySelf', return 1. otherwise, return undef.
1582
1583 =cut
1584
1585 sub CurrentUserCanModify {
1586     my $self  = shift;
1587     my $right = shift;
1588
1589     if ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1590         return (1);
1591     }
1592
1593     #If the field is marked as an "administrators only" field,
1594     # don\'t let the user touch it.
1595     elsif ( $self->_Accessible( $right, 'admin' ) ) {
1596         return (undef);
1597     }
1598
1599     #If the current user is trying to modify themselves
1600     elsif ( ( $self->id == $self->CurrentUser->id )
1601         and ( $self->CurrentUser->HasRight(Right => 'ModifySelf', Object => $RT::System) ) )
1602     {
1603         return (1);
1604     }
1605
1606     #If we don\'t have a good reason to grant them rights to modify
1607     # by now, they lose
1608     else {
1609         return (undef);
1610     }
1611
1612 }
1613
1614 # }}}
1615
1616 # {{{ sub CurrentUserHasRight
1617
1618 =head2 CurrentUserHasRight
1619
1620 Takes a single argument. returns 1 if $Self->CurrentUser
1621 has the requested right. returns undef otherwise
1622
1623 =cut
1624
1625 sub CurrentUserHasRight {
1626     my $self  = shift;
1627     my $right = shift;
1628
1629     return ( $self->CurrentUser->HasRight(Right => $right, Object => $RT::System) );
1630 }
1631
1632 # }}}
1633
1634 # {{{ sub _CleanupInvalidDelegations
1635
1636 =head2 _CleanupInvalidDelegations { InsideTransaction => undef }
1637
1638 Revokes all ACE entries delegated by this user which are inconsistent
1639 with their current delegation rights.  Does not perform permission
1640 checks.  Should only ever be called from inside the RT library.
1641
1642 If called from inside a transaction, specify a true value for the
1643 InsideTransaction parameter.
1644
1645 Returns a true value if the deletion succeeded; returns a false value
1646 and logs an internal error if the deletion fails (should not happen).
1647
1648 =cut
1649
1650 # XXX Currently there is a _CleanupInvalidDelegations method in both
1651 # RT::User and RT::Group.  If the recursive cleanup call for groups is
1652 # ever unrolled and merged, this code will probably want to be
1653 # factored out into RT::Principal.
1654
1655 sub _CleanupInvalidDelegations {
1656     my $self = shift;
1657     my %args = ( InsideTransaction => undef,
1658                   @_ );
1659
1660     unless ( $self->Id ) {
1661         $RT::Logger->warning("User not loaded.");
1662         return (undef);
1663     }
1664
1665     my $in_trans = $args{InsideTransaction};
1666
1667     return(1) if ($self->HasRight(Right => 'DelegateRights',
1668                                   Object => $RT::System));
1669
1670     # Look up all delegation rights currently posessed by this user.
1671     my $deleg_acl = RT::ACL->new($RT::SystemUser);
1672     $deleg_acl->LimitToPrincipal(Type => 'User',
1673                                  Id => $self->PrincipalId,
1674                                  IncludeGroupMembership => 1);
1675     $deleg_acl->Limit( FIELD => 'RightName',
1676                        OPERATOR => '=',
1677                        VALUE => 'DelegateRights' );
1678     my @allowed_deleg_objects = map {$_->Object()}
1679         @{$deleg_acl->ItemsArrayRef()};
1680
1681     # Look up all rights delegated by this principal which are
1682     # inconsistent with the allowed delegation objects.
1683     my $acl_to_del = RT::ACL->new($RT::SystemUser);
1684     $acl_to_del->DelegatedBy(Id => $self->Id);
1685     foreach (@allowed_deleg_objects) {
1686         $acl_to_del->LimitNotObject($_);
1687     }
1688
1689     # Delete all disallowed delegations
1690     while ( my $ace = $acl_to_del->Next() ) {
1691         my $ret = $ace->_Delete(InsideTransaction => 1);
1692         unless ($ret) {
1693             $RT::Handle->Rollback() unless $in_trans;
1694             $RT::Logger->warning("Couldn't delete delegated ACL entry ".$ace->Id);
1695             return (undef);
1696         }
1697     }
1698
1699     $RT::Handle->Commit() unless $in_trans;
1700     return (1);
1701 }
1702
1703 # }}}
1704
1705 # {{{ sub _Set
1706
1707 sub _Set {
1708     my $self = shift;
1709
1710     my %args = (
1711         Field => undef,
1712         Value => undef,
1713         TransactionType   => 'Set',
1714         RecordTransaction => 1,
1715         @_
1716     );
1717
1718     # Nobody is allowed to futz with RT_System or Nobody
1719
1720     if ( ($self->Id == $RT::SystemUser->Id )  ||
1721          ($self->Id == $RT::Nobody->Id)) {
1722         return ( 0, $self->loc("Can not modify system users") );
1723     }
1724     unless ( $self->CurrentUserCanModify( $args{'Field'} ) ) {
1725         return ( 0, $self->loc("Permission Denied") );
1726     }
1727
1728     my $Old = $self->SUPER::_Value("$args{'Field'}");
1729
1730     my ($ret, $msg) = $self->SUPER::_Set( Field => $args{'Field'},
1731                                           Value => $args{'Value'} );
1732
1733     #If we can't actually set the field to the value, don't record
1734     # a transaction. instead, get out of here.
1735     if ( $ret == 0 ) { return ( 0, $msg ); }
1736
1737     if ( $args{'RecordTransaction'} == 1 ) {
1738
1739         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1740                                                Type => $args{'TransactionType'},
1741                                                Field     => $args{'Field'},
1742                                                NewValue  => $args{'Value'},
1743                                                OldValue  => $Old,
1744                                                TimeTaken => $args{'TimeTaken'},
1745         );
1746         return ( $Trans, scalar $TransObj->BriefDescription );
1747     }
1748     else {
1749         return ( $ret, $msg );
1750     }
1751 }
1752
1753 # }}}
1754
1755 # {{{ sub _Value
1756
1757 =head2 _Value
1758
1759 Takes the name of a table column.
1760 Returns its value as a string, if the user passes an ACL check
1761
1762 =cut
1763
1764 sub _Value {
1765
1766     my $self  = shift;
1767     my $field = shift;
1768
1769     #If the current user doesn't have ACLs, don't let em at it.
1770
1771     my @PublicFields = qw( Name EmailAddress Organization Disabled
1772       RealName NickName Gecos ExternalAuthId
1773       AuthSystem ExternalContactInfoId
1774       ContactInfoSystem );
1775
1776     #if the field is public, return it.
1777     if ( $self->_Accessible( $field, 'public' ) ) {
1778         return ( $self->SUPER::_Value($field) );
1779
1780     }
1781
1782     #If the user wants to see their own values, let them
1783     # TODO figure ouyt a better way to deal with this
1784    elsif ( $self->CurrentUser->Id == $self->Id ) {
1785         return ( $self->SUPER::_Value($field) );
1786     }
1787
1788     #If the user has the admin users right, return the field
1789     elsif ( $self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1790         return ( $self->SUPER::_Value($field) );
1791     }
1792     else {
1793         return (undef);
1794     }
1795
1796 }
1797
1798 # }}}
1799
1800 sub BasicColumns {
1801     (
1802         [ Name => 'User Id' ],
1803         [ EmailAddress => 'Email' ],
1804         [ RealName => 'Name' ],
1805         [ Organization => 'Organization' ],
1806     );
1807 }
1808
1809 1;
1810
1811