rt/lib/RT/User_Overlay.pm

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