rt/lib/RT/CurrentUser.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
   6 #                                          <jesse@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26 #
  27 #
  28 # CONTRIBUTION SUBMISSION POLICY:
  29 #
  30 # (The following paragraph is not intended to limit the rights granted
  31 # to you to modify and distribute this software under the terms of
  32 # the GNU General Public License and is only of importance to you if
  33 # you choose to contribute your changes and enhancements to the
  34 # community by submitting them to Best Practical Solutions, LLC.)
  35 #
  36 # By intentionally submitting any modifications, corrections or
  37 # derivatives to this work, or any other work intended for use with
  38 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  39 # you are the copyright holder for those contributions and you grant
  40 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  41 # royalty-free, perpetual, license to use, copy, create derivative
  42 # works based on those contributions, and sublicense and distribute
  43 # those contributions and any derivatives thereof.
  44 #
  45 # END BPS TAGGED BLOCK }}}
  46
  47 =head1 NAME
  48
  49   RT::CurrentUser - an RT object representing the current user
  50
  51 =head1 SYNOPSIS
  52
  53   use RT::CurrentUser
  54
  55
  56 =head1 DESCRIPTION
  57
  58
  59 =head1 METHODS
  60
  61
  62 =begin testing
  63
  64 ok (require RT::CurrentUser);
  65
  66 =end testing
  67
  68 =cut
  69
  70
  71 package RT::CurrentUser;
  72
  73 use RT::Record;
  74 use RT::I18N;
  75
  76 use strict;
  77 use base qw/RT::Record/;
  78
  79 # {{{ sub _Init
  80
  81 #The basic idea here is that $self->CurrentUser is always supposed
  82 # to be a CurrentUser object. but that's hard to do when we're trying to load
  83 # the CurrentUser object
  84
  85 sub _Init {
  86     my $self = shift;
  87     my $User = shift;
  88
  89     $self->{'table'} = "Users";
  90
  91     if ( defined($User) ) {
  92
  93         if (   UNIVERSAL::isa( $User, 'RT::User' )
  94             || UNIVERSAL::isa( $User, 'RT::CurrentUser' ) )
  95         {
  96             $self->Load( $User->id );
  97
  98         }
  99         elsif ( ref($User) ) {
 100             $RT::Logger->crit(
 101                 "RT::CurrentUser->new() called with a bogus argument: $User");
 102         }
 103         else {
 104             $self->Load($User);
 105         }
 106     }
 107
 108     $self->_BuildTableAttributes();
 109
 110 }
 111 # }}}
 112
 113 # {{{ sub Create
 114
 115 sub Create {
 116     my $self = shift;
 117     return (0, $self->loc('Permission Denied'));
 118 }
 119
 120 # }}}
 121
 122 # {{{ sub Delete
 123
 124 sub Delete {
 125     my $self = shift;
 126     return (0, $self->loc('Permission Denied'));
 127 }
 128
 129 # }}}
 130
 131 # {{{ sub UserObj
 132
 133 =head2 UserObj
 134
 135   Returns the RT::User object associated with this CurrentUser object.
 136
 137 =cut
 138
 139 sub UserObj {
 140     my $self = shift;
 141
 142         use RT::User;
 143         my $user = RT::User->new($self);
 144
 145         unless ($user->Load($self->Id)) {
 146             $RT::Logger->err($self->loc("Couldn't load [_1] from the users database.\n", $self->Id));
 147         }
 148     return ($user);
 149 }
 150 # }}}
 151
 152 # {{{ sub PrincipalObj
 153
 154 =head2 PrincipalObj
 155
 156     Returns this user's principal object.  this is just a helper routine for
 157     $self->UserObj->PrincipalObj
 158
 159 =cut
 160
 161 sub PrincipalObj {
 162     my $self = shift;
 163     return($self->UserObj->PrincipalObj);
 164 }
 165
 166
 167 # }}}
 168
 169
 170 # {{{ sub PrincipalId
 171
 172 =head2 PrincipalId
 173
 174     Returns this user's principal Id.  this is just a helper routine for
 175     $self->UserObj->PrincipalId
 176
 177 =cut
 178
 179 sub PrincipalId {
 180     my $self = shift;
 181     return($self->UserObj->PrincipalId);
 182 }
 183
 184
 185 # }}}
 186
 187
 188 # {{{ sub _Accessible
 189
 190
 191  sub _CoreAccessible  {
 192      {
 193          Name           => { 'read' => 1 },
 194            Gecos        => { 'read' => 1 },
 195            RealName     => { 'read' => 1 },
 196            Lang     => { 'read' => 1 },
 197            Password     => { 'read' => 0, 'write' => 0 },
 198           EmailAddress => { 'read' => 1, 'write' => 0 }
 199      };
 200
 201 }
 202 # }}}
 203
 204 # {{{ sub LoadByEmail
 205
 206 =head2 LoadByEmail
 207
 208 Loads a User into this CurrentUser object.
 209 Takes the email address of the user to load.
 210
 211 =cut
 212
 213 sub LoadByEmail  {
 214     my $self = shift;
 215     my $identifier = shift;
 216
 217     $identifier = RT::User::CanonicalizeEmailAddress(undef, $identifier);
 218
 219     $self->LoadByCol("EmailAddress",$identifier);
 220
 221 }
 222 # }}}
 223
 224 # {{{ sub LoadByGecos
 225
 226 =head2 LoadByGecos
 227
 228 Loads a User into this CurrentUser object.
 229 Takes a unix username as its only argument.
 230
 231 =cut
 232
 233 sub LoadByGecos  {
 234     my $self = shift;
 235     my $identifier = shift;
 236
 237     $self->LoadByCol("Gecos",$identifier);
 238
 239 }
 240 # }}}
 241
 242 # {{{ sub LoadByName
 243
 244 =head2 LoadByName
 245
 246 Loads a User into this CurrentUser object.
 247 Takes a Name.
 248
 249 =cut
 250
 251 sub LoadByName {
 252     my $self = shift;
 253     my $identifier = shift;
 254     $self->LoadByCol("Name",$identifier);
 255
 256 }
 257 # }}}
 258
 259 # {{{ sub Load
 260
 261 =head2 Load
 262
 263 Loads a User into this CurrentUser object.
 264 Takes either an integer (users id column reference) or a Name
 265 The latter is deprecated. Instead, you should use LoadByName.
 266 Formerly, this routine also took email addresses.
 267
 268 =cut
 269
 270 sub Load  {
 271   my $self = shift;
 272   my $identifier = shift;
 273
 274   #if it's an int, load by id. otherwise, load by name.
 275   if ($identifier !~ /\D/) {
 276     $self->SUPER::LoadById($identifier);
 277   }
 278
 279   elsif (UNIVERSAL::isa($identifier,"RT::User")) {
 280          # DWIM if they pass a user in
 281          $self->SUPER::LoadById($identifier->Id);
 282   }
 283   else {
 284       # This is a bit dangerous, we might get false authen if somebody
 285       # uses ambigous userids or real names:
 286       $self->LoadByCol("Name",$identifier);
 287   }
 288 }
 289
 290 # }}}
 291
 292 # {{{ sub IsPassword
 293
 294 =head2 IsPassword
 295
 296 Takes a password as a string.  Passes it off to IsPassword in this
 297 user's UserObj.  If it is the user's password and the user isn't
 298 disabled, returns 1.
 299
 300 Otherwise, returns undef.
 301
 302 =cut
 303
 304 sub IsPassword {
 305   my $self = shift;
 306   my $value = shift;
 307
 308   return ($self->UserObj->IsPassword($value));
 309 }
 310
 311 # }}}
 312
 313 # {{{ sub Privileged
 314
 315 =head2 Privileged
 316
 317 Returns true if the current user can be granted rights and be
 318 a member of groups.
 319
 320 =cut
 321
 322 sub Privileged {
 323     my $self = shift;
 324     return ($self->UserObj->Privileged());
 325 }
 326
 327 # }}}
 328
 329
 330 # {{{ sub HasRight
 331
 332 =head2 HasRight
 333
 334 calls $self->UserObj->HasRight with the arguments passed in
 335
 336 =cut
 337
 338 sub HasRight {
 339   my $self = shift;
 340   return ($self->UserObj->HasRight(@_));
 341 }
 342
 343 # }}}
 344
 345 # {{{ Localization
 346
 347 =head2 LanguageHandle
 348
 349 Returns this current user's langauge handle. Should take a language
 350 specification. but currently doesn't
 351
 352 =begin testing
 353
 354 ok (my $cu = RT::CurrentUser->new('root'));
 355 ok (my $lh = $cu->LanguageHandle('en-us'));
 356 ok ($lh != undef);
 357 ok ($lh->isa('Locale::Maketext'));
 358 is ($cu->loc('TEST_STRING'), "Concrete Mixer", "Localized TEST_STRING into English");
 359 ok ($lh = $cu->LanguageHandle('fr'));
 360 is ($cu->loc('Before'), "Avant", "Localized TEST_STRING into Frenc");
 361
 362 =end testing
 363
 364 =cut
 365
 366 sub LanguageHandle {
 367     my $self = shift;
 368     if (   ( !defined $self->{'LangHandle'} )
 369         || ( !UNIVERSAL::can( $self->{'LangHandle'}, 'maketext' ) )
 370         || (@_) ) {
 371         if ( !$RT::SystemUser or ($self->id || 0) == $RT::SystemUser->id() ) {
 372             @_ = qw(en-US);
 373         }
 374
 375         elsif ( $self->Lang ) {
 376             push @_, $self->Lang;
 377         }
 378         $self->{'LangHandle'} = RT::I18N->get_handle(@_);
 379     }
 380
 381     # Fall back to english.
 382     unless ( $self->{'LangHandle'} ) {
 383         die "We couldn't get a dictionary. Nye mogu naidti slovar. No puedo encontrar dictionario.";
 384     }
 385     return ( $self->{'LangHandle'} );
 386 }
 387
 388 sub loc {
 389     my $self = shift;
 390     return '' if $_[0] eq '';
 391
 392     my $handle = $self->LanguageHandle;
 393
 394     if (@_ == 1) {
 395         # pre-scan the lexicon hashes to return _AUTO keys verbatim,
 396         # to keep locstrings containing '[' and '~' from tripping over Maketext
 397         return $_[0] unless grep { exists $_->{$_[0]} } @{ $handle->_lex_refs };
 398     }
 399
 400     return $handle->maketext(@_);
 401 }
 402
 403 sub loc_fuzzy {
 404     my $self = shift;
 405     return '' if (!$_[0] ||  $_[0] eq '');
 406
 407     # XXX: work around perl's deficiency when matching utf8 data
 408     return $_[0] if Encode::is_utf8($_[0]);
 409     my $result = $self->LanguageHandle->maketext_fuzzy(@_);
 410
 411     return($result);
 412 }
 413 # }}}
 414
 415
 416 =head2 CurrentUser
 417
 418 Return  the current currentuser object
 419
 420 =cut
 421
 422 sub CurrentUser {
 423     my $self = shift;
 424     return($self);
 425
 426 }
 427
 428 =head2 Authenticate
 429
 430 Takes $password, $created and $nonce, and returns a boolean value
 431 representing whether the authentication succeeded.
 432
 433 If both $nonce and $created are specified, validate $password against:
 434
 435     encode_base64(sha1(
 436         $nonce .
 437         $created .
 438         sha1_hex( "$username:$realm:$server_pass" )
 439     ))
 440
 441 where $server_pass is the md5_hex(password) digest stored in the
 442 database, $created is in ISO time format, and $nonce is a random
 443 string no longer than 32 bytes.
 444
 445 =cut
 446
 447 sub Authenticate {
 448     my ($self, $password, $created, $nonce, $realm) = @_;
 449
 450     require Digest::MD5;
 451     require Digest::SHA1;
 452     require MIME::Base64;
 453
 454     my $username = $self->UserObj->Name or return;
 455     my $server_pass = $self->UserObj->__Value('Password') or return;
 456     my $auth_digest = MIME::Base64::encode_base64(Digest::SHA1::sha1(
 457         $nonce .
 458         $created .
 459         Digest::MD5::md5_hex("$username:$realm:$server_pass")
 460     ));
 461
 462     chomp($password);
 463     chomp($auth_digest);
 464
 465     return ($password eq $auth_digest);
 466 }
 467
 468 # }}}
 469
 470
 471 eval "require RT::CurrentUser_Vendor";
 472 die $@ if ($@ && $@ !~ qr{^Can't locate RT/CurrentUser_Vendor.pm});
 473 eval "require RT::CurrentUser_Local";
 474 die $@ if ($@ && $@ !~ qr{^Can't locate RT/CurrentUser_Local.pm});
 475
 476 1;
 477