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,
1356 #much false laziness w/Ticket_Overlay.pm. now with RT 3.8!
1358 # A helper table for links mapping to make it easier
1359 # to build and parse links between tickets
1361 use vars '%LINKDIRMAP';
1364 MemberOf => { Base => 'MemberOf',
1365 Target => 'HasMember', },
1366 RefersTo => { Base => 'RefersTo',
1367 Target => 'ReferredToBy', },
1368 DependsOn => { Base => 'DependsOn',
1369 Target => 'DependedOnBy', },
1370 MergedInto => { Base => 'MergedInto',
1371 Target => 'MergedInto', },
1375 sub LINKDIRMAP { return \%LINKDIRMAP }
1380 # #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
1381 # #tobias meant by $f
1382 # my $field = shift;
1383 # my $type = shift || "";
1385 # unless ( $self->{"$field$type"} ) {
1386 # $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
1387 # if ( $self->CurrentUserHasRight('ShowTicket') ) {
1388 # # Maybe this ticket is a merged ticket
1389 # my $Tickets = new RT::Tickets( $self->CurrentUser );
1390 # # at least to myself
1391 # $self->{"$field$type"}->Limit( FIELD => $field,
1392 # VALUE => $self->URI,
1393 # ENTRYAGGREGATOR => 'OR' );
1394 # $Tickets->Limit( FIELD => 'EffectiveId',
1395 # VALUE => $self->EffectiveId );
1396 # while (my $Ticket = $Tickets->Next) {
1397 # $self->{"$field$type"}->Limit( FIELD => $field,
1398 # VALUE => $Ticket->URI,
1399 # ENTRYAGGREGATOR => 'OR' );
1401 # $self->{"$field$type"}->Limit( FIELD => 'Type',
1406 # return ( $self->{"$field$type"} );
1411 Delete a link. takes a paramhash of Base, Target and Type.
1412 Either Base or Target must be null. The null value will
1413 be replaced with this ticket\'s id
1426 unless ( $args{'Target'} || $args{'Base'} ) {
1427 $RT::Logger->error("Base or Target must be specified\n");
1428 return ( 0, $self->loc('Either base or target must be specified') );
1433 $right++ if $self->CurrentUserHasRight('AdminUsers');
1434 if ( !$right && $RT::StrictLinkACL ) {
1435 return ( 0, $self->loc("Permission Denied") );
1438 # # If the other URI is an RT::Ticket, we want to make sure the user
1439 # # can modify it too...
1440 # my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
1441 # return (0, $msg) unless $status;
1442 # if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
1445 # if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
1446 # ( $RT::StrictLinkACL && $right < 2 ) )
1448 # return ( 0, $self->loc("Permission Denied") );
1451 my ($val, $Msg) = $self->SUPER::_DeleteLink(%args);
1454 $RT::Logger->debug("Couldn't find that link\n");
1458 my ($direction, $remote_link);
1460 if ( $args{'Base'} ) {
1461 $remote_link = $args{'Base'};
1462 $direction = 'Target';
1464 elsif ( $args{'Target'} ) {
1465 $remote_link = $args{'Target'};
1469 if ( $args{'Silent'} ) {
1470 return ( $val, $Msg );
1473 my $remote_uri = RT::URI->new( $self->CurrentUser );
1474 $remote_uri->FromURI( $remote_link );
1476 my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1477 Type => 'DeleteLink',
1478 Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
1479 OldValue => $remote_uri->URI || $remote_link,
1483 if ( $remote_uri->IsLocal ) {
1485 my $OtherObj = $remote_uri->Object;
1486 my ( $val, $Msg ) = $OtherObj->_NewTransaction(Type => 'DeleteLink',
1487 Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
1488 : $LINKDIRMAP{$args{'Type'}}->{Target},
1489 OldValue => $self->URI,
1490 ActivateScrips => ! $RT::LinkTransactionsRun1Scrip,
1494 return ( $Trans, $Msg );
1500 my %args = ( Target => '',
1506 unless ( $args{'Target'} || $args{'Base'} ) {
1507 $RT::Logger->error("Base or Target must be specified\n");
1508 return ( 0, $self->loc('Either base or target must be specified') );
1512 $right++ if $self->CurrentUserHasRight('AdminUsers');
1513 if ( !$right && $RT::StrictLinkACL ) {
1514 return ( 0, $self->loc("Permission Denied") );
1517 # # If the other URI is an RT::Ticket, we want to make sure the user
1518 # # can modify it too...
1519 # my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
1520 # return (0, $msg) unless $status;
1521 # if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
1524 # if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
1525 # ( $RT::StrictLinkACL && $right < 2 ) )
1527 # return ( 0, $self->loc("Permission Denied") );
1530 return $self->_AddLink(%args);
1533 #sub __GetTicketFromURI {
1535 # my %args = ( URI => '', @_ );
1537 # # If the other URI is an RT::Ticket, we want to make sure the user
1538 # # can modify it too...
1539 # my $uri_obj = RT::URI->new( $self->CurrentUser );
1540 # $uri_obj->FromURI( $args{'URI'} );
1542 # unless ( $uri_obj->Resolver && $uri_obj->Scheme ) {
1543 # my $msg = $self->loc( "Couldn't resolve '[_1]' into a URI.", $args{'URI'} );
1544 # $RT::Logger->warning( "$msg\n" );
1545 # return( 0, $msg );
1547 # my $obj = $uri_obj->Resolver->Object;
1548 # unless ( UNIVERSAL::isa($obj, 'RT::Ticket') && $obj->id ) {
1549 # return (1, 'Found not a ticket', undef);
1551 # return (1, 'Found ticket', $obj);
1556 Private non-acled variant of AddLink so that links can be added during create.
1562 my %args = ( Target => '',
1568 my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args);
1569 return ($val, $msg) if !$val || $exist;
1571 my ($direction, $remote_link);
1572 if ( $args{'Target'} ) {
1573 $remote_link = $args{'Target'};
1574 $direction = 'Base';
1575 } elsif ( $args{'Base'} ) {
1576 $remote_link = $args{'Base'};
1577 $direction = 'Target';
1580 # Don't write the transaction if we're doing this on create
1581 if ( $args{'Silent'} ) {
1582 return ( $val, $msg );
1585 my $remote_uri = RT::URI->new( $self->CurrentUser );
1586 $remote_uri->FromURI( $remote_link );
1588 #Write the transaction
1589 my ( $Trans, $Msg, $TransObj ) =
1590 $self->_NewTransaction(Type => 'AddLink',
1591 Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
1592 NewValue => $remote_uri->URI || $remote_link,
1595 if ( $remote_uri->IsLocal ) {
1597 my $OtherObj = $remote_uri->Object;
1598 my ( $val, $Msg ) = $OtherObj->_NewTransaction(Type => 'AddLink',
1599 Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
1600 : $LINKDIRMAP{$args{'Type'}}->{Target},
1601 NewValue => $self->URI,
1602 ActivateScrips => ! $RT::LinkTransactionsRun1Scrip,
1605 return ( $val, $Msg );
1616 Shim around PrincipalObj->HasRight. See L<RT::Principal>.
1622 return $self->PrincipalObj->HasRight(@_);
1625 =head2 CurrentUserCanModify RIGHT
1627 If the user has rights for this object, either because
1628 he has 'AdminUsers' or (if he\'s trying to edit himself and the right isn\'t an
1629 admin right) 'ModifySelf', return 1. otherwise, return undef.
1633 sub CurrentUserCanModify {
1637 if ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1641 #If the field is marked as an "administrators only" field,
1642 # don\'t let the user touch it.
1643 elsif ( $self->_Accessible( $field, 'admin' ) ) {
1647 #If the current user is trying to modify themselves
1648 elsif ( ( $self->id == $self->CurrentUser->id )
1649 and ( $self->CurrentUser->HasRight(Right => 'ModifySelf', Object => $RT::System) ) )
1654 #If we don\'t have a good reason to grant them rights to modify
1662 =head2 CurrentUserHasRight
1664 Takes a single argument. returns 1 if $Self->CurrentUser
1665 has the requested right. returns undef otherwise
1669 sub CurrentUserHasRight {
1673 return ( $self->CurrentUser->HasRight(Right => $right, Object => $RT::System) );
1679 $name = ref($name).'-'.$name->Id;
1682 return 'Pref-'.$name;
1685 =head2 Preferences NAME/OBJ DEFAULT
1687 Obtain user preferences associated with given object or name.
1688 Returns DEFAULT if no preferences found. If DEFAULT is a hashref,
1689 override the entries with user preferences.
1695 my $name = _PrefName (shift);
1696 my $default = shift;
1698 my $attr = RT::Attribute->new( $self->CurrentUser );
1699 $attr->LoadByNameAndObject( Object => $self, Name => $name );
1701 my $content = $attr->Id ? $attr->Content : undef;
1702 unless ( ref $content eq 'HASH' ) {
1703 return defined $content ? $content : $default;
1706 if (ref $default eq 'HASH') {
1707 for (keys %$default) {
1708 exists $content->{$_} or $content->{$_} = $default->{$_};
1711 elsif (defined $default) {
1712 $RT::Logger->error("Preferences $name for user".$self->Id." is hash but default is not");
1717 =head2 SetPreferences NAME/OBJ VALUE
1719 Set user preferences associated with given object or name.
1723 sub SetPreferences {
1725 my $name = _PrefName( shift );
1728 return (0, $self->loc("No permission to set preferences"))
1729 unless $self->CurrentUserCanModify('Preferences');
1731 my $attr = RT::Attribute->new( $self->CurrentUser );
1732 $attr->LoadByNameAndObject( Object => $self, Name => $name );
1734 return $attr->SetContent( $value );
1737 return $self->AddAttribute( Name => $name, Content => $value );
1741 =head2 WatchedQueues ROLE_LIST
1743 Returns a RT::Queues object containing every queue watched by the user.
1745 Takes a list of roles which is some subset of ('Cc', 'AdminCc'). Defaults to:
1747 $user->WatchedQueues('Cc', 'AdminCc');
1754 my @roles = @_ || ('Cc', 'AdminCc');
1756 $RT::Logger->debug('WatcheQueues got user ' . $self->Name);
1758 my $watched_queues = RT::Queues->new($self->CurrentUser);
1760 my $group_alias = $watched_queues->Join(
1764 FIELD2 => 'Instance',
1767 $watched_queues->Limit(
1768 ALIAS => $group_alias,
1770 VALUE => 'RT::Queue-Role',
1771 ENTRYAGGREGATOR => 'AND',
1773 if (grep { $_ eq 'Cc' } @roles) {
1774 $watched_queues->Limit(
1775 SUBCLAUSE => 'LimitToWatchers',
1776 ALIAS => $group_alias,
1779 ENTRYAGGREGATOR => 'OR',
1782 if (grep { $_ eq 'AdminCc' } @roles) {
1783 $watched_queues->Limit(
1784 SUBCLAUSE => 'LimitToWatchers',
1785 ALIAS => $group_alias,
1788 ENTRYAGGREGATOR => 'OR',
1792 my $queues_alias = $watched_queues->Join(
1793 ALIAS1 => $group_alias,
1795 TABLE2 => 'CachedGroupMembers',
1796 FIELD2 => 'GroupId',
1798 $watched_queues->Limit(
1799 ALIAS => $queues_alias,
1800 FIELD => 'MemberId',
1801 VALUE => $self->PrincipalId,
1804 $RT::Logger->debug("WatchedQueues got " . $watched_queues->Count . " queues");
1806 return $watched_queues;
1810 =head2 _CleanupInvalidDelegations { InsideTransaction => undef }
1812 Revokes all ACE entries delegated by this user which are inconsistent
1813 with their current delegation rights. Does not perform permission
1814 checks. Should only ever be called from inside the RT library.
1816 If called from inside a transaction, specify a true value for the
1817 InsideTransaction parameter.
1819 Returns a true value if the deletion succeeded; returns a false value
1820 and logs an internal error if the deletion fails (should not happen).
1824 # XXX Currently there is a _CleanupInvalidDelegations method in both
1825 # RT::User and RT::Group. If the recursive cleanup call for groups is
1826 # ever unrolled and merged, this code will probably want to be
1827 # factored out into RT::Principal.
1829 sub _CleanupInvalidDelegations {
1831 my %args = ( InsideTransaction => undef,
1834 unless ( $self->Id ) {
1835 $RT::Logger->warning("User not loaded.");
1839 my $in_trans = $args{InsideTransaction};
1841 return(1) if ($self->HasRight(Right => 'DelegateRights',
1842 Object => $RT::System));
1844 # Look up all delegation rights currently posessed by this user.
1845 my $deleg_acl = RT::ACL->new($RT::SystemUser);
1846 $deleg_acl->LimitToPrincipal(Type => 'User',
1847 Id => $self->PrincipalId,
1848 IncludeGroupMembership => 1);
1849 $deleg_acl->Limit( FIELD => 'RightName',
1851 VALUE => 'DelegateRights' );
1852 my @allowed_deleg_objects = map {$_->Object()}
1853 @{$deleg_acl->ItemsArrayRef()};
1855 # Look up all rights delegated by this principal which are
1856 # inconsistent with the allowed delegation objects.
1857 my $acl_to_del = RT::ACL->new($RT::SystemUser);
1858 $acl_to_del->DelegatedBy(Id => $self->Id);
1859 foreach (@allowed_deleg_objects) {
1860 $acl_to_del->LimitNotObject($_);
1863 # Delete all disallowed delegations
1864 while ( my $ace = $acl_to_del->Next() ) {
1865 my $ret = $ace->_Delete(InsideTransaction => 1);
1867 $RT::Handle->Rollback() unless $in_trans;
1868 $RT::Logger->warning("Couldn't delete delegated ACL entry ".$ace->Id);
1873 $RT::Handle->Commit() unless $in_trans;
1883 TransactionType => 'Set',
1884 RecordTransaction => 1,
1888 # Nobody is allowed to futz with RT_System or Nobody
1890 if ( ($self->Id == $RT::SystemUser->Id ) ||
1891 ($self->Id == $RT::Nobody->Id)) {
1892 return ( 0, $self->loc("Can not modify system users") );
1894 unless ( $self->CurrentUserCanModify( $args{'Field'} ) ) {
1895 return ( 0, $self->loc("Permission Denied") );
1898 my $Old = $self->SUPER::_Value("$args{'Field'}");
1900 my ($ret, $msg) = $self->SUPER::_Set( Field => $args{'Field'},
1901 Value => $args{'Value'} );
1903 #If we can't actually set the field to the value, don't record
1904 # a transaction. instead, get out of here.
1905 if ( $ret == 0 ) { return ( 0, $msg ); }
1907 if ( $args{'RecordTransaction'} == 1 ) {
1909 my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1910 Type => $args{'TransactionType'},
1911 Field => $args{'Field'},
1912 NewValue => $args{'Value'},
1914 TimeTaken => $args{'TimeTaken'},
1916 return ( $Trans, scalar $TransObj->BriefDescription );
1919 return ( $ret, $msg );
1925 Takes the name of a table column.
1926 Returns its value as a string, if the user passes an ACL check
1935 #If the current user doesn't have ACLs, don't let em at it.
1937 my @PublicFields = qw( Name EmailAddress Organization Disabled
1938 RealName NickName Gecos ExternalAuthId
1939 AuthSystem ExternalContactInfoId
1940 ContactInfoSystem );
1942 #if the field is public, return it.
1943 if ( $self->_Accessible( $field, 'public' ) ) {
1944 return ( $self->SUPER::_Value($field) );
1948 #If the user wants to see their own values, let them
1949 # TODO figure ouyt a better way to deal with this
1950 elsif ( defined($self->Id) && $self->CurrentUser->Id == $self->Id ) {
1951 return ( $self->SUPER::_Value($field) );
1954 #If the user has the admin users right, return the field
1955 elsif ( $self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1956 return ( $self->SUPER::_Value($field) );
1966 Return the friendly name
1972 return $self->RealName if defined($self->RealName);
1973 return $self->Name if defined($self->Name);
1979 Returns the preferred key of the user. If none is set, then this will query
1980 GPG and set the preferred key to the maximally trusted key found (and then
1981 return it). Returns C<undef> if no preferred key can be found.
1988 return undef unless RT->Config->Get('GnuPG')->{'Enable'};
1990 if ( ($self->CurrentUser->Id != $self->Id ) &&
1991 !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1997 my $prefkey = $self->FirstAttribute('PreferredKey');
1998 return $prefkey->Content if $prefkey;
2000 # we don't have a preferred key for this user, so now we must query GPG
2001 require RT::Crypt::GnuPG;
2002 my %res = RT::Crypt::GnuPG::GetKeysForEncryption($self->EmailAddress);
2003 return undef unless defined $res{'info'};
2004 my @keys = @{ $res{'info'} };
2005 return undef if @keys == 0;
2008 $prefkey = $keys[0]->{'Fingerprint'};
2011 # prefer the maximally trusted key
2012 @keys = sort { $b->{'TrustLevel'} <=> $a->{'TrustLevel'} } @keys;
2013 $prefkey = $keys[0]->{'Fingerprint'};
2016 $self->SetAttribute(Name => 'PreferredKey', Content => $prefkey);
2024 #If the user wants to see their own values, let them.
2025 #If the user is an admin, let them.
2026 #Otherwwise, don't let them.
2028 if ( ($self->CurrentUser->Id != $self->Id ) &&
2029 !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
2033 my $key = $self->FirstAttribute('PrivateKey') or return undef;
2034 return $key->Content;
2041 unless ($self->CurrentUserCanModify('PrivateKey')) {
2042 return (0, $self->loc("Permission Denied"));
2046 my ($status, $msg) = $self->DeleteAttribute('PrivateKey');
2047 unless ( $status ) {
2048 $RT::Logger->error( "Couldn't delete attribute: $msg" );
2049 return ($status, $self->loc("Couldn't unset private key"));
2051 return ($status, $self->loc("Unset private key"));
2054 # check that it's really private key
2056 my %tmp = RT::Crypt::GnuPG::GetKeysForSigning( $key );
2057 return (0, $self->loc("No such key or it's not suitable for signing"))
2058 if $tmp{'exit_code'} || !$tmp{'info'};
2061 my ($status, $msg) = $self->SetAttribute(
2062 Name => 'PrivateKey',
2065 return ($status, $self->loc("Couldn't set private key"))
2067 return ($status, $self->loc("Set private key"));
2072 [ Name => 'User Id' ],
2073 [ EmailAddress => 'Email' ],
2074 [ RealName => 'Name' ],
2075 [ Organization => 'Organization' ],