rt/lib/RT/User.pm

   1 # $Header: /home/cvs/cvsroot/freeside/rt/lib/RT/User.pm,v 1.1 2002-08-12 06:17:07 ivan Exp $
   2 # (c) 1996-2000 Jesse Vincent <jesse@fsck.com>
   3 # This software is redistributable under the terms of the GNU GPL
   4
   5 =head1 NAME
   6
   7   RT::User - RT User object
   8
   9 =head1 SYNOPSIS
  10
  11   use RT::User;
  12
  13 =head1 DESCRIPTION
  14
  15
  16 =head1 METHODS
  17
  18 =begin testing
  19
  20 ok(require RT::TestHarness);
  21 ok(require RT::User);
  22
  23 =end testing
  24
  25
  26 =cut
  27
  28
  29 package RT::User;
  30 use RT::Record;
  31 @ISA= qw(RT::Record);
  32
  33 # {{{ sub _Init
  34 sub _Init  {
  35     my $self = shift;
  36     $self->{'table'} = "Users";
  37     return($self->SUPER::_Init(@_));
  38 }
  39 # }}}
  40
  41 # {{{ sub _Accessible
  42
  43 sub _Accessible  {
  44   my $self = shift;
  45   my %Cols = (
  46               # {{{ Core RT info
  47               Name => 'public/read/write/admin',
  48               Password => 'write',
  49               Comments => 'read/write/admin',
  50               Signature => 'read/write',
  51               EmailAddress => 'public/read/write',
  52               PagerEmailAddress => 'read/write',
  53               FreeformContactInfo => 'read/write',
  54               Organization => 'public/read/write/admin',
  55               Disabled => 'public/read/write/admin', #To modify this attribute, we have helper
  56               #methods
  57               Privileged => 'read/write/admin', # 0=no 1=user 2=system
  58
  59               # }}}
  60
  61               # {{{ Names
  62
  63               RealName => 'public/read/write',
  64               NickName => 'public/read/write',
  65               # }}}
  66
  67               # {{{ Localization and Internationalization
  68               Lang => 'public/read/write',
  69               EmailEncoding => 'public/read/write',
  70               WebEncoding => 'public/read/write',
  71               # }}}
  72
  73               # {{{ External ContactInfo Linkage
  74               ExternalContactInfoId => 'public/read/write/admin',
  75               ContactInfoSystem => 'public/read/write/admin',
  76               # }}}
  77
  78               # {{{ User Authentication identifier
  79               ExternalAuthId => 'public/read/write/admin',
  80               #Authentication system used for user
  81               AuthSystem => 'public/read/write/admin',
  82               Gecos => 'public/read/write/admin', #Gecos is the name of the fields in a
  83               # unix passwd file. In this case, it refers to "Unix Username"
  84               # }}}
  85
  86               # {{{ Telephone numbers
  87               HomePhone =>  'read/write',
  88               WorkPhone => 'read/write',
  89               MobilePhone => 'read/write',
  90               PagerPhone => 'read/write',
  91
  92               # }}}
  93
  94               # {{{ Paper Address
  95               Address1 => 'read/write',
  96               Address2 => 'read/write',
  97               City => 'read/write',
  98               State => 'read/write',
  99               Zip => 'read/write',
 100               Country => 'read/write',
 101               # }}}
 102
 103               # {{{ Core DBIx::Record Attributes
 104               Creator => 'read/auto',
 105               Created => 'read/auto',
 106               LastUpdatedBy => 'read/auto',
 107               LastUpdated => 'read/auto'
 108
 109               # }}}
 110              );
 111   return($self->SUPER::_Accessible(@_, %Cols));
 112 }
 113
 114 # }}}
 115
 116 # {{{ sub Create
 117
 118 sub Create  {
 119     my $self = shift;
 120     my %args = (Privileged => 0,
 121                 @_ # get the real argumentlist
 122                );
 123
 124     #Check the ACL
 125     unless ($self->CurrentUserHasRight('AdminUsers')) {
 126         return (0, 'No permission to create users');
 127     }
 128
 129     if (! $args{'Password'})  {
 130         $args{'Password'} = '*NO-PASSWORD*';
 131     }
 132     elsif (length($args{'Password'}) < $RT::MinimumPasswordLength) {
 133         return(0,"Password too short");
 134     }
 135     else {
 136         my $salt = join '', ('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64];
 137         $args{'Password'} = crypt($args{'Password'}, $salt);
 138     }
 139
 140
 141     #TODO Specify some sensible defaults.
 142
 143     unless (defined ($args{'Name'})) {
 144         return(0, "Must specify 'Name' attribute");
 145     }
 146
 147
 148     #SANITY CHECK THE NAME AND ABORT IF IT'S TAKEN
 149     if ($RT::SystemUser) { #This only works if RT::SystemUser has been defined
 150                 my $TempUser = RT::User->new($RT::SystemUser);
 151                 $TempUser->Load($args{'Name'});
 152                 return (0, 'Name in use') if ($TempUser->Id);
 153
 154                 return(0, 'Email address in use')
 155                         unless ($self->ValidateEmailAddress($args{'EmailAddress'}));
 156     }
 157     else {
 158                 $RT::Logger->warning("$self couldn't check for pre-existing ".
 159                              " users on create. This will happen".
 160                              " on installation\n");
 161     }
 162
 163     my $id = $self->SUPER::Create(%args);
 164
 165     #If the create failed.
 166     unless ($id) {
 167                 return (0, 'Could not create user');
 168     }
 169
 170
 171     #TODO post 2.0
 172     #if ($args{'SendWelcomeMessage'}) {
 173     #   #TODO: Check if the email exists and looks valid
 174     #   #TODO: Send the user a "welcome message"
 175     #}
 176
 177     return ($id, 'User created');
 178 }
 179
 180 # }}}
 181
 182 # {{{ sub _BootstrapCreate
 183
 184 #create a user without validating _any_ data.
 185
 186 #To be used only on database init.
 187
 188 sub _BootstrapCreate {
 189     my $self = shift;
 190     my %args = (@_);
 191
 192     $args{'Password'} = "*NO-PASSWORD*";
 193     my $id = $self->SUPER::Create(%args);
 194
 195     #If the create failed.
 196     return (0, 'Could not create user')
 197       unless ($id);
 198
 199     return ($id, 'User created');
 200 }
 201
 202 # }}}
 203
 204 # {{{ sub Delete
 205
 206 sub Delete  {
 207     my $self = shift;
 208
 209     return(0, 'Deleting this object would violate referential integrity');
 210
 211 }
 212
 213 # }}}
 214
 215 # {{{ sub Load
 216
 217 =head2 Load
 218
 219 Load a user object from the database. Takes a single argument.
 220 If the argument is numerical, load by the column 'id'. Otherwise, load by
 221 the "Name" column which is the user's textual username.
 222
 223 =cut
 224
 225 sub Load  {
 226     my $self = shift;
 227     my $identifier = shift || return undef;
 228
 229     #if it's an int, load by id. otherwise, load by name.
 230     if ($identifier !~ /\D/) {
 231         $self->SUPER::LoadById($identifier);
 232     }
 233     else {
 234         $self->LoadByCol("Name",$identifier);
 235     }
 236 }
 237
 238 # }}}
 239
 240
 241 # {{{ sub LoadByEmail
 242
 243 =head2 LoadByEmail
 244
 245 Tries to load this user object from the database by the user's email address.
 246
 247
 248 =cut
 249
 250 sub LoadByEmail {
 251     my $self=shift;
 252     my $address = shift;
 253
 254     # Never load an empty address as an email address.
 255     unless ($address) {
 256         return(undef);
 257     }
 258
 259     $address = RT::CanonicalizeAddress($address);
 260     #$RT::Logger->debug("Trying to load an email address: $address\n");
 261     return $self->LoadByCol("EmailAddress", $address);
 262 }
 263 # }}}
 264
 265
 266 # {{{ sub ValidateEmailAddress
 267
 268 =head2 ValidateEmailAddress ADDRESS
 269
 270 Returns true if the email address entered is not in use by another user or is
 271 undef or ''. Returns false if it's in use.
 272
 273 =cut
 274
 275 sub ValidateEmailAddress {
 276         my $self = shift;
 277         my $Value = shift;
 278
 279         # if the email address is null, it's always valid
 280         return (1) if(!$Value || $Value eq "");
 281
 282         my $TempUser = RT::User->new($RT::SystemUser);
 283         $TempUser->LoadByEmail($Value);
 284
 285         if( $TempUser->id &&
 286            ($TempUser->id != $self->id)) { # if we found a user with that address
 287                                         # it's invalid to set this user's address to it
 288                 return(undef);
 289         }
 290         else { #it's a valid email address
 291                 return(1);
 292         }
 293 }
 294
 295 # }}}
 296
 297
 298
 299
 300 # {{{ sub SetRandomPassword
 301
 302 =head2 SetRandomPassword
 303
 304 Takes no arguments. Returns a status code and a new password or an error message.
 305 If the status is 1, the second value returned is the new password.
 306 If the status is anything else, the new value returned is the error code.
 307
 308 =cut
 309
 310 sub SetRandomPassword  {
 311     my $self = shift;
 312
 313
 314     unless ($self->CurrentUserCanModify('Password')) {
 315         return (0, "Permission Denied");
 316     }
 317
 318     my $pass = $self->GenerateRandomPassword(6,8);
 319
 320     # If we have "notify user on
 321
 322     my ($val, $msg) = $self->SetPassword($pass);
 323
 324     #If we got an error return the error.
 325     return (0, $msg) unless ($val);
 326
 327     #Otherwise, we changed the password, lets return it.
 328     return (1, $pass);
 329
 330 }
 331
 332 # }}}
 333
 334
 335 # {{{ sub ResetPassword
 336
 337 =head2 ResetPassword
 338
 339 Returns status, [ERROR or new password].  Resets this user\'s password to
 340 a randomly generated pronouncable password and emails them, using a
 341 global template called "RT_PasswordChange", which can be overridden
 342 with global templates "RT_PasswordChange_Privileged" or "RT_PasswordChange_NonPrivileged"
 343 for privileged and Non-privileged users respectively.
 344
 345 =cut
 346
 347 sub ResetPassword {
 348     my $self = shift;
 349
 350     unless ($self->CurrentUserCanModify('Password')) {
 351         return (0, "Permission Denied");
 352     }
 353     my ($status, $pass) = $self->SetRandomPassword();
 354
 355     unless ($status) {
 356         return (0, "$pass");
 357     }
 358
 359     my $template = RT::Template->new($self->CurrentUser);
 360
 361
 362     if ($self->IsPrivileged) {
 363         $template->LoadGlobalTemplate('RT_PasswordChange_Privileged');
 364     }
 365     else {
 366         $template->LoadGlobalTemplate('RT_PasswordChange_Privileged');
 367     }
 368
 369     unless ($template->Id) {
 370         $template->LoadGlobalTemplate('RT_PasswordChange');
 371     }
 372
 373     unless ($template->Id) {
 374         $RT::Logger->crit("$self tried to send ".$self->Name." a password reminder ".
 375                           "but couldn't find a password change template");
 376     }
 377
 378     my $notification =  RT::Action::SendPasswordEmail->new(TemplateObj => $template,
 379                                                            Argument => $pass);
 380
 381     $notification->SetTo($self->EmailAddress);
 382
 383     my ($ret);
 384     $ret = $notification->Prepare();
 385     if ($ret) {
 386         $ret = $notification->Commit();
 387     }
 388
 389     if ($ret) {
 390         return(1, 'New password notification sent');
 391     }   else {
 392         return (0, 'Notification could not be sent');
 393     }
 394
 395 }
 396
 397
 398 # }}}
 399
 400 # {{{ sub GenerateRandomPassword
 401
 402 =head2 GenerateRandomPassword MIN_LEN and MAX_LEN
 403
 404 Returns a random password between MIN_LEN and MAX_LEN characters long.
 405
 406 =cut
 407
 408 sub GenerateRandomPassword {
 409     my $self = shift;
 410     my $min_length = shift;
 411     my $max_length = shift;
 412
 413     #This code derived from mpw.pl, a bit of code with a sordid history
 414     # Its notes:
 415
 416     # Perl cleaned up a bit by Jesse Vincent 1/14/2001.
 417     # Converted to perl from C by Marc Horowitz, 1/20/2000.
 418     # Converted to C from Multics PL/I by Bill Sommerfeld, 4/21/86.
 419     # Original PL/I version provided by Jerry Saltzer.
 420
 421
 422     my ($frequency, $start_freq, $total_sum, $row_sums);
 423
 424     #When munging characters, we need to know where to start counting letters from
 425     my $a = ord('a');
 426
 427     # frequency of English digraphs (from D Edwards 1/27/66)
 428     $frequency =
 429       [ [ 4, 20, 28, 52, 2, 11, 28, 4, 32, 4, 6, 62, 23,
 430           167, 2, 14, 0, 83, 76, 127, 7, 25, 8, 1, 9, 1 ], # aa - az
 431         [ 13, 0, 0, 0, 55, 0, 0, 0, 8, 2, 0, 22, 0,
 432           0, 11, 0, 0, 15, 4, 2, 13, 0, 0, 0, 15, 0 ], # ba - bz
 433         [ 32, 0, 7, 1, 69, 0, 0, 33, 17, 0, 10, 9, 1,
 434           0, 50, 3, 0, 10, 0, 28, 11, 0, 0, 0, 3, 0 ], # ca - cz
 435         [ 40, 16, 9, 5, 65, 18, 3, 9, 56, 0, 1, 4, 15,
 436           6, 16, 4, 0, 21, 18, 53, 19, 5, 15, 0, 3, 0 ], # da - dz
 437         [ 84, 20, 55, 125, 51, 40, 19, 16, 50, 1, 4, 55, 54,
 438           146, 35, 37, 6, 191, 149, 65, 9, 26, 21, 12, 5, 0 ], # ea - ez
 439         [ 19, 3, 5, 1, 19, 21, 1, 3, 30, 2, 0, 11, 1,
 440           0, 51, 0, 0, 26, 8, 47, 6, 3, 3, 0, 2, 0 ], # fa - fz
 441         [ 20, 4, 3, 2, 35, 1, 3, 15, 18, 0, 0, 5, 1,
 442           4, 21, 1, 1, 20, 9, 21, 9, 0, 5, 0, 1, 0 ], # ga - gz
 443         [ 101, 1, 3, 0, 270, 5, 1, 6, 57, 0, 0, 0, 3,
 444           2, 44, 1, 0, 3, 10, 18, 6, 0, 5, 0, 3, 0 ], # ha - hz
 445         [ 40, 7, 51, 23, 25, 9, 11, 3, 0, 0, 2, 38, 25,
 446           202, 56, 12, 1, 46, 79, 117, 1, 22, 0, 4, 0, 3 ], # ia - iz
 447         [ 3, 0, 0, 0, 5, 0, 0, 0, 1, 0, 0, 0, 0,
 448           0, 4, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0 ], # ja - jz
 449         [ 1, 0, 0, 0, 11, 0, 0, 0, 13, 0, 0, 0, 0,
 450           2, 0, 0, 0, 0, 6, 2, 1, 0, 2, 0, 1, 0 ], # ka - kz
 451         [ 44, 2, 5, 12, 62, 7, 5, 2, 42, 1, 1, 53, 2,
 452           2, 25, 1, 1, 2, 16, 23, 9, 0, 1, 0, 33, 0 ], # la - lz
 453         [ 52, 14, 1, 0, 64, 0, 0, 3, 37, 0, 0, 0, 7,
 454           1, 17, 18, 1, 2, 12, 3, 8, 0, 1, 0, 2, 0 ], # ma - mz
 455         [ 42, 10, 47, 122, 63, 19, 106, 12, 30, 1, 6, 6, 9,
 456           7, 54, 7, 1, 7, 44, 124, 6, 1, 15, 0, 12, 0 ], # na - nz
 457         [ 7, 12, 14, 17, 5, 95, 3, 5, 14, 0, 0, 19, 41,
 458           134, 13, 23, 0, 91, 23, 42, 55, 16, 28, 0, 4, 1 ], # oa - oz
 459         [ 19, 1, 0, 0, 37, 0, 0, 4, 8, 0, 0, 15, 1,
 460           0, 27, 9, 0, 33, 14, 7, 6, 0, 0, 0, 0, 0 ], # pa - pz
 461         [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
 462           0, 0, 0, 0, 0, 0, 0, 17, 0, 0, 0, 0, 0 ], # qa - qz
 463         [ 83, 8, 16, 23, 169, 4, 8, 8, 77, 1, 10, 5, 26,
 464           16, 60, 4, 0, 24, 37, 55, 6, 11, 4, 0, 28, 0 ], # ra - rz
 465         [ 65, 9, 17, 9, 73, 13, 1, 47, 75, 3, 0, 7, 11,
 466           12, 56, 17, 6, 9, 48, 116, 35, 1, 28, 0, 4, 0 ], # sa - sz
 467         [ 57, 22, 3, 1, 76, 5, 2, 330, 126, 1, 0, 14, 10,
 468           6, 79, 7, 0, 49, 50, 56, 21, 2, 27, 0, 24, 0 ], # ta - tz
 469         [ 11, 5, 9, 6, 9, 1, 6, 0, 9, 0, 1, 19, 5,
 470           31, 1, 15, 0, 47, 39, 31, 0, 3, 0, 0, 0, 0 ], # ua - uz
 471         [ 7, 0, 0, 0, 72, 0, 0, 0, 28, 0, 0, 0, 0,
 472           0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0 ], # va - vz
 473         [ 36, 1, 1, 0, 38, 0, 0, 33, 36, 0, 0, 4, 1,
 474           8, 15, 0, 0, 0, 4, 2, 0, 0, 1, 0, 0, 0 ], # wa - wz
 475         [ 1, 0, 2, 0, 0, 1, 0, 0, 3, 0, 0, 0, 0,
 476           0, 1, 5, 0, 0, 0, 3, 0, 0, 1, 0, 0, 0 ], # xa - xz
 477         [ 14, 5, 4, 2, 7, 12, 12, 6, 10, 0, 0, 3, 7,
 478           5, 17, 3, 0, 4, 16, 30, 0, 0, 5, 0, 0, 0 ], # ya - yz
 479         [ 1, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0,
 480           0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ] ]; # za - zz
 481
 482     #We need to know the totals for each row
 483     $row_sums =
 484       [ map { my $sum = 0; map { $sum += $_ } @$_; $sum } @$frequency ];
 485
 486
 487     #Frequency with which a given letter starts a word.
 488     $start_freq =
 489       [ 1299, 425, 725, 271, 375, 470, 93, 223, 1009, 24, 20, 355, 379,
 490         319, 823, 618, 21, 317, 962, 1991, 271, 104, 516, 6, 16, 14 ];
 491
 492     $total_sum = 0; map { $total_sum += $_ } @$start_freq;
 493
 494
 495     my $length = $min_length + int(rand($max_length-$min_length));
 496
 497     my $char = $self->GenerateRandomNextChar($total_sum, $start_freq);
 498     my @word = ($char+$a);
 499     for (2..$length) {
 500         $char = $self->_GenerateRandomNextChar($row_sums->[$char], $frequency->[$char]);
 501         push(@word, $char+$a);
 502     }
 503
 504     #Return the password
 505     return pack("C*",@word);
 506
 507 }
 508
 509
 510 #A private helper function for RandomPassword
 511 # Takes a row summary and a frequency chart for the next character to be searched
 512 sub _GenerateRandomNextChar {
 513     my $self = shift;
 514     my($all, $freq) = @_;
 515     my($pos, $i);
 516
 517     for ($pos = int(rand($all)), $i=0;
 518          $pos >= $freq->[$i];
 519          $pos -= $freq->[$i], $i++) {};
 520
 521     return($i);
 522 }
 523
 524 # }}}
 525
 526 # {{{ sub SetPassword
 527
 528 =head2 SetPassword
 529
 530 Takes a string. Checks the string's length and sets this user's password
 531 to that string.
 532
 533 =cut
 534
 535 sub SetPassword {
 536     my $self = shift;
 537     my $password = shift;
 538
 539     unless ($self->CurrentUserCanModify('Password')) {
 540         return(0, 'Permission Denied');
 541     }
 542
 543     if (! $password)  {
 544         return(0, "No password set");
 545     }
 546     elsif (length($password) < $RT::MinimumPasswordLength) {
 547         return(0,"Password too short");
 548     }
 549     else {
 550         my $salt = join '', ('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64];
 551         return ( $self->SUPER::SetPassword(crypt($password, $salt)) );
 552     }
 553
 554 }
 555
 556 # }}}
 557
 558 # {{{ sub IsPassword
 559
 560 =head2 IsPassword
 561
 562 Returns true if the passed in value is this user's password.
 563 Returns undef otherwise.
 564
 565 =cut
 566
 567 sub IsPassword {
 568     my $self = shift;
 569     my $value = shift;
 570
 571     #TODO there isn't any apparent way to legitimately ACL this
 572
 573     # RT does not allow null passwords
 574     if ((!defined ($value)) or ($value eq '')) {
 575         return(undef);
 576     }
 577     if ($self->Disabled) {
 578         $RT::Logger->info("Disabled user ".$self->Name." tried to log in");
 579         return(undef);
 580     }
 581
 582     if ( ($self->__Value('Password') eq '') ||
 583          ($self->__Value('Password') eq undef) )  {
 584         return(undef);
 585      }
 586     if ($self->__Value('Password') eq crypt($value, $self->__Value('Password'))) {
 587         return (1);
 588     }
 589     else {
 590         return (undef);
 591     }
 592 }
 593
 594 # }}}
 595
 596 # {{{ sub SetDisabled
 597
 598 =head2 Sub SetDisabled
 599
 600 Toggles the user's disabled flag.
 601 If this flag is
 602 set, all password checks for this user will fail. All ACL checks for this
 603 user will fail. The user will appear in no user listings.
 604
 605 =cut
 606
 607 # }}}
 608
 609 # {{{ ACL Related routines
 610
 611 # {{{ GrantQueueRight
 612
 613 =head2 GrantQueueRight
 614
 615 Grant a queue right to this user.  Takes a paramhash of which the elements
 616 RightAppliesTo and RightName are important.
 617
 618 =cut
 619
 620 sub GrantQueueRight {
 621
 622     my $self = shift;
 623     my %args = ( RightScope => 'Queue',
 624                  RightName => undef,
 625                  RightAppliesTo => undef,
 626                  PrincipalType => 'User',
 627                  PrincipalId => $self->Id,
 628                  @_);
 629
 630     #ACL check handled in ACE.pm
 631
 632     require RT::ACE;
 633
 634 #    $RT::Logger->debug("$self ->GrantQueueRight right:". $args{'RightName'} .
 635 #                      " applies to queue ".$args{'RightAppliesTo'}."\n");
 636
 637     my $ace = new RT::ACE($self->CurrentUser);
 638
 639     return ($ace->Create(%args));
 640 }
 641
 642 # }}}
 643
 644 # {{{ GrantSystemRight
 645
 646 =head2 GrantSystemRight
 647
 648 Grant a system right to this user.
 649 The only element that's important to set is RightName.
 650
 651 =cut
 652 sub GrantSystemRight {
 653
 654     my $self = shift;
 655     my %args = ( RightScope => 'System',
 656                  RightName => undef,
 657                  RightAppliesTo => 0,
 658                  PrincipalType => 'User',
 659                  PrincipalId => $self->Id,
 660                  @_);
 661
 662
 663     #ACL check handled in ACE.pm
 664
 665     require RT::ACE;
 666     my $ace = new RT::ACE($self->CurrentUser);
 667
 668     return ($ace->Create(%args));
 669 }
 670
 671
 672 # }}}
 673
 674 # {{{ sub HasQueueRight
 675
 676 =head2 HasQueueRight
 677
 678 Takes a paramhash which can contain
 679 these items:
 680     TicketObj => RT::Ticket or QueueObj => RT::Queue or Queue => integer
 681     IsRequestor => undef, (for bootstrapping create)
 682     Right => 'Right'
 683
 684
 685 Returns 1 if this user has the right specified in the paramhash. for the queue
 686 passed in.
 687
 688 Returns undef if they don't
 689
 690 =cut
 691
 692 sub HasQueueRight {
 693     my $self = shift;
 694     my %args = ( TicketObj => undef,
 695                  QueueObj => undef,
 696                  Queue => undef,
 697                  IsRequestor => undef,
 698                  Right => undef,
 699                  @_);
 700
 701     my ($IsRequestor, $IsCc, $IsAdminCc, $IsOwner);
 702
 703     if (defined $args{'Queue'}) {
 704         $args{'QueueObj'} = new RT::Queue($self->CurrentUser);
 705         $args{'QueueObj'}->Load($args{'Queue'});
 706     }
 707
 708     if (defined $args{'TicketObj'}) {
 709         $args{'QueueObj'} = $args{'TicketObj'}->QueueObj();
 710     }
 711
 712     # {{{ Validate and load up the QueueId
 713     unless ((defined $args{'QueueObj'}) and ($args{'QueueObj'}->Id)) {
 714         require Carp;
 715         $RT::Logger->debug(Carp::cluck ("$self->HasQueueRight Couldn't find a queue id"));
 716         return undef;
 717     }
 718
 719     # }}}
 720
 721
 722     # Figure out whether a user has the right we're asking about.
 723     # first see if they have the right personally for the queue in question.
 724     my $retval = $self->_HasRight(Scope => 'Queue',
 725                                   AppliesTo => $args{'QueueObj'}->Id,
 726                                   Right => $args{'Right'},
 727                                   IsOwner => $IsOwner);
 728
 729     return ($retval) if (defined $retval);
 730
 731     # then we see whether they have the right personally globally.
 732     $retval = $self->HasSystemRight( $args{'Right'});
 733
 734     return ($retval) if (defined $retval);
 735
 736     # now that we know they don't have the right personally,
 737
 738     # {{{ Find out about whether the current user is a Requestor, Cc, AdminCc or Owner
 739
 740     if (defined $args{'TicketObj'}) {
 741         if ($args{'TicketObj'}->IsRequestor($self)) {#user is requestor
 742             $IsRequestor = 1;
 743         }
 744
 745         if ($args{'TicketObj'}->IsCc($self)) { #If user is a cc
 746             $IsCc = 1;
 747         }
 748
 749         if ($args{'TicketObj'}->IsAdminCc($self)) { #If user is an admin cc
 750             $IsAdminCc = 1;
 751         }
 752
 753         if ($args{'TicketObj'}->IsOwner($self)) { #If user is an owner
 754             $IsOwner = 1;
 755         }
 756     }
 757
 758     if (defined $args{'QueueObj'}) {
 759         if ($args{'QueueObj'}->IsCc($self)) { #If user is a cc
 760             $IsCc = 1;
 761         }
 762         if ($args{'QueueObj'}->IsAdminCc($self)) { #If user is an admin cc
 763             $IsAdminCc = 1;
 764         }
 765
 766     }
 767     # }}}
 768
 769     # then see whether they have the right for the queue as a member of a metagroup
 770
 771     $retval = $self->_HasRight(Scope => 'Queue',
 772                                   AppliesTo => $args{'QueueObj'}->Id,
 773                                   Right => $args{'Right'},
 774                                   IsOwner => $IsOwner,
 775                                   IsCc => $IsCc,
 776                                   IsAdminCc => $IsAdminCc,
 777                                   IsRequestor => $IsRequestor
 778                                  );
 779
 780     return ($retval) if (defined $retval);
 781
 782     #   then we see whether they have the right globally as a member of a metagroup
 783     $retval = $self->HasSystemRight( $args{'Right'},
 784                                      (IsOwner => $IsOwner,
 785                                       IsCc => $IsCc,
 786                                       IsAdminCc => $IsAdminCc,
 787                                       IsRequestor => $IsRequestor
 788                                      ) );
 789
 790     #If they haven't gotten it by now, they just lose.
 791     return ($retval);
 792
 793 }
 794
 795 # }}}
 796
 797 # {{{ sub HasSystemRight
 798
 799 =head2 HasSystemRight
 800
 801 takes an array of a single value and a paramhash.
 802 The single argument is the right being passed in.
 803 the param hash is some additional data. (IsCc, IsOwner, IsAdminCc and IsRequestor)
 804
 805 Returns 1 if this user has the listed 'right'. Returns undef if this user doesn't.
 806
 807 =cut
 808
 809 sub HasSystemRight {
 810     my $self = shift;
 811     my $right = shift;
 812
 813     my %args = ( IsOwner => undef,
 814                  IsCc => undef,
 815                  IsAdminCc => undef,
 816                  IsRequestor => undef,
 817                  @_);
 818
 819     unless (defined $right) {
 820
 821         $RT::Logger->debug("$self RT::User::HasSystemRight was passed in no right.");
 822         return(undef);
 823     }
 824     return ( $self->_HasRight ( Scope => 'System',
 825                                 AppliesTo => '0',
 826                                 Right => $right,
 827                                 IsOwner => $args{'IsOwner'},
 828                                 IsCc => $args{'IsCc'},
 829                                 IsAdminCc => $args{'IsAdminCc'},
 830                                 IsRequestor => $args{'IsRequestor'},
 831
 832                               )
 833            );
 834
 835 }
 836
 837 # }}}
 838
 839 # {{{ sub _HasRight
 840
 841 =head2 sub _HasRight (Right => 'right', Scope => 'scope',  AppliesTo => int, ExtendedPrincipals => SQL)
 842
 843 _HasRight is a private helper method for checking a user's rights. It takes
 844 several options:
 845
 846 =item Right is a textual right name
 847
 848 =item Scope is a textual scope name. (As of July these were Queue, Ticket and System
 849
 850 =item AppliesTo is the numerical Id of the object identified in the scope. For tickets, this is the queue #. for queues, this is the queue #
 851
 852 =item ExtendedPrincipals is an  SQL select clause which assumes that the only
 853 table in play is ACL.  It's used by HasQueueRight to pass in which
 854 metaprincipals apply. Actually, it's probably obsolete. TODO: remove it.
 855
 856 Returns 1 if a matching ACE was found.
 857
 858 Returns undef if no ACE was found.
 859
 860 =cut
 861
 862
 863 sub _HasRight {
 864
 865     my $self = shift;
 866     my %args = ( Right => undef,
 867                  Scope => undef,
 868                  AppliesTo => undef,
 869                  IsRequestor => undef,
 870                  IsCc => undef,
 871                  IsAdminCc => undef,
 872                  IsOwner => undef,
 873                  ExtendedPrincipals => undef,
 874                  @_);
 875
 876     if ($self->Disabled) {
 877         $RT::Logger->debug ("Disabled User:  ".$self->Name.
 878                             " failed access check for ".$args{'Right'}.
 879                             " to object ".$args{'Scope'}."/".
 880                             $args{'AppliesTo'}."\n");
 881         return (undef);
 882     }
 883
 884     if (!defined $args{'Right'}) {
 885         $RT::Logger->debug("_HasRight called without a right\n");
 886         return(undef);
 887     }
 888     elsif (!defined $args{'Scope'}) {
 889         $RT::Logger->debug("_HasRight called without a scope\n");
 890         return(undef);
 891     }
 892     elsif (!defined $args{'AppliesTo'}) {
 893         $RT::Logger->debug("_HasRight called without an AppliesTo object\n");
 894         return(undef);
 895     }
 896
 897     #If we've cached a win or loss for this lookup say so
 898
 899     #TODO Security +++ check to make sure this is complete and right
 900
 901     #Construct a hashkey to cache decisions in
 902     my ($hashkey);
 903     { #it's ugly, but we need to turn off warning, cuz we're joining nulls.
 904         local $^W=0;
 905         $hashkey =$self->Id .":". join(':',%args);
 906     }
 907
 908   # $RT::Logger->debug($hashkey."\n");
 909
 910     #Anything older than 10 seconds needs to be rechecked
 911     my $cache_timeout = (time - 10);
 912
 913
 914     if ((defined $self->{'rights'}{"$hashkey"}) &&
 915             ($self->{'rights'}{"$hashkey"} == 1 ) &&
 916         (defined $self->{'rights'}{"$hashkey"}{'set'} ) &&
 917             ($self->{'rights'}{"$hashkey"}{'set'} > $cache_timeout)) {
 918 #         $RT::Logger->debug("Cached ACL win for ".
 919 #                            $args{'Right'}.$args{'Scope'}.
 920 #                            $args{'AppliesTo'}."\n");
 921         return ($self->{'rights'}{"$hashkey"});
 922     }
 923     elsif ((defined $self->{'rights'}{"$hashkey"}) &&
 924                ($self->{'rights'}{"$hashkey"} == -1)  &&
 925            (defined $self->{'rights'}{"$hashkey"}{'set'}) &&
 926                ($self->{'rights'}{"$hashkey"}{'set'} > $cache_timeout)) {
 927
 928 #       $RT::Logger->debug("Cached ACL loss decision for ".
 929 #                          $args{'Right'}.$args{'Scope'}.
 930 #                          $args{'AppliesTo'}."\n");
 931
 932         return(undef);
 933     }
 934
 935
 936     my $RightClause = "(RightName = '$args{'Right'}')";
 937     my $ScopeClause = "(RightScope = '$args{'Scope'}')";
 938
 939     #If an AppliesTo was passed in, we should pay attention to it.
 940     #otherwise, none is needed
 941
 942     $ScopeClause = "($ScopeClause AND (RightAppliesTo = $args{'AppliesTo'}))"
 943       if ($args{'AppliesTo'});
 944
 945
 946     # The generic principals clause looks for users with my id
 947     # and Rights that apply to _everyone_
 948     my $PrincipalsClause = "((PrincipalType = 'User') AND (PrincipalId = ".$self->Id."))";
 949
 950
 951     # If the user is the superuser, grant them the damn right ;)
 952     my $SuperUserClause =
 953       "(RightName = 'SuperUser') AND (RightScope = 'System') AND (RightAppliesTo = 0)";
 954
 955     # If we've been passed in an extended principals clause, we should lump it
 956     # on to the existing principals clause. it'll make life easier
 957     if ($args{'ExtendedPrincipals'}) {
 958         $PrincipalsClause = "(($PrincipalsClause) OR ".
 959           "($args{'ExtendedPrincipalsClause'}))";
 960     }
 961
 962     my $GroupPrincipalsClause = "((ACL.PrincipalType = 'Group') ".
 963       "AND (ACL.PrincipalId = Groups.Id) AND (GroupMembers.GroupId = Groups.Id) ".
 964      " AND (GroupMembers.UserId = ".$self->Id."))";
 965
 966
 967
 968
 969     # {{{ A bunch of magic statements that make the metagroups listed
 970     # work. basically, we if the user falls into the right group,
 971     # we add the type of ACL check needed
 972     my (@MetaPrincipalsSubClauses, $MetaPrincipalsClause);
 973
 974     #The user is always part of the 'Everyone' Group
 975     push (@MetaPrincipalsSubClauses,  "((Groups.Name = 'Everyone') AND
 976                                        (PrincipalType = 'Group') AND
 977                                        (Groups.Id = PrincipalId))");
 978
 979     if ($args{'IsAdminCc'}) {
 980         push (@MetaPrincipalsSubClauses,  "((Groups.Name = 'AdminCc') AND
 981                                        (PrincipalType = 'Group') AND
 982                                        (Groups.Id = PrincipalId))");
 983     }
 984     if ($args{'IsCc'}) {
 985         push (@MetaPrincipalsSubClauses, " ((Groups.Name = 'Cc') AND
 986                                        (PrincipalType = 'Group') AND
 987                                        (Groups.Id = PrincipalId))");
 988     }
 989     if ($args{'IsRequestor'}) {
 990         push (@MetaPrincipalsSubClauses,  " ((Groups.Name = 'Requestor') AND
 991                                        (PrincipalType = 'Group') AND
 992                                        (Groups.Id = PrincipalId))");
 993     }
 994     if ($args{'IsOwner'}) {
 995
 996         push (@MetaPrincipalsSubClauses, " ((Groups.Name = 'Owner') AND
 997                                        (PrincipalType = 'Group') AND
 998                                        (Groups.Id = PrincipalId))");
 999     }
1000
1001     # }}}
1002
1003     my ($GroupRightsQuery, $MetaGroupRightsQuery, $IndividualRightsQuery, $hitcount);
1004
1005     # {{{ If there are any metaprincipals to be checked
1006     if (@MetaPrincipalsSubClauses) {
1007         #chop off the leading or
1008         #TODO redo this with an array and a join
1009         $MetaPrincipalsClause = join (" OR ", @MetaPrincipalsSubClauses);
1010
1011         $MetaGroupRightsQuery =  "SELECT COUNT(ACL.id) FROM ACL, Groups".
1012           " WHERE " .
1013             " ($ScopeClause) AND ($RightClause) AND ($MetaPrincipalsClause)";
1014
1015         # {{{ deal with checking if the user has a right as a member of a metagroup
1016
1017 #       $RT::Logger->debug("Now Trying $MetaGroupRightsQuery\n");
1018         $hitcount = $self->_Handle->FetchResult($MetaGroupRightsQuery);
1019
1020         #if there's a match, the right is granted
1021         if ($hitcount) {
1022             $self->{'rights'}{"$hashkey"}{'set'} = time;
1023             $self->{'rights'}{"$hashkey"} = 1;
1024             return (1);
1025         }
1026
1027 #       $RT::Logger->debug("No ACL matched MetaGroups query: $MetaGroupRightsQuery\n");
1028
1029         # }}}
1030
1031     }
1032     # }}}
1033
1034     # {{{ deal with checking if the user has a right as a member of a group
1035     # This query checks to se whether the user has the right as a member of a
1036     # group
1037     $GroupRightsQuery = "SELECT COUNT(ACL.id) FROM ACL, GroupMembers, Groups".
1038       " WHERE " .
1039         " (((($ScopeClause) AND ($RightClause)) OR ($SuperUserClause)) ".
1040           " AND ($GroupPrincipalsClause))";
1041
1042     #  $RT::Logger->debug("Now Trying $GroupRightsQuery\n");
1043     $hitcount = $self->_Handle->FetchResult($GroupRightsQuery);
1044
1045     #if there's a match, the right is granted
1046     if ($hitcount) {
1047         $self->{'rights'}{"$hashkey"}{'set'} = time;
1048         $self->{'rights'}{"$hashkey"} = 1;
1049         return (1);
1050     }
1051
1052 #    $RT::Logger->debug("No ACL matched $GroupRightsQuery\n");
1053
1054     # }}}
1055
1056     # {{{ Check to see whether the user has a right as an individual
1057
1058     # This query checks to see whether the current user has the right directly
1059     $IndividualRightsQuery = "SELECT COUNT(ACL.id) FROM ACL WHERE ".
1060       " ((($ScopeClause) AND ($RightClause)) OR ($SuperUserClause)) " .
1061         " AND ($PrincipalsClause)";
1062
1063
1064     $hitcount = $self->_Handle->FetchResult($IndividualRightsQuery);
1065
1066     if ($hitcount) {
1067         $self->{'rights'}{"$hashkey"}{'set'} = time;
1068         $self->{'rights'}{"$hashkey"} = 1;
1069         return (1);
1070     }
1071     # }}}
1072
1073     else { #If the user just doesn't have the right
1074
1075 #       $RT::Logger->debug("No ACL matched $IndividualRightsQuery\n");
1076
1077         #If nothing matched, return 0.
1078         $self->{'rights'}{"$hashkey"}{'set'} = time;
1079         $self->{'rights'}{"$hashkey"} = -1;
1080
1081
1082         return (undef);
1083     }
1084 }
1085
1086 # }}}
1087
1088 # {{{ sub CurrentUserCanModify
1089
1090 =head2 CurrentUserCanModify RIGHT
1091
1092 If the user has rights for this object, either because
1093 he has 'AdminUsers' or (if he\'s trying to edit himself and the right isn\'t an
1094 admin right) 'ModifySelf', return 1. otherwise, return undef.
1095
1096 =cut
1097
1098 sub CurrentUserCanModify {
1099     my $self = shift;
1100     my $right = shift;
1101
1102     if ($self->CurrentUserHasRight('AdminUsers')) {
1103         return (1);
1104     }
1105     #If the field is marked as an "administrators only" field,
1106     # don\'t let the user touch it.
1107     elsif ($self->_Accessible($right, 'admin')) {
1108         return(undef);
1109     }
1110
1111     #If the current user is trying to modify themselves
1112     elsif ( ($self->id == $self->CurrentUser->id)  and
1113             ($self->CurrentUserHasRight('ModifySelf'))) {
1114         return(1);
1115     }
1116
1117     #If we don\'t have a good reason to grant them rights to modify
1118     # by now, they lose
1119     else {
1120         return(undef);
1121     }
1122
1123 }
1124
1125 # }}}
1126
1127 # {{{ sub CurrentUserHasRight
1128
1129 =head2 CurrentUserHasRight
1130
1131   Takes a single argument. returns 1 if $Self->CurrentUser
1132   has the requested right. returns undef otherwise
1133
1134 =cut
1135
1136 sub CurrentUserHasRight {
1137     my $self = shift;
1138     my $right = shift;
1139
1140     return ($self->CurrentUser->HasSystemRight($right));
1141 }
1142
1143 # }}}
1144
1145
1146 # {{{ sub _Set
1147
1148 sub _Set {
1149   my $self = shift;
1150
1151   my %args = (Field => undef,
1152               Value => undef,
1153               @_
1154              );
1155
1156   # Nobody is allowed to futz with RT_System or Nobody unless they
1157   # want to change an email address. For 2.2, neither should have an email address
1158
1159   if ($self->Privileged == 2) {
1160     return (0, "Can not modify system users");
1161   }
1162   unless ($self->CurrentUserCanModify($args{'Field'})) {
1163       return (0, "Permission Denied");
1164   }
1165
1166
1167
1168   #Set the new value
1169   my ($ret, $msg)=$self->SUPER::_Set(Field => $args{'Field'},
1170                                      Value=> $args{'Value'});
1171
1172     return ($ret, $msg);
1173 }
1174
1175 # }}}
1176
1177 # {{{ sub _Value
1178
1179 =head2 _Value
1180
1181 Takes the name of a table column.
1182 Returns its value as a string, if the user passes an ACL check
1183
1184 =cut
1185
1186 sub _Value  {
1187
1188   my $self = shift;
1189   my $field = shift;
1190
1191   #If the current user doesn't have ACLs, don't let em at it.
1192
1193   my @PublicFields = qw( Name EmailAddress Organization Disabled
1194                          RealName NickName Gecos ExternalAuthId
1195                          AuthSystem ExternalContactInfoId
1196                          ContactInfoSystem );
1197
1198   #if the field is public, return it.
1199   if ($self->_Accessible($field, 'public')) {
1200       return($self->SUPER::_Value($field));
1201
1202   }
1203   #If the user wants to see their own values, let them
1204   elsif ($self->CurrentUser->Id == $self->Id) {
1205       return($self->SUPER::_Value($field));
1206   }
1207   #If the user has the admin users right, return the field
1208   elsif ($self->CurrentUserHasRight('AdminUsers')) {
1209       return($self->SUPER::_Value($field));
1210   }
1211   else {
1212       return(undef);
1213   }
1214
1215
1216 }
1217
1218 # }}}
1219
1220 # }}}
1221 1;
1222