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