rt/lib/RT/User_Overlay.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 =head1 NAME
  50
  51   RT::User - RT User object
  52
  53 =head1 SYNOPSIS
  54
  55   use RT::User;
  56
  57 =head1 DESCRIPTION
  58
  59
  60 =head1 METHODS
  61
  62
  63
  64 =cut
  65
  66
  67 package RT::User;
  68
  69 use strict;
  70 no warnings qw(redefine);
  71
  72 use Digest::SHA;
  73 use Digest::MD5;
  74 use RT::Principals;
  75 use RT::ACE;
  76 use RT::Interface::Email;
  77 use Encode;
  78
  79 sub _OverlayAccessible {
  80     {
  81
  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 },
  98
  99     }
 100 }
 101
 102
 103
 104 =head2 Create { PARAMHASH }
 105
 106
 107
 108 =cut
 109
 110
 111 sub Create {
 112     my $self = shift;
 113     my %args = (
 114         Privileged => 0,
 115         Disabled => 0,
 116         EmailAddress => '',
 117         _RecordTransaction => 1,
 118         @_    # get the real argumentlist
 119     );
 120
 121     # remove the value so it does not cripple SUPER::Create
 122     my $record_transaction = delete $args{'_RecordTransaction'};
 123
 124     #Check the ACL
 125     unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
 126         return ( 0, $self->loc('Permission Denied') );
 127     }
 128
 129
 130     unless ($self->CanonicalizeUserInfo(\%args)) {
 131         return ( 0, $self->loc("Could not set user info") );
 132     }
 133
 134     $args{'EmailAddress'} = $self->CanonicalizeEmailAddress($args{'EmailAddress'});
 135
 136     # if the user doesn't have a name defined, set it to the email address
 137     $args{'Name'} = $args{'EmailAddress'} unless ($args{'Name'});
 138
 139
 140
 141     my $privileged = delete $args{'Privileged'};
 142
 143
 144     if ($args{'CryptedPassword'} ) {
 145         $args{'Password'} = $args{'CryptedPassword'};
 146         delete $args{'CryptedPassword'};
 147     }
 148     elsif ( !$args{'Password'} ) {
 149         $args{'Password'} = '*NO-PASSWORD*';
 150     }
 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')) );
 153     }
 154
 155     else {
 156         $args{'Password'} = $self->_GeneratePassword($args{'Password'});
 157     }
 158
 159     #TODO Specify some sensible defaults.
 160
 161     unless ( $args{'Name'} ) {
 162         return ( 0, $self->loc("Must specify 'Name' attribute") );
 163     }
 164
 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 );
 170
 171         my ($val, $message) = $self->ValidateEmailAddress( $args{'EmailAddress'} );
 172         return (0, $message) unless ( $val );
 173     }
 174     else {
 175         $RT::Logger->warning( "$self couldn't check for pre-existing users");
 176     }
 177
 178
 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'},
 185                                 ObjectId => '0');
 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') );
 192     }
 193
 194     $principal->__Set(Field => 'ObjectId', Value => $principal_id);
 195     delete $args{'Disabled'};
 196
 197     $self->SUPER::Create(id => $principal_id , %args);
 198     my $id = $self->Id;
 199
 200     #If the create failed.
 201     unless ($id) {
 202         $RT::Handle->Rollback();
 203         $RT::Logger->error("Could not create a new user - " .join('-', %args));
 204
 205         return ( 0, $self->loc('Could not create user') );
 206     }
 207
 208     my $aclstash = RT::Group->new($self->CurrentUser);
 209     my $stash_id = $aclstash->_CreateACLEquivalenceGroup($principal);
 210
 211     unless ($stash_id) {
 212         $RT::Handle->Rollback();
 213         $RT::Logger->crit("Couldn't stash the user in groupmembers");
 214         return ( 0, $self->loc('Could not create user') );
 215     }
 216
 217
 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') );
 224     }
 225
 226
 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') );
 233     }
 234
 235
 236     my $access_class = RT::Group->new($self->CurrentUser);
 237     if ($privileged)  {
 238         $access_class->LoadSystemInternalGroup('Privileged');
 239     } else {
 240         $access_class->LoadSystemInternalGroup('Unprivileged');
 241     }
 242
 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') );
 247     }
 248
 249
 250     my ($ac_id, $ac_msg) = $access_class->_AddMember( InsideTransaction => 1, PrincipalId => $self->PrincipalId);
 251
 252     unless ($ac_id) {
 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') );
 257     }
 258
 259
 260     if ( $record_transaction ) {
 261     $self->_NewTransaction( Type => "Create" );
 262     }
 263
 264     $RT::Handle->Commit;
 265
 266     return ( $id, $self->loc('User created') );
 267 }
 268
 269 =head2 SetPrivileged BOOL
 270
 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.
 273
 274 Returns a standard RT tuple of (val, msg);
 275
 276
 277 =cut
 278
 279 sub SetPrivileged {
 280     my $self = shift;
 281     my $val = shift;
 282
 283     #Check the ACL
 284     unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
 285         return ( 0, $self->loc('Permission Denied') );
 286     }
 287
 288     my $priv = RT::Group->new($self->CurrentUser);
 289     $priv->LoadSystemInternalGroup('Privileged');
 290     unless ($priv->Id) {
 291         $RT::Logger->crit("Could not find Privileged pseudogroup");
 292         return(0,$self->loc("Failed to find 'Privileged' users pseudogroup."));
 293     }
 294
 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"));
 300     }
 301
 302     my $principal = $self->PrincipalId;
 303     if ($val) {
 304         if ($priv->HasMember($principal)) {
 305             #$RT::Logger->debug("That user is already privileged");
 306             return (0,$self->loc("That user is already privileged"));
 307         }
 308         if ($unpriv->HasMember($principal)) {
 309             $unpriv->_DeleteMember($principal);
 310         } else {
 311         # if we had layered transactions, life would be good
 312         # sadly, we have to just go ahead, even if something
 313         # bogus happened
 314             $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
 315                 "unprivileged. something is drastically wrong.");
 316         }
 317         my ($status, $msg) = $priv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
 318         if ($status) {
 319             return (1, $self->loc("That user is now privileged"));
 320         } else {
 321             return (0, $msg);
 322         }
 323     }
 324     else {
 325         if ($unpriv->HasMember($principal)) {
 326             #$RT::Logger->debug("That user is already unprivileged");
 327             return (0,$self->loc("That user is already unprivileged"));
 328         }
 329         if ($priv->HasMember($principal)) {
 330             $priv->_DeleteMember( $principal );
 331         } else {
 332         # if we had layered transactions, life would be good
 333         # sadly, we have to just go ahead, even if something
 334         # bogus happened
 335             $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
 336                 "unprivileged. something is drastically wrong.");
 337         }
 338         my ($status, $msg) = $unpriv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
 339         if ($status) {
 340             return (1, $self->loc("That user is now unprivileged"));
 341         } else {
 342             return (0, $msg);
 343         }
 344     }
 345 }
 346
 347 =head2 Privileged
 348
 349 Returns true if this user is privileged. Returns undef otherwise.
 350
 351 =cut
 352
 353 sub Privileged {
 354     my $self = shift;
 355     my $priv = RT::Group->new($self->CurrentUser);
 356     $priv->LoadSystemInternalGroup('Privileged');
 357     if ( $priv->HasMember( $self->PrincipalId ) ) {
 358         return(1);
 359     }
 360     else {
 361         return(undef);
 362     }
 363 }
 364
 365 #create a user without validating _any_ data.
 366
 367 #To be used only on database init.
 368 # We can't localize here because it's before we _have_ a loc framework
 369
 370 sub _BootstrapCreate {
 371     my $self = shift;
 372     my %args = (@_);
 373
 374     $args{'Password'} = '*NO-PASSWORD*';
 375
 376
 377     $RT::Handle->BeginTransaction();
 378
 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);
 384
 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' );
 390     }
 391     $self->SUPER::Create(id => $principal_id, %args);
 392     my $id = $self->Id;
 393     #If the create failed.
 394       unless ($id) {
 395       $RT::Handle->Rollback();
 396       return ( 0, 'Could not create user' ) ; #never loc this
 397     }
 398
 399     my $aclstash = RT::Group->new($self->CurrentUser);
 400     my $stash_id  = $aclstash->_CreateACLEquivalenceGroup($principal);
 401
 402     unless ($stash_id) {
 403         $RT::Handle->Rollback();
 404         $RT::Logger->crit("Couldn't stash the user in groupmembers");
 405         return ( 0, $self->loc('Could not create user') );
 406     }
 407
 408
 409     $RT::Handle->Commit();
 410
 411     return ( $id, 'User created' );
 412 }
 413
 414 sub Delete {
 415     my $self = shift;
 416
 417     return ( 0, $self->loc('Deleting this object would violate referential integrity') );
 418
 419 }
 420
 421 =head2 Load
 422
 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
 427 username.
 428
 429 =cut
 430
 431 sub Load {
 432     my $self = shift;
 433     my $identifier = shift || return undef;
 434
 435     if ( $identifier !~ /\D/ ) {
 436         return $self->SUPER::LoadById( $identifier );
 437     }
 438     elsif ( UNIVERSAL::isa( $identifier, 'RT::User' ) ) {
 439         return $self->SUPER::LoadById( $identifier->Id );
 440     }
 441     else {
 442         return $self->LoadByCol( "Name", $identifier );
 443     }
 444 }
 445
 446 =head2 LoadByEmail
 447
 448 Tries to load this user object from the database by the user's email address.
 449
 450 =cut
 451
 452 sub LoadByEmail {
 453     my $self    = shift;
 454     my $address = shift;
 455
 456     # Never load an empty address as an email address.
 457     unless ($address) {
 458         return (undef);
 459     }
 460
 461     $address = $self->CanonicalizeEmailAddress($address);
 462
 463     #$RT::Logger->debug("Trying to load an email address: $address");
 464     return $self->LoadByCol( "EmailAddress", $address );
 465 }
 466
 467 =head2 LoadOrCreateByEmail ADDRESS
 468
 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.
 472
 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.
 475
 476 =cut
 477
 478 sub LoadOrCreateByEmail {
 479     my $self = shift;
 480     my $email = shift;
 481
 482     my ($message, $name);
 483     if ( UNIVERSAL::isa( $email => 'Email::Address' ) ) {
 484         ($email, $name) = ($email->address, $email->phrase);
 485     } else {
 486         ($email, $name) = RT::Interface::Email::ParseAddressFromHeader( $email );
 487     }
 488
 489     $self->LoadByEmail( $email );
 490     $self->Load( $email ) unless $self->Id;
 491     $message = $self->loc('User loaded');
 492
 493     unless( $self->Id ) {
 494         my $val;
 495         ($val, $message) = $self->Create(
 496             Name         => $email,
 497             EmailAddress => $email,
 498             RealName     => $name,
 499             Privileged   => 0,
 500             Comments     => 'Autocreated when added as a watcher',
 501         );
 502         unless ( $val ) {
 503             # Deal with the race condition of two account creations at once
 504             $self->LoadByEmail( $email );
 505             unless ( $self->Id ) {
 506                 sleep 5;
 507                 $self->LoadByEmail( $email );
 508             }
 509             if ( $self->Id ) {
 510                 $RT::Logger->error("Recovered from creation failure due to race condition");
 511                 $message = $self->loc("User loaded");
 512             }
 513             else {
 514                 $RT::Logger->crit("Failed to create user ". $email .": " .$message);
 515             }
 516         }
 517     }
 518     return (0, $message) unless $self->id;
 519     return ($self->Id, $message);
 520 }
 521
 522 =head2 ValidateEmailAddress ADDRESS
 523
 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.
 526
 527 =cut
 528
 529 sub ValidateEmailAddress {
 530     my $self  = shift;
 531     my $Value = shift;
 532
 533     # if the email address is null, it's always valid
 534     return (1) if ( !$Value || $Value eq "" );
 535
 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 ) );
 540     }
 541
 542
 543     my $TempUser = RT::User->new($RT::SystemUser);
 544     $TempUser->LoadByEmail($Value);
 545
 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') );
 550     }
 551     else {    #it's a valid email address
 552         return (1);
 553     }
 554 }
 555
 556 =head2 SetEmailAddress
 557
 558 Check to make sure someone else isn't using this email address already
 559 so that a better email address can be returned
 560
 561 =cut
 562
 563 sub SetEmailAddress {
 564     my $self = shift;
 565     my $Value = shift;
 566
 567     my ($val, $message) = $self->ValidateEmailAddress( $Value );
 568     if ( $val ) {
 569         return $self->_Set( Field => 'EmailAddress', Value => $Value );
 570     } else {
 571         return ( 0, $message )
 572     }
 573
 574 }
 575
 576 =head2 EmailFrequency
 577
 578 Takes optional Ticket argument in paramhash. Returns 'no email',
 579 'squelched', 'daily', 'weekly' or empty string depending on
 580 user preferences.
 581
 582 =over 4
 583
 584 =item 'no email' - user has no email, so can not recieve notifications.
 585
 586 =item 'squelched' - returned only when Ticket argument is provided and
 587 notifications to the user has been supressed for this ticket.
 588
 589 =item 'daily' - retruned when user recieve daily messages digest instead
 590 of immediate delivery.
 591
 592 =item 'weekly' - previous, but weekly.
 593
 594 =item empty string returned otherwise.
 595
 596 =back
 597
 598 =cut
 599
 600 sub EmailFrequency {
 601     my $self = shift;
 602     my %args = (
 603         Ticket => undef,
 604         @_
 605     );
 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;
 614     return '';
 615 }
 616
 617 =head2 CanonicalizeEmailAddress ADDRESS
 618
 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.
 624
 625 =cut
 626
 627 sub CanonicalizeEmailAddress {
 628     my $self = shift;
 629     my $email = shift;
 630     # Example: the following rule would treat all email
 631     # coming from a subdomain as coming from second level domain
 632     # foo.com
 633     if ( my $match   = RT->Config->Get('CanonicalizeEmailAddressMatch') and
 634          my $replace = RT->Config->Get('CanonicalizeEmailAddressReplace') )
 635     {
 636         $email =~ s/$match/$replace/gi;
 637     }
 638     return ($email);
 639 }
 640
 641 =head2 CanonicalizeUserInfo HASH of ARGS
 642
 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.
 646
 647 This function is intended to allow users to have their info looked up via
 648 an outside source and modified upon creation.
 649
 650 =cut
 651
 652 sub CanonicalizeUserInfo {
 653     my $self = shift;
 654     my $args = shift;
 655     my $success = 1;
 656
 657     return ($success);
 658 }
 659
 660
 661 =head2 Password and authentication related functions
 662
 663 =head3 SetRandomPassword
 664
 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.
 668
 669 =cut
 670
 671 sub SetRandomPassword {
 672     my $self = shift;
 673
 674     unless ( $self->CurrentUserCanModify('Password') ) {
 675         return ( 0, $self->loc("Permission Denied") );
 676     }
 677
 678
 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);
 681
 682     my $pass = $self->GenerateRandomPassword( $min, $max) ;
 683
 684     # If we have "notify user on
 685
 686     my ( $val, $msg ) = $self->SetPassword($pass);
 687
 688     #If we got an error return the error.
 689     return ( 0, $msg ) unless ($val);
 690
 691     #Otherwise, we changed the password, lets return it.
 692     return ( 1, $pass );
 693
 694 }
 695
 696 =head3 ResetPassword
 697
 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.
 703
 704 =cut
 705
 706 sub ResetPassword {
 707     my $self = shift;
 708
 709     unless ( $self->CurrentUserCanModify('Password') ) {
 710         return ( 0, $self->loc("Permission Denied") );
 711     }
 712     my ( $status, $pass ) = $self->SetRandomPassword();
 713
 714     unless ($status) {
 715         return ( 0, "$pass" );
 716     }
 717
 718     my $ret = RT::Interface::Email::SendEmailUsingTemplate(
 719         To        => $self->EmailAddress,
 720         Template  => 'PasswordChange',
 721         Arguments => {
 722             NewPassword => $pass,
 723         },
 724         );
 725
 726     if ($ret) {
 727         return ( 1, $self->loc('New password notification sent') );
 728     }
 729     else {
 730         return ( 0, $self->loc('Notification could not be sent') );
 731     }
 732
 733 }
 734
 735 =head3 GenerateRandomPassword MIN_LEN and MAX_LEN
 736
 737 Returns a random password between MIN_LEN and MAX_LEN characters long.
 738
 739 =cut
 740
 741 sub GenerateRandomPassword {
 742     my $self       = shift;
 743     my $min_length = shift;
 744     my $max_length = shift;
 745
 746     #This code derived from mpw.pl, a bit of code with a sordid history
 747     # Its notes:
 748
 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.
 753
 754     my ( $frequency, $start_freq, $total_sum, $row_sums );
 755
 756     #When munging characters, we need to know where to start counting letters from
 757     my $a = ord('a');
 758
 759     # frequency of English digraphs (from D Edwards 1/27/66)
 760     $frequency = [
 761         [
 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
 764         ],    # aa - az
 765         [
 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
 768         ],    # ba - bz
 769         [
 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
 772         ],    # ca - cz
 773         [
 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
 776         ],    # da - dz
 777         [
 778             84, 20, 55, 125, 51, 40, 19, 16,  50,  1,
 779             4,  55, 54, 146, 35, 37, 6,  191, 149, 65,
 780             9,  26, 21, 12,  5,  0
 781         ],    # ea - ez
 782         [
 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
 785         ],    # fa - fz
 786         [
 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
 789         ],    # ga - gz
 790         [
 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
 793         ],    # ha - hz
 794         [
 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
 797         ],    # ia - iz
 798         [
 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
 801         ],    # ja - jz
 802         [
 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
 805         ],    # ka - kz
 806         [
 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
 809         ],    # la - lz
 810         [
 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
 813         ],    # ma - mz
 814         [
 815             42, 10, 47, 122, 63, 19, 106, 12, 30, 1,
 816             6,  6,  9,  7,   54, 7,  1,   7,  44, 124,
 817             6,  1,  15, 0,   12, 0
 818         ],    # na - nz
 819         [
 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
 822         ],    # oa - oz
 823         [
 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
 826         ],    # pa - pz
 827         [
 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
 830         ],    # qa - qz
 831         [
 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
 834         ],    # ra - rz
 835         [
 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
 838         ],    # sa - sz
 839         [
 840             57, 22, 3,  1, 76, 5, 2, 330, 126, 1,
 841             0,  14, 10, 6, 79, 7, 0, 49,  50,  56,
 842             21, 2,  27, 0, 24, 0
 843         ],    # ta - tz
 844         [
 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
 847         ],    # ua - uz
 848         [
 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
 851         ],    # va - vz
 852         [
 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
 855         ],    # wa - wz
 856         [
 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
 859         ],    # xa - xz
 860         [
 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
 863         ],    # ya - yz
 864         [
 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
 867         ]
 868     ];    # za - zz
 869
 870     #We need to know the totals for each row
 871     $row_sums = [
 872         map {
 873             my $sum = 0;
 874             map { $sum += $_ } @$_;
 875             $sum;
 876           } @$frequency
 877     ];
 878
 879     #Frequency with which a given letter starts a word.
 880     $start_freq = [
 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
 884     ];
 885
 886     $total_sum = 0;
 887     map { $total_sum += $_ } @$start_freq;
 888
 889     my $length = $min_length + int( rand( $max_length - $min_length ) );
 890
 891     my $char = $self->_GenerateRandomNextChar( $total_sum, $start_freq );
 892     my @word = ( $char + $a );
 893     for ( 2 .. $length ) {
 894         $char =
 895           $self->_GenerateRandomNextChar( $row_sums->[$char],
 896             $frequency->[$char] );
 897         push ( @word, $char + $a );
 898     }
 899
 900     #Return the password
 901     return pack( "C*", @word );
 902
 903 }
 904
 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 {
 908     my $self = shift;
 909     my ( $all, $freq ) = @_;
 910     my ( $pos, $i );
 911
 912     for ( $pos = int( rand($all) ), $i = 0 ;
 913         $pos >= $freq->[$i] ;
 914         $pos -= $freq->[$i], $i++ )
 915     {
 916     }
 917
 918     return ($i);
 919 }
 920
 921 sub SafeSetPassword {
 922     my $self = shift;
 923     my %args = (
 924         Current      => undef,
 925         New          => undef,
 926         Confirmation => undef,
 927         @_,
 928     );
 929     return (1) unless defined $args{'New'} && length $args{'New'};
 930
 931     my %cond = $self->CurrentUserRequireToSetPassword;
 932
 933     unless ( $cond{'CanSet'} ) {
 934         return (0, $self->loc('You can not set password.') .' '. $cond{'Reason'} );
 935     }
 936
 937     my $error = '';
 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.");
 941         }
 942         else {
 943             $error = $self->loc("Please enter your current password.");
 944         }
 945     } elsif ( $args{'New'} ne $args{'Confirmation'} ) {
 946         $error = $self->loc("Passwords do not match.");
 947     }
 948
 949     if ( $error ) {
 950         $error .= ' '. $self->loc('Password has not been set.');
 951         return (0, $error);
 952     }
 953
 954     return $self->SetPassword( $args{'New'} );
 955 }
 956
 957 =head3 SetPassword
 958
 959 Takes a string. Checks the string's length and sets this user's password
 960 to that string.
 961
 962 =cut
 963
 964 sub SetPassword {
 965     my $self     = shift;
 966     my $password = shift;
 967
 968     unless ( $self->CurrentUserCanModify('Password') ) {
 969         return ( 0, $self->loc('Password: Permission Denied') );
 970     }
 971
 972     if ( !$password ) {
 973         return ( 0, $self->loc("No password set") );
 974     }
 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')) );
 977     }
 978     else {
 979         my $new = !$self->HasPassword;
 980         $password = $self->_GeneratePassword($password);
 981         my ( $val, $msg ) = $self->SUPER::SetPassword($password);
 982         if ($val) {
 983             return ( 1, $self->loc("Password set") ) if $new;
 984             return ( 1, $self->loc("Password changed") );
 985         }
 986         else {
 987             return ( $val, $msg );
 988         }
 989     }
 990
 991 }
 992
 993 =head3 _GeneratePassword PASSWORD [, SALT]
 994
 995 Returns a salted SHA-256 hash of the password passed in, in base64
 996 encoding.
 997
 998 =cut
 999
