rt/lib/RT/User.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2012 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 =head1 METHODS
  60
  61 =cut
  62
  63
  64 package RT::User;
  65
  66 use strict;
  67 use warnings;
  68
  69
  70 use base 'RT::Record';
  71
  72 sub Table {'Users'}
  73
  74
  75
  76
  77
  78
  79 use Digest::SHA;
  80 use Digest::MD5;
  81 use RT::Principals;
  82 use RT::ACE;
  83 use RT::Interface::Email;
  84 use Encode;
  85 use Text::Password::Pronounceable;
  86
  87 sub _OverlayAccessible {
  88     {
  89
  90         Name                    => { public => 1,  admin => 1 },
  91           Password              => { read   => 0 },
  92           EmailAddress          => { public => 1 },
  93           Organization          => { public => 1,  admin => 1 },
  94           RealName              => { public => 1 },
  95           NickName              => { public => 1 },
  96           Lang                  => { public => 1 },
  97           EmailEncoding         => { public => 1 },
  98           WebEncoding           => { public => 1 },
  99           ExternalContactInfoId => { public => 1,  admin => 1 },
 100           ContactInfoSystem     => { public => 1,  admin => 1 },
 101           ExternalAuthId        => { public => 1,  admin => 1 },
 102           AuthSystem            => { public => 1,  admin => 1 },
 103           Gecos                 => { public => 1,  admin => 1 },
 104           PGPKey                => { public => 1,  admin => 1 },
 105           PrivateKey            => {               admin => 1 },
 106
 107     }
 108 }
 109
 110
 111
 112 =head2 Create { PARAMHASH }
 113
 114
 115
 116 =cut
 117
 118
 119 sub Create {
 120     my $self = shift;
 121     my %args = (
 122         Privileged => 0,
 123         Disabled => 0,
 124         EmailAddress => '',
 125         _RecordTransaction => 1,
 126         @_    # get the real argumentlist
 127     );
 128
 129     # remove the value so it does not cripple SUPER::Create
 130     my $record_transaction = delete $args{'_RecordTransaction'};
 131
 132     #Check the ACL
 133     unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
 134         return ( 0, $self->loc('Permission Denied') );
 135     }
 136
 137
 138     unless ($self->CanonicalizeUserInfo(\%args)) {
 139         return ( 0, $self->loc("Could not set user info") );
 140     }
 141
 142     $args{'EmailAddress'} = $self->CanonicalizeEmailAddress($args{'EmailAddress'});
 143
 144     # if the user doesn't have a name defined, set it to the email address
 145     $args{'Name'} = $args{'EmailAddress'} unless ($args{'Name'});
 146
 147
 148
 149     my $privileged = delete $args{'Privileged'};
 150
 151
 152     if ($args{'CryptedPassword'} ) {
 153         $args{'Password'} = $args{'CryptedPassword'};
 154         delete $args{'CryptedPassword'};
 155     } elsif ( !$args{'Password'} ) {
 156         $args{'Password'} = '*NO-PASSWORD*';
 157     } else {
 158         my ($ok, $msg) = $self->ValidatePassword($args{'Password'});
 159         return ($ok, $msg) if !$ok;
 160
 161         $args{'Password'} = $self->_GeneratePassword($args{'Password'});
 162     }
 163
 164     #TODO Specify some sensible defaults.
 165
 166     unless ( $args{'Name'} ) {
 167         return ( 0, $self->loc("Must specify 'Name' attribute") );
 168     }
 169
 170     #SANITY CHECK THE NAME AND ABORT IF IT'S TAKEN
 171     if (RT->SystemUser) {   #This only works if RT::SystemUser has been defined
 172         my $TempUser = RT::User->new(RT->SystemUser);
 173         $TempUser->Load( $args{'Name'} );
 174         return ( 0, $self->loc('Name in use') ) if ( $TempUser->Id );
 175
 176         my ($val, $message) = $self->ValidateEmailAddress( $args{'EmailAddress'} );
 177         return (0, $message) unless ( $val );
 178     } else {
 179         $RT::Logger->warning( "$self couldn't check for pre-existing users");
 180     }
 181
 182
 183     $RT::Handle->BeginTransaction();
 184     # Groups deal with principal ids, rather than user ids.
 185     # When creating this user, set up a principal Id for it.
 186     my $principal = RT::Principal->new($self->CurrentUser);
 187     my $principal_id = $principal->Create(PrincipalType => 'User',
 188                                 Disabled => $args{'Disabled'},
 189                                 ObjectId => '0');
 190     # If we couldn't create a principal Id, get the fuck out.
 191     unless ($principal_id) {
 192         $RT::Handle->Rollback();
 193         $RT::Logger->crit("Couldn't create a Principal on new user create.");
 194         $RT::Logger->crit("Strange things are afoot at the circle K");
 195         return ( 0, $self->loc('Could not create user') );
 196     }
 197
 198     $principal->__Set(Field => 'ObjectId', Value => $principal_id);
 199     delete $args{'Disabled'};
 200
 201     $self->SUPER::Create(id => $principal_id , %args);
 202     my $id = $self->Id;
 203
 204     #If the create failed.
 205     unless ($id) {
 206         $RT::Handle->Rollback();
 207         $RT::Logger->error("Could not create a new user - " .join('-', %args));
 208
 209         return ( 0, $self->loc('Could not create user') );
 210     }
 211
 212     my $aclstash = RT::Group->new($self->CurrentUser);
 213     my $stash_id = $aclstash->_CreateACLEquivalenceGroup($principal);
 214
 215     unless ($stash_id) {
 216         $RT::Handle->Rollback();
 217         $RT::Logger->crit("Couldn't stash the user in groupmembers");
 218         return ( 0, $self->loc('Could not create user') );
 219     }
 220
 221
 222     my $everyone = RT::Group->new($self->CurrentUser);
 223     $everyone->LoadSystemInternalGroup('Everyone');
 224     unless ($everyone->id) {
 225         $RT::Logger->crit("Could not load Everyone group on user creation.");
 226         $RT::Handle->Rollback();
 227         return ( 0, $self->loc('Could not create user') );
 228     }
 229
 230
 231     my ($everyone_id, $everyone_msg) = $everyone->_AddMember( InsideTransaction => 1, PrincipalId => $self->PrincipalId);
 232     unless ($everyone_id) {
 233         $RT::Logger->crit("Could not add user to Everyone group on user creation.");
 234         $RT::Logger->crit($everyone_msg);
 235         $RT::Handle->Rollback();
 236         return ( 0, $self->loc('Could not create user') );
 237     }
 238
 239
 240     my $access_class = RT::Group->new($self->CurrentUser);
 241     if ($privileged)  {
 242         $access_class->LoadSystemInternalGroup('Privileged');
 243     } else {
 244         $access_class->LoadSystemInternalGroup('Unprivileged');
 245     }
 246
 247     unless ($access_class->id) {
 248         $RT::Logger->crit("Could not load Privileged or Unprivileged group on user creation");
 249         $RT::Handle->Rollback();
 250         return ( 0, $self->loc('Could not create user') );
 251     }
 252
 253
 254     my ($ac_id, $ac_msg) = $access_class->_AddMember( InsideTransaction => 1, PrincipalId => $self->PrincipalId);
 255
 256     unless ($ac_id) {
 257         $RT::Logger->crit("Could not add user to Privileged or Unprivileged group on user creation. Aborted");
 258         $RT::Logger->crit($ac_msg);
 259         $RT::Handle->Rollback();
 260         return ( 0, $self->loc('Could not create user') );
 261     }
 262
 263
 264     if ( $record_transaction ) {
 265         $self->_NewTransaction( Type => "Create" );
 266     }
 267
 268     $RT::Handle->Commit;
 269
 270     return ( $id, $self->loc('User created') );
 271 }
 272
 273 =head2 ValidatePassword STRING
 274
 275 Returns either (0, "failure reason") or 1 depending on whether the given
 276 password is valid.
 277
 278 =cut
 279
 280 sub ValidatePassword {
 281     my $self = shift;
 282     my $password = shift;
 283
 284     if ( length($password) < RT->Config->Get('MinimumPasswordLength') ) {
 285         return ( 0, $self->loc("Password needs to be at least [_1] characters long", RT->Config->Get('MinimumPasswordLength')) );
 286     }
 287
 288     return 1;
 289 }
 290
 291 =head2 SetPrivileged BOOL
 292
 293 If passed a true value, makes this user a member of the "Privileged"  PseudoGroup.
 294 Otherwise, makes this user a member of the "Unprivileged" pseudogroup.
 295
 296 Returns a standard RT tuple of (val, msg);
 297
 298
 299 =cut
 300
 301 sub SetPrivileged {
 302     my $self = shift;
 303     my $val = shift;
 304
 305     #Check the ACL
 306     unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
 307         return ( 0, $self->loc('Permission Denied') );
 308     }
 309
 310     $self->_SetPrivileged($val);
 311 }
 312
 313 sub _SetPrivileged {
 314     my $self = shift;
 315     my $val = shift;
 316     my $priv = RT::Group->new($self->CurrentUser);
 317     $priv->LoadSystemInternalGroup('Privileged');
 318     unless ($priv->Id) {
 319         $RT::Logger->crit("Could not find Privileged pseudogroup");
 320         return(0,$self->loc("Failed to find 'Privileged' users pseudogroup."));
 321     }
 322
 323     my $unpriv = RT::Group->new($self->CurrentUser);
 324     $unpriv->LoadSystemInternalGroup('Unprivileged');
 325     unless ($unpriv->Id) {
 326         $RT::Logger->crit("Could not find unprivileged pseudogroup");
 327         return(0,$self->loc("Failed to find 'Unprivileged' users pseudogroup"));
 328     }
 329
 330     my $principal = $self->PrincipalId;
 331     if ($val) {
 332         if ($priv->HasMember($principal)) {
 333             #$RT::Logger->debug("That user is already privileged");
 334             return (0,$self->loc("That user is already privileged"));
 335         }
 336         if ($unpriv->HasMember($principal)) {
 337             $unpriv->_DeleteMember($principal);
 338         } else {
 339         # if we had layered transactions, life would be good
 340         # sadly, we have to just go ahead, even if something
 341         # bogus happened
 342             $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
 343                 "unprivileged. something is drastically wrong.");
 344         }
 345         my ($status, $msg) = $priv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
 346         if ($status) {
 347             return (1, $self->loc("That user is now privileged"));
 348         } else {
 349             return (0, $msg);
 350         }
 351     } else {
 352         if ($unpriv->HasMember($principal)) {
 353             #$RT::Logger->debug("That user is already unprivileged");
 354             return (0,$self->loc("That user is already unprivileged"));
 355         }
 356         if ($priv->HasMember($principal)) {
 357             $priv->_DeleteMember( $principal );
 358         } else {
 359         # if we had layered transactions, life would be good
 360         # sadly, we have to just go ahead, even if something
 361         # bogus happened
 362             $RT::Logger->crit("User ".$self->Id." is neither privileged nor ".
 363                 "unprivileged. something is drastically wrong.");
 364         }
 365         my ($status, $msg) = $unpriv->_AddMember( InsideTransaction => 1, PrincipalId => $principal);
 366         if ($status) {
 367             return (1, $self->loc("That user is now unprivileged"));
 368         } else {
 369             return (0, $msg);
 370         }
 371     }
 372 }
 373
 374 =head2 Privileged
 375
 376 Returns true if this user is privileged. Returns undef otherwise.
 377
 378 =cut
 379
 380 sub Privileged {
 381     my $self = shift;
 382     if ( RT->PrivilegedUsers->HasMember( $self->id ) ) {
 383         return(1);
 384     } else {
 385         return(undef);
 386     }
 387 }
 388
 389 #create a user without validating _any_ data.
 390
 391 #To be used only on database init.
 392 # We can't localize here because it's before we _have_ a loc framework
 393
 394 sub _BootstrapCreate {
 395     my $self = shift;
 396     my %args = (@_);
 397
 398     $args{'Password'} = '*NO-PASSWORD*';
 399
 400
 401     $RT::Handle->BeginTransaction();
 402
 403     # Groups deal with principal ids, rather than user ids.
 404     # When creating this user, set up a principal Id for it.
 405     my $principal = RT::Principal->new($self->CurrentUser);
 406     my $principal_id = $principal->Create(PrincipalType => 'User', ObjectId => '0');
 407     $principal->__Set(Field => 'ObjectId', Value => $principal_id);
 408
 409     # If we couldn't create a principal Id, get the fuck out.
 410     unless ($principal_id) {
 411         $RT::Handle->Rollback();
 412         $RT::Logger->crit("Couldn't create a Principal on new user create. Strange things are afoot at the circle K");
 413         return ( 0, 'Could not create user' );
 414     }
 415     $self->SUPER::Create(id => $principal_id, %args);
 416     my $id = $self->Id;
 417     #If the create failed.
 418       unless ($id) {
 419       $RT::Handle->Rollback();
 420       return ( 0, 'Could not create user' ) ; #never loc this
 421     }
 422
 423     my $aclstash = RT::Group->new($self->CurrentUser);
 424     my $stash_id  = $aclstash->_CreateACLEquivalenceGroup($principal);
 425
 426     unless ($stash_id) {
 427         $RT::Handle->Rollback();
 428         $RT::Logger->crit("Couldn't stash the user in groupmembers");
 429         return ( 0, $self->loc('Could not create user') );
 430     }
 431
 432     $RT::Handle->Commit();
 433
 434     return ( $id, 'User created' );
 435 }
 436
 437 sub Delete {
 438     my $self = shift;
 439
 440     return ( 0, $self->loc('Deleting this object would violate referential integrity') );
 441
 442 }
 443
 444 =head2 Load
 445
 446 Load a user object from the database. Takes a single argument.
 447 If the argument is numerical, load by the column 'id'. If a user
 448 object or its subclass passed then loads the same user by id.
 449 Otherwise, load by the "Name" column which is the user's textual
 450 username.
 451
 452 =cut
 453
 454 sub Load {
 455     my $self = shift;
 456     my $identifier = shift || return undef;
 457
 458     if ( $identifier !~ /\D/ ) {
 459         return $self->SUPER::LoadById( $identifier );
 460     } elsif ( UNIVERSAL::isa( $identifier, 'RT::User' ) ) {
 461         return $self->SUPER::LoadById( $identifier->Id );
 462     } else {
 463         return $self->LoadByCol( "Name", $identifier );
 464     }
 465 }
 466
 467 =head2 LoadByEmail
 468
 469 Tries to load this user object from the database by the user's email address.
 470
 471 =cut
 472
 473 sub LoadByEmail {
 474     my $self    = shift;
 475     my $address = shift;
 476
 477     # Never load an empty address as an email address.
 478     unless ($address) {
 479         return (undef);
 480     }
 481
 482     $address = $self->CanonicalizeEmailAddress($address);
 483
 484     #$RT::Logger->debug("Trying to load an email address: $address");
 485     return $self->LoadByCol( "EmailAddress", $address );
 486 }
 487
 488 =head2 LoadOrCreateByEmail ADDRESS
 489
 490 Attempts to find a user who has the provided email address. If that fails, creates an unprivileged user with
 491 the provided email address and loads them. Address can be provided either as L<Email::Address> object
 492 or string which is parsed using the module.
 493
 494 Returns a tuple of the user's id and a status message.
 495 0 will be returned in place of the user's id in case of failure.
 496
 497 =cut
 498
 499 sub LoadOrCreateByEmail {
 500     my $self = shift;
 501     my $email = shift;
 502
 503     my ($message, $name);
 504     if ( UNIVERSAL::isa( $email => 'Email::Address' ) ) {
 505         ($email, $name) = ($email->address, $email->phrase);
 506     } else {
 507         ($email, $name) = RT::Interface::Email::ParseAddressFromHeader( $email );
 508     }
 509
 510     $self->LoadByEmail( $email );
 511     $self->Load( $email ) unless $self->Id;
 512     $message = $self->loc('User loaded');
 513
 514     unless( $self->Id ) {
 515         my $val;
 516         ($val, $message) = $self->Create(
 517             Name         => $email,
 518             EmailAddress => $email,
 519             RealName     => $name,
 520             Privileged   => 0,
 521             Comments     => 'Autocreated when added as a watcher',
 522         );
 523         unless ( $val ) {
 524             # Deal with the race condition of two account creations at once
 525             $self->LoadByEmail( $email );
 526             unless ( $self->Id ) {
 527                 sleep 5;
 528                 $self->LoadByEmail( $email );
 529             }
 530             if ( $self->Id ) {
 531                 $RT::Logger->error("Recovered from creation failure due to race condition");
 532                 $message = $self->loc("User loaded");
 533             } else {
 534                 $RT::Logger->crit("Failed to create user ". $email .": " .$message);
 535             }
 536         }
 537     }
 538     return (0, $message) unless $self->id;
 539     return ($self->Id, $message);
 540 }
 541
 542 =head2 ValidateEmailAddress ADDRESS
 543
 544 Returns true if the email address entered is not in use by another user or is
 545 undef or ''. Returns false if it's in use.
 546
 547 =cut
 548
 549 sub ValidateEmailAddress {
 550     my $self  = shift;
 551     my $Value = shift;
 552
 553     # if the email address is null, it's always valid
 554     return (1) if ( !$Value || $Value eq "" );
 555
 556     if ( RT->Config->Get('ValidateUserEmailAddresses') ) {
 557         # We only allow one valid email address
 558         my @addresses = Email::Address->parse($Value);
 559         return ( 0, $self->loc('Invalid syntax for email address') ) unless ( ( scalar (@addresses) == 1 ) && ( $addresses[0]->address ) );
 560     }
 561
 562
 563     my $TempUser = RT::User->new(RT->SystemUser);
 564     $TempUser->LoadByEmail($Value);
 565
 566     if ( $TempUser->id && ( !$self->id || $TempUser->id != $self->id ) )
 567     {    # if we found a user with that address
 568             # it's invalid to set this user's address to it
 569         return ( 0, $self->loc('Email address in use') );
 570     } else {    #it's a valid email address
 571         return (1);
 572     }
 573 }
 574
 575 =head2 SetEmailAddress
 576
 577 Check to make sure someone else isn't using this email address already
 578 so that a better email address can be returned
 579
 580 =cut
 581
 582 sub SetEmailAddress {
 583     my $self  = shift;
 584     my $Value = shift;
 585     $Value = '' unless defined $Value;
 586
 587     my ($val, $message) = $self->ValidateEmailAddress( $Value );
 588     if ( $val ) {
 589         return $self->_Set( Field => 'EmailAddress', Value => $Value );
 590     } else {
 591         return ( 0, $message )
 592     }
 593
 594 }
 595
 596 =head2 EmailFrequency
 597
 598 Takes optional Ticket argument in paramhash. Returns 'no email',
 599 'squelched', 'daily', 'weekly' or empty string depending on
 600 user preferences.
 601
 602 =over 4
 603
 604 =item 'no email' - user has no email, so can not recieve notifications.
 605
 606 =item 'squelched' - returned only when Ticket argument is provided and
 607 notifications to the user has been supressed for this ticket.
 608
 609 =item 'daily' - retruned when user recieve daily messages digest instead
 610 of immediate delivery.
 611
 612 =item 'weekly' - previous, but weekly.
 613
 614 =item empty string returned otherwise.
 615
 616 =back
 617
 618 =cut
 619
 620 sub EmailFrequency {
 621     my $self = shift;
 622     my %args = (
 623         Ticket => undef,
 624         @_
 625     );
 626     return '' unless $self->id && $self->id != RT->Nobody->id
 627         && $self->id != RT->SystemUser->id;
 628     return 'no email address' unless my $email = $self->EmailAddress;
 629     return 'email disabled for ticket' if $args{'Ticket'} &&
 630         grep lc $email eq lc $_->Content, $args{'Ticket'}->SquelchMailTo;
 631     my $frequency = RT->Config->Get( 'EmailFrequency', $self ) || '';
 632     return 'daily' if $frequency =~ /daily/i;
 633     return 'weekly' if $frequency =~ /weekly/i;
 634     return '';
 635 }
 636
 637 =head2 CanonicalizeEmailAddress ADDRESS
 638
 639 CanonicalizeEmailAddress converts email addresses into canonical form.
 640 it takes one email address in and returns the proper canonical
 641 form. You can dump whatever your proper local config is in here.  Note
 642 that it may be called as a static method; in this case the first argument
 643 is class name not an object.
 644
 645 =cut
 646
 647 sub CanonicalizeEmailAddress {
 648     my $self = shift;
 649     my $email = shift;
 650     # Example: the following rule would treat all email
 651     # coming from a subdomain as coming from second level domain
 652     # foo.com
 653     if ( my $match   = RT->Config->Get('CanonicalizeEmailAddressMatch') and
 654          my $replace = RT->Config->Get('CanonicalizeEmailAddressReplace') )
 655     {
 656         $email =~ s/$match/$replace/gi;
 657     }
 658     return ($email);
 659 }
 660
 661 =head2 CanonicalizeUserInfo HASH of ARGS
 662
 663 CanonicalizeUserInfo can convert all User->Create options.
 664 it takes a hashref of all the params sent to User->Create and
 665 returns that same hash, by default nothing is done.
 666
 667 This function is intended to allow users to have their info looked up via
 668 an outside source and modified upon creation.
 669
 670 =cut
 671
 672 sub CanonicalizeUserInfo {
 673     my $self = shift;
 674     my $args = shift;
 675     my $success = 1;
 676
 677     return ($success);
 678 }
 679
 680
 681 =head2 Password and authentication related functions
 682
 683 =head3 SetRandomPassword
 684
 685 Takes no arguments. Returns a status code and a new password or an error message.
 686 If the status is 1, the second value returned is the new password.
 687 If the status is anything else, the new value returned is the error code.
 688
 689 =cut
 690
 691 sub SetRandomPassword {
 692     my $self = shift;
 693
 694     unless ( $self->CurrentUserCanModify('Password') ) {
 695         return ( 0, $self->loc("Permission Denied") );
 696     }
 697
 698
 699     my $min = ( RT->Config->Get('MinimumPasswordLength') > 6 ?  RT->Config->Get('MinimumPasswordLength') : 6);
 700     my $max = ( RT->Config->Get('MinimumPasswordLength') > 8 ?  RT->Config->Get('MinimumPasswordLength') : 8);
 701
 702     my $pass = $self->GenerateRandomPassword( $min, $max) ;
 703
 704     # If we have "notify user on
 705
 706     my ( $val, $msg ) = $self->SetPassword($pass);
 707
 708     #If we got an error return the error.
 709     return ( 0, $msg ) unless ($val);
 710
 711     #Otherwise, we changed the password, lets return it.
 712     return ( 1, $pass );
 713
 714 }
 715
 716 =head3 ResetPassword
 717
 718 Returns status, [ERROR or new password].  Resets this user's password to
 719 a randomly generated pronouncable password and emails them, using a
 720 global template called "PasswordChange".
 721
 722 This function is currently unused in the UI, but available for local scripts.
 723
 724 =cut
 725
 726 sub ResetPassword {
 727     my $self = shift;
 728
 729     unless ( $self->CurrentUserCanModify('Password') ) {
 730         return ( 0, $self->loc("Permission Denied") );
 731     }
 732     my ( $status, $pass ) = $self->SetRandomPassword();
 733
 734     unless ($status) {
 735         return ( 0, "$pass" );
 736     }
 737
 738     my $ret = RT::Interface::Email::SendEmailUsingTemplate(
 739         To        => $self->EmailAddress,
 740         Template  => 'PasswordChange',
 741         Arguments => {
 742             NewPassword => $pass,
 743         },
 744     );
 745
 746     if ($ret) {
 747         return ( 1, $self->loc('New password notification sent') );
 748     } else {
 749         return ( 0, $self->loc('Notification could not be sent') );
 750     }
 751
 752 }
 753
 754 =head3 GenerateRandomPassword MIN_LEN and MAX_LEN
 755
 756 Returns a random password between MIN_LEN and MAX_LEN characters long.
 757
 758 =cut
 759
 760 sub GenerateRandomPassword {
 761     my $self = shift;   # just to drop it
 762     return Text::Password::Pronounceable->generate(@_);
 763 }
 764
 765 sub SafeSetPassword {
 766     my $self = shift;
 767     my %args = (
 768         Current      => undef,
 769         New          => undef,
 770         Confirmation => undef,
 771         @_,
 772     );
 773     return (1) unless defined $args{'New'} && length $args{'New'};
 774
 775     my %cond = $self->CurrentUserRequireToSetPassword;
 776
 777     unless ( $cond{'CanSet'} ) {
 778         return (0, $self->loc('You can not set password.') .' '. $cond{'Reason'} );
 779     }
 780
 781     my $error = '';
 782     if ( $cond{'RequireCurrent'} && !$self->CurrentUser->IsPassword($args{'Current'}) ) {
 783         if ( defined $args{'Current'} && length $args{'Current'} ) {
 784             $error = $self->loc("Please enter your current password correctly.");
 785         } else {
 786             $error = $self->loc("Please enter your current password.");
 787         }
 788     } elsif ( $args{'New'} ne $args{'Confirmation'} ) {
 789         $error = $self->loc("Passwords do not match.");
 790     }
 791
 792     if ( $error ) {
 793         $error .= ' '. $self->loc('Password has not been set.');
 794         return (0, $error);
 795     }
 796
 797     return $self->SetPassword( $args{'New'} );
 798 }
 799
 800 =head3 SetPassword
 801
 802 Takes a string. Checks the string's length and sets this user's password
 803 to that string.
 804
 805 =cut
 806
 807 sub SetPassword {
 808     my $self     = shift;
 809     my $password = shift;
 810
 811     unless ( $self->CurrentUserCanModify('Password') ) {
 812         return ( 0, $self->loc('Password: Permission Denied') );
 813     }
 814
 815     if ( !$password ) {
 816         return ( 0, $self->loc("No password set") );
 817     } else {
 818         my ($val, $msg) = $self->ValidatePassword($password);
 819         return ($val, $msg) if !$val;
 820
 821         my $new = !$self->HasPassword;
 822         $password = $self->_GeneratePassword($password);
 823
 824         ( $val, $msg ) = $self->_Set(Field => 'Password', Value => $password);
 825         if ($val) {
 826             return ( 1, $self->loc("Password set") ) if $new;
 827             return ( 1, $self->loc("Password changed") );
 828         } else {
 829             return ( $val, $msg );
 830         }
 831     }
 832
 833 }
 834
 835 sub _GeneratePassword_sha512 {
 836     my $self = shift;
 837     my ($password, $salt) = @_;
 838
 839     # Generate a 16-character base64 salt
 840     unless ($salt) {
 841         $salt = "";
 842         $salt .= ("a".."z", "A".."Z","0".."9", "+", "/")[rand 64]
 843             for 1..16;
 844     }
 845
 846     my $sha = Digest::SHA->new(512);
 847     $sha->add($salt);
 848     $sha->add(encode_utf8($password));
 849     return join("!", "", "sha512", $salt, $sha->b64digest);
 850 }
 851
 852 =head3 _GeneratePassword PASSWORD [, SALT]
 853
 854 Returns a string to store in the database.  This string takes the form:
 855
 856    !method!salt!hash
 857
 858 By default, the method is currently C<sha512>.
 859
 860 =cut
 861
 862 sub _GeneratePassword {
 863     my $self = shift;
 864     return $self->_GeneratePassword_sha512(@_);
 865 }
 866
 867 =head3 HasPassword
 868
 869 Returns true if the user has a valid password, otherwise returns false.
 870
 871 =cut
 872
 873 sub HasPassword {
 874     my $self = shift;
 875     my $pwd = $self->__Value('Password');
 876     return undef if !defined $pwd
 877                     || $pwd eq ''
 878                     || $pwd eq '*NO-PASSWORD*';
 879     return 1;
 880 }
 881
 882 =head3 IsPassword
 883
 884 Returns true if the passed in value is this user's password.
 885 Returns undef otherwise.
 886
 887 =cut
 888
 889 sub IsPassword {
 890     my $self  = shift;
 891     my $value = shift;
 892
 893     #TODO there isn't any apparent way to legitimately ACL this
 894
 895     # RT does not allow null passwords
 896     if ( ( !defined($value) ) or ( $value eq '' ) ) {
 897         return (undef);
 898     }
 899
 900    if ( $self->PrincipalObj->Disabled ) {
 901         $RT::Logger->info(
 902             "Disabled user " . $self->Name . " tried to log in" );
 903         return (undef);
 904     }
 905
 906     unless ($self->HasPassword) {
 907         return(undef);
 908      }
 909
 910     my $stored = $self->__Value('Password');
 911     if ($stored =~ /^!/) {
 912         # If it's a new-style (>= RT 4.0) password, it starts with a '!'
 913         my (undef, $method, $salt, undef) = split /!/, $stored;
 914         if ($method eq "sha512") {
 915             return $self->_GeneratePassword_sha512($value, $salt) eq $stored;
 916         } else {
 917             $RT::Logger->warn("Unknown hash method $method");
 918             return 0;
 919         }
 920     } elsif (length $stored == 40) {
 921         # The truncated SHA256(salt,MD5(passwd)) form from 2010/12 is 40 characters long
 922         my $hash = MIME::Base64::decode_base64($stored);
 923         # Decoding yields 30 byes; first 4 are the salt, the rest are substr(SHA256,0,26)
 924         my $salt = substr($hash, 0, 4, "");
 925         return 0 unless substr(Digest::SHA::sha256($salt . Digest::MD5::md5($value)), 0, 26) eq $hash;
 926     } elsif (length $stored == 32) {
 927         # Hex nonsalted-md5
 928         return 0 unless Digest::MD5::md5_hex(encode_utf8($value)) eq $stored;
 929     } elsif (length $stored == 22) {
 930         # Base64 nonsalted-md5
 931         return 0 unless Digest::MD5::md5_base64(encode_utf8($value)) eq $stored;
 932     } elsif (length $stored == 13) {
 933         # crypt() output
 934         return 0 unless crypt(encode_utf8($value), $stored) eq $stored;
 935     } else {
 936         $RT::Logger->warning("Unknown password form");
 937         return 0;
 938     }
 939
 940     # We got here by validating successfully, but with a legacy
 941     # password form.  Update to the most recent form.
 942     my $obj = $self->isa("RT::CurrentUser") ? $self->UserObj : $self;
 943     $obj->_Set(Field => 'Password', Value =>  $self->_GeneratePassword($value) );
 944     return 1;
 945 }
 946
 947 sub CurrentUserRequireToSetPassword {
 948     my $self = shift;
 949
 950     my %res = (
 951         CanSet => 1,
 952         Reason => '',
 953         RequireCurrent => 1,
 954     );
 955
 956     if ( RT->Config->Get('WebExternalAuth')
 957         && !RT->Config->Get('WebFallbackToInternalAuth')
 958     ) {
 959         $res{'CanSet'} = 0;
 960         $res{'Reason'} = $self->loc("External authentication enabled.");
 961     } elsif ( !$self->CurrentUser->HasPassword ) {
 962         if ( $self->CurrentUser->id == ($self->id||0) ) {
 963             # don't require current password if user has no
 964             $res{'RequireCurrent'} = 0;
 965         } else {
 966             $res{'CanSet'} = 0;
 967             $res{'Reason'} = $self->loc("Your password is not set.");
 968         }
 969     }
 970
 971     return %res;
 972 }
 973
 974 =head3 AuthToken
 975
 976 Returns an authentication string associated with the user. This
 977 string can be used to generate passwordless URLs to integrate
 978 RT with services and programms like callendar managers, rss
 979 readers and other.
 980
 981 =cut
 982
 983 sub AuthToken {
 984     my $self = shift;
 985     my $secret = $self->_Value( AuthToken => @_ );
 986     return $secret if $secret;
 987
 988     $secret = substr(Digest::MD5::md5_hex(time . {} . rand()),0,16);
 989
 990     my $tmp = RT::User->new( RT->SystemUser );
 991     $tmp->Load( $self->id );
 992     my ($status, $msg) = $tmp->SetAuthToken( $secret );
 993     unless ( $status ) {
 994         $RT::Logger->error( "Couldn't set auth token: $msg" );
 995         return undef;
 996     }
 997     return $secret;
 998 }
 999
