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