1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2011 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::User - RT User object
70 no warnings qw(redefine);
76 use RT::Interface::Email;
79 sub _OverlayAccessible {
82 Name => { public => 1, admin => 1 },
83 Password => { read => 0 },
84 EmailAddress => { public => 1 },
85 Organization => { public => 1, admin => 1 },
86 RealName => { public => 1 },
87 NickName => { public => 1 },
88 Lang => { public => 1 },
89 EmailEncoding => { public => 1 },
90 WebEncoding => { public => 1 },
91 ExternalContactInfoId => { public => 1, admin => 1 },
92 ContactInfoSystem => { public => 1, admin => 1 },
93 ExternalAuthId => { public => 1, admin => 1 },
94 AuthSystem => { public => 1, admin => 1 },
95 Gecos => { public => 1, admin => 1 },
96 PGPKey => { public => 1, admin => 1 },
103 =head2 Create { PARAMHASH }
116 _RecordTransaction => 1,
117 @_ # get the real argumentlist
120 # remove the value so it does not cripple SUPER::Create
121 my $record_transaction = delete $args{'_RecordTransaction'};
124 unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
125 return ( 0, $self->loc('Permission Denied') );
129 unless ($self->CanonicalizeUserInfo(\%args)) {
130 return ( 0, $self->loc("Could not set user info") );
133 $args{'EmailAddress'} = $self->CanonicalizeEmailAddress($args{'EmailAddress'});
135 # if the user doesn't have a name defined, set it to the email address
136 $args{'Name'} = $args{'EmailAddress'} unless ($args{'Name'});
140 my $privileged = delete $args{'Privileged'};
143 if ($args{'CryptedPassword'} ) {
144 $args{'Password'} = $args{'CryptedPassword'};
145 delete $args{'CryptedPassword'};
147 elsif ( !$args{'Password'} ) {
148 $args{'Password'} = '*NO-PASSWORD*';
150 elsif ( length( $args{'Password'} ) < RT->Config->Get('MinimumPasswordLength') ) {
151 return ( 0, $self->loc("Password needs to be at least [_1] characters long",RT->Config->Get('MinimumPasswordLength')) );
155 $args{'Password'} = $self->_GeneratePassword($args{'Password'});
158 #TODO Specify some sensible defaults.
160 unless ( $args{'Name'} ) {
161 return ( 0, $self->loc("Must specify 'Name' attribute") );
164 #SANITY CHECK THE NAME AND ABORT IF IT'S TAKEN
165 if ($RT::SystemUser) { #This only works if RT::SystemUser has been defined
166 my $TempUser = RT::User->new($RT::SystemUser);
167 $TempUser->Load( $args{'Name'} );
168 return ( 0, $self->loc('Name in use') ) if ( $TempUser->Id );
170 my ($val, $message) = $self->ValidateEmailAddress( $args{'EmailAddress'} );
171 return (0, $message) unless ( $val );
174 $RT::Logger->warning( "$self couldn't check for pre-existing users");
178 $RT::Handle->BeginTransaction();
179 # Groups deal with principal ids, rather than user ids.
180 # When creating this user, set up a principal Id for it.
181 my $principal = RT::Principal->new($self->CurrentUser);
182 my $principal_id = $principal->Create(PrincipalType => 'User',
183 Disabled => $args{'Disabled'},
185 # If we couldn't create a principal Id, get the fuck out.
186 unless ($principal_id) {
187 $RT::Handle->Rollback();
188 $RT::Logger->crit("Couldn't create a Principal on new user create.");
189 $RT::Logger->crit("Strange things are afoot at the circle K");
190 return ( 0, $self->loc('Could not create user') );
193 $principal->__Set(Field => 'ObjectId', Value => $principal_id);
194 delete $args{'Disabled'};
196 $self->SUPER::Create(id => $principal_id , %args);
199 #If the create failed.
201 $RT::Handle->Rollback();
202 $RT::Logger->error("Could not create a new user - " .join('-', %args));
204 return ( 0, $self->loc('Could not create user') );
207 my $aclstash = RT::Group->new($self->CurrentUser);
208 my $stash_id = $aclstash->_CreateACLEquivalenceGroup($principal);
211 $RT::Handle->Rollback();
212 $RT::Logger->crit("Couldn't stash the user in groupmembers");
213 return ( 0, $self->loc('Could not create user') );
217 my $everyone = RT::Group->new($self->CurrentUser);
218 $everyone->LoadSystemInternalGroup('Everyone');
219 unless ($everyone->id) {
220 $RT::Logger->crit("Could not load Everyone group on user creation.");
221 $RT::Handle->Rollback();
222 return ( 0, $self->loc('Could not create user') );
226 my ($everyone_id, $everyone_msg) = $everyone->_AddMember( InsideTransaction => 1, PrincipalId => $self->PrincipalId);
227 unless ($everyone_id) {
228 $RT::Logger->crit("Could not add user to Everyone group on user creation.");
229 $RT::Logger->crit($everyone_msg);
230 $RT::Handle->Rollback();
231 return ( 0, $self->loc('Could not create user') );
235 my $access_class = RT::Group->new($self->CurrentUser);
237 $access_class->LoadSystemInternalGroup('Privileged');
239 $access_class->LoadSystemInternalGroup('Unprivileged');
242 unless ($access_class->id) {
243 $RT::Logger->crit("Could not load Privileged or Unprivileged group on user creation");
244 $RT::Handle->Rollback();
245 return ( 0, $self->loc('Could not create user') );
249 my ($ac_id, $ac_msg) = $access_class->_AddMember( InsideTransaction => 1, PrincipalId => $self->PrincipalId);
252 $RT::Logger->crit("Could not add user to Privileged or Unprivileged group on user creation. Aborted");
253 $RT::Logger->crit($ac_msg);
254 $RT::Handle->Rollback();
255 return ( 0, $self->loc('Could not create user') );
259 if ( $record_transaction ) {
260 $self->_NewTransaction( Type => "Create" );
265 return ( $id, $self->loc('User created') );
268 =head2 SetPrivileged BOOL
270 If passed a true value, makes this user a member of the "Privileged" PseudoGroup.
271 Otherwise, makes this user a member of the "Unprivileged" pseudogroup.
273 Returns a standard RT tuple of (val, msg);
283 unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
284 return ( 0, $self->loc('Permission Denied') );
287 my $priv = RT::Group->new($self->CurrentUser);
288 $priv->LoadSystemInternalGroup('Privileged');
290 $RT::Logger->crit("Could not find Privileged pseudogroup");
291 return(0,$self->loc("Failed to find 'Privileged' users pseudogroup."));
294 my $unpriv = RT::Group->new($self->CurrentUser);
295 $unpriv->LoadSystemInternalGroup('Unprivileged');
296 unless ($unpriv->Id) {
297 $RT::Logger->crit("Could not find unprivileged pseudogroup");
298 return(0,$self->loc("Failed to find 'Unprivileged' users pseudogroup"));
301 my $principal = $self->PrincipalId;
303 if ($priv->HasMember($principal)) {
304 #$RT::Logger->debug("That user is already privileged");
305 return (0,$self->loc("That user is already privileged"));
307 if ($unpriv->HasMember($principal)) {
308 $unpriv->_DeleteMember($principal);
310 # if we had layered transactions, life would be good
311 # sadly, we have to just go ahead, even if something
313 $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
314 "unprivileged. something is drastically wrong.");
316 my ($status, $msg) = $priv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
318 return (1, $self->loc("That user is now privileged"));
324 if ($unpriv->HasMember($principal)) {
325 #$RT::Logger->debug("That user is already unprivileged");
326 return (0,$self->loc("That user is already unprivileged"));
328 if ($priv->HasMember($principal)) {
329 $priv->_DeleteMember( $principal );
331 # if we had layered transactions, life would be good
332 # sadly, we have to just go ahead, even if something
334 $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
335 "unprivileged. something is drastically wrong.");
337 my ($status, $msg) = $unpriv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
339 return (1, $self->loc("That user is now unprivileged"));
348 Returns true if this user is privileged. Returns undef otherwise.
354 my $priv = RT::Group->new($self->CurrentUser);
355 $priv->LoadSystemInternalGroup('Privileged');
356 if ( $priv->HasMember( $self->PrincipalId ) ) {
364 #create a user without validating _any_ data.
366 #To be used only on database init.
367 # We can't localize here because it's before we _have_ a loc framework
369 sub _BootstrapCreate {
373 $args{'Password'} = '*NO-PASSWORD*';
376 $RT::Handle->BeginTransaction();
378 # Groups deal with principal ids, rather than user ids.
379 # When creating this user, set up a principal Id for it.
380 my $principal = RT::Principal->new($self->CurrentUser);
381 my $principal_id = $principal->Create(PrincipalType => 'User', ObjectId => '0');
382 $principal->__Set(Field => 'ObjectId', Value => $principal_id);
384 # If we couldn't create a principal Id, get the fuck out.
385 unless ($principal_id) {
386 $RT::Handle->Rollback();
387 $RT::Logger->crit("Couldn't create a Principal on new user create. Strange things are afoot at the circle K");
388 return ( 0, 'Could not create user' );
390 $self->SUPER::Create(id => $principal_id, %args);
392 #If the create failed.
394 $RT::Handle->Rollback();
395 return ( 0, 'Could not create user' ) ; #never loc this
398 my $aclstash = RT::Group->new($self->CurrentUser);
399 my $stash_id = $aclstash->_CreateACLEquivalenceGroup($principal);
402 $RT::Handle->Rollback();
403 $RT::Logger->crit("Couldn't stash the user in groupmembers");
404 return ( 0, $self->loc('Could not create user') );
408 $RT::Handle->Commit();
410 return ( $id, 'User created' );
416 return ( 0, $self->loc('Deleting this object would violate referential integrity') );
422 Load a user object from the database. Takes a single argument.
423 If the argument is numerical, load by the column 'id'. If a user
424 object or its subclass passed then loads the same user by id.
425 Otherwise, load by the "Name" column which is the user's textual
432 my $identifier = shift || return undef;
434 if ( $identifier !~ /\D/ ) {
435 return $self->SUPER::LoadById( $identifier );
437 elsif ( UNIVERSAL::isa( $identifier, 'RT::User' ) ) {
438 return $self->SUPER::LoadById( $identifier->Id );
441 return $self->LoadByCol( "Name", $identifier );
447 Tries to load this user object from the database by the user's email address.
455 # Never load an empty address as an email address.
460 $address = $self->CanonicalizeEmailAddress($address);
462 #$RT::Logger->debug("Trying to load an email address: $address");
463 return $self->LoadByCol( "EmailAddress", $address );
466 =head2 LoadOrCreateByEmail ADDRESS
468 Attempts to find a user who has the provided email address. If that fails, creates an unprivileged user with
469 the provided email address and loads them. Address can be provided either as L<Email::Address> object
470 or string which is parsed using the module.
472 Returns a tuple of the user's id and a status message.
473 0 will be returned in place of the user's id in case of failure.
477 sub LoadOrCreateByEmail {
481 my ($message, $name);
482 if ( UNIVERSAL::isa( $email => 'Email::Address' ) ) {
483 ($email, $name) = ($email->address, $email->phrase);
485 ($email, $name) = RT::Interface::Email::ParseAddressFromHeader( $email );
488 $self->LoadByEmail( $email );
489 $self->Load( $email ) unless $self->Id;
490 $message = $self->loc('User loaded');
492 unless( $self->Id ) {
494 ($val, $message) = $self->Create(
496 EmailAddress => $email,
499 Comments => 'Autocreated when added as a watcher',
502 # Deal with the race condition of two account creations at once
503 $self->LoadByEmail( $email );
504 unless ( $self->Id ) {
506 $self->LoadByEmail( $email );
509 $RT::Logger->error("Recovered from creation failure due to race condition");
510 $message = $self->loc("User loaded");
513 $RT::Logger->crit("Failed to create user ". $email .": " .$message);
517 return (0, $message) unless $self->id;
518 return ($self->Id, $message);
521 =head2 ValidateEmailAddress ADDRESS
523 Returns true if the email address entered is not in use by another user or is
524 undef or ''. Returns false if it's in use.
528 sub ValidateEmailAddress {
532 # if the email address is null, it's always valid
533 return (1) if ( !$Value || $Value eq "" );
535 if ( RT->Config->Get('ValidateUserEmailAddresses') ) {
536 # We only allow one valid email address
537 my @addresses = Email::Address->parse($Value);
538 return ( 0, $self->loc('Invalid syntax for email address') ) unless ( ( scalar (@addresses) == 1 ) && ( $addresses[0]->address ) );
542 my $TempUser = RT::User->new($RT::SystemUser);
543 $TempUser->LoadByEmail($Value);
545 if ( $TempUser->id && ( !$self->id || $TempUser->id != $self->id ) )
546 { # if we found a user with that address
547 # it's invalid to set this user's address to it
548 return ( 0, $self->loc('Email address in use') );
550 else { #it's a valid email address
555 =head2 SetEmailAddress
557 Check to make sure someone else isn't using this email address already
558 so that a better email address can be returned
562 sub SetEmailAddress {
566 my ($val, $message) = $self->ValidateEmailAddress( $Value );
568 return $self->_Set( Field => 'EmailAddress', Value => $Value );
570 return ( 0, $message )
575 =head2 EmailFrequency
577 Takes optional Ticket argument in paramhash. Returns 'no email',
578 'squelched', 'daily', 'weekly' or empty string depending on
583 =item 'no email' - user has no email, so can not recieve notifications.
585 =item 'squelched' - returned only when Ticket argument is provided and
586 notifications to the user has been supressed for this ticket.
588 =item 'daily' - retruned when user recieve daily messages digest instead
589 of immediate delivery.
591 =item 'weekly' - previous, but weekly.
593 =item empty string returned otherwise.
605 return '' unless $self->id && $self->id != $RT::Nobody->id
606 && $self->id != $RT::SystemUser->id;
607 return 'no email' unless my $email = $self->EmailAddress;
608 return 'squelched' if $args{'Ticket'} &&
609 grep lc $email eq lc $_->Content, $args{'Ticket'}->SquelchMailTo;
610 my $frequency = RT->Config->Get( 'EmailFrequency', $self ) || '';
611 return 'daily' if $frequency =~ /daily/i;
612 return 'weekly' if $frequency =~ /weekly/i;
616 =head2 CanonicalizeEmailAddress ADDRESS
618 CanonicalizeEmailAddress converts email addresses into canonical form.
619 it takes one email address in and returns the proper canonical
620 form. You can dump whatever your proper local config is in here. Note
621 that it may be called as a static method; in this case the first argument
622 is class name not an object.
626 sub CanonicalizeEmailAddress {
629 # Example: the following rule would treat all email
630 # coming from a subdomain as coming from second level domain
632 if ( my $match = RT->Config->Get('CanonicalizeEmailAddressMatch') and
633 my $replace = RT->Config->Get('CanonicalizeEmailAddressReplace') )
635 $email =~ s/$match/$replace/gi;
640 =head2 CanonicalizeUserInfo HASH of ARGS
642 CanonicalizeUserInfo can convert all User->Create options.
643 it takes a hashref of all the params sent to User->Create and
644 returns that same hash, by default nothing is done.
646 This function is intended to allow users to have their info looked up via
647 an outside source and modified upon creation.
651 sub CanonicalizeUserInfo {
660 =head2 Password and authentication related functions
662 =head3 SetRandomPassword
664 Takes no arguments. Returns a status code and a new password or an error message.
665 If the status is 1, the second value returned is the new password.
666 If the status is anything else, the new value returned is the error code.
670 sub SetRandomPassword {
673 unless ( $self->CurrentUserCanModify('Password') ) {
674 return ( 0, $self->loc("Permission Denied") );
678 my $min = ( RT->Config->Get('MinimumPasswordLength') > 6 ? RT->Config->Get('MinimumPasswordLength') : 6);
679 my $max = ( RT->Config->Get('MinimumPasswordLength') > 8 ? RT->Config->Get('MinimumPasswordLength') : 8);
681 my $pass = $self->GenerateRandomPassword( $min, $max) ;
683 # If we have "notify user on
685 my ( $val, $msg ) = $self->SetPassword($pass);
687 #If we got an error return the error.
688 return ( 0, $msg ) unless ($val);
690 #Otherwise, we changed the password, lets return it.
697 Returns status, [ERROR or new password]. Resets this user\'s password to
698 a randomly generated pronouncable password and emails them, using a
699 global template called "RT_PasswordChange", which can be overridden
700 with global templates "RT_PasswordChange_Privileged" or "RT_PasswordChange_NonPrivileged"
701 for privileged and Non-privileged users respectively.
708 unless ( $self->CurrentUserCanModify('Password') ) {
709 return ( 0, $self->loc("Permission Denied") );
711 my ( $status, $pass ) = $self->SetRandomPassword();
714 return ( 0, "$pass" );
717 my $ret = RT::Interface::Email::SendEmailUsingTemplate(
718 To => $self->EmailAddress,
719 Template => 'PasswordChange',
721 NewPassword => $pass,
726 return ( 1, $self->loc('New password notification sent') );
729 return ( 0, $self->loc('Notification could not be sent') );
734 =head3 GenerateRandomPassword MIN_LEN and MAX_LEN
736 Returns a random password between MIN_LEN and MAX_LEN characters long.
740 sub GenerateRandomPassword {
742 my $min_length = shift;
743 my $max_length = shift;
745 #This code derived from mpw.pl, a bit of code with a sordid history
748 # Perl cleaned up a bit by Jesse Vincent 1/14/2001.
749 # Converted to perl from C by Marc Horowitz, 1/20/2000.
750 # Converted to C from Multics PL/I by Bill Sommerfeld, 4/21/86.
751 # Original PL/I version provided by Jerry Saltzer.
753 my ( $frequency, $start_freq, $total_sum, $row_sums );
755 #When munging characters, we need to know where to start counting letters from
758 # frequency of English digraphs (from D Edwards 1/27/66)
761 4, 20, 28, 52, 2, 11, 28, 4, 32, 4, 6, 62, 23, 167,
762 2, 14, 0, 83, 76, 127, 7, 25, 8, 1, 9, 1
765 13, 0, 0, 0, 55, 0, 0, 0, 8, 2, 0, 22, 0, 0,
766 11, 0, 0, 15, 4, 2, 13, 0, 0, 0, 15, 0
769 32, 0, 7, 1, 69, 0, 0, 33, 17, 0, 10, 9, 1, 0,
770 50, 3, 0, 10, 0, 28, 11, 0, 0, 0, 3, 0
773 40, 16, 9, 5, 65, 18, 3, 9, 56, 0, 1, 4, 15, 6,
774 16, 4, 0, 21, 18, 53, 19, 5, 15, 0, 3, 0
777 84, 20, 55, 125, 51, 40, 19, 16, 50, 1,
778 4, 55, 54, 146, 35, 37, 6, 191, 149, 65,
782 19, 3, 5, 1, 19, 21, 1, 3, 30, 2, 0, 11, 1, 0,
783 51, 0, 0, 26, 8, 47, 6, 3, 3, 0, 2, 0
786 20, 4, 3, 2, 35, 1, 3, 15, 18, 0, 0, 5, 1, 4,
787 21, 1, 1, 20, 9, 21, 9, 0, 5, 0, 1, 0
790 101, 1, 3, 0, 270, 5, 1, 6, 57, 0, 0, 0, 3, 2,
791 44, 1, 0, 3, 10, 18, 6, 0, 5, 0, 3, 0
794 40, 7, 51, 23, 25, 9, 11, 3, 0, 0, 2, 38, 25, 202,
795 56, 12, 1, 46, 79, 117, 1, 22, 0, 4, 0, 3
798 3, 0, 0, 0, 5, 0, 0, 0, 1, 0, 0, 0, 0, 0,
799 4, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0
802 1, 0, 0, 0, 11, 0, 0, 0, 13, 0, 0, 0, 0, 2,
803 0, 0, 0, 0, 6, 2, 1, 0, 2, 0, 1, 0
806 44, 2, 5, 12, 62, 7, 5, 2, 42, 1, 1, 53, 2, 2,
807 25, 1, 1, 2, 16, 23, 9, 0, 1, 0, 33, 0
810 52, 14, 1, 0, 64, 0, 0, 3, 37, 0, 0, 0, 7, 1,
811 17, 18, 1, 2, 12, 3, 8, 0, 1, 0, 2, 0
814 42, 10, 47, 122, 63, 19, 106, 12, 30, 1,
815 6, 6, 9, 7, 54, 7, 1, 7, 44, 124,
819 7, 12, 14, 17, 5, 95, 3, 5, 14, 0, 0, 19, 41, 134,
820 13, 23, 0, 91, 23, 42, 55, 16, 28, 0, 4, 1
823 19, 1, 0, 0, 37, 0, 0, 4, 8, 0, 0, 15, 1, 0,
824 27, 9, 0, 33, 14, 7, 6, 0, 0, 0, 0, 0
827 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
828 0, 0, 0, 0, 0, 0, 17, 0, 0, 0, 0, 0
831 83, 8, 16, 23, 169, 4, 8, 8, 77, 1, 10, 5, 26, 16,
832 60, 4, 0, 24, 37, 55, 6, 11, 4, 0, 28, 0
835 65, 9, 17, 9, 73, 13, 1, 47, 75, 3, 0, 7, 11, 12,
836 56, 17, 6, 9, 48, 116, 35, 1, 28, 0, 4, 0
839 57, 22, 3, 1, 76, 5, 2, 330, 126, 1,
840 0, 14, 10, 6, 79, 7, 0, 49, 50, 56,
844 11, 5, 9, 6, 9, 1, 6, 0, 9, 0, 1, 19, 5, 31,
845 1, 15, 0, 47, 39, 31, 0, 3, 0, 0, 0, 0
848 7, 0, 0, 0, 72, 0, 0, 0, 28, 0, 0, 0, 0, 0,
849 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0
852 36, 1, 1, 0, 38, 0, 0, 33, 36, 0, 0, 4, 1, 8,
853 15, 0, 0, 0, 4, 2, 0, 0, 1, 0, 0, 0
856 1, 0, 2, 0, 0, 1, 0, 0, 3, 0, 0, 0, 0, 0,
857 1, 5, 0, 0, 0, 3, 0, 0, 1, 0, 0, 0
860 14, 5, 4, 2, 7, 12, 12, 6, 10, 0, 0, 3, 7, 5,
861 17, 3, 0, 4, 16, 30, 0, 0, 5, 0, 0, 0
864 1, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0,
865 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
869 #We need to know the totals for each row
873 map { $sum += $_ } @$_;
878 #Frequency with which a given letter starts a word.
880 1299, 425, 725, 271, 375, 470, 93, 223, 1009, 24,
881 20, 355, 379, 319, 823, 618, 21, 317, 962, 1991,
882 271, 104, 516, 6, 16, 14
886 map { $total_sum += $_ } @$start_freq;
888 my $length = $min_length + int( rand( $max_length - $min_length ) );
890 my $char = $self->_GenerateRandomNextChar( $total_sum, $start_freq );
891 my @word = ( $char + $a );
892 for ( 2 .. $length ) {
894 $self->_GenerateRandomNextChar( $row_sums->[$char],
895 $frequency->[$char] );
896 push ( @word, $char + $a );
900 return pack( "C*", @word );
904 #A private helper function for RandomPassword
905 # Takes a row summary and a frequency chart for the next character to be searched
906 sub _GenerateRandomNextChar {
908 my ( $all, $freq ) = @_;
911 for ( $pos = int( rand($all) ), $i = 0 ;
912 $pos >= $freq->[$i] ;
913 $pos -= $freq->[$i], $i++ )
920 sub SafeSetPassword {
925 Confirmation => undef,
928 return (1) unless defined $args{'New'} && length $args{'New'};
930 my %cond = $self->CurrentUserRequireToSetPassword;
932 unless ( $cond{'CanSet'} ) {
933 return (0, $self->loc('You can not set password.') .' '. $cond{'Reason'} );
937 if ( $cond{'RequireCurrent'} && !$self->CurrentUser->IsPassword($args{'Current'}) ) {
938 if ( defined $args{'Current'} && length $args{'Current'} ) {
939 $error = $self->loc("Please enter your current password correctly.");
942 $error = $self->loc("Please enter your current password.");
944 } elsif ( $args{'New'} ne $args{'Confirmation'} ) {
945 $error = $self->loc("Passwords do not match.");
949 $error .= ' '. $self->loc('Password has not been set.');
953 return $self->SetPassword( $args{'New'} );
958 Takes a string. Checks the string's length and sets this user's password
965 my $password = shift;
967 unless ( $self->CurrentUserCanModify('Password') ) {
968 return ( 0, $self->loc('Password: Permission Denied') );
972 return ( 0, $self->loc("No password set") );
974 elsif ( length($password) < RT->Config->Get('MinimumPasswordLength') ) {
975 return ( 0, $self->loc("Password needs to be at least [_1] characters long", RT->Config->Get('MinimumPasswordLength')) );
978 my $new = !$self->HasPassword;
979 $password = $self->_GeneratePassword($password);
980 my ( $val, $msg ) = $self->SUPER::SetPassword($password);
982 return ( 1, $self->loc("Password set") ) if $new;
983 return ( 1, $self->loc("Password changed") );
986 return ( $val, $msg );
992 =head3 _GeneratePassword PASSWORD [, SALT]
994 Returns a salted SHA-256 hash of the password passed in, in base64
999 sub _GeneratePassword {
1001 my ($password, $salt) = @_;
1003 # Generate a random 4-byte salt
1004 $salt ||= pack("C4",map{int rand(256)} 1..4);
1006 # Encode the salt, and a truncated SHA256 of the MD5 of the
1007 # password. The additional, un-necessary level of MD5 allows for
1008 # transparent upgrading to this scheme, from the previous unsalted
1010 return MIME::Base64::encode_base64(
1011 $salt . substr(Digest::SHA::sha256($salt . Digest::MD5::md5($password)),0,26),
1016 =head3 _GeneratePasswordBase64 PASSWORD
1018 returns an MD5 hash of the password passed in, in base64 encoding
1023 sub _GeneratePasswordBase64 {
1025 my $password = shift;
1027 my $md5 = Digest::MD5->new();
1028 $md5->add(encode_utf8($password));
1029 return ($md5->b64digest);
1035 Returns true if the user has a valid password, otherwise returns false.
1041 my $pwd = $self->__Value('Password');
1042 return undef if !defined $pwd
1044 || $pwd eq '*NO-PASSWORD*';
1050 Returns true if the passed in value is this user's password.
1051 Returns undef otherwise.
1059 #TODO there isn't any apparent way to legitimately ACL this
1061 # RT does not allow null passwords
1062 if ( ( !defined($value) ) or ( $value eq '' ) ) {
1066 if ( $self->PrincipalObj->Disabled ) {
1068 "Disabled user " . $self->Name . " tried to log in" );
1072 unless ($self->HasPassword) {
1076 my $stored = $self->__Value('Password');
1077 if (length $stored == 40) {
1078 # The truncated SHA256(salt,MD5(passwd)) form from 2010/12 is 40 characters long
1079 my $hash = MIME::Base64::decode_base64($stored);
1080 # The first 4 bytes are the salt, the rest is substr(SHA256,0,26)
1081 my $salt = substr($hash, 0, 4, "");
1082 return substr(Digest::SHA::sha256($salt . Digest::MD5::md5($value)), 0, 26) eq $hash;
1083 } elsif (length $stored == 32) {
1085 return 0 unless Digest::MD5::md5_hex(encode_utf8($value)) eq $stored;
1086 } elsif (length $stored == 22) {
1087 # Base64 nonsalted-md5
1088 return 0 unless Digest::MD5::md5_base64(encode_utf8($value)) eq $stored;
1089 } elsif (length $stored == 13) {
1091 return 0 unless crypt(encode_utf8($value), $stored) eq $stored;
1093 $RT::Logger->warn("Unknown password form");
1097 # We got here by validating successfully, but with a legacy
1098 # password form. Update to the most recent form.
1099 my $obj = $self->isa("RT::CurrentUser") ? $self->UserObj : $self;
1100 $obj->_Set(Field => 'Password', Value => $self->_GeneratePassword($value) );
1104 sub CurrentUserRequireToSetPassword {
1110 RequireCurrent => 1,
1113 if ( RT->Config->Get('WebExternalAuth')
1114 && !RT->Config->Get('WebFallbackToInternalAuth')
1117 $res{'Reason'} = $self->loc("External authentication enabled.");
1119 elsif ( !$self->CurrentUser->HasPassword ) {
1120 if ( $self->CurrentUser->id == ($self->id||0) ) {
1121 # don't require current password if user has no
1122 $res{'RequireCurrent'} = 0;
1126 $res{'Reason'} = $self->loc("Your password is not set.");
1135 Returns an authentication string associated with the user. This
1136 string can be used to generate passwordless URLs to integrate
1137 RT with services and programms like callendar managers, rss
1144 my $secret = $self->FirstAttribute("AuthToken");
1145 return $secret->Content if $secret;
1148 $self = RT::User->new( $RT::SystemUser );
1150 $secret = substr(Digest::MD5::md5_hex(time . {} . rand()),0,16);
1151 my ($status, $msg) = $self->SetAttribute( Name => "AuthToken", Content => $secret );
1152 unless ( $status ) {
1153 $RT::Logger->error( "Couldn't set auth token: $msg" );
1159 =head3 GenerateAuthToken
1161 Generate a random authentication string for the user.
1165 sub GenerateAuthToken {
1167 my $token = substr(Digest::MD5::md5_hex(time . {} . rand()),0,16);
1168 return $self->SetAttribute( Name => "AuthToken", Content => $token );
1171 =head3 GenerateAuthString
1173 Takes a string and returns back a hex hash string. Later you can use
1174 this pair to make sure it's generated by this user using L</ValidateAuthString>
1178 sub GenerateAuthString {
1180 my $protect = shift;
1182 my $str = $self->AuthToken . $protect;
1185 return substr(Digest::MD5::md5_hex($str),0,16);
1188 =head3 ValidateAuthString
1190 Takes auth string and protected string. Returns true is protected string
1191 has been protected by user's L</AuthToken>. See also L</GenerateAuthString>.
1195 sub ValidateAuthString {
1197 my $auth_string = shift;
1198 my $protected = shift;
1200 my $str = $self->AuthToken . $protected;
1201 utf8::encode( $str );
1203 return $auth_string eq substr(Digest::MD5::md5_hex($str),0,16);
1208 Toggles the user's disabled flag.
1210 set, all password checks for this user will fail. All ACL checks for this
1211 user will fail. The user will appear in no user listings.
1218 unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1219 return (0, $self->loc('Permission Denied'));
1222 $RT::Handle->BeginTransaction();
1223 my $set_err = $self->PrincipalObj->SetDisabled($val);
1225 $RT::Handle->Rollback();
1226 $RT::Logger->warning(sprintf("Couldn't %s user %s", ($val == 1) ? "disable" : "enable", $self->PrincipalObj->Id));
1229 $self->_NewTransaction( Type => ($val == 1) ? "Disabled" : "Enabled" );
1231 $RT::Handle->Commit();
1234 return (1, $self->loc("User disabled"));
1236 return (1, $self->loc("User enabled"));
1243 Returns true if user is disabled or false otherwise
1249 return $self->PrincipalObj->Disabled(@_);
1254 Returns the principal object for this user. returns an empty RT::Principal
1255 if there's no principal object matching this user.
1256 The response is cached. PrincipalObj should never ever change.
1263 unless ( $self->id ) {
1264 $RT::Logger->error("Couldn't get principal for not loaded object");
1268 my $obj = RT::Principal->new( $self->CurrentUser );
1269 $obj->LoadById( $self->id );
1270 unless ( $obj->id ) {
1271 $RT::Logger->crit( 'No principal for user #'. $self->id );
1273 } elsif ( $obj->PrincipalType ne 'User' ) {
1274 $RT::Logger->crit( 'User #'. $self->id .' has principal of '. $obj->PrincipalType .' type' );
1283 Returns this user's PrincipalId
1292 =head2 HasGroupRight
1294 Takes a paramhash which can contain
1296 GroupObj => RT::Group or Group => integer
1300 Returns 1 if this user has the right specified in the paramhash for the Group
1303 Returns undef if they don't.
1317 if ( defined $args{'Group'} ) {
1318 $args{'GroupObj'} = RT::Group->new( $self->CurrentUser );
1319 $args{'GroupObj'}->Load( $args{'Group'} );
1322 # Validate and load up the GroupId
1323 unless ( ( defined $args{'GroupObj'} ) and ( $args{'GroupObj'}->Id ) ) {
1327 # Figure out whether a user has the right we're asking about.
1328 my $retval = $self->HasRight(
1329 Object => $args{'GroupObj'},
1330 Right => $args{'Right'},
1338 Returns a group collection object containing the groups of which this
1345 my $groups = RT::Groups->new($self->CurrentUser);
1346 $groups->LimitToUserDefinedGroups;
1347 $groups->WithMember(PrincipalId => $self->Id,
1354 Shim around PrincipalObj->HasRight. See L<RT::Principal>.
1360 return $self->PrincipalObj->HasRight(@_);
1363 =head2 CurrentUserCanModify RIGHT
1365 If the user has rights for this object, either because
1366 he has 'AdminUsers' or (if he\'s trying to edit himself and the right isn\'t an
1367 admin right) 'ModifySelf', return 1. otherwise, return undef.
1371 sub CurrentUserCanModify {
1375 if ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1379 #If the field is marked as an "administrators only" field,
1380 # don\'t let the user touch it.
1381 elsif ( $self->_Accessible( $field, 'admin' ) ) {
1385 #If the current user is trying to modify themselves
1386 elsif ( ( $self->id == $self->CurrentUser->id )
1387 and ( $self->CurrentUser->HasRight(Right => 'ModifySelf', Object => $RT::System) ) )
1392 #If we don\'t have a good reason to grant them rights to modify
1400 =head2 CurrentUserHasRight
1402 Takes a single argument. returns 1 if $Self->CurrentUser
1403 has the requested right. returns undef otherwise
1407 sub CurrentUserHasRight {
1411 return ( $self->CurrentUser->HasRight(Right => $right, Object => $RT::System) );
1417 $name = ref($name).'-'.$name->Id;
1420 return 'Pref-'.$name;
1423 =head2 Preferences NAME/OBJ DEFAULT
1425 Obtain user preferences associated with given object or name.
1426 Returns DEFAULT if no preferences found. If DEFAULT is a hashref,
1427 override the entries with user preferences.
1433 my $name = _PrefName (shift);
1434 my $default = shift;
1436 my $attr = RT::Attribute->new( $self->CurrentUser );
1437 $attr->LoadByNameAndObject( Object => $self, Name => $name );
1439 my $content = $attr->Id ? $attr->Content : undef;
1440 unless ( ref $content eq 'HASH' ) {
1441 return defined $content ? $content : $default;
1444 if (ref $default eq 'HASH') {
1445 for (keys %$default) {
1446 exists $content->{$_} or $content->{$_} = $default->{$_};
1449 elsif (defined $default) {
1450 $RT::Logger->error("Preferences $name for user".$self->Id." is hash but default is not");
1455 =head2 SetPreferences NAME/OBJ VALUE
1457 Set user preferences associated with given object or name.
1461 sub SetPreferences {
1463 my $name = _PrefName( shift );
1466 return (0, $self->loc("No permission to set preferences"))
1467 unless $self->CurrentUserCanModify('Preferences');
1469 my $attr = RT::Attribute->new( $self->CurrentUser );
1470 $attr->LoadByNameAndObject( Object => $self, Name => $name );
1472 return $attr->SetContent( $value );
1475 return $self->AddAttribute( Name => $name, Content => $value );
1479 =head2 WatchedQueues ROLE_LIST
1481 Returns a RT::Queues object containing every queue watched by the user.
1483 Takes a list of roles which is some subset of ('Cc', 'AdminCc'). Defaults to:
1485 $user->WatchedQueues('Cc', 'AdminCc');
1492 my @roles = @_ || ('Cc', 'AdminCc');
1494 $RT::Logger->debug('WatcheQueues got user ' . $self->Name);
1496 my $watched_queues = RT::Queues->new($self->CurrentUser);
1498 my $group_alias = $watched_queues->Join(
1502 FIELD2 => 'Instance',
1505 $watched_queues->Limit(
1506 ALIAS => $group_alias,
1508 VALUE => 'RT::Queue-Role',
1509 ENTRYAGGREGATOR => 'AND',
1511 if (grep { $_ eq 'Cc' } @roles) {
1512 $watched_queues->Limit(
1513 SUBCLAUSE => 'LimitToWatchers',
1514 ALIAS => $group_alias,
1517 ENTRYAGGREGATOR => 'OR',
1520 if (grep { $_ eq 'AdminCc' } @roles) {
1521 $watched_queues->Limit(
1522 SUBCLAUSE => 'LimitToWatchers',
1523 ALIAS => $group_alias,
1526 ENTRYAGGREGATOR => 'OR',
1530 my $queues_alias = $watched_queues->Join(
1531 ALIAS1 => $group_alias,
1533 TABLE2 => 'CachedGroupMembers',
1534 FIELD2 => 'GroupId',
1536 $watched_queues->Limit(
1537 ALIAS => $queues_alias,
1538 FIELD => 'MemberId',
1539 VALUE => $self->PrincipalId,
1542 $RT::Logger->debug("WatchedQueues got " . $watched_queues->Count . " queues");
1544 return $watched_queues;
1548 =head2 _CleanupInvalidDelegations { InsideTransaction => undef }
1550 Revokes all ACE entries delegated by this user which are inconsistent
1551 with their current delegation rights. Does not perform permission
1552 checks. Should only ever be called from inside the RT library.
1554 If called from inside a transaction, specify a true value for the
1555 InsideTransaction parameter.
1557 Returns a true value if the deletion succeeded; returns a false value
1558 and logs an internal error if the deletion fails (should not happen).
1562 # XXX Currently there is a _CleanupInvalidDelegations method in both
1563 # RT::User and RT::Group. If the recursive cleanup call for groups is
1564 # ever unrolled and merged, this code will probably want to be
1565 # factored out into RT::Principal.
1567 sub _CleanupInvalidDelegations {
1569 my %args = ( InsideTransaction => undef,
1572 unless ( $self->Id ) {
1573 $RT::Logger->warning("User not loaded.");
1577 my $in_trans = $args{InsideTransaction};
1579 return(1) if ($self->HasRight(Right => 'DelegateRights',
1580 Object => $RT::System));
1582 # Look up all delegation rights currently posessed by this user.
1583 my $deleg_acl = RT::ACL->new($RT::SystemUser);
1584 $deleg_acl->LimitToPrincipal(Type => 'User',
1585 Id => $self->PrincipalId,
1586 IncludeGroupMembership => 1);
1587 $deleg_acl->Limit( FIELD => 'RightName',
1589 VALUE => 'DelegateRights' );
1590 my @allowed_deleg_objects = map {$_->Object()}
1591 @{$deleg_acl->ItemsArrayRef()};
1593 # Look up all rights delegated by this principal which are
1594 # inconsistent with the allowed delegation objects.
1595 my $acl_to_del = RT::ACL->new($RT::SystemUser);
1596 $acl_to_del->DelegatedBy(Id => $self->Id);
1597 foreach (@allowed_deleg_objects) {
1598 $acl_to_del->LimitNotObject($_);
1601 # Delete all disallowed delegations
1602 while ( my $ace = $acl_to_del->Next() ) {
1603 my $ret = $ace->_Delete(InsideTransaction => 1);
1605 $RT::Handle->Rollback() unless $in_trans;
1606 $RT::Logger->warning("Couldn't delete delegated ACL entry ".$ace->Id);
1611 $RT::Handle->Commit() unless $in_trans;
1621 TransactionType => 'Set',
1622 RecordTransaction => 1,
1626 # Nobody is allowed to futz with RT_System or Nobody
1628 if ( ($self->Id == $RT::SystemUser->Id ) ||
1629 ($self->Id == $RT::Nobody->Id)) {
1630 return ( 0, $self->loc("Can not modify system users") );
1632 unless ( $self->CurrentUserCanModify( $args{'Field'} ) ) {
1633 return ( 0, $self->loc("Permission Denied") );
1636 my $Old = $self->SUPER::_Value("$args{'Field'}");
1638 my ($ret, $msg) = $self->SUPER::_Set( Field => $args{'Field'},
1639 Value => $args{'Value'} );
1641 #If we can't actually set the field to the value, don't record
1642 # a transaction. instead, get out of here.
1643 if ( $ret == 0 ) { return ( 0, $msg ); }
1645 if ( $args{'RecordTransaction'} == 1 ) {
1647 my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1648 Type => $args{'TransactionType'},
1649 Field => $args{'Field'},
1650 NewValue => $args{'Value'},
1652 TimeTaken => $args{'TimeTaken'},
1654 return ( $Trans, scalar $TransObj->BriefDescription );
1657 return ( $ret, $msg );
1663 Takes the name of a table column.
1664 Returns its value as a string, if the user passes an ACL check
1673 #If the current user doesn't have ACLs, don't let em at it.
1675 my @PublicFields = qw( Name EmailAddress Organization Disabled
1676 RealName NickName Gecos ExternalAuthId
1677 AuthSystem ExternalContactInfoId
1678 ContactInfoSystem );
1680 #if the field is public, return it.
1681 if ( $self->_Accessible( $field, 'public' ) ) {
1682 return ( $self->SUPER::_Value($field) );
1686 #If the user wants to see their own values, let them
1687 # TODO figure ouyt a better way to deal with this
1688 elsif ( defined($self->Id) && $self->CurrentUser->Id == $self->Id ) {
1689 return ( $self->SUPER::_Value($field) );
1692 #If the user has the admin users right, return the field
1693 elsif ( $self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1694 return ( $self->SUPER::_Value($field) );
1704 Return the friendly name
1710 return $self->RealName if defined($self->RealName);
1711 return $self->Name if defined($self->Name);
1717 Returns the preferred key of the user. If none is set, then this will query
1718 GPG and set the preferred key to the maximally trusted key found (and then
1719 return it). Returns C<undef> if no preferred key can be found.
1726 return undef unless RT->Config->Get('GnuPG')->{'Enable'};
1728 if ( ($self->CurrentUser->Id != $self->Id ) &&
1729 !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1735 my $prefkey = $self->FirstAttribute('PreferredKey');
1736 return $prefkey->Content if $prefkey;
1738 # we don't have a preferred key for this user, so now we must query GPG
1739 require RT::Crypt::GnuPG;
1740 my %res = RT::Crypt::GnuPG::GetKeysForEncryption($self->EmailAddress);
1741 return undef unless defined $res{'info'};
1742 my @keys = @{ $res{'info'} };
1743 return undef if @keys == 0;
1746 $prefkey = $keys[0]->{'Fingerprint'};
1749 # prefer the maximally trusted key
1750 @keys = sort { $b->{'TrustLevel'} <=> $a->{'TrustLevel'} } @keys;
1751 $prefkey = $keys[0]->{'Fingerprint'};
1754 $self->SetAttribute(Name => 'PreferredKey', Content => $prefkey);
1762 #If the user wants to see their own values, let them.
1763 #If the user is an admin, let them.
1764 #Otherwwise, don't let them.
1766 if ( ($self->CurrentUser->Id != $self->Id ) &&
1767 !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1771 my $key = $self->FirstAttribute('PrivateKey') or return undef;
1772 return $key->Content;
1779 unless ($self->CurrentUserCanModify('PrivateKey')) {
1780 return (0, $self->loc("Permission Denied"));
1784 my ($status, $msg) = $self->DeleteAttribute('PrivateKey');
1785 unless ( $status ) {
1786 $RT::Logger->error( "Couldn't delete attribute: $msg" );
1787 return ($status, $self->loc("Couldn't unset private key"));
1789 return ($status, $self->loc("Unset private key"));
1792 # check that it's really private key
1794 my %tmp = RT::Crypt::GnuPG::GetKeysForSigning( $key );
1795 return (0, $self->loc("No such key or it's not suitable for signing"))
1796 if $tmp{'exit_code'} || !$tmp{'info'};
1799 my ($status, $msg) = $self->SetAttribute(
1800 Name => 'PrivateKey',
1803 return ($status, $self->loc("Couldn't set private key"))
1805 return ($status, $self->loc("Set private key"));
1810 [ Name => 'User Id' ],
1811 [ EmailAddress => 'Email' ],
1812 [ RealName => 'Name' ],
1813 [ Organization => 'Organization' ],