1000 =head3 GenerateAuthToken
1001
1002 Generate a random authentication string for the user.
1003
1004 =cut
1005
1006 sub GenerateAuthToken {
1007     my $self = shift;
1008     my $token = substr(Digest::MD5::md5_hex(time . {} . rand()),0,16);
1009     return $self->SetAuthToken( $token );
1010 }
1011
1012 =head3 GenerateAuthString
1013
1014 Takes a string and returns back a hex hash string. Later you can use
1015 this pair to make sure it's generated by this user using L</ValidateAuthString>
1016
1017 =cut
1018
1019 sub GenerateAuthString {
1020     my $self = shift;
1021     my $protect = shift;
1022
1023     my $str = $self->AuthToken . $protect;
1024     utf8::encode($str);
1025
1026     return substr(Digest::MD5::md5_hex($str),0,16);
1027 }
1028
1029 =head3 ValidateAuthString
1030
1031 Takes auth string and protected string. Returns true is protected string
1032 has been protected by user's L</AuthToken>. See also L</GenerateAuthString>.
1033
1034 =cut
1035
1036 sub ValidateAuthString {
1037     my $self = shift;
1038     my $auth_string = shift;
1039     my $protected = shift;
1040
1041     my $str = $self->AuthToken . $protected;
1042     utf8::encode( $str );
1043
1044     return $auth_string eq substr(Digest::MD5::md5_hex($str),0,16);
1045 }
1046
1047 =head2 SetDisabled
1048
1049 Toggles the user's disabled flag.
1050 If this flag is
1051 set, all password checks for this user will fail. All ACL checks for this
1052 user will fail. The user will appear in no user listings.
1053
1054 =cut
1055
1056 sub SetDisabled {
1057     my $self = shift;
1058     my $val = shift;
1059     unless ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1060         return (0, $self->loc('Permission Denied'));
1061     }
1062
1063     $RT::Handle->BeginTransaction();
1064     my $set_err = $self->PrincipalObj->SetDisabled($val);
1065     unless ($set_err) {
1066         $RT::Handle->Rollback();
1067         $RT::Logger->warning(sprintf("Couldn't %s user %s", ($val == 1) ? "disable" : "enable", $self->PrincipalObj->Id));
1068         return (undef);
1069     }
1070     $self->_NewTransaction( Type => ($val == 1) ? "Disabled" : "Enabled" );
1071
1072     $RT::Handle->Commit();
1073
1074     if ( $val == 1 ) {
1075         return (1, $self->loc("User disabled"));
1076     } else {
1077         return (1, $self->loc("User enabled"));
1078     }
1079
1080 }
1081
1082 =head2 Disabled
1083
1084 Returns true if user is disabled or false otherwise
1085
1086 =cut
1087
1088 sub Disabled {
1089     my $self = shift;
1090     return $self->PrincipalObj->Disabled(@_);
1091 }
1092
1093 =head2 PrincipalObj
1094
1095 Returns the principal object for this user. returns an empty RT::Principal
1096 if there's no principal object matching this user.
1097 The response is cached. PrincipalObj should never ever change.
1098
1099 =cut
1100
1101 sub PrincipalObj {
1102     my $self = shift;
1103
1104     unless ( $self->id ) {
1105         $RT::Logger->error("Couldn't get principal for an empty user");
1106         return undef;
1107     }
1108
1109     if ( !$self->{_principal_obj} ) {
1110
1111         my $obj = RT::Principal->new( $self->CurrentUser );
1112         $obj->LoadById( $self->id );
1113         if (! $obj->id ) {
1114             $RT::Logger->crit( 'No principal for user #' . $self->id );
1115             return undef;
1116         } elsif ( $obj->PrincipalType ne 'User' ) {
1117             $RT::Logger->crit(   'User #' . $self->id . ' has principal of ' . $obj->PrincipalType . ' type' );
1118             return undef;
1119         }
1120         $self->{_principal_obj} = $obj;
1121     }
1122     return $self->{_principal_obj};
1123 }
1124
1125
1126 =head2 PrincipalId
1127
1128 Returns this user's PrincipalId
1129
1130 =cut
1131
1132 sub PrincipalId {
1133     my $self = shift;
1134     return $self->Id;
1135 }
1136
1137 =head2 HasGroupRight
1138
1139 Takes a paramhash which can contain
1140 these items:
1141     GroupObj => RT::Group or Group => integer
1142     Right => 'Right'
1143
1144
1145 Returns 1 if this user has the right specified in the paramhash for the Group
1146 passed in.
1147
1148 Returns undef if they don't.
1149
1150 =cut
1151
1152 sub HasGroupRight {
1153     my $self = shift;
1154     my %args = (
1155         GroupObj    => undef,
1156         Group       => undef,
1157         Right       => undef,
1158         @_
1159     );
1160
1161
1162     if ( defined $args{'Group'} ) {
1163         $args{'GroupObj'} = RT::Group->new( $self->CurrentUser );
1164         $args{'GroupObj'}->Load( $args{'Group'} );
1165     }
1166
1167     # Validate and load up the GroupId
1168     unless ( ( defined $args{'GroupObj'} ) and ( $args{'GroupObj'}->Id ) ) {
1169         return undef;
1170     }
1171
1172     # Figure out whether a user has the right we're asking about.
1173     my $retval = $self->HasRight(
1174         Object => $args{'GroupObj'},
1175         Right     => $args{'Right'},
1176     );
1177
1178     return ($retval);
1179 }
1180
1181 =head2 OwnGroups
1182
1183 Returns a group collection object containing the groups of which this
1184 user is a member.
1185
1186 =cut
1187
1188 sub OwnGroups {
1189     my $self = shift;
1190     my $groups = RT::Groups->new($self->CurrentUser);
1191     $groups->LimitToUserDefinedGroups;
1192     $groups->WithMember(
1193         PrincipalId => $self->Id,
1194         Recursively => 1
1195     );
1196     return $groups;
1197 }
1198
1199 =head2 HasRight
1200
1201 Shim around PrincipalObj->HasRight. See L<RT::Principal>.
1202
1203 =cut
1204
1205 sub HasRight {
1206     my $self = shift;
1207     return $self->PrincipalObj->HasRight(@_);
1208 }
1209
1210 =head2 CurrentUserCanSee [FIELD]
1211
1212 Returns true if the current user can see the user, based on if it is
1213 public, ourself, or we have AdminUsers
1214
1215 =cut
1216
1217 sub CurrentUserCanSee {
1218     my $self = shift;
1219     my ($what) = @_;
1220
1221     # If it's public, fine.  Note that $what may be "transaction", which
1222     # doesn't have an Accessible value, and thus falls through below.
1223     if ( $self->_Accessible( $what, 'public' ) ) {
1224         return 1;
1225     }
1226
1227     # Users can see their own properties
1228     elsif ( defined($self->Id) && $self->CurrentUser->Id == $self->Id ) {
1229         return 1;
1230     }
1231
1232     # If the user has the admin users right, that's also enough
1233     elsif ( $self->CurrentUser->HasRight( Right => 'AdminUsers', Object => $RT::System) ) {
1234         return 1;
1235     }
1236     else {
1237         return 0;
1238     }
1239 }
1240
1241 =head2 CurrentUserCanModify RIGHT
1242
1243 If the user has rights for this object, either because
1244 he has 'AdminUsers' or (if he's trying to edit himself and the right isn't an
1245 admin right) 'ModifySelf', return 1. otherwise, return undef.
1246
1247 =cut
1248
1249 sub CurrentUserCanModify {
1250     my $self  = shift;
1251     my $field = shift;
1252
1253     if ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1254         return (1);
1255     }
1256
1257     #If the field is marked as an "administrators only" field,
1258     # don't let the user touch it.
1259     elsif ( $self->_Accessible( $field, 'admin' ) ) {
1260         return (undef);
1261     }
1262
1263     #If the current user is trying to modify themselves
1264     elsif ( ( $self->id == $self->CurrentUser->id )
1265         and ( $self->CurrentUser->HasRight(Right => 'ModifySelf', Object => $RT::System) ) )
1266     {
1267         return (1);
1268     }
1269
1270     #If we don't have a good reason to grant them rights to modify
1271     # by now, they lose
1272     else {
1273         return (undef);
1274     }
1275
1276 }
1277
1278 =head2 CurrentUserHasRight
1279
1280 Takes a single argument. returns 1 if $Self->CurrentUser
1281 has the requested right. returns undef otherwise
1282
1283 =cut
1284
1285 sub CurrentUserHasRight {
1286     my $self  = shift;
1287     my $right = shift;
1288
1289     return ( $self->CurrentUser->HasRight(Right => $right, Object => $RT::System) );
1290 }
1291
1292 sub _PrefName {
1293     my $name = shift;
1294     if (ref $name) {
1295         $name = ref($name).'-'.$name->Id;
1296     }
1297
1298     return 'Pref-'.$name;
1299 }
1300
1301 =head2 Preferences NAME/OBJ DEFAULT
1302
1303 Obtain user preferences associated with given object or name.
1304 Returns DEFAULT if no preferences found.  If DEFAULT is a hashref,
1305 override the entries with user preferences.
1306
1307 =cut
1308
1309 sub Preferences {
1310     my $self  = shift;
1311     my $name = _PrefName (shift);
1312     my $default = shift;
1313
1314     my $attr = RT::Attribute->new( $self->CurrentUser );
1315     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1316
1317     my $content = $attr->Id ? $attr->Content : undef;
1318     unless ( ref $content eq 'HASH' ) {
1319         return defined $content ? $content : $default;
1320     }
1321
1322     if (ref $default eq 'HASH') {
1323         for (keys %$default) {
1324             exists $content->{$_} or $content->{$_} = $default->{$_};
1325         }
1326     } elsif (defined $default) {
1327         $RT::Logger->error("Preferences $name for user".$self->Id." is hash but default is not");
1328     }
1329     return $content;
1330 }
1331
1332 =head2 SetPreferences NAME/OBJ VALUE
1333
1334 Set user preferences associated with given object or name.
1335
1336 =cut
1337
1338 sub SetPreferences {
1339     my $self = shift;
1340     my $name = _PrefName( shift );
1341     my $value = shift;
1342
1343     return (0, $self->loc("No permission to set preferences"))
1344         unless $self->CurrentUserCanModify('Preferences');
1345
1346     my $attr = RT::Attribute->new( $self->CurrentUser );
1347     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1348     if ( $attr->Id ) {
1349         my ($ok, $msg) = $attr->SetContent( $value );
1350         return (1, "No updates made")
1351             if $msg eq "That is already the current value";
1352         return ($ok, $msg);
1353     } else {
1354         return $self->AddAttribute( Name => $name, Content => $value );
1355     }
1356 }
1357
1358 =head2 Stylesheet
1359
1360 Returns a list of valid stylesheets take from preferences.
1361
1362 =cut
1363
1364 sub Stylesheet {
1365     my $self = shift;
1366
1367     my $style = RT->Config->Get('WebDefaultStylesheet', $self->CurrentUser);
1368
1369     if (RT::Interface::Web->ComponentPathIsSafe($style)) {
1370         my @css_paths = map { $_ . '/NoAuth/css' } RT::Interface::Web->ComponentRoots;
1371
1372         for my $css_path (@css_paths) {
1373             if (-d "$css_path/$style") {
1374                 return $style
1375             }
1376         }
1377     }
1378
1379     # Fall back to the system stylesheet.
1380     return RT->Config->Get('WebDefaultStylesheet');
1381 }
1382
1383 =head2 WatchedQueues ROLE_LIST
1384
1385 Returns a RT::Queues object containing every queue watched by the user.
1386
1387 Takes a list of roles which is some subset of ('Cc', 'AdminCc').  Defaults to:
1388
1389 $user->WatchedQueues('Cc', 'AdminCc');
1390
1391 =cut
1392
1393 sub WatchedQueues {
1394
1395     my $self = shift;
1396     my @roles = @_ || ('Cc', 'AdminCc');
1397
1398     $RT::Logger->debug('WatcheQueues got user ' . $self->Name);
1399
1400     my $watched_queues = RT::Queues->new($self->CurrentUser);
1401
1402     my $group_alias = $watched_queues->Join(
1403                                              ALIAS1 => 'main',
1404                                              FIELD1 => 'id',
1405                                              TABLE2 => 'Groups',
1406                                              FIELD2 => 'Instance',
1407                                            );
1408
1409     $watched_queues->Limit(
1410                             ALIAS => $group_alias,
1411                             FIELD => 'Domain',
1412                             VALUE => 'RT::Queue-Role',
1413                             ENTRYAGGREGATOR => 'AND',
1414                           );
1415     if (grep { $_ eq 'Cc' } @roles) {
1416         $watched_queues->Limit(
1417                                 SUBCLAUSE => 'LimitToWatchers',
1418                                 ALIAS => $group_alias,
1419                                 FIELD => 'Type',
1420                                 VALUE => 'Cc',
1421                                 ENTRYAGGREGATOR => 'OR',
1422                               );
1423     }
1424     if (grep { $_ eq 'AdminCc' } @roles) {
1425         $watched_queues->Limit(
1426                                 SUBCLAUSE => 'LimitToWatchers',
1427                                 ALIAS => $group_alias,
1428                                 FIELD => 'Type',
1429                                 VALUE => 'AdminCc',
1430                                 ENTRYAGGREGATOR => 'OR',
1431                               );
1432     }
1433
1434     my $queues_alias = $watched_queues->Join(
1435                                               ALIAS1 => $group_alias,
1436                                               FIELD1 => 'id',
1437                                               TABLE2 => 'CachedGroupMembers',
1438                                               FIELD2 => 'GroupId',
1439                                             );
1440     $watched_queues->Limit(
1441                             ALIAS => $queues_alias,
1442                             FIELD => 'MemberId',
1443                             VALUE => $self->PrincipalId,
1444                           );
1445     $watched_queues->Limit(
1446                             ALIAS => $queues_alias,
1447                             FIELD => 'Disabled',
1448                             VALUE => 0,
1449                           );
1450
1451
1452     $RT::Logger->debug("WatchedQueues got " . $watched_queues->Count . " queues");
1453
1454     return $watched_queues;
1455
1456 }
1457
1458 sub _Set {
1459     my $self = shift;
1460
1461     my %args = (
1462         Field => undef,
1463         Value => undef,
1464     TransactionType   => 'Set',
1465     RecordTransaction => 1,
1466         @_
1467     );
1468
1469     # Nobody is allowed to futz with RT_System or Nobody
1470
1471     if ( ($self->Id == RT->SystemUser->Id )  ||
1472          ($self->Id == RT->Nobody->Id)) {
1473         return ( 0, $self->loc("Can not modify system users") );
1474     }
1475     unless ( $self->CurrentUserCanModify( $args{'Field'} ) ) {
1476         return ( 0, $self->loc("Permission Denied") );
1477     }
1478
1479     my $Old = $self->SUPER::_Value("$args{'Field'}");
1480
1481     my ($ret, $msg) = $self->SUPER::_Set( Field => $args{'Field'},
1482                       Value => $args{'Value'} );
1483
1484     #If we can't actually set the field to the value, don't record
1485     # a transaction. instead, get out of here.
1486     if ( $ret == 0 ) { return ( 0, $msg ); }
1487
1488     if ( $args{'RecordTransaction'} == 1 ) {
1489         if ($args{'Field'} eq "Password") {
1490             $args{'Value'} = $Old = '********';
1491         }
1492         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1493                                                Type => $args{'TransactionType'},
1494                                                Field     => $args{'Field'},
1495                                                NewValue  => $args{'Value'},
1496                                                OldValue  => $Old,
1497                                                TimeTaken => $args{'TimeTaken'},
1498         );
1499         return ( $Trans, scalar $TransObj->BriefDescription );
1500     } else {
1501         return ( $ret, $msg );
1502     }
1503 }
1504
1505 =head2 _Value
1506
1507 Takes the name of a table column.
1508 Returns its value as a string, if the user passes an ACL check
1509
1510 =cut
1511
1512 sub _Value {
1513
1514     my $self  = shift;
1515     my $field = shift;
1516
1517     # Defer to the abstraction above to know if the field can be read
1518     return $self->SUPER::_Value($field) if $self->CurrentUserCanSee($field);
1519     return undef;
1520 }
1521
1522 =head2 FriendlyName
1523
1524 Return the friendly name
1525
1526 =cut
1527
1528 sub FriendlyName {
1529     my $self = shift;
1530     return $self->RealName if defined($self->RealName);
1531     return $self->Name if defined($self->Name);
1532     return "";
1533 }
1534
1535 =head2 PreferredKey
1536
1537 Returns the preferred key of the user. If none is set, then this will query
1538 GPG and set the preferred key to the maximally trusted key found (and then
1539 return it). Returns C<undef> if no preferred key can be found.
1540
1541 =cut
1542
1543 sub PreferredKey
1544 {
1545     my $self = shift;
1546     return undef unless RT->Config->Get('GnuPG')->{'Enable'};
1547
1548     if ( ($self->CurrentUser->Id != $self->Id )  &&
1549           !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1550           return undef;
1551     }
1552
1553
1554
1555     my $prefkey = $self->FirstAttribute('PreferredKey');
1556     return $prefkey->Content if $prefkey;
1557
1558     # we don't have a preferred key for this user, so now we must query GPG
1559     require RT::Crypt::GnuPG;
1560     my %res = RT::Crypt::GnuPG::GetKeysForEncryption($self->EmailAddress);
1561     return undef unless defined $res{'info'};
1562     my @keys = @{ $res{'info'} };
1563     return undef if @keys == 0;
1564
1565     if (@keys == 1) {
1566         $prefkey = $keys[0]->{'Fingerprint'};
1567     } else {
1568         # prefer the maximally trusted key
1569         @keys = sort { $b->{'TrustLevel'} <=> $a->{'TrustLevel'} } @keys;
1570         $prefkey = $keys[0]->{'Fingerprint'};
1571     }
1572
1573     $self->SetAttribute(Name => 'PreferredKey', Content => $prefkey);
1574     return $prefkey;
1575 }
1576
1577 sub PrivateKey {
1578     my $self = shift;
1579
1580
1581     #If the user wants to see their own values, let them.
1582     #If the user is an admin, let them.
1583     #Otherwwise, don't let them.
1584     #
1585     if ( ($self->CurrentUser->Id != $self->Id )  &&
1586           !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1587           return undef;
1588     }
1589
1590     my $key = $self->FirstAttribute('PrivateKey') or return undef;
1591     return $key->Content;
1592 }
1593
1594 sub SetPrivateKey {
1595     my $self = shift;
1596     my $key = shift;
1597
1598     unless ($self->CurrentUserCanModify('PrivateKey')) {
1599         return (0, $self->loc("Permission Denied"));
1600     }
1601
1602     unless ( $key ) {
1603         my ($status, $msg) = $self->DeleteAttribute('PrivateKey');
1604         unless ( $status ) {
1605             $RT::Logger->error( "Couldn't delete attribute: $msg" );
1606             return ($status, $self->loc("Couldn't unset private key"));
1607         }
1608         return ($status, $self->loc("Unset private key"));
1609     }
1610
1611     # check that it's really private key
1612     {
1613         my %tmp = RT::Crypt::GnuPG::GetKeysForSigning( $key );
1614         return (0, $self->loc("No such key or it's not suitable for signing"))
1615             if $tmp{'exit_code'} || !$tmp{'info'};
1616     }
1617
1618     my ($status, $msg) = $self->SetAttribute(
1619         Name => 'PrivateKey',
1620         Content => $key,
1621     );
1622     return ($status, $self->loc("Couldn't set private key"))
1623         unless $status;
1624     return ($status, $self->loc("Set private key"));
1625 }
1626
1627 sub BasicColumns {
1628     (
1629     [ Name => 'Username' ],
1630     [ EmailAddress => 'Email' ],
1631     [ RealName => 'Name' ],
1632     [ Organization => 'Organization' ],
1633     );
1634 }
1635
1636 =head2 Create PARAMHASH
1637
1638 Create takes a hash of values and creates a row in the database:
1639
1640   varchar(200) 'Name'.
1641   varbinary(256) 'Password'.
1642   varchar(16) 'AuthToken'.
1643   text 'Comments'.
1644   text 'Signature'.
1645   varchar(120) 'EmailAddress'.
1646   text 'FreeformContactInfo'.
1647   varchar(200) 'Organization'.
1648   varchar(120) 'RealName'.
1649   varchar(16) 'NickName'.
1650   varchar(16) 'Lang'.
1651   varchar(16) 'EmailEncoding'.
1652   varchar(16) 'WebEncoding'.
1653   varchar(100) 'ExternalContactInfoId'.
1654   varchar(30) 'ContactInfoSystem'.
1655   varchar(100) 'ExternalAuthId'.
1656   varchar(30) 'AuthSystem'.
1657   varchar(16) 'Gecos'.
1658   varchar(30) 'HomePhone'.
1659   varchar(30) 'WorkPhone'.
1660   varchar(30) 'MobilePhone'.
1661   varchar(30) 'PagerPhone'.
1662   varchar(200) 'Address1'.
1663   varchar(200) 'Address2'.
1664   varchar(100) 'City'.
1665   varchar(100) 'State'.
1666   varchar(16) 'Zip'.
1667   varchar(50) 'Country'.
1668   varchar(50) 'Timezone'.
1669   text 'PGPKey'.
1670
1671 =cut
1672
1673
1674
1675
1676 =head2 id
1677
1678 Returns the current value of id.
1679 (In the database, id is stored as int(11).)
1680
1681
1682 =cut
1683
1684
1685 =head2 Name
1686
1687 Returns the current value of Name.
1688 (In the database, Name is stored as varchar(200).)
1689
1690
1691
1692 =head2 SetName VALUE
1693
1694
1695 Set Name to VALUE.
1696 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1697 (In the database, Name will be stored as a varchar(200).)
1698
1699
1700 =cut
1701
1702
1703 =head2 Password
1704
1705 Returns the current value of Password.
1706 (In the database, Password is stored as varchar(256).)
1707
1708
1709
1710 =head2 SetPassword VALUE
1711
1712
1713 Set Password to VALUE.
1714 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1715 (In the database, Password will be stored as a varchar(256).)
1716
1717
1718 =cut
1719
1720
1721 =head2 AuthToken
1722
1723 Returns the current value of AuthToken.
1724 (In the database, AuthToken is stored as varchar(16).)
1725
1726
1727
1728 =head2 SetAuthToken VALUE
1729
1730
1731 Set AuthToken to VALUE.
1732 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1733 (In the database, AuthToken will be stored as a varchar(16).)
1734
1735
1736 =cut
1737
1738
1739 =head2 Comments
1740
1741 Returns the current value of Comments.
1742 (In the database, Comments is stored as text.)
1743
1744
1745
1746 =head2 SetComments VALUE
1747
1748
1749 Set Comments to VALUE.
1750 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1751 (In the database, Comments will be stored as a text.)
1752
1753
1754 =cut
1755
1756
1757 =head2 Signature
1758
1759 Returns the current value of Signature.
1760 (In the database, Signature is stored as text.)
1761
1762
1763
1764 =head2 SetSignature VALUE
1765
1766
1767 Set Signature to VALUE.
1768 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1769 (In the database, Signature will be stored as a text.)
1770
1771
1772 =cut
1773
1774
1775 =head2 EmailAddress
1776
1777 Returns the current value of EmailAddress.
1778 (In the database, EmailAddress is stored as varchar(120).)
1779
1780
1781
1782 =head2 SetEmailAddress VALUE
1783
1784
1785 Set EmailAddress to VALUE.
1786 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1787 (In the database, EmailAddress will be stored as a varchar(120).)
1788
1789
1790 =cut
1791
1792
1793 =head2 FreeformContactInfo
1794
1795 Returns the current value of FreeformContactInfo.
1796 (In the database, FreeformContactInfo is stored as text.)
1797
1798
1799
1800 =head2 SetFreeformContactInfo VALUE
1801
1802
1803 Set FreeformContactInfo to VALUE.
1804 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1805 (In the database, FreeformContactInfo will be stored as a text.)
1806
1807
1808 =cut
1809
1810
1811 =head2 Organization
1812
1813 Returns the current value of Organization.
1814 (In the database, Organization is stored as varchar(200).)
1815
1816
1817
1818 =head2 SetOrganization VALUE
1819
1820
1821 Set Organization to VALUE.
1822 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1823 (In the database, Organization will be stored as a varchar(200).)
1824
1825
1826 =cut
1827
1828
1829 =head2 RealName
1830
1831 Returns the current value of RealName.
1832 (In the database, RealName is stored as varchar(120).)
1833
1834
1835
1836 =head2 SetRealName VALUE
1837
1838
1839 Set RealName to VALUE.
1840 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1841 (In the database, RealName will be stored as a varchar(120).)
1842
1843
1844 =cut
1845
1846
1847 =head2 NickName
1848
1849 Returns the current value of NickName.
1850 (In the database, NickName is stored as varchar(16).)
1851
1852
1853
1854 =head2 SetNickName VALUE
1855
1856
1857 Set NickName to VALUE.
1858 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1859 (In the database, NickName will be stored as a varchar(16).)
1860
1861
1862 =cut
1863
1864
1865 =head2 Lang
1866
1867 Returns the current value of Lang.
1868 (In the database, Lang is stored as varchar(16).)
1869
1870
1871
1872 =head2 SetLang VALUE
1873
1874
1875 Set Lang to VALUE.
1876 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1877 (In the database, Lang will be stored as a varchar(16).)
1878
1879
1880 =cut
1881
1882
1883 =head2 EmailEncoding
1884
1885 Returns the current value of EmailEncoding.
1886 (In the database, EmailEncoding is stored as varchar(16).)
1887
1888
1889
1890 =head2 SetEmailEncoding VALUE
1891
1892
1893 Set EmailEncoding to VALUE.
1894 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1895 (In the database, EmailEncoding will be stored as a varchar(16).)
1896
1897
1898 =cut
1899
1900
1901 =head2 WebEncoding
1902
1903 Returns the current value of WebEncoding.
1904 (In the database, WebEncoding is stored as varchar(16).)
1905
1906
1907
1908 =head2 SetWebEncoding VALUE
1909
1910
1911 Set WebEncoding to VALUE.
1912 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1913 (In the database, WebEncoding will be stored as a varchar(16).)
1914
1915
1916 =cut
1917
1918
1919 =head2 ExternalContactInfoId
1920
1921 Returns the current value of ExternalContactInfoId.
1922 (In the database, ExternalContactInfoId is stored as varchar(100).)
1923
1924
1925
1926 =head2 SetExternalContactInfoId VALUE
1927
1928
1929 Set ExternalContactInfoId to VALUE.
1930 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1931 (In the database, ExternalContactInfoId will be stored as a varchar(100).)
1932
1933
1934 =cut
1935
1936
1937 =head2 ContactInfoSystem
1938
1939 Returns the current value of ContactInfoSystem.
1940 (In the database, ContactInfoSystem is stored as varchar(30).)
1941
1942
1943
1944 =head2 SetContactInfoSystem VALUE
1945
1946
1947 Set ContactInfoSystem to VALUE.
1948 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1949 (In the database, ContactInfoSystem will be stored as a varchar(30).)
1950
1951
1952 =cut
1953
1954
1955 =head2 ExternalAuthId
1956
1957 Returns the current value of ExternalAuthId.
1958 (In the database, ExternalAuthId is stored as varchar(100).)
1959
1960
1961
1962 =head2 SetExternalAuthId VALUE
1963
1964
1965 Set ExternalAuthId to VALUE.
1966 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1967 (In the database, ExternalAuthId will be stored as a varchar(100).)
1968
1969
1970 =cut
1971
1972
1973 =head2 AuthSystem
1974
1975 Returns the current value of AuthSystem.
1976 (In the database, AuthSystem is stored as varchar(30).)
1977
1978
1979
1980 =head2 SetAuthSystem VALUE
1981
1982
1983 Set AuthSystem to VALUE.
1984 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1985 (In the database, AuthSystem will be stored as a varchar(30).)
1986
1987
1988 =cut
1989
1990
1991 =head2 Gecos
1992
1993 Returns the current value of Gecos.
1994 (In the database, Gecos is stored as varchar(16).)
1995
1996
1997
1998 =head2 SetGecos VALUE
1999
2000
2001 Set Gecos to VALUE.
2002 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2003 (In the database, Gecos will be stored as a varchar(16).)
2004
2005
2006 =cut
2007
2008
2009 =head2 HomePhone
2010
2011 Returns the current value of HomePhone.
2012 (In the database, HomePhone is stored as varchar(30).)
2013
2014
2015
2016 =head2 SetHomePhone VALUE
2017
2018
2019 Set HomePhone to VALUE.
2020 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2021 (In the database, HomePhone will be stored as a varchar(30).)
2022
2023
2024 =cut
2025
2026
2027 =head2 WorkPhone
2028
2029 Returns the current value of WorkPhone.
2030 (In the database, WorkPhone is stored as varchar(30).)
2031
2032
2033
2034 =head2 SetWorkPhone VALUE
2035
2036
2037 Set WorkPhone to VALUE.
2038 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2039 (In the database, WorkPhone will be stored as a varchar(30).)
2040
2041
2042 =cut
2043
2044
2045 =head2 MobilePhone
2046
2047 Returns the current value of MobilePhone.
2048 (In the database, MobilePhone is stored as varchar(30).)
2049
2050
2051
2052 =head2 SetMobilePhone VALUE
2053
2054
2055 Set MobilePhone to VALUE.
2056 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2057 (In the database, MobilePhone will be stored as a varchar(30).)
2058
2059
2060 =cut
2061
2062
2063 =head2 PagerPhone
2064
2065 Returns the current value of PagerPhone.
2066 (In the database, PagerPhone is stored as varchar(30).)
2067
2068
2069
2070 =head2 SetPagerPhone VALUE
2071
2072
2073 Set PagerPhone to VALUE.
2074 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2075 (In the database, PagerPhone will be stored as a varchar(30).)
2076
2077
2078 =cut
2079
2080
2081 =head2 Address1
2082
2083 Returns the current value of Address1.
2084 (In the database, Address1 is stored as varchar(200).)
2085
2086
2087
2088 =head2 SetAddress1 VALUE
2089
2090
2091 Set Address1 to VALUE.
2092 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2093 (In the database, Address1 will be stored as a varchar(200).)
2094
2095
2096 =cut
2097
2098
2099 =head2 Address2
2100
2101 Returns the current value of Address2.
2102 (In the database, Address2 is stored as varchar(200).)
2103
2104
2105
2106 =head2 SetAddress2 VALUE
2107
2108
2109 Set Address2 to VALUE.
2110 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2111 (In the database, Address2 will be stored as a varchar(200).)
2112
2113
2114 =cut
2115
2116
2117 =head2 City
2118
2119 Returns the current value of City.
2120 (In the database, City is stored as varchar(100).)
2121
2122
2123
2124 =head2 SetCity VALUE
2125
2126
2127 Set City to VALUE.
2128 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2129 (In the database, City will be stored as a varchar(100).)
2130
2131
2132 =cut
2133
2134
2135 =head2 State
2136
2137 Returns the current value of State.
2138 (In the database, State is stored as varchar(100).)
2139
2140
2141
2142 =head2 SetState VALUE
2143
2144
2145 Set State to VALUE.
2146 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2147 (In the database, State will be stored as a varchar(100).)
2148
2149
2150 =cut
2151
2152
2153 =head2 Zip
2154
2155 Returns the current value of Zip.
2156 (In the database, Zip is stored as varchar(16).)
2157
2158
2159
2160 =head2 SetZip VALUE
2161
2162
2163 Set Zip to VALUE.
2164 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2165 (In the database, Zip will be stored as a varchar(16).)
2166
2167
2168 =cut
2169
2170
2171 =head2 Country
2172
2173 Returns the current value of Country.
2174 (In the database, Country is stored as varchar(50).)
2175
2176
2177
2178 =head2 SetCountry VALUE
2179
2180
2181 Set Country to VALUE.
2182 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2183 (In the database, Country will be stored as a varchar(50).)
2184
2185
2186 =cut
2187
2188
2189 =head2 Timezone
2190
2191 Returns the current value of Timezone.
2192 (In the database, Timezone is stored as varchar(50).)
2193
2194
2195
2196 =head2 SetTimezone VALUE
2197
2198
2199 Set Timezone to VALUE.
2200 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2201 (In the database, Timezone will be stored as a varchar(50).)
2202
2203
2204 =cut
2205
2206
2207 =head2 PGPKey
2208
2209 Returns the current value of PGPKey.
2210 (In the database, PGPKey is stored as text.)
2211
2212
2213
2214 =head2 SetPGPKey VALUE
2215
2216
2217 Set PGPKey to VALUE.
2218 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2219 (In the database, PGPKey will be stored as a text.)
2220
2221
2222 =cut
2223
2224
2225 =head2 Creator
2226
2227 Returns the current value of Creator.
2228 (In the database, Creator is stored as int(11).)
2229
2230
2231 =cut
2232
2233
2234 =head2 Created
2235
2236 Returns the current value of Created.
2237 (In the database, Created is stored as datetime.)
2238
2239
2240 =cut
2241
2242
2243 =head2 LastUpdatedBy
2244
2245 Returns the current value of LastUpdatedBy.
2246 (In the database, LastUpdatedBy is stored as int(11).)
2247
2248
2249 =cut
2250
2251
2252 =head2 LastUpdated
2253
2254 Returns the current value of LastUpdated.
2255 (In the database, LastUpdated is stored as datetime.)
2256
2257
2258 =cut
2259
2260
2261 # much false laziness w/Ticket.pm.  now with RT 4!
2262 our %LINKDIRMAP = (
2263     MemberOf => { Base => 'MemberOf',
2264                   Target => 'HasMember', },
2265     RefersTo => { Base => 'RefersTo',
2266                 Target => 'ReferredToBy', },
2267     DependsOn => { Base => 'DependsOn',
2268                    Target => 'DependedOnBy', },
2269     MergedInto => { Base => 'MergedInto',
2270                    Target => 'MergedInto', },
2271
2272 );
2273
2274 sub LINKDIRMAP   { return \%LINKDIRMAP   }
2275
2276
2277 =head2 DeleteLink
2278
2279 Delete a link. takes a paramhash of Base, Target and Type.
2280 Either Base or Target must be null. The null value will
2281 be replaced with this ticket\'s id
2282
2283 =cut
2284
2285 sub DeleteLink {
2286     my $self = shift;
2287     my %args = (
2288         Base   => undef,
2289         Target => undef,
2290         Type   => undef,
2291         @_
2292     );
2293
2294     unless ( $args{'Target'} || $args{'Base'} ) {
2295         $RT::Logger->error("Base or Target must be specified\n");
2296         return ( 0, $self->loc('Either base or target must be specified') );
2297     }
2298
2299     #check acls
2300     my $right = 0;
2301     $right++ if $self->CurrentUserHasRight('AdminUsers');
2302     if ( !$right && $RT::StrictLinkACL ) {
2303         return ( 0, $self->loc("Permission Denied") );
2304     }
2305
2306 #    # If the other URI is an RT::Ticket, we want to make sure the user
2307 #    # can modify it too...
2308 #    my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
2309 #    return (0, $msg) unless $status;
2310 #    if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
2311 #        $right++;
2312 #    }
2313 #    if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
2314 #         ( $RT::StrictLinkACL && $right < 2 ) )
2315 #    {
2316 #        return ( 0, $self->loc("Permission Denied") );
2317 #    }
2318
2319     my ($val, $Msg) = $self->SUPER::_DeleteLink(%args);
2320
2321     if ( !$val ) {
2322         $RT::Logger->debug("Couldn't find that link\n");
2323         return ( 0, $Msg );
2324     }
2325
2326     my ($direction, $remote_link);
2327
2328     if ( $args{'Base'} ) {
2329        $remote_link = $args{'Base'};
2330        $direction = 'Target';
2331     }
2332     elsif ( $args{'Target'} ) {
2333        $remote_link = $args{'Target'};
2334         $direction='Base';
2335     }
2336
2337     if ( $args{'Silent'} ) {
2338         return ( $val, $Msg );
2339     }
2340     else {
2341        my $remote_uri = RT::URI->new( $self->CurrentUser );
2342        $remote_uri->FromURI( $remote_link );
2343
2344         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
2345             Type      => 'DeleteLink',
2346             Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
2347            OldValue =>  $remote_uri->URI || $remote_link,
2348             TimeTaken => 0
2349         );
2350
2351         if ( $remote_uri->IsLocal ) {
2352
2353             my $OtherObj = $remote_uri->Object;
2354             my ( $val, $Msg ) = $OtherObj->_NewTransaction(Type  => 'DeleteLink',
2355                                                            Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
2356                                                                                            : $LINKDIRMAP{$args{'Type'}}->{Target},
2357                                                            OldValue => $self->URI,
2358                                                            ActivateScrips => ! $RT::LinkTransactionsRun1Scrip,
2359                                                            TimeTaken => 0 );
2360         }
2361
2362         return ( $Trans, $Msg );
2363     }
2364 }
2365
2366 sub AddLink {
2367     my $self = shift;
2368     my %args = ( Target => '',
2369                  Base   => '',
2370                  Type   => '',
2371                  Silent => undef,
2372                  @_ );
2373
2374     unless ( $args{'Target'} || $args{'Base'} ) {
2375         $RT::Logger->error("Base or Target must be specified\n");
2376         return ( 0, $self->loc('Either base or target must be specified') );
2377     }
2378
2379     my $right = 0;
2380     $right++ if $self->CurrentUserHasRight('AdminUsers');
2381     if ( !$right && $RT::StrictLinkACL ) {
2382         return ( 0, $self->loc("Permission Denied") );
2383     }
2384
2385 #    # If the other URI is an RT::Ticket, we want to make sure the user
2386 #    # can modify it too...
2387 #    my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
2388 #    return (0, $msg) unless $status;
2389 #    if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
2390 #        $right++;
2391 #    }
2392 #    if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
2393 #         ( $RT::StrictLinkACL && $right < 2 ) )
2394 #    {
2395 #        return ( 0, $self->loc("Permission Denied") );
2396 #    }
2397
2398     return $self->_AddLink(%args);
2399 }
2400
2401 =head2 _AddLink
2402
2403 Private non-acled variant of AddLink so that links can be added during create.
2404
2405 =cut
2406
2407 sub _AddLink {
2408     my $self = shift;
2409     my %args = ( Target => '',
2410                  Base   => '',
2411                  Type   => '',
2412                  Silent => undef,
2413                  @_ );
2414
2415     my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args);
2416     return ($val, $msg) if !$val || $exist;
2417
2418     my ($direction, $remote_link);
2419     if ( $args{'Target'} ) {
2420         $remote_link  = $args{'Target'};
2421         $direction    = 'Base';
2422     } elsif ( $args{'Base'} ) {
2423         $remote_link  = $args{'Base'};
2424         $direction    = 'Target';
2425     }
2426
2427     # Don't write the transaction if we're doing this on create
2428     if ( $args{'Silent'} ) {
2429         return ( $val, $msg );
2430     }
2431     else {
2432         my $remote_uri = RT::URI->new( $self->CurrentUser );
2433        $remote_uri->FromURI( $remote_link );
2434
2435         #Write the transaction
2436         my ( $Trans, $Msg, $TransObj ) =
2437            $self->_NewTransaction(Type  => 'AddLink',
2438                                   Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
2439                                   NewValue =>  $remote_uri->URI || $remote_link,
2440                                   TimeTaken => 0 );
2441
2442         if ( $remote_uri->IsLocal ) {
2443
2444             my $OtherObj = $remote_uri->Object;
2445             my ( $val, $Msg ) = $OtherObj->_NewTransaction(Type  => 'AddLink',
2446                                                            Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
2447                                                                                            : $LINKDIRMAP{$args{'Type'}}->{Target},
2448                                                            NewValue => $self->URI,
2449                                                            ActivateScrips => ! $RT::LinkTransactionsRun1Scrip,
2450                                                            TimeTaken => 0 );
2451         }
2452         return ( $val, $Msg );
2453     }
2454
2455 }
2456
2457
2458 sub _CoreAccessible {
2459     {
2460
2461         id =>
2462         {read => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
2463         Name =>
2464         {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
2465         Password =>
2466         {read => 1, write => 1, sql_type => 12, length => 256,  is_blob => 0,  is_numeric => 0,  type => 'varchar(256)', default => ''},
2467         AuthToken =>
2468         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2469         Comments =>
2470         {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
2471         Signature =>
2472         {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
2473         EmailAddress =>
2474         {read => 1, write => 1, sql_type => 12, length => 120,  is_blob => 0,  is_numeric => 0,  type => 'varchar(120)', default => ''},
2475         FreeformContactInfo =>
2476         {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
2477         Organization =>
2478         {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
2479         RealName =>
2480         {read => 1, write => 1, sql_type => 12, length => 120,  is_blob => 0,  is_numeric => 0,  type => 'varchar(120)', default => ''},
2481         NickName =>
2482         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2483         Lang =>
2484         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2485         EmailEncoding =>
2486         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2487         WebEncoding =>
2488         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2489         ExternalContactInfoId =>
2490         {read => 1, write => 1, sql_type => 12, length => 100,  is_blob => 0,  is_numeric => 0,  type => 'varchar(100)', default => ''},
2491         ContactInfoSystem =>
2492         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2493         ExternalAuthId =>
2494         {read => 1, write => 1, sql_type => 12, length => 100,  is_blob => 0,  is_numeric => 0,  type => 'varchar(100)', default => ''},
2495         AuthSystem =>
2496         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2497         Gecos =>
2498         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2499         HomePhone =>
2500         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2501         WorkPhone =>
2502         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2503         MobilePhone =>
2504         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2505         PagerPhone =>
2506         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2507         Address1 =>
2508         {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
2509         Address2 =>
2510         {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
2511         City =>
2512         {read => 1, write => 1, sql_type => 12, length => 100,  is_blob => 0,  is_numeric => 0,  type => 'varchar(100)', default => ''},
2513         State =>
2514         {read => 1, write => 1, sql_type => 12, length => 100,  is_blob => 0,  is_numeric => 0,  type => 'varchar(100)', default => ''},
2515         Zip =>
2516         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2517         Country =>
2518         {read => 1, write => 1, sql_type => 12, length => 50,  is_blob => 0,  is_numeric => 0,  type => 'varchar(50)', default => ''},
2519         Timezone =>
2520         {read => 1, write => 1, sql_type => 12, length => 50,  is_blob => 0,  is_numeric => 0,  type => 'varchar(50)', default => ''},
2521         PGPKey =>
2522         {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
2523         Creator =>
2524         {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
2525         Created =>
2526         {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
2527         LastUpdatedBy =>
2528         {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
2529         LastUpdated =>
2530         {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
2531
2532  }
2533 };
2534
2535 RT::Base->_ImportOverlays();
2536
2537
2538 1;