1000 sub _GeneratePassword {
1001     my $self = shift;
1002     my ($password, $salt) = @_;
1003
1004     # Generate a random 4-byte salt
1005     $salt ||= pack("C4",map{int rand(256)} 1..4);
1006
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
1010     # MD5 one.
1011     return MIME::Base64::encode_base64(
1012         $salt . substr(Digest::SHA::sha256($salt . Digest::MD5::md5($password)),0,26),
1013         "" # No newline
1014     );
1015 }
1016
1017 =head3 _GeneratePasswordBase64 PASSWORD
1018
1019 returns an MD5 hash of the password passed in, in base64 encoding
1020 (obsoleted now).
1021
1022 =cut
1023
1024 sub _GeneratePasswordBase64 {
1025     my $self = shift;
1026     my $password = shift;
1027
1028     my $md5 = Digest::MD5->new();
1029     $md5->add(encode_utf8($password));
1030     return ($md5->b64digest);
1031
1032 }
1033
1034 =head3 HasPassword
1035
1036 Returns true if the user has a valid password, otherwise returns false.
1037
1038 =cut
1039
1040 sub HasPassword {
1041     my $self = shift;
1042     my $pwd = $self->__Value('Password');
1043     return undef if !defined $pwd
1044                     || $pwd eq ''
1045                     || $pwd eq '*NO-PASSWORD*';
1046     return 1;
1047 }
1048
1049 =head3 IsPassword
1050
1051 Returns true if the passed in value is this user's password.
1052 Returns undef otherwise.
1053
1054 =cut
1055
1056 sub IsPassword {
1057     my $self  = shift;
1058     my $value = shift;
1059
1060     #TODO there isn't any apparent way to legitimately ACL this
1061
1062     # RT does not allow null passwords
1063     if ( ( !defined($value) ) or ( $value eq '' ) ) {
1064         return (undef);
1065     }
1066
1067    if ( $self->PrincipalObj->Disabled ) {
1068         $RT::Logger->info(
1069             "Disabled user " . $self->Name . " tried to log in" );
1070         return (undef);
1071     }
1072
1073     unless ($self->HasPassword) {
1074         return(undef);
1075      }
1076
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) {
1085         # Hex nonsalted-md5
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) {
1091         # crypt() output
1092         return 0 unless crypt(encode_utf8($value), $stored) eq $stored;
1093     } else {
1094         $RT::Logger->warning("Unknown password form");
1095         return 0;
1096     }
1097
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) );
1102     return 1;
1103 }
1104
1105 sub CurrentUserRequireToSetPassword {
1106     my $self = shift;
1107
1108     my %res = (
1109         CanSet => 1,
1110         Reason => '',
1111         RequireCurrent => 1,
1112     );
1113
1114     if ( RT->Config->Get('WebExternalAuth')
1115         && !RT->Config->Get('WebFallbackToInternalAuth')
1116     ) {
1117         $res{'CanSet'} = 0;
1118         $res{'Reason'} = $self->loc("External authentication enabled.");
1119     }
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;
1124         }
1125         else {
1126             $res{'CanSet'} = 0;
1127             $res{'Reason'} = $self->loc("Your password is not set.");
1128         }
1129     }
1130
1131     return %res;
1132 }
1133
1134 =head3 AuthToken
1135
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
1139 readers and other.
1140
1141 =cut
1142
1143 sub AuthToken {
1144     my $self = shift;
1145     my $secret = $self->FirstAttribute("AuthToken");
1146     return $secret->Content if $secret;
1147
1148     my $id = $self->id;
1149     $self = RT::User->new( $RT::SystemUser );
1150     $self->Load( $id );
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" );
1155         return undef;
1156     }
1157     return $secret;
1158 }
1159
1160 =head3 GenerateAuthToken
1161
1162 Generate a random authentication string for the user.
1163
1164 =cut
1165
1166 sub GenerateAuthToken {
1167     my $self = shift;
1168     my $token = substr(Digest::MD5::md5_hex(time . {} . rand()),0,16);
1169     return $self->SetAttribute( Name => "AuthToken", Content => $token );
1170 }
1171
1172 =head3 GenerateAuthString
1173
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>
1176
1177 =cut
1178
1179 sub GenerateAuthString {
1180     my $self = shift;
1181     my $protect = shift;
1182
1183     my $str = $self->AuthToken . $protect;
1184     utf8::encode($str);
1185
1186     return substr(Digest::MD5::md5_hex($str),0,16);
1187 }
1188
1189 =head3 ValidateAuthString
1190
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>.
1193
1194 =cut
1195
1196 sub ValidateAuthString {
1197     my $self = shift;
1198     my $auth_string = shift;
1199     my $protected = shift;
1200
1201     my $str = $self->AuthToken . $protected;
1202     utf8::encode( $str );
1203
1204     return $auth_string eq substr(Digest::MD5::md5_hex($str),0,16);
1205 }
1206
1207 =head2 SetDisabled
1208
1209 Toggles the user's disabled flag.
1210 If this flag is
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.
1213
1214 =cut
1215
1216 sub SetDisabled {
1217     my $self = shift;
1218     my $val = shift;
1219     unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1220         return (0, $self->loc('Permission Denied'));
1221     }
1222
1223     $RT::Handle->BeginTransaction();
1224     my $set_err = $self->PrincipalObj->SetDisabled($val);
1225     unless ($set_err) {
1226         $RT::Handle->Rollback();
1227         $RT::Logger->warning(sprintf("Couldn't %s user %s", ($val == 1) ? "disable" : "enable", $self->PrincipalObj->Id));
1228         return (undef);
1229     }
1230     $self->_NewTransaction( Type => ($val == 1) ? "Disabled" : "Enabled" );
1231
1232     $RT::Handle->Commit();
1233
1234     if ( $val == 1 ) {
1235         return (1, $self->loc("User disabled"));
1236     } else {
1237         return (1, $self->loc("User enabled"));
1238     }
1239
1240 }
1241
1242 =head2 Disabled
1243
1244 Returns true if user is disabled or false otherwise
1245
1246 =cut
1247
1248 sub Disabled {
1249     my $self = shift;
1250     return $self->PrincipalObj->Disabled(@_);
1251 }
1252
1253 =head2 PrincipalObj
1254
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.
1258
1259 =cut
1260
1261 sub PrincipalObj {
1262     my $self = shift;
1263
1264     unless ( $self->id ) {
1265         $RT::Logger->error("Couldn't get principal for not loaded object");
1266         return undef;
1267     }
1268
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 );
1273         return undef;
1274     } elsif ( $obj->PrincipalType ne 'User' ) {
1275         $RT::Logger->crit( 'User #'. $self->id .' has principal of '. $obj->PrincipalType .' type' );
1276         return undef;
1277     }
1278     return $obj;
1279 }
1280
1281
1282 =head2 PrincipalId
1283
1284 Returns this user's PrincipalId
1285
1286 =cut
1287
1288 sub PrincipalId {
1289     my $self = shift;
1290     return $self->Id;
1291 }
1292
1293 =head2 HasGroupRight
1294
1295 Takes a paramhash which can contain
1296 these items:
1297     GroupObj => RT::Group or Group => integer
1298     Right => 'Right'
1299
1300
1301 Returns 1 if this user has the right specified in the paramhash for the Group
1302 passed in.
1303
1304 Returns undef if they don't.
1305
1306 =cut
1307
1308 sub HasGroupRight {
1309     my $self = shift;
1310     my %args = (
1311         GroupObj    => undef,
1312         Group       => undef,
1313         Right       => undef,
1314         @_
1315     );
1316
1317
1318     if ( defined $args{'Group'} ) {
1319         $args{'GroupObj'} = RT::Group->new( $self->CurrentUser );
1320         $args{'GroupObj'}->Load( $args{'Group'} );
1321     }
1322
1323     # Validate and load up the GroupId
1324     unless ( ( defined $args{'GroupObj'} ) and ( $args{'GroupObj'}->Id ) ) {
1325         return undef;
1326     }
1327
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'},
1332     );
1333
1334     return ($retval);
1335 }
1336
1337 =head2 OwnGroups
1338
1339 Returns a group collection object containing the groups of which this
1340 user is a member.
1341
1342 =cut
1343
1344 sub OwnGroups {
1345     my $self = shift;
1346     my $groups = RT::Groups->new($self->CurrentUser);
1347     $groups->LimitToUserDefinedGroups;
1348     $groups->WithMember(PrincipalId => $self->Id,
1349             Recursively => 1);
1350     return $groups;
1351 }
1352
1353 # }}}
1354
1355 # {{{ Links
1356
1357 #much false laziness w/Ticket_Overlay.pm.  now with RT 3.8!
1358
1359 # A helper table for links mapping to make it easier
1360 # to build and parse links between tickets
1361
1362 use vars '%LINKDIRMAP';
1363
1364 %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', },
1373
1374 );
1375
1376 sub LINKDIRMAP   { return \%LINKDIRMAP   }
1377
1378 #sub _Links {
1379 #    my $self = shift;
1380 #
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 || "";
1385 #
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' );
1401 #            }
1402 #            $self->{"$field$type"}->Limit( FIELD => 'Type',
1403 #                                           VALUE => $type )
1404 #              if ($type);
1405 #        }
1406 #    }
1407 #    return ( $self->{"$field$type"} );
1408 #}
1409
1410 =head2 DeleteLink
1411
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
1415
1416 =cut
1417
1418 sub DeleteLink {
1419     my $self = shift;
1420     my %args = (
1421         Base   => undef,
1422         Target => undef,
1423         Type   => undef,
1424         @_
1425     );
1426
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') );
1430     }
1431
1432     #check acls
1433     my $right = 0;
1434     $right++ if $self->CurrentUserHasRight('AdminUsers');
1435     if ( !$right && $RT::StrictLinkACL ) {
1436         return ( 0, $self->loc("Permission Denied") );
1437     }
1438
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') ) {
1444 #        $right++;
1445 #    }
1446 #    if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
1447 #         ( $RT::StrictLinkACL && $right < 2 ) )
1448 #    {
1449 #        return ( 0, $self->loc("Permission Denied") );
1450 #    }
1451
1452     my ($val, $Msg) = $self->SUPER::_DeleteLink(%args);
1453
1454     if ( !$val ) {
1455         $RT::Logger->debug("Couldn't find that link\n");
1456         return ( 0, $Msg );
1457     }
1458
1459     my ($direction, $remote_link);
1460
1461     if ( $args{'Base'} ) {
1462         $remote_link = $args{'Base'};
1463         $direction = 'Target';
1464     }
1465     elsif ( $args{'Target'} ) {
1466         $remote_link = $args{'Target'};
1467         $direction='Base';
1468     }
1469
1470     if ( $args{'Silent'} ) {
1471         return ( $val, $Msg );
1472     }
1473     else {
1474         my $remote_uri = RT::URI->new( $self->CurrentUser );
1475         $remote_uri->FromURI( $remote_link );
1476
1477         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1478             Type      => 'DeleteLink',
1479             Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
1480             OldValue =>  $remote_uri->URI || $remote_link,
1481             TimeTaken => 0
1482         );
1483
1484         if ( $remote_uri->IsLocal ) {
1485
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,
1492                                                            TimeTaken => 0 );
1493         }
1494
1495         return ( $Trans, $Msg );
1496     }
1497 }
1498
1499 sub AddLink {
1500     my $self = shift;
1501     my %args = ( Target => '',
1502                  Base   => '',
1503                  Type   => '',
1504                  Silent => undef,
1505                  @_ );
1506
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') );
1510     }
1511
1512     my $right = 0;
1513     $right++ if $self->CurrentUserHasRight('AdminUsers');
1514     if ( !$right && $RT::StrictLinkACL ) {
1515         return ( 0, $self->loc("Permission Denied") );
1516     }
1517
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') ) {
1523 #        $right++;
1524 #    }
1525 #    if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
1526 #         ( $RT::StrictLinkACL && $right < 2 ) )
1527 #    {
1528 #        return ( 0, $self->loc("Permission Denied") );
1529 #    }
1530
1531     return $self->_AddLink(%args);
1532 }
1533
1534 #sub __GetTicketFromURI {
1535 #    my $self = shift;
1536 #    my %args = ( URI => '', @_ );
1537 #
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'} );
1542 #
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 );
1547 #    }
1548 #    my $obj = $uri_obj->Resolver->Object;
1549 #    unless ( UNIVERSAL::isa($obj, 'RT::Ticket') && $obj->id ) {
1550 #        return (1, 'Found not a ticket', undef);
1551 #    }
1552 #    return (1, 'Found ticket', $obj);
1553 #}
1554
1555 =head2 _AddLink
1556
1557 Private non-acled variant of AddLink so that links can be added during create.
1558
1559 =cut
1560
1561 sub _AddLink {
1562     my $self = shift;
1563     my %args = ( Target => '',
1564                  Base   => '',
1565                  Type   => '',
1566                  Silent => undef,
1567                  @_ );
1568
1569     my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args);
1570     return ($val, $msg) if !$val || $exist;
1571
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';
1579     }
1580
1581     # Don't write the transaction if we're doing this on create
1582     if ( $args{'Silent'} ) {
1583         return ( $val, $msg );
1584     }
1585     else {
1586         my $remote_uri = RT::URI->new( $self->CurrentUser );
1587         $remote_uri->FromURI( $remote_link );
1588
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,
1594                                    TimeTaken => 0 );
1595
1596         if ( $remote_uri->IsLocal ) {
1597
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,
1604                                                            TimeTaken => 0 );
1605         }
1606         return ( $val, $Msg );
1607     }
1608
1609 }
1610
1611
1612
1613 # }}}
1614
1615 =head2 HasRight
1616
1617 Shim around PrincipalObj->HasRight. See L<RT::Principal>.
1618
1619 =cut
1620
1621 sub HasRight {
1622     my $self = shift;
1623     return $self->PrincipalObj->HasRight(@_);
1624 }
1625
1626 =head2 CurrentUserCanSee [FIELD]
1627
1628 Returns true if the current user can see the user, based on if it is
1629 public, ourself, or we have AdminUsers
1630
1631 =cut
1632
1633 sub CurrentUserCanSee {
1634     my $self = shift;
1635     my ($what) = @_;
1636
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' ) ) {
1640         return 1;
1641     }
1642
1643     # Users can see their own properties
1644     elsif ( defined($self->Id) && $self->CurrentUser->Id == $self->Id ) {
1645         return 1;
1646     }
1647
1648     # If the user has the admin users right, that's also enough
1649     elsif ( $self->CurrentUser->HasRight( Right => 'AdminUsers', Object => $RT::System) ) {
1650         return 1;
1651     }
1652     else {
1653         return 0;
1654     }
1655 }
1656
1657 =head2 CurrentUserCanModify RIGHT
1658
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.
1662
1663 =cut
1664
1665 sub CurrentUserCanModify {
1666     my $self  = shift;
1667     my $field = shift;
1668
1669     if ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1670         return (1);
1671     }
1672
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' ) ) {
1676         return (undef);
1677     }
1678
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) ) )
1682     {
1683         return (1);
1684     }
1685
1686     #If we don\'t have a good reason to grant them rights to modify
1687     # by now, they lose
1688     else {
1689         return (undef);
1690     }
1691
1692 }
1693
1694 =head2 CurrentUserHasRight
1695
1696 Takes a single argument. returns 1 if $Self->CurrentUser
1697 has the requested right. returns undef otherwise
1698
1699 =cut
1700
1701 sub CurrentUserHasRight {
1702     my $self  = shift;
1703     my $right = shift;
1704
1705     return ( $self->CurrentUser->HasRight(Right => $right, Object => $RT::System) );
1706 }
1707
1708 sub _PrefName {
1709     my $name = shift;
1710     if (ref $name) {
1711         $name = ref($name).'-'.$name->Id;
1712     }
1713
1714     return 'Pref-'.$name;
1715 }
1716
1717 =head2 Preferences NAME/OBJ DEFAULT
1718
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.
1722
1723 =cut
1724
1725 sub Preferences {
1726     my $self  = shift;
1727     my $name = _PrefName (shift);
1728     my $default = shift;
1729
1730     my $attr = RT::Attribute->new( $self->CurrentUser );
1731     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1732
1733     my $content = $attr->Id ? $attr->Content : undef;
1734     unless ( ref $content eq 'HASH' ) {
1735         return defined $content ? $content : $default;
1736     }
1737
1738     if (ref $default eq 'HASH') {
1739         for (keys %$default) {
1740             exists $content->{$_} or $content->{$_} = $default->{$_};
1741         }
1742     }
1743     elsif (defined $default) {
1744         $RT::Logger->error("Preferences $name for user".$self->Id." is hash but default is not");
1745     }
1746     return $content;
1747 }
1748
1749 =head2 SetPreferences NAME/OBJ VALUE
1750
1751 Set user preferences associated with given object or name.
1752
1753 =cut
1754
1755 sub SetPreferences {
1756     my $self = shift;
1757     my $name = _PrefName( shift );
1758     my $value = shift;
1759
1760     return (0, $self->loc("No permission to set preferences"))
1761         unless $self->CurrentUserCanModify('Preferences');
1762
1763     my $attr = RT::Attribute->new( $self->CurrentUser );
1764     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1765     if ( $attr->Id ) {
1766         return $attr->SetContent( $value );
1767     }
1768     else {
1769         return $self->AddAttribute( Name => $name, Content => $value );
1770     }
1771 }
1772
1773 =head2 WatchedQueues ROLE_LIST
1774
1775 Returns a RT::Queues object containing every queue watched by the user.
1776
1777 Takes a list of roles which is some subset of ('Cc', 'AdminCc').  Defaults to:
1778
1779 $user->WatchedQueues('Cc', 'AdminCc');
1780
1781 =cut
1782
1783 sub WatchedQueues {
1784
1785     my $self = shift;
1786     my @roles = @_ || ('Cc', 'AdminCc');
1787
1788     $RT::Logger->debug('WatcheQueues got user ' . $self->Name);
1789
1790     my $watched_queues = RT::Queues->new($self->CurrentUser);
1791
1792     my $group_alias = $watched_queues->Join(
1793                                              ALIAS1 => 'main',
1794                                              FIELD1 => 'id',
1795                                              TABLE2 => 'Groups',
1796                                              FIELD2 => 'Instance',
1797                                            );
1798
1799     $watched_queues->Limit(
1800                             ALIAS => $group_alias,
1801                             FIELD => 'Domain',
1802                             VALUE => 'RT::Queue-Role',
1803                             ENTRYAGGREGATOR => 'AND',
1804                           );
1805     if (grep { $_ eq 'Cc' } @roles) {
1806         $watched_queues->Limit(
1807                                 SUBCLAUSE => 'LimitToWatchers',
1808                                 ALIAS => $group_alias,
1809                                 FIELD => 'Type',
1810                                 VALUE => 'Cc',
1811                                 ENTRYAGGREGATOR => 'OR',
1812                               );
1813     }
1814     if (grep { $_ eq 'AdminCc' } @roles) {
1815         $watched_queues->Limit(
1816                                 SUBCLAUSE => 'LimitToWatchers',
1817                                 ALIAS => $group_alias,
1818                                 FIELD => 'Type',
1819                                 VALUE => 'AdminCc',
1820                                 ENTRYAGGREGATOR => 'OR',
1821                               );
1822     }
1823
1824     my $queues_alias = $watched_queues->Join(
1825                                               ALIAS1 => $group_alias,
1826                                               FIELD1 => 'id',
1827                                               TABLE2 => 'CachedGroupMembers',
1828                                               FIELD2 => 'GroupId',
1829                                             );
1830     $watched_queues->Limit(
1831                             ALIAS => $queues_alias,
1832                             FIELD => 'MemberId',
1833                             VALUE => $self->PrincipalId,
1834                           );
1835     $watched_queues->Limit(
1836                             ALIAS => $queues_alias,
1837                             FIELD => 'Disabled',
1838                             VALUE => 0,
1839                           );
1840
1841
1842     $RT::Logger->debug("WatchedQueues got " . $watched_queues->Count . " queues");
1843
1844     return $watched_queues;
1845
1846 }
1847
1848 =head2 CleanupInvalidDelegations { InsideTransaction => undef }
1849
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.
1853
1854 If called from inside a transaction, specify a true value for the
1855 InsideTransaction parameter.
1856
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).
1859
1860 =cut
1861
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.
1866
1867 # backcompat for 3.8.8 and before
1868 *_CleanupInvalidDelegations = \&CleanupInvalidDelegations;
1869
1870 sub CleanupInvalidDelegations {
1871     my $self = shift;
1872     my %args = ( InsideTransaction => undef,
1873           @_ );
1874
1875     unless ( $self->Id ) {
1876     $RT::Logger->warning("User not loaded.");
1877     return (undef);
1878     }
1879
1880     my $in_trans = $args{InsideTransaction};
1881
1882     return(1) if ($self->HasRight(Right => 'DelegateRights',
1883                   Object => $RT::System));
1884
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',
1891                OPERATOR => '=',
1892                VALUE => 'DelegateRights' );
1893     my @allowed_deleg_objects = map {$_->Object()}
1894     @{$deleg_acl->ItemsArrayRef()};
1895
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($_);
1902     }
1903
1904     # Delete all disallowed delegations
1905     while ( my $ace = $acl_to_del->Next() ) {
1906     my $ret = $ace->_Delete(InsideTransaction => 1);
1907     unless ($ret) {
1908         $RT::Handle->Rollback() unless $in_trans;
1909         $RT::Logger->warning("Couldn't delete delegated ACL entry ".$ace->Id);
1910         return (undef);
1911     }
1912     }
1913
1914     $RT::Handle->Commit() unless $in_trans;
1915     return (1);
1916 }
1917
1918 sub _Set {
1919     my $self = shift;
1920
1921     my %args = (
1922         Field => undef,
1923         Value => undef,
1924     TransactionType   => 'Set',
1925     RecordTransaction => 1,
1926         @_
1927     );
1928
1929     # Nobody is allowed to futz with RT_System or Nobody
1930
1931     if ( ($self->Id == $RT::SystemUser->Id )  ||
1932          ($self->Id == $RT::Nobody->Id)) {
1933         return ( 0, $self->loc("Can not modify system users") );
1934     }
1935     unless ( $self->CurrentUserCanModify( $args{'Field'} ) ) {
1936         return ( 0, $self->loc("Permission Denied") );
1937     }
1938
1939     my $Old = $self->SUPER::_Value("$args{'Field'}");
1940
1941     my ($ret, $msg) = $self->SUPER::_Set( Field => $args{'Field'},
1942                       Value => $args{'Value'} );
1943
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 ); }
1947
1948     if ( $args{'RecordTransaction'} == 1 ) {
1949         if ($args{'Field'} eq "Password") {
1950             $args{'Value'} = $Old = '********';
1951         }
1952         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1953                                                Type => $args{'TransactionType'},
1954                                                Field     => $args{'Field'},
1955                                                NewValue  => $args{'Value'},
1956                                                OldValue  => $Old,
1957                                                TimeTaken => $args{'TimeTaken'},
1958         );
1959         return ( $Trans, scalar $TransObj->BriefDescription );
1960     }
1961     else {
1962         return ( $ret, $msg );
1963     }
1964 }
1965
1966 =head2 _Value
1967
1968 Takes the name of a table column.
1969 Returns its value as a string, if the user passes an ACL check
1970
1971 =cut
1972
1973 sub _Value {
1974
1975     my $self  = shift;
1976     my $field = shift;
1977
1978     # Defer to the abstraction above to know if the field can be read
1979     return $self->SUPER::_Value($field) if $self->CurrentUserCanSee($field);
1980     return undef;
1981 }
1982
1983 =head2 FriendlyName
1984
1985 Return the friendly name
1986
1987 =cut
1988
1989 sub FriendlyName {
1990     my $self = shift;
1991     return $self->RealName if defined($self->RealName);
1992     return $self->Name if defined($self->Name);
1993     return "";
1994 }
1995
1996 =head2 PreferredKey
1997
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.
2001
2002 =cut
2003
2004 sub PreferredKey
2005 {
2006     my $self = shift;
2007     return undef unless RT->Config->Get('GnuPG')->{'Enable'};
2008
2009     if ( ($self->CurrentUser->Id != $self->Id )  &&
2010           !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
2011           return undef;
2012     }
2013
2014
2015
2016     my $prefkey = $self->FirstAttribute('PreferredKey');
2017     return $prefkey->Content if $prefkey;
2018
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;
2025
2026     if (@keys == 1) {
2027         $prefkey = $keys[0]->{'Fingerprint'};
2028     }
2029     else {
2030         # prefer the maximally trusted key
2031         @keys = sort { $b->{'TrustLevel'} <=> $a->{'TrustLevel'} } @keys;
2032         $prefkey = $keys[0]->{'Fingerprint'};
2033     }
2034
2035     $self->SetAttribute(Name => 'PreferredKey', Content => $prefkey);
2036     return $prefkey;
2037 }
2038
2039 sub PrivateKey {
2040     my $self = shift;
2041
2042
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.
2046     #
2047     if ( ($self->CurrentUser->Id != $self->Id )  &&
2048           !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
2049           return undef;
2050     }
2051
2052     my $key = $self->FirstAttribute('PrivateKey') or return undef;
2053     return $key->Content;
2054 }
2055
2056 sub SetPrivateKey {
2057     my $self = shift;
2058     my $key = shift;
2059
2060     unless ($self->CurrentUserCanModify('PrivateKey')) {
2061         return (0, $self->loc("Permission Denied"));
2062     }
2063
2064     unless ( $key ) {
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"));
2069         }
2070         return ($status, $self->loc("Unset private key"));
2071     }
2072
2073     # check that it's really private key
2074     {
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'};
2078     }
2079
2080     my ($status, $msg) = $self->SetAttribute(
2081         Name => 'PrivateKey',
2082         Content => $key,
2083     );
2084     return ($status, $self->loc("Couldn't set private key"))
2085         unless $status;
2086     return ($status, $self->loc("Set private key"));
2087 }
2088
2089 sub BasicColumns {
2090     (
2091     [ Name => 'User Id' ],
2092     [ EmailAddress => 'Email' ],
2093     [ RealName => 'Name' ],
2094     [ Organization => 'Organization' ],
2095     );
2096 }
2097
2098 1;
2099
2100