1 # BEGIN BPS TAGGED BLOCK {{{
5 # This software is Copyright (c) 1996-2013 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 },
97 PrivateKey => { admin => 1 },
104 =head2 Create { PARAMHASH }
117 _RecordTransaction => 1,
118 @_ # get the real argumentlist
121 # remove the value so it does not cripple SUPER::Create
122 my $record_transaction = delete $args{'_RecordTransaction'};
125 unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
126 return ( 0, $self->loc('Permission Denied') );
130 unless ($self->CanonicalizeUserInfo(\%args)) {
131 return ( 0, $self->loc("Could not set user info") );
134 $args{'EmailAddress'} = $self->CanonicalizeEmailAddress($args{'EmailAddress'});
136 # if the user doesn't have a name defined, set it to the email address
137 $args{'Name'} = $args{'EmailAddress'} unless ($args{'Name'});
141 my $privileged = delete $args{'Privileged'};
144 if ($args{'CryptedPassword'} ) {
145 $args{'Password'} = $args{'CryptedPassword'};
146 delete $args{'CryptedPassword'};
148 elsif ( !$args{'Password'} ) {
149 $args{'Password'} = '*NO-PASSWORD*';
151 elsif ( length( $args{'Password'} ) < RT->Config->Get('MinimumPasswordLength') ) {
152 return ( 0, $self->loc("Password needs to be at least [_1] characters long",RT->Config->Get('MinimumPasswordLength')) );
156 $args{'Password'} = $self->_GeneratePassword($args{'Password'});
159 #TODO Specify some sensible defaults.
161 unless ( $args{'Name'} ) {
162 return ( 0, $self->loc("Must specify 'Name' attribute") );
165 #SANITY CHECK THE NAME AND ABORT IF IT'S TAKEN
166 if ($RT::SystemUser) { #This only works if RT::SystemUser has been defined
167 my $TempUser = RT::User->new($RT::SystemUser);
168 $TempUser->Load( $args{'Name'} );
169 return ( 0, $self->loc('Name in use') ) if ( $TempUser->Id );
171 my ($val, $message) = $self->ValidateEmailAddress( $args{'EmailAddress'} );
172 return (0, $message) unless ( $val );
175 $RT::Logger->warning( "$self couldn't check for pre-existing users");
179 $RT::Handle->BeginTransaction();
180 # Groups deal with principal ids, rather than user ids.
181 # When creating this user, set up a principal Id for it.
182 my $principal = RT::Principal->new($self->CurrentUser);
183 my $principal_id = $principal->Create(PrincipalType => 'User',
184 Disabled => $args{'Disabled'},
186 # If we couldn't create a principal Id, get the fuck out.
187 unless ($principal_id) {
188 $RT::Handle->Rollback();
189 $RT::Logger->crit("Couldn't create a Principal on new user create.");
190 $RT::Logger->crit("Strange things are afoot at the circle K");
191 return ( 0, $self->loc('Could not create user') );
194 $principal->__Set(Field => 'ObjectId', Value => $principal_id);
195 delete $args{'Disabled'};
197 $self->SUPER::Create(id => $principal_id , %args);
200 #If the create failed.
202 $RT::Handle->Rollback();
203 $RT::Logger->error("Could not create a new user - " .join('-', %args));
205 return ( 0, $self->loc('Could not create user') );
208 my $aclstash = RT::Group->new($self->CurrentUser);
209 my $stash_id = $aclstash->_CreateACLEquivalenceGroup($principal);
212 $RT::Handle->Rollback();
213 $RT::Logger->crit("Couldn't stash the user in groupmembers");
214 return ( 0, $self->loc('Could not create user') );
218 my $everyone = RT::Group->new($self->CurrentUser);
219 $everyone->LoadSystemInternalGroup('Everyone');
220 unless ($everyone->id) {
221 $RT::Logger->crit("Could not load Everyone group on user creation.");
222 $RT::Handle->Rollback();
223 return ( 0, $self->loc('Could not create user') );
227 my ($everyone_id, $everyone_msg) = $everyone->_AddMember( InsideTransaction => 1, PrincipalId => $self->PrincipalId);
228 unless ($everyone_id) {
229 $RT::Logger->crit("Could not add user to Everyone group on user creation.");
230 $RT::Logger->crit($everyone_msg);
231 $RT::Handle->Rollback();
232 return ( 0, $self->loc('Could not create user') );
236 my $access_class = RT::Group->new($self->CurrentUser);
238 $access_class->LoadSystemInternalGroup('Privileged');
240 $access_class->LoadSystemInternalGroup('Unprivileged');
243 unless ($access_class->id) {
244 $RT::Logger->crit("Could not load Privileged or Unprivileged group on user creation");
245 $RT::Handle->Rollback();
246 return ( 0, $self->loc('Could not create user') );
250 my ($ac_id, $ac_msg) = $access_class->_AddMember( InsideTransaction => 1, PrincipalId => $self->PrincipalId);
253 $RT::Logger->crit("Could not add user to Privileged or Unprivileged group on user creation. Aborted");
254 $RT::Logger->crit($ac_msg);
255 $RT::Handle->Rollback();
256 return ( 0, $self->loc('Could not create user') );
260 if ( $record_transaction ) {
261 $self->_NewTransaction( Type => "Create" );
266 return ( $id, $self->loc('User created') );
269 =head2 SetPrivileged BOOL
271 If passed a true value, makes this user a member of the "Privileged" PseudoGroup.
272 Otherwise, makes this user a member of the "Unprivileged" pseudogroup.
274 Returns a standard RT tuple of (val, msg);
284 unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
285 return ( 0, $self->loc('Permission Denied') );
288 my $priv = RT::Group->new($self->CurrentUser);
289 $priv->LoadSystemInternalGroup('Privileged');
291 $RT::Logger->crit("Could not find Privileged pseudogroup");
292 return(0,$self->loc("Failed to find 'Privileged' users pseudogroup."));
295 my $unpriv = RT::Group->new($self->CurrentUser);
296 $unpriv->LoadSystemInternalGroup('Unprivileged');
297 unless ($unpriv->Id) {
298 $RT::Logger->crit("Could not find unprivileged pseudogroup");
299 return(0,$self->loc("Failed to find 'Unprivileged' users pseudogroup"));
302 my $principal = $self->PrincipalId;
304 if ($priv->HasMember($principal)) {
305 #$RT::Logger->debug("That user is already privileged");
306 return (0,$self->loc("That user is already privileged"));
308 if ($unpriv->HasMember($principal)) {
309 $unpriv->_DeleteMember($principal);
311 # if we had layered transactions, life would be good
312 # sadly, we have to just go ahead, even if something
314 $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
315 "unprivileged. something is drastically wrong.");
317 my ($status, $msg) = $priv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
319 return (1, $self->loc("That user is now privileged"));
325 if ($unpriv->HasMember($principal)) {
326 #$RT::Logger->debug("That user is already unprivileged");
327 return (0,$self->loc("That user is already unprivileged"));
329 if ($priv->HasMember($principal)) {
330 $priv->_DeleteMember( $principal );
332 # if we had layered transactions, life would be good
333 # sadly, we have to just go ahead, even if something
335 $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
336 "unprivileged. something is drastically wrong.");
338 my ($status, $msg) = $unpriv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
340 return (1, $self->loc("That user is now unprivileged"));
349 Returns true if this user is privileged. Returns undef otherwise.
355 my $priv = RT::Group->new($self->CurrentUser);
356 $priv->LoadSystemInternalGroup('Privileged');
357 if ( $priv->HasMember( $self->PrincipalId ) ) {
365 #create a user without validating _any_ data.
367 #To be used only on database init.
368 # We can't localize here because it's before we _have_ a loc framework
370 sub _BootstrapCreate {
374 $args{'Password'} = '*NO-PASSWORD*';
377 $RT::Handle->BeginTransaction();
379 # Groups deal with principal ids, rather than user ids.
380 # When creating this user, set up a principal Id for it.
381 my $principal = RT::Principal->new($self->CurrentUser);
382 my $principal_id = $principal->Create(PrincipalType => 'User', ObjectId => '0');
383 $principal->__Set(Field => 'ObjectId', Value => $principal_id);
385 # If we couldn't create a principal Id, get the fuck out.
386 unless ($principal_id) {
387 $RT::Handle->Rollback();
388 $RT::Logger->crit("Couldn't create a Principal on new user create. Strange things are afoot at the circle K");
389 return ( 0, 'Could not create user' );
391 $self->SUPER::Create(id => $principal_id, %args);
393 #If the create failed.
395 $RT::Handle->Rollback();
396 return ( 0, 'Could not create user' ) ; #never loc this
399 my $aclstash = RT::Group->new($self->CurrentUser);
400 my $stash_id = $aclstash->_CreateACLEquivalenceGroup($principal);
403 $RT::Handle->Rollback();
404 $RT::Logger->crit("Couldn't stash the user in groupmembers");
405 return ( 0, $self->loc('Could not create user') );
409 $RT::Handle->Commit();
411 return ( $id, 'User created' );
417 return ( 0, $self->loc('Deleting this object would violate referential integrity') );
423 Load a user object from the database. Takes a single argument.
424 If the argument is numerical, load by the column 'id'. If a user
425 object or its subclass passed then loads the same user by id.
426 Otherwise, load by the "Name" column which is the user's textual
433 my $identifier = shift || return undef;
435 if ( $identifier !~ /\D/ ) {
436 return $self->SUPER::LoadById( $identifier );
438 elsif ( UNIVERSAL::isa( $identifier, 'RT::User' ) ) {
439 return $self->SUPER::LoadById( $identifier->Id );
442 return $self->LoadByCol( "Name", $identifier );
448 Tries to load this user object from the database by the user's email address.
456 # Never load an empty address as an email address.
461 $address = $self->CanonicalizeEmailAddress($address);
463 #$RT::Logger->debug("Trying to load an email address: $address");
464 return $self->LoadByCol( "EmailAddress", $address );
467 =head2 LoadOrCreateByEmail ADDRESS
469 Attempts to find a user who has the provided email address. If that fails, creates an unprivileged user with
470 the provided email address and loads them. Address can be provided either as L<Email::Address> object
471 or string which is parsed using the module.
473 Returns a tuple of the user's id and a status message.
474 0 will be returned in place of the user's id in case of failure.
478 sub LoadOrCreateByEmail {
482 my ($message, $name);
483 if ( UNIVERSAL::isa( $email => 'Email::Address' ) ) {
484 ($email, $name) = ($email->address, $email->phrase);
486 ($email, $name) = RT::Interface::Email::ParseAddressFromHeader( $email );
489 $self->LoadByEmail( $email );
490 $self->Load( $email ) unless $self->Id;
491 $message = $self->loc('User loaded');
493 unless( $self->Id ) {
495 ($val, $message) = $self->Create(
497 EmailAddress => $email,
500 Comments => 'Autocreated when added as a watcher',
503 # Deal with the race condition of two account creations at once
504 $self->LoadByEmail( $email );
505 unless ( $self->Id ) {
507 $self->LoadByEmail( $email );
510 $RT::Logger->error("Recovered from creation failure due to race condition");
511 $message = $self->loc("User loaded");
514 $RT::Logger->crit("Failed to create user ". $email .": " .$message);
518 return (0, $message) unless $self->id;
519 return ($self->Id, $message);
522 =head2 ValidateEmailAddress ADDRESS
524 Returns true if the email address entered is not in use by another user or is
525 undef or ''. Returns false if it's in use.
529 sub ValidateEmailAddress {
533 # if the email address is null, it's always valid
534 return (1) if ( !$Value || $Value eq "" );
536 if ( RT->Config->Get('ValidateUserEmailAddresses') ) {
537 # We only allow one valid email address
538 my @addresses = Email::Address->parse($Value);
539 return ( 0, $self->loc('Invalid syntax for email address') ) unless ( ( scalar (@addresses) == 1 ) && ( $addresses[0]->address ) );
543 my $TempUser = RT::User->new($RT::SystemUser);
544 $TempUser->LoadByEmail($Value);
546 if ( $TempUser->id && ( !$self->id || $TempUser->id != $self->id ) )
547 { # if we found a user with that address
548 # it's invalid to set this user's address to it
549 return ( 0, $self->loc('Email address in use') );
551 else { #it's a valid email address
556 =head2 SetEmailAddress
558 Check to make sure someone else isn't using this email address already
559 so that a better email address can be returned
563 sub SetEmailAddress {
567 my ($val, $message) = $self->ValidateEmailAddress( $Value );
569 return $self->_Set( Field => 'EmailAddress', Value => $Value );
571 return ( 0, $message )
576 =head2 EmailFrequency
578 Takes optional Ticket argument in paramhash. Returns 'no email',
579 'squelched', 'daily', 'weekly' or empty string depending on
584 =item 'no email' - user has no email, so can not recieve notifications.
586 =item 'squelched' - returned only when Ticket argument is provided and
587 notifications to the user has been supressed for this ticket.
589 =item 'daily' - retruned when user recieve daily messages digest instead
590 of immediate delivery.
592 =item 'weekly' - previous, but weekly.
594 =item empty string returned otherwise.
606 return '' unless $self->id && $self->id != $RT::Nobody->id
607 && $self->id != $RT::SystemUser->id;
608 return 'no email' unless my $email = $self->EmailAddress;
609 return 'squelched' if $args{'Ticket'} &&
610 grep lc $email eq lc $_->Content, $args{'Ticket'}->SquelchMailTo;
611 my $frequency = RT->Config->Get( 'EmailFrequency', $self ) || '';
612 return 'daily' if $frequency =~ /daily/i;
613 return 'weekly' if $frequency =~ /weekly/i;
617 =head2 CanonicalizeEmailAddress ADDRESS
619 CanonicalizeEmailAddress converts email addresses into canonical form.
620 it takes one email address in and returns the proper canonical
621 form. You can dump whatever your proper local config is in here. Note
622 that it may be called as a static method; in this case the first argument
623 is class name not an object.
627 sub CanonicalizeEmailAddress {
630 # Example: the following rule would treat all email
631 # coming from a subdomain as coming from second level domain
633 if ( my $match = RT->Config->Get('CanonicalizeEmailAddressMatch') and
634 my $replace = RT->Config->Get('CanonicalizeEmailAddressReplace') )
636 $email =~ s/$match/$replace/gi;
641 =head2 CanonicalizeUserInfo HASH of ARGS
643 CanonicalizeUserInfo can convert all User->Create options.
644 it takes a hashref of all the params sent to User->Create and
645 returns that same hash, by default nothing is done.
647 This function is intended to allow users to have their info looked up via
648 an outside source and modified upon creation.
652 sub CanonicalizeUserInfo {
661 =head2 Password and authentication related functions
663 =head3 SetRandomPassword
665 Takes no arguments. Returns a status code and a new password or an error message.
666 If the status is 1, the second value returned is the new password.
667 If the status is anything else, the new value returned is the error code.
671 sub SetRandomPassword {
674 unless ( $self->CurrentUserCanModify('Password') ) {
675 return ( 0, $self->loc("Permission Denied") );
679 my $min = ( RT->Config->Get('MinimumPasswordLength') > 6 ? RT->Config->Get('MinimumPasswordLength') : 6);
680 my $max = ( RT->Config->Get('MinimumPasswordLength') > 8 ? RT->Config->Get('MinimumPasswordLength') : 8);
682 my $pass = $self->GenerateRandomPassword( $min, $max) ;
684 # If we have "notify user on
686 my ( $val, $msg ) = $self->SetPassword($pass);
688 #If we got an error return the error.
689 return ( 0, $msg ) unless ($val);
691 #Otherwise, we changed the password, lets return it.
698 Returns status, [ERROR or new password]. Resets this user\'s password to
699 a randomly generated pronouncable password and emails them, using a
700 global template called "RT_PasswordChange", which can be overridden
701 with global templates "RT_PasswordChange_Privileged" or "RT_PasswordChange_NonPrivileged"
702 for privileged and Non-privileged users respectively.
709 unless ( $self->CurrentUserCanModify('Password') ) {
710 return ( 0, $self->loc("Permission Denied") );
712 my ( $status, $pass ) = $self->SetRandomPassword();
715 return ( 0, "$pass" );
718 my $ret = RT::Interface::Email::SendEmailUsingTemplate(
719 To => $self->EmailAddress,
720 Template => 'PasswordChange',
722 NewPassword => $pass,
727 return ( 1, $self->loc('New password notification sent') );
730 return ( 0, $self->loc('Notification could not be sent') );
735 =head3 GenerateRandomPassword MIN_LEN and MAX_LEN
737 Returns a random password between MIN_LEN and MAX_LEN characters long.
741 sub GenerateRandomPassword {
743 my $min_length = shift;
744 my $max_length = shift;
746 #This code derived from mpw.pl, a bit of code with a sordid history
749 # Perl cleaned up a bit by Jesse Vincent 1/14/2001.
750 # Converted to perl from C by Marc Horowitz, 1/20/2000.
751 # Converted to C from Multics PL/I by Bill Sommerfeld, 4/21/86.
752 # Original PL/I version provided by Jerry Saltzer.
754 my ( $frequency, $start_freq, $total_sum, $row_sums );
756 #When munging characters, we need to know where to start counting letters from
759 # frequency of English digraphs (from D Edwards 1/27/66)
762 4, 20, 28, 52, 2, 11, 28, 4, 32, 4, 6, 62, 23, 167,
763 2, 14, 0, 83, 76, 127, 7, 25, 8, 1, 9, 1
766 13, 0, 0, 0, 55, 0, 0, 0, 8, 2, 0, 22, 0, 0,
767 11, 0, 0, 15, 4, 2, 13, 0, 0, 0, 15, 0
770 32, 0, 7, 1, 69, 0, 0, 33, 17, 0, 10, 9, 1, 0,
771 50, 3, 0, 10, 0, 28, 11, 0, 0, 0, 3, 0
774 40, 16, 9, 5, 65, 18, 3, 9, 56, 0, 1, 4, 15, 6,
775 16, 4, 0, 21, 18, 53, 19, 5, 15, 0, 3, 0
778 84, 20, 55, 125, 51, 40, 19, 16, 50, 1,
779 4, 55, 54, 146, 35, 37, 6, 191, 149, 65,
783 19, 3, 5, 1, 19, 21, 1, 3, 30, 2, 0, 11, 1, 0,
784 51, 0, 0, 26, 8, 47, 6, 3, 3, 0, 2, 0
787 20, 4, 3, 2, 35, 1, 3, 15, 18, 0, 0, 5, 1, 4,
788 21, 1, 1, 20, 9, 21, 9, 0, 5, 0, 1, 0
791 101, 1, 3, 0, 270, 5, 1, 6, 57, 0, 0, 0, 3, 2,
792 44, 1, 0, 3, 10, 18, 6, 0, 5, 0, 3, 0
795 40, 7, 51, 23, 25, 9, 11, 3, 0, 0, 2, 38, 25, 202,
796 56, 12, 1, 46, 79, 117, 1, 22, 0, 4, 0, 3
799 3, 0, 0, 0, 5, 0, 0, 0, 1, 0, 0, 0, 0, 0,
800 4, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0
803 1, 0, 0, 0, 11, 0, 0, 0, 13, 0, 0, 0, 0, 2,
804 0, 0, 0, 0, 6, 2, 1, 0, 2, 0, 1, 0
807 44, 2, 5, 12, 62, 7, 5, 2, 42, 1, 1, 53, 2, 2,
808 25, 1, 1, 2, 16, 23, 9, 0, 1, 0, 33, 0
811 52, 14, 1, 0, 64, 0, 0, 3, 37, 0, 0, 0, 7, 1,
812 17, 18, 1, 2, 12, 3, 8, 0, 1, 0, 2, 0
815 42, 10, 47, 122, 63, 19, 106, 12, 30, 1,
816 6, 6, 9, 7, 54, 7, 1, 7, 44, 124,
820 7, 12, 14, 17, 5, 95, 3, 5, 14, 0, 0, 19, 41, 134,
821 13, 23, 0, 91, 23, 42, 55, 16, 28, 0, 4, 1
824 19, 1, 0, 0, 37, 0, 0, 4, 8, 0, 0, 15, 1, 0,
825 27, 9, 0, 33, 14, 7, 6, 0, 0, 0, 0, 0
828 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
829 0, 0, 0, 0, 0, 0, 17, 0, 0, 0, 0, 0
832 83, 8, 16, 23, 169, 4, 8, 8, 77, 1, 10, 5, 26, 16,
833 60, 4, 0, 24, 37, 55, 6, 11, 4, 0, 28, 0
836 65, 9, 17, 9, 73, 13, 1, 47, 75, 3, 0, 7, 11, 12,
837 56, 17, 6, 9, 48, 116, 35, 1, 28, 0, 4, 0
840 57, 22, 3, 1, 76, 5, 2, 330, 126, 1,
841 0, 14, 10, 6, 79, 7, 0, 49, 50, 56,
845 11, 5, 9, 6, 9, 1, 6, 0, 9, 0, 1, 19, 5, 31,
846 1, 15, 0, 47, 39, 31, 0, 3, 0, 0, 0, 0
849 7, 0, 0, 0, 72, 0, 0, 0, 28, 0, 0, 0, 0, 0,
850 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0
853 36, 1, 1, 0, 38, 0, 0, 33, 36, 0, 0, 4, 1, 8,
854 15, 0, 0, 0, 4, 2, 0, 0, 1, 0, 0, 0
857 1, 0, 2, 0, 0, 1, 0, 0, 3, 0, 0, 0, 0, 0,
858 1, 5, 0, 0, 0, 3, 0, 0, 1, 0, 0, 0
861 14, 5, 4, 2, 7, 12, 12, 6, 10, 0, 0, 3, 7, 5,
862 17, 3, 0, 4, 16, 30, 0, 0, 5, 0, 0, 0
865 1, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0,
866 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
870 #We need to know the totals for each row
874 map { $sum += $_ } @$_;
879 #Frequency with which a given letter starts a word.
881 1299, 425, 725, 271, 375, 470, 93, 223, 1009, 24,
882 20, 355, 379, 319, 823, 618, 21, 317, 962, 1991,
883 271, 104, 516, 6, 16, 14
887 map { $total_sum += $_ } @$start_freq;
889 my $length = $min_length + int( rand( $max_length - $min_length ) );
891 my $char = $self->_GenerateRandomNextChar( $total_sum, $start_freq );
892 my @word = ( $char + $a );
893 for ( 2 .. $length ) {
895 $self->_GenerateRandomNextChar( $row_sums->[$char],
896 $frequency->[$char] );
897 push ( @word, $char + $a );
901 return pack( "C*", @word );
905 #A private helper function for RandomPassword
906 # Takes a row summary and a frequency chart for the next character to be searched
907 sub _GenerateRandomNextChar {
909 my ( $all, $freq ) = @_;
912 for ( $pos = int( rand($all) ), $i = 0 ;
913 $pos >= $freq->[$i] ;
914 $pos -= $freq->[$i], $i++ )
921 sub SafeSetPassword {
926 Confirmation => undef,
929 return (1) unless defined $args{'New'} && length $args{'New'};
931 my %cond = $self->CurrentUserRequireToSetPassword;
933 unless ( $cond{'CanSet'} ) {
934 return (0, $self->loc('You can not set password.') .' '. $cond{'Reason'} );
938 if ( $cond{'RequireCurrent'} && !$self->CurrentUser->IsPassword($args{'Current'}) ) {
939 if ( defined $args{'Current'} && length $args{'Current'} ) {
940 $error = $self->loc("Please enter your current password correctly.");
943 $error = $self->loc("Please enter your current password.");
945 } elsif ( $args{'New'} ne $args{'Confirmation'} ) {
946 $error = $self->loc("Passwords do not match.");
950 $error .= ' '. $self->loc('Password has not been set.');
954 return $self->SetPassword( $args{'New'} );
959 Takes a string. Checks the string's length and sets this user's password
966 my $password = shift;
968 unless ( $self->CurrentUserCanModify('Password') ) {
969 return ( 0, $self->loc('Password: Permission Denied') );
973 return ( 0, $self->loc("No password set") );
975 elsif ( length($password) < RT->Config->Get('MinimumPasswordLength') ) {
976 return ( 0, $self->loc("Password needs to be at least [_1] characters long", RT->Config->Get('MinimumPasswordLength')) );
979 my $new = !$self->HasPassword;
980 $password = $self->_GeneratePassword($password);
981 my ( $val, $msg ) = $self->SUPER::SetPassword($password);
983 return ( 1, $self->loc("Password set") ) if $new;
984 return ( 1, $self->loc("Password changed") );
987 return ( $val, $msg );
993 =head3 _GeneratePassword PASSWORD [, SALT]
995 Returns a salted SHA-256 hash of the password passed in, in base64
1000 sub _GeneratePassword {
1002 my ($password, $salt) = @_;
1004 # Generate a random 4-byte salt
1005 $salt ||= pack("C4",map{int rand(256)} 1..4);
1007 # Encode the salt, and a truncated SHA256 of the MD5 of the
1008 # password. The additional, un-necessary level of MD5 allows for
1009 # transparent upgrading to this scheme, from the previous unsalted
1011 return MIME::Base64::encode_base64(
1012 $salt . substr(Digest::SHA::sha256($salt . Digest::MD5::md5($password)),0,26),
1017 =head3 _GeneratePasswordBase64 PASSWORD
1019 returns an MD5 hash of the password passed in, in base64 encoding
1024 sub _GeneratePasswordBase64 {
1026 my $password = shift;
1028 my $md5 = Digest::MD5->new();
1029 $md5->add(encode_utf8($password));
1030 return ($md5->b64digest);
1036 Returns true if the user has a valid password, otherwise returns false.
1042 my $pwd = $self->__Value('Password');
1043 return undef if !defined $pwd
1045 || $pwd eq '*NO-PASSWORD*';
1051 Returns true if the passed in value is this user's password.
1052 Returns undef otherwise.
1060 #TODO there isn't any apparent way to legitimately ACL this
1062 # RT does not allow null passwords
1063 if ( ( !defined($value) ) or ( $value eq '' ) ) {
1067 if ( $self->PrincipalObj->Disabled ) {
1069 "Disabled user " . $self->Name . " tried to log in" );
1073 unless ($self->HasPassword) {
1077 my $stored = $self->__Value('Password');
1078 if (length $stored == 40) {
1079 # The truncated SHA256(salt,MD5(passwd)) form from 2010/12 is 40 characters long
1080 my $hash = MIME::Base64::decode_base64($stored);
1081 # The first 4 bytes are the salt, the rest is substr(SHA256,0,26)
1082 my $salt = substr($hash, 0, 4, "");
1083 return substr(Digest::SHA::sha256($salt . Digest::MD5::md5($value)), 0, 26) eq $hash;
1084 } elsif (length $stored == 32) {
1086 return 0 unless Digest::MD5::md5_hex(encode_utf8($value)) eq $stored;
1087 } elsif (length $stored == 22) {
1088 # Base64 nonsalted-md5
1089 return 0 unless Digest::MD5::md5_base64(encode_utf8($value)) eq $stored;
1090 } elsif (length $stored == 13) {
1092 return 0 unless crypt(encode_utf8($value), $stored) eq $stored;
1094 $RT::Logger->warning("Unknown password form");
1098 # We got here by validating successfully, but with a legacy
1099 # password form. Update to the most recent form.
1100 my $obj = $self->isa("RT::CurrentUser") ? $self->UserObj : $self;
1101 $obj->_Set(Field => 'Password', Value => $self->_GeneratePassword($value) );
1105 sub CurrentUserRequireToSetPassword {
1111 RequireCurrent => 1,
1114 if ( RT->Config->Get('WebExternalAuth')
1115 && !RT->Config->Get('WebFallbackToInternalAuth')
1118 $res{'Reason'} = $self->loc("External authentication enabled.");
1120 elsif ( !$self->CurrentUser->HasPassword ) {
1121 if ( $self->CurrentUser->id == ($self->id||0) ) {
1122 # don't require current password if user has no
1123 $res{'RequireCurrent'} = 0;
1127 $res{'Reason'} = $self->loc("Your password is not set.");
1136 Returns an authentication string associated with the user. This
1137 string can be used to generate passwordless URLs to integrate
1138 RT with services and programms like callendar managers, rss
1145 my $secret = $self->FirstAttribute("AuthToken");
1146 return $secret->Content if $secret;
1149 $self = RT::User->new( $RT::SystemUser );
1151 $secret = substr(Digest::MD5::md5_hex(time . {} . rand()),0,16);
1152 my ($status, $msg) = $self->SetAttribute( Name => "AuthToken", Content => $secret );
1153 unless ( $status ) {
1154 $RT::Logger->error( "Couldn't set auth token: $msg" );
1160 =head3 GenerateAuthToken
1162 Generate a random authentication string for the user.
1166 sub GenerateAuthToken {
1168 my $token = substr(Digest::MD5::md5_hex(time . {} . rand()),0,16);
1169 return $self->SetAttribute( Name => "AuthToken", Content => $token );
1172 =head3 GenerateAuthString
1174 Takes a string and returns back a hex hash string. Later you can use
1175 this pair to make sure it's generated by this user using L</ValidateAuthString>
1179 sub GenerateAuthString {
1181 my $protect = shift;
1183 my $str = $self->AuthToken . $protect;
1186 return substr(Digest::MD5::md5_hex($str),0,16);
1189 =head3 ValidateAuthString
1191 Takes auth string and protected string. Returns true is protected string
1192 has been protected by user's L</AuthToken>. See also L</GenerateAuthString>.
1196 sub ValidateAuthString {
1198 my $auth_string = shift;
1199 my $protected = shift;
1201 my $str = $self->AuthToken . $protected;
1202 utf8::encode( $str );
1204 return $auth_string eq substr(Digest::MD5::md5_hex($str),0,16);
1209 Toggles the user's disabled flag.
1211 set, all password checks for this user will fail. All ACL checks for this
1212 user will fail. The user will appear in no user listings.
1219 unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1220 return (0, $self->loc('Permission Denied'));
1223 $RT::Handle->BeginTransaction();
1224 my $set_err = $self->PrincipalObj->SetDisabled($val);
1226 $RT::Handle->Rollback();
1227 $RT::Logger->warning(sprintf("Couldn't %s user %s", ($val == 1) ? "disable" : "enable", $self->PrincipalObj->Id));
1230 $self->_NewTransaction( Type => ($val == 1) ? "Disabled" : "Enabled" );
1232 $RT::Handle->Commit();
1235 return (1, $self->loc("User disabled"));
1237 return (1, $self->loc("User enabled"));
1244 Returns true if user is disabled or false otherwise
1250 return $self->PrincipalObj->Disabled(@_);
1255 Returns the principal object for this user. returns an empty RT::Principal
1256 if there's no principal object matching this user.
1257 The response is cached. PrincipalObj should never ever change.
1264 unless ( $self->id ) {
1265 $RT::Logger->error("Couldn't get principal for not loaded object");
1269 my $obj = RT::Principal->new( $self->CurrentUser );
1270 $obj->LoadById( $self->id );
1271 unless ( $obj->id ) {
1272 $RT::Logger->crit( 'No principal for user #'. $self->id );
1274 } elsif ( $obj->PrincipalType ne 'User' ) {
1275 $RT::Logger->crit( 'User #'. $self->id .' has principal of '. $obj->PrincipalType .' type' );
1284 Returns this user's PrincipalId
1293 =head2 HasGroupRight
1295 Takes a paramhash which can contain
1297 GroupObj => RT::Group or Group => integer
1301 Returns 1 if this user has the right specified in the paramhash for the Group
1304 Returns undef if they don't.
1318 if ( defined $args{'Group'} ) {
1319 $args{'GroupObj'} = RT::Group->new( $self->CurrentUser );
1320 $args{'GroupObj'}->Load( $args{'Group'} );
1323 # Validate and load up the GroupId
1324 unless ( ( defined $args{'GroupObj'} ) and ( $args{'GroupObj'}->Id ) ) {
1328 # Figure out whether a user has the right we're asking about.
1329 my $retval = $self->HasRight(
1330 Object => $args{'GroupObj'},
1331 Right => $args{'Right'},
1339 Returns a group collection object containing the groups of which this
1346 my $groups = RT::Groups->new($self->CurrentUser);
1347 $groups->LimitToUserDefinedGroups;
1348 $groups->WithMember(PrincipalId => $self->Id,
1357 #much false laziness w/Ticket_Overlay.pm. now with RT 3.8!
1359 # A helper table for links mapping to make it easier
1360 # to build and parse links between tickets
1362 use vars '%LINKDIRMAP';
1365 MemberOf => { Base => 'MemberOf',
1366 Target => 'HasMember', },
1367 RefersTo => { Base => 'RefersTo',
1368 Target => 'ReferredToBy', },
1369 DependsOn => { Base => 'DependsOn',
1370 Target => 'DependedOnBy', },
1371 MergedInto => { Base => 'MergedInto',
1372 Target => 'MergedInto', },
1376 sub LINKDIRMAP { return \%LINKDIRMAP }
1381 # #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1382 # #tobias meant by $f
1383 # my $field = shift;
1384 # my $type = shift || "";
1386 # unless ( $self->{"$field$type"} ) {
1387 # $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
1388 # if ( $self->CurrentUserHasRight('ShowTicket') ) {
1389 # # Maybe this ticket is a merged ticket
1390 # my $Tickets = new RT::Tickets( $self->CurrentUser );
1391 # # at least to myself
1392 # $self->{"$field$type"}->Limit( FIELD => $field,
1393 # VALUE => $self->URI,
1394 # ENTRYAGGREGATOR => 'OR' );
1395 # $Tickets->Limit( FIELD => 'EffectiveId',
1396 # VALUE => $self->EffectiveId );
1397 # while (my $Ticket = $Tickets->Next) {
1398 # $self->{"$field$type"}->Limit( FIELD => $field,
1399 # VALUE => $Ticket->URI,
1400 # ENTRYAGGREGATOR => 'OR' );
1402 # $self->{"$field$type"}->Limit( FIELD => 'Type',
1407 # return ( $self->{"$field$type"} );
1412 Delete a link. takes a paramhash of Base, Target and Type.
1413 Either Base or Target must be null. The null value will
1414 be replaced with this ticket\'s id
1427 unless ( $args{'Target'} || $args{'Base'} ) {
1428 $RT::Logger->error("Base or Target must be specified\n");
1429 return ( 0, $self->loc('Either base or target must be specified') );
1434 $right++ if $self->CurrentUserHasRight('AdminUsers');
1435 if ( !$right && $RT::StrictLinkACL ) {
1436 return ( 0, $self->loc("Permission Denied") );
1439 # # If the other URI is an RT::Ticket, we want to make sure the user
1440 # # can modify it too...
1441 # my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
1442 # return (0, $msg) unless $status;
1443 # if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
1446 # if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
1447 # ( $RT::StrictLinkACL && $right < 2 ) )
1449 # return ( 0, $self->loc("Permission Denied") );
1452 my ($val, $Msg) = $self->SUPER::_DeleteLink(%args);
1455 $RT::Logger->debug("Couldn't find that link\n");
1459 my ($direction, $remote_link);
1461 if ( $args{'Base'} ) {
1462 $remote_link = $args{'Base'};
1463 $direction = 'Target';
1465 elsif ( $args{'Target'} ) {
1466 $remote_link = $args{'Target'};
1470 if ( $args{'Silent'} ) {
1471 return ( $val, $Msg );
1474 my $remote_uri = RT::URI->new( $self->CurrentUser );
1475 $remote_uri->FromURI( $remote_link );
1477 my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1478 Type => 'DeleteLink',
1479 Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
1480 OldValue => $remote_uri->URI || $remote_link,
1484 if ( $remote_uri->IsLocal ) {
1486 my $OtherObj = $remote_uri->Object;
1487 my ( $val, $Msg ) = $OtherObj->_NewTransaction(Type => 'DeleteLink',
1488 Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
1489 : $LINKDIRMAP{$args{'Type'}}->{Target},
1490 OldValue => $self->URI,
1491 ActivateScrips => ! $RT::LinkTransactionsRun1Scrip,
1495 return ( $Trans, $Msg );
1501 my %args = ( Target => '',
1507 unless ( $args{'Target'} || $args{'Base'} ) {
1508 $RT::Logger->error("Base or Target must be specified\n");
1509 return ( 0, $self->loc('Either base or target must be specified') );
1513 $right++ if $self->CurrentUserHasRight('AdminUsers');
1514 if ( !$right && $RT::StrictLinkACL ) {
1515 return ( 0, $self->loc("Permission Denied") );
1518 # # If the other URI is an RT::Ticket, we want to make sure the user
1519 # # can modify it too...
1520 # my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
1521 # return (0, $msg) unless $status;
1522 # if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
1525 # if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
1526 # ( $RT::StrictLinkACL && $right < 2 ) )
1528 # return ( 0, $self->loc("Permission Denied") );
1531 return $self->_AddLink(%args);
1534 #sub __GetTicketFromURI {
1536 # my %args = ( URI => '', @_ );
1538 # # If the other URI is an RT::Ticket, we want to make sure the user
1539 # # can modify it too...
1540 # my $uri_obj = RT::URI->new( $self->CurrentUser );
1541 # $uri_obj->FromURI( $args{'URI'} );
1543 # unless ( $uri_obj->Resolver && $uri_obj->Scheme ) {
1544 # my $msg = $self->loc( "Couldn't resolve '[_1]' into a URI.", $args{'URI'} );
1545 # $RT::Logger->warning( "$msg\n" );
1546 # return( 0, $msg );
1548 # my $obj = $uri_obj->Resolver->Object;
1549 # unless ( UNIVERSAL::isa($obj, 'RT::Ticket') && $obj->id ) {
1550 # return (1, 'Found not a ticket', undef);
1552 # return (1, 'Found ticket', $obj);
1557 Private non-acled variant of AddLink so that links can be added during create.
1563 my %args = ( Target => '',
1569 my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args);
1570 return ($val, $msg) if !$val || $exist;
1572 my ($direction, $remote_link);
1573 if ( $args{'Target'} ) {
1574 $remote_link = $args{'Target'};
1575 $direction = 'Base';
1576 } elsif ( $args{'Base'} ) {
1577 $remote_link = $args{'Base'};
1578 $direction = 'Target';
1581 # Don't write the transaction if we're doing this on create
1582 if ( $args{'Silent'} ) {
1583 return ( $val, $msg );
1586 my $remote_uri = RT::URI->new( $self->CurrentUser );
1587 $remote_uri->FromURI( $remote_link );
1589 #Write the transaction
1590 my ( $Trans, $Msg, $TransObj ) =
1591 $self->_NewTransaction(Type => 'AddLink',
1592 Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
1593 NewValue => $remote_uri->URI || $remote_link,
1596 if ( $remote_uri->IsLocal ) {
1598 my $OtherObj = $remote_uri->Object;
1599 my ( $val, $Msg ) = $OtherObj->_NewTransaction(Type => 'AddLink',
1600 Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
1601 : $LINKDIRMAP{$args{'Type'}}->{Target},
1602 NewValue => $self->URI,
1603 ActivateScrips => ! $RT::LinkTransactionsRun1Scrip,
1606 return ( $val, $Msg );
1617 Shim around PrincipalObj->HasRight. See L<RT::Principal>.
1623 return $self->PrincipalObj->HasRight(@_);
1626 =head2 CurrentUserCanSee [FIELD]
1628 Returns true if the current user can see the user, based on if it is
1629 public, ourself, or we have AdminUsers
1633 sub CurrentUserCanSee {
1637 # If it's public, fine. Note that $what may be "transaction", which
1638 # doesn't have an Accessible value, and thus falls through below.
1639 if ( $self->_Accessible( $what, 'public' ) ) {
1643 # Users can see their own properties
1644 elsif ( defined($self->Id) && $self->CurrentUser->Id == $self->Id ) {
1648 # If the user has the admin users right, that's also enough
1649 elsif ( $self->CurrentUser->HasRight( Right => 'AdminUsers', Object => $RT::System) ) {
1657 =head2 CurrentUserCanModify RIGHT
1659 If the user has rights for this object, either because
1660 he has 'AdminUsers' or (if he\'s trying to edit himself and the right isn\'t an
1661 admin right) 'ModifySelf', return 1. otherwise, return undef.
1665 sub CurrentUserCanModify {
1669 if ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1673 #If the field is marked as an "administrators only" field,
1674 # don\'t let the user touch it.
1675 elsif ( $self->_Accessible( $field, 'admin' ) ) {
1679 #If the current user is trying to modify themselves
1680 elsif ( ( $self->id == $self->CurrentUser->id )
1681 and ( $self->CurrentUser->HasRight(Right => 'ModifySelf', Object => $RT::System) ) )
1686 #If we don\'t have a good reason to grant them rights to modify
1694 =head2 CurrentUserHasRight
1696 Takes a single argument. returns 1 if $Self->CurrentUser
1697 has the requested right. returns undef otherwise
1701 sub CurrentUserHasRight {
1705 return ( $self->CurrentUser->HasRight(Right => $right, Object => $RT::System) );
1711 $name = ref($name).'-'.$name->Id;
1714 return 'Pref-'.$name;
1717 =head2 Preferences NAME/OBJ DEFAULT
1719 Obtain user preferences associated with given object or name.
1720 Returns DEFAULT if no preferences found. If DEFAULT is a hashref,
1721 override the entries with user preferences.
1727 my $name = _PrefName (shift);
1728 my $default = shift;
1730 my $attr = RT::Attribute->new( $self->CurrentUser );
1731 $attr->LoadByNameAndObject( Object => $self, Name => $name );
1733 my $content = $attr->Id ? $attr->Content : undef;
1734 unless ( ref $content eq 'HASH' ) {
1735 return defined $content ? $content : $default;
1738 if (ref $default eq 'HASH') {
1739 for (keys %$default) {
1740 exists $content->{$_} or $content->{$_} = $default->{$_};
1743 elsif (defined $default) {
1744 $RT::Logger->error("Preferences $name for user".$self->Id." is hash but default is not");
1749 =head2 SetPreferences NAME/OBJ VALUE
1751 Set user preferences associated with given object or name.
1755 sub SetPreferences {
1757 my $name = _PrefName( shift );
1760 return (0, $self->loc("No permission to set preferences"))
1761 unless $self->CurrentUserCanModify('Preferences');
1763 my $attr = RT::Attribute->new( $self->CurrentUser );
1764 $attr->LoadByNameAndObject( Object => $self, Name => $name );
1766 return $attr->SetContent( $value );
1769 return $self->AddAttribute( Name => $name, Content => $value );
1773 =head2 WatchedQueues ROLE_LIST
1775 Returns a RT::Queues object containing every queue watched by the user.
1777 Takes a list of roles which is some subset of ('Cc', 'AdminCc'). Defaults to:
1779 $user->WatchedQueues('Cc', 'AdminCc');
1786 my @roles = @_ || ('Cc', 'AdminCc');
1788 $RT::Logger->debug('WatcheQueues got user ' . $self->Name);
1790 my $watched_queues = RT::Queues->new($self->CurrentUser);
1792 my $group_alias = $watched_queues->Join(
1796 FIELD2 => 'Instance',
1799 $watched_queues->Limit(
1800 ALIAS => $group_alias,
1802 VALUE => 'RT::Queue-Role',
1803 ENTRYAGGREGATOR => 'AND',
1805 if (grep { $_ eq 'Cc' } @roles) {
1806 $watched_queues->Limit(
1807 SUBCLAUSE => 'LimitToWatchers',
1808 ALIAS => $group_alias,
1811 ENTRYAGGREGATOR => 'OR',
1814 if (grep { $_ eq 'AdminCc' } @roles) {
1815 $watched_queues->Limit(
1816 SUBCLAUSE => 'LimitToWatchers',
1817 ALIAS => $group_alias,
1820 ENTRYAGGREGATOR => 'OR',
1824 my $queues_alias = $watched_queues->Join(
1825 ALIAS1 => $group_alias,
1827 TABLE2 => 'CachedGroupMembers',
1828 FIELD2 => 'GroupId',
1830 $watched_queues->Limit(
1831 ALIAS => $queues_alias,
1832 FIELD => 'MemberId',
1833 VALUE => $self->PrincipalId,
1835 $watched_queues->Limit(
1836 ALIAS => $queues_alias,
1837 FIELD => 'Disabled',
1842 $RT::Logger->debug("WatchedQueues got " . $watched_queues->Count . " queues");
1844 return $watched_queues;
1848 =head2 CleanupInvalidDelegations { InsideTransaction => undef }
1850 Revokes all ACE entries delegated by this user which are inconsistent
1851 with their current delegation rights. Does not perform permission
1852 checks. Should only ever be called from inside the RT library.
1854 If called from inside a transaction, specify a true value for the
1855 InsideTransaction parameter.
1857 Returns a true value if the deletion succeeded; returns a false value
1858 and logs an internal error if the deletion fails (should not happen).
1862 # XXX Currently there is a CleanupInvalidDelegations method in both
1863 # RT::User and RT::Group. If the recursive cleanup call for groups is
1864 # ever unrolled and merged, this code will probably want to be
1865 # factored out into RT::Principal.
1867 # backcompat for 3.8.8 and before
1868 *_CleanupInvalidDelegations = \&CleanupInvalidDelegations;
1870 sub CleanupInvalidDelegations {
1872 my %args = ( InsideTransaction => undef,
1875 unless ( $self->Id ) {
1876 $RT::Logger->warning("User not loaded.");
1880 my $in_trans = $args{InsideTransaction};
1882 return(1) if ($self->HasRight(Right => 'DelegateRights',
1883 Object => $RT::System));
1885 # Look up all delegation rights currently posessed by this user.
1886 my $deleg_acl = RT::ACL->new($RT::SystemUser);
1887 $deleg_acl->LimitToPrincipal(Type => 'User',
1888 Id => $self->PrincipalId,
1889 IncludeGroupMembership => 1);
1890 $deleg_acl->Limit( FIELD => 'RightName',
1892 VALUE => 'DelegateRights' );
1893 my @allowed_deleg_objects = map {$_->Object()}
1894 @{$deleg_acl->ItemsArrayRef()};
1896 # Look up all rights delegated by this principal which are
1897 # inconsistent with the allowed delegation objects.
1898 my $acl_to_del = RT::ACL->new($RT::SystemUser);
1899 $acl_to_del->DelegatedBy(Id => $self->Id);
1900 foreach (@allowed_deleg_objects) {
1901 $acl_to_del->LimitNotObject($_);
1904 # Delete all disallowed delegations
1905 while ( my $ace = $acl_to_del->Next() ) {
1906 my $ret = $ace->_Delete(InsideTransaction => 1);
1908 $RT::Handle->Rollback() unless $in_trans;
1909 $RT::Logger->warning("Couldn't delete delegated ACL entry ".$ace->Id);
1914 $RT::Handle->Commit() unless $in_trans;
1924 TransactionType => 'Set',
1925 RecordTransaction => 1,
1929 # Nobody is allowed to futz with RT_System or Nobody
1931 if ( ($self->Id == $RT::SystemUser->Id ) ||
1932 ($self->Id == $RT::Nobody->Id)) {
1933 return ( 0, $self->loc("Can not modify system users") );
1935 unless ( $self->CurrentUserCanModify( $args{'Field'} ) ) {
1936 return ( 0, $self->loc("Permission Denied") );
1939 my $Old = $self->SUPER::_Value("$args{'Field'}");
1941 my ($ret, $msg) = $self->SUPER::_Set( Field => $args{'Field'},
1942 Value => $args{'Value'} );
1944 #If we can't actually set the field to the value, don't record
1945 # a transaction. instead, get out of here.
1946 if ( $ret == 0 ) { return ( 0, $msg ); }
1948 if ( $args{'RecordTransaction'} == 1 ) {
1949 if ($args{'Field'} eq "Password") {
1950 $args{'Value'} = $Old = '********';
1952 my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1953 Type => $args{'TransactionType'},
1954 Field => $args{'Field'},
1955 NewValue => $args{'Value'},
1957 TimeTaken => $args{'TimeTaken'},
1959 return ( $Trans, scalar $TransObj->BriefDescription );
1962 return ( $ret, $msg );
1968 Takes the name of a table column.
1969 Returns its value as a string, if the user passes an ACL check
1978 # Defer to the abstraction above to know if the field can be read
1979 return $self->SUPER::_Value($field) if $self->CurrentUserCanSee($field);
1985 Return the friendly name
1991 return $self->RealName if defined($self->RealName);
1992 return $self->Name if defined($self->Name);
1998 Returns the preferred key of the user. If none is set, then this will query
1999 GPG and set the preferred key to the maximally trusted key found (and then
2000 return it). Returns C<undef> if no preferred key can be found.
2007 return undef unless RT->Config->Get('GnuPG')->{'Enable'};
2009 if ( ($self->CurrentUser->Id != $self->Id ) &&
2010 !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
2016 my $prefkey = $self->FirstAttribute('PreferredKey');
2017 return $prefkey->Content if $prefkey;
2019 # we don't have a preferred key for this user, so now we must query GPG
2020 require RT::Crypt::GnuPG;
2021 my %res = RT::Crypt::GnuPG::GetKeysForEncryption($self->EmailAddress);
2022 return undef unless defined $res{'info'};
2023 my @keys = @{ $res{'info'} };
2024 return undef if @keys == 0;
2027 $prefkey = $keys[0]->{'Fingerprint'};
2030 # prefer the maximally trusted key
2031 @keys = sort { $b->{'TrustLevel'} <=> $a->{'TrustLevel'} } @keys;
2032 $prefkey = $keys[0]->{'Fingerprint'};
2035 $self->SetAttribute(Name => 'PreferredKey', Content => $prefkey);
2043 #If the user wants to see their own values, let them.
2044 #If the user is an admin, let them.
2045 #Otherwwise, don't let them.
2047 if ( ($self->CurrentUser->Id != $self->Id ) &&
2048 !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
2052 my $key = $self->FirstAttribute('PrivateKey') or return undef;
2053 return $key->Content;
2060 unless ($self->CurrentUserCanModify('PrivateKey')) {
2061 return (0, $self->loc("Permission Denied"));
2065 my ($status, $msg) = $self->DeleteAttribute('PrivateKey');
2066 unless ( $status ) {
2067 $RT::Logger->error( "Couldn't delete attribute: $msg" );
2068 return ($status, $self->loc("Couldn't unset private key"));
2070 return ($status, $self->loc("Unset private key"));
2073 # check that it's really private key
2075 my %tmp = RT::Crypt::GnuPG::GetKeysForSigning( $key );
2076 return (0, $self->loc("No such key or it's not suitable for signing"))
2077 if $tmp{'exit_code'} || !$tmp{'info'};
2080 my ($status, $msg) = $self->SetAttribute(
2081 Name => 'PrivateKey',
2084 return ($status, $self->loc("Couldn't set private key"))
2086 return ($status, $self->loc("Set private key"));
2091 [ Name => 'User Id' ],
2092 [ EmailAddress => 'Email' ],
2093 [ RealName => 'Name' ],
2094 [ Organization => 'Organization' ],