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