1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
6 # <sales@bestpractical.com>
8 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
30 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
47 # END BPS TAGGED BLOCK }}}
51 RT::CurrentUser - an RT object representing the current user
58 my $current_user = RT::CurrentUser->new;
59 $current_user->Load(...);
61 my $current_user = RT::CurrentUser->new( $user_obj );
63 my $current_user = RT::CurrentUser->new( $address || $name || $id );
66 $current_user->UserObj->SetName('new_name');
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
78 See also L<RT::User> for a list of methods this class has.
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.
89 package RT::CurrentUser;
97 use base qw/RT::User/;
99 #The basic idea here is that $self->CurrentUser is always supposed
100 # to be a CurrentUser object. but that's hard to do when we're trying to load
101 # the CurrentUser object
107 $self->{'table'} = "Users";
109 if ( defined $User ) {
111 if ( UNIVERSAL::isa( $User, 'RT::User' ) ) {
112 $self->LoadById( $User->id );
114 elsif ( ref $User ) {
116 "RT::CurrentUser->new() called with a bogus argument: $User");
119 $self->Load( $User );
123 $self->_BuildTableAttributes;
127 =head2 Create, Delete and Set*
129 As stated above it's a subclass of L<RT::User>, but this class is read-only
130 and calls to these methods are illegal. Return 'permission denied' message
137 $RT::Logger->error('RT::CurrentUser is read-only, RT::User for manipulation');
138 return (0, $self->loc('Permission Denied'));
143 $RT::Logger->error('RT::CurrentUser is read-only, RT::User for manipulation');
144 return (0, $self->loc('Permission Denied'));
149 $RT::Logger->error('RT::CurrentUser is read-only, RT::User for manipulation');
150 return (0, $self->loc('Permission Denied'));
155 Returns the L<RT::User> object associated with this CurrentUser object.
162 my $user = RT::User->new( $self );
163 unless ( $user->LoadById( $self->Id ) ) {
164 $RT::Logger->error("Couldn't load " . $self->Id . " from the users database.");
169 sub _CoreAccessible {
171 Name => { 'read' => 1 },
172 Gecos => { 'read' => 1 },
173 RealName => { 'read' => 1 },
174 Lang => { 'read' => 1 },
175 Password => { 'read' => 0, 'write' => 0 },
176 EmailAddress => { 'read' => 1, 'write' => 0 }
183 Loads a User into this CurrentUser object.
184 Takes a unix username as its only argument.
190 return $self->LoadByCol( "Gecos", shift );
195 Loads a User into this CurrentUser object.
202 return $self->LoadByCol( "Name", shift );
205 =head2 LanguageHandle
207 Returns this current user's langauge handle. Should take a language
208 specification. but currently doesn't
214 if ( !defined $self->{'LangHandle'}
215 || !UNIVERSAL::can( $self->{'LangHandle'}, 'maketext' )
218 if ( my $lang = $self->Lang ) {
221 elsif ( $self->id && ($self->id == (RT->SystemUser->id||0) || $self->id == (RT->Nobody->id||0)) ) {
222 # don't use ENV magic for system users
226 $self->{'LangHandle'} = RT::I18N->get_handle(@_);
229 # Fall back to english.
230 unless ( $self->{'LangHandle'} ) {
231 die "We couldn't get a dictionary. Ne mogu naidti slovar. No puedo encontrar dictionario.";
233 return $self->{'LangHandle'};
238 return '' if !defined $_[0] || $_[0] eq '';
240 my $handle = $self->LanguageHandle;
243 # If we have no [_1] replacements, and the key does not appear
244 # in the lexicon, unescape (using ~) and return it verbatim, as
246 my $unescaped = $_[0];
247 $unescaped =~ s!~(.)!$1!g;
248 return $unescaped unless grep exists $_->{$_[0]}, @{ $handle->_lex_refs };
251 return $handle->maketext(@_);
256 return '' if !defined $_[0] || $_[0] eq '';
258 # XXX: work around perl's deficiency when matching utf8 data
259 return $_[0] if Encode::is_utf8($_[0]);
261 return $self->LanguageHandle->maketext_fuzzy( @_ );
266 Return the current currentuser object
276 Takes $password, $created and $nonce, and returns a boolean value
277 representing whether the authentication succeeded.
279 If both $nonce and $created are specified, validate $password against:
284 sha1_hex( "$username:$realm:$server_pass" )
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.
294 my ($self, $password, $created, $nonce, $realm) = @_;
297 require Digest::SHA1;
298 require MIME::Base64;
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(
305 Digest::MD5::md5_hex("$username:$realm:$server_pass")
311 return ($password eq $auth_digest);
314 RT::Base->_ImportOverlays();