rt/lib/RT/CurrentUser.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
   6 #                                          <sales@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/licenses/old-licenses/gpl-2.0.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
  49 =head1 NAME
  50
  51   RT::CurrentUser - an RT object representing the current user
  52
  53 =head1 SYNOPSIS
  54
  55     use RT::CurrentUser;
  56
  57     # laod
  58     my $current_user = new RT::CurrentUser;
  59     $current_user->Load(...);
  60     # or
  61     my $current_user = RT::CurrentUser->new( $user_obj );
  62     # or
  63     my $current_user = RT::CurrentUser->new( $address || $name || $id );
  64
  65     # manipulation
  66     $current_user->UserObj->SetName('new_name');
  67
  68
  69 =head1 DESCRIPTION
  70
  71 B<Read-only> subclass of L<RT::User> class. Used to define the current
  72 user. You should pass an instance of this class to constructors of
  73 many RT classes, then the instance used to check ACLs and localize
  74 strings.
  75
  76 =head1 METHODS
  77
  78 See also L<RT::User> for a list of methods this class has.
  79
  80 =head2 new
  81
  82 Returns new CurrentUser object. Unlike all other classes of RT it takes
  83 either subclass of C<RT::User> class object or scalar value that is
  84 passed to Load method.
  85
  86 =cut
  87
  88
  89 package RT::CurrentUser;
  90
  91 use RT::I18N;
  92
  93 use strict;
  94 use warnings;
  95
  96 use base qw/RT::User/;
  97
  98 #The basic idea here is that $self->CurrentUser is always supposed
  99 # to be a CurrentUser object. but that's hard to do when we're trying to load
 100 # the CurrentUser object
 101
 102 sub _Init {
 103     my $self = shift;
 104     my $User = shift;
 105
 106     $self->{'table'} = "Users";
 107
 108     if ( defined $User ) {
 109
 110         if ( UNIVERSAL::isa( $User, 'RT::User' ) ) {
 111             $self->LoadById( $User->id );
 112         }
 113         elsif ( ref $User ) {
 114             $RT::Logger->crit(
 115                 "RT::CurrentUser->new() called with a bogus argument: $User");
 116         }
 117         else {
 118             $self->Load( $User );
 119         }
 120     }
 121
 122     $self->_BuildTableAttributes;
 123
 124 }
 125
 126 =head2 Create, Delete and Set*
 127
 128 As stated above it's a subclass of L<RT::User>, but this class is read-only
 129 and calls to these methods are illegal. Return 'permission denied' message
 130 and log an error.
 131
 132 =cut
 133
 134 sub Create {
 135     my $self = shift;
 136     $RT::Logger->error('RT::CurrentUser is read-only, RT::User for manipulation');
 137     return (0, $self->loc('Permission Denied'));
 138 }
 139
 140 sub Delete {
 141     my $self = shift;
 142     $RT::Logger->error('RT::CurrentUser is read-only, RT::User for manipulation');
 143     return (0, $self->loc('Permission Denied'));
 144 }
 145
 146 sub _Set {
 147     my $self = shift;
 148     $RT::Logger->error('RT::CurrentUser is read-only, RT::User for manipulation');
 149     return (0, $self->loc('Permission Denied'));
 150 }
 151
 152 =head2 UserObj
 153
 154 Returns the L<RT::User> object associated with this CurrentUser object.
 155
 156 =cut
 157
 158 sub UserObj {
 159     my $self = shift;
 160
 161     my $user = RT::User->new( $self );
 162     unless ( $user->LoadById( $self->Id ) ) {
 163         $RT::Logger->error(
 164             $self->loc("Couldn't load [_1] from the users database.\n", $self->Id)
 165         );
 166     }
 167     return $user;
 168 }
 169
 170 sub _CoreAccessible  {
 171      {
 172          Name           => { 'read' => 1 },
 173            Gecos        => { 'read' => 1 },
 174            RealName     => { 'read' => 1 },
 175            Lang     => { 'read' => 1 },
 176            Password     => { 'read' => 0, 'write' => 0 },
 177           EmailAddress => { 'read' => 1, 'write' => 0 }
 178      };
 179
 180 }
 181
 182 =head2 LoadByGecos
 183
 184 Loads a User into this CurrentUser object.
 185 Takes a unix username as its only argument.
 186
 187 =cut
 188
 189 sub LoadByGecos  {
 190     my $self = shift;
 191     return $self->LoadByCol( "Gecos", shift );
 192 }
 193
 194 =head2 LoadByName
 195
 196 Loads a User into this CurrentUser object.
 197 Takes a Name.
 198
 199 =cut
 200
 201 sub LoadByName {
 202     my $self = shift;
 203     return $self->LoadByCol( "Name", shift );
 204 }
 205
 206 =head2 LanguageHandle
 207
 208 Returns this current user's langauge handle. Should take a language
 209 specification. but currently doesn't
 210
 211 =cut
 212
 213 sub LanguageHandle {
 214     my $self = shift;
 215     if (   !defined $self->{'LangHandle'}
 216         || !UNIVERSAL::can( $self->{'LangHandle'}, 'maketext' )
 217         || @_ )
 218     {
 219         if ( my $lang = $self->Lang ) {
 220             push @_, $lang;
 221         }
 222         elsif ( $self->id && ($self->id == ($RT::SystemUser->id||0) || $self->id == ($RT::Nobody->id||0)) ) {
 223             # don't use ENV magic for system users
 224             push @_, 'en';
 225         }
 226
 227         $self->{'LangHandle'} = RT::I18N->get_handle(@_);
 228     }
 229
 230     # Fall back to english.
 231     unless ( $self->{'LangHandle'} ) {
 232         die "We couldn't get a dictionary. Ne mogu naidti slovar. No puedo encontrar dictionario.";
 233     }
 234     return $self->{'LangHandle'};
 235 }
 236
 237 sub loc {
 238     my $self = shift;
 239     return '' if !defined $_[0] || $_[0] eq '';
 240
 241     my $handle = $self->LanguageHandle;
 242
 243     if (@_ == 1) {
 244         # pre-scan the lexicon hashes to return _AUTO keys verbatim,
 245         # to keep locstrings containing '[' and '~' from tripping over Maketext
 246         return $_[0] unless grep exists $_->{$_[0]}, @{ $handle->_lex_refs };
 247     }
 248
 249     return $handle->maketext(@_);
 250 }
 251
 252 sub loc_fuzzy {
 253     my $self = shift;
 254     return '' if !defined $_[0] || $_[0] eq '';
 255
 256     # XXX: work around perl's deficiency when matching utf8 data
 257     return $_[0] if Encode::is_utf8($_[0]);
 258
 259     return $self->LanguageHandle->maketext_fuzzy( @_ );
 260 }
 261
 262 =head2 CurrentUser
 263
 264 Return the current currentuser object
 265
 266 =cut
 267
 268 sub CurrentUser {
 269     my $self = shift;
 270     return($self);
 271
 272 }
 273
 274 =head2 Authenticate
 275
 276 Takes $password, $created and $nonce, and returns a boolean value
 277 representing whether the authentication succeeded.
 278
 279 If both $nonce and $created are specified, validate $password against:
 280
 281     encode_base64(sha1(
 282         $nonce .
 283         $created .
 284         sha1_hex( "$username:$realm:$server_pass" )
 285     ))
 286
 287 where $server_pass is the md5_hex(password) digest stored in the
 288 database, $created is in ISO time format, and $nonce is a random
 289 string no longer than 32 bytes.
 290
 291 =cut
 292
 293 sub Authenticate {
 294     my ($self, $password, $created, $nonce, $realm) = @_;
 295
 296     require Digest::MD5;
 297     require Digest::SHA1;
 298     require MIME::Base64;
 299
 300     my $username = $self->UserObj->Name or return;
 301     my $server_pass = $self->UserObj->__Value('Password') or return;
 302     my $auth_digest = MIME::Base64::encode_base64(Digest::SHA1::sha1(
 303         $nonce .
 304         $created .
 305         Digest::MD5::md5_hex("$username:$realm:$server_pass")
 306     ));
 307
 308     chomp($password);
 309     chomp($auth_digest);
 310
 311     return ($password eq $auth_digest);
 312 }
 313
 314 RT::Base->_ImportOverlays();
 315
 316 1;