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->warning("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 CurrentUserCanSee [FIELD]
1210
1211 Returns true if the current user can see the user, based on if it is
1212 public, ourself, or we have AdminUsers
1213
1214 =cut
1215
1216 sub CurrentUserCanSee {
1217     my $self = shift;
1218     my ($what) = @_;
1219
1220     # If it's public, fine.  Note that $what may be "transaction", which
1221     # doesn't have an Accessible value, and thus falls through below.
1222     if ( $self->_Accessible( $what, 'public' ) ) {
1223         return 1;
1224     }
1225
1226     # Users can see their own properties
1227     elsif ( defined($self->Id) && $self->CurrentUser->Id == $self->Id ) {
1228         return 1;
1229     }
1230
1231     # If the user has the admin users right, that's also enough
1232     elsif ( $self->CurrentUser->HasRight( Right => 'AdminUsers', Object => $RT::System) ) {
1233         return 1;
1234     }
1235     else {
1236         return 0;
1237     }
1238 }
1239
1240 =head2 CurrentUserCanModify RIGHT
1241
1242 If the user has rights for this object, either because
1243 he has 'AdminUsers' or (if he's trying to edit himself and the right isn't an
1244 admin right) 'ModifySelf', return 1. otherwise, return undef.
1245
1246 =cut
1247
1248 sub CurrentUserCanModify {
1249     my $self  = shift;
1250     my $field = shift;
1251
1252     if ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
1253         return (1);
1254     }
1255
1256     #If the field is marked as an "administrators only" field,
1257     # don't let the user touch it.
1258     elsif ( $self->_Accessible( $field, 'admin' ) ) {
1259         return (undef);
1260     }
1261
1262     #If the current user is trying to modify themselves
1263     elsif ( ( $self->id == $self->CurrentUser->id )
1264         and ( $self->CurrentUser->HasRight(Right => 'ModifySelf', Object => $RT::System) ) )
1265     {
1266         return (1);
1267     }
1268
1269     #If we don't have a good reason to grant them rights to modify
1270     # by now, they lose
1271     else {
1272         return (undef);
1273     }
1274
1275 }
1276
1277 =head2 CurrentUserHasRight
1278
1279 Takes a single argument. returns 1 if $Self->CurrentUser
1280 has the requested right. returns undef otherwise
1281
1282 =cut
1283
1284 sub CurrentUserHasRight {
1285     my $self  = shift;
1286     my $right = shift;
1287
1288     return ( $self->CurrentUser->HasRight(Right => $right, Object => $RT::System) );
1289 }
1290
1291 sub _PrefName {
1292     my $name = shift;
1293     if (ref $name) {
1294         $name = ref($name).'-'.$name->Id;
1295     }
1296
1297     return 'Pref-'.$name;
1298 }
1299
1300 =head2 Preferences NAME/OBJ DEFAULT
1301
1302 Obtain user preferences associated with given object or name.
1303 Returns DEFAULT if no preferences found.  If DEFAULT is a hashref,
1304 override the entries with user preferences.
1305
1306 =cut
1307
1308 sub Preferences {
1309     my $self  = shift;
1310     my $name = _PrefName (shift);
1311     my $default = shift;
1312
1313     my $attr = RT::Attribute->new( $self->CurrentUser );
1314     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1315
1316     my $content = $attr->Id ? $attr->Content : undef;
1317     unless ( ref $content eq 'HASH' ) {
1318         return defined $content ? $content : $default;
1319     }
1320
1321     if (ref $default eq 'HASH') {
1322         for (keys %$default) {
1323             exists $content->{$_} or $content->{$_} = $default->{$_};
1324         }
1325     } elsif (defined $default) {
1326         $RT::Logger->error("Preferences $name for user".$self->Id." is hash but default is not");
1327     }
1328     return $content;
1329 }
1330
1331 =head2 SetPreferences NAME/OBJ VALUE
1332
1333 Set user preferences associated with given object or name.
1334
1335 =cut
1336
1337 sub SetPreferences {
1338     my $self = shift;
1339     my $name = _PrefName( shift );
1340     my $value = shift;
1341
1342     return (0, $self->loc("No permission to set preferences"))
1343         unless $self->CurrentUserCanModify('Preferences');
1344
1345     my $attr = RT::Attribute->new( $self->CurrentUser );
1346     $attr->LoadByNameAndObject( Object => $self, Name => $name );
1347     if ( $attr->Id ) {
1348         my ($ok, $msg) = $attr->SetContent( $value );
1349         return (1, "No updates made")
1350             if $msg eq "That is already the current value";
1351         return ($ok, $msg);
1352     } else {
1353         return $self->AddAttribute( Name => $name, Content => $value );
1354     }
1355 }
1356
1357 =head2 Stylesheet
1358
1359 Returns a list of valid stylesheets take from preferences.
1360
1361 =cut
1362
1363 sub Stylesheet {
1364     my $self = shift;
1365
1366     my $style = RT->Config->Get('WebDefaultStylesheet', $self->CurrentUser);
1367
1368     if (RT::Interface::Web->ComponentPathIsSafe($style)) {
1369         my @css_paths = map { $_ . '/NoAuth/css' } RT::Interface::Web->ComponentRoots;
1370
1371         for my $css_path (@css_paths) {
1372             if (-d "$css_path/$style") {
1373                 return $style
1374             }
1375         }
1376     }
1377
1378     # Fall back to the system stylesheet.
1379     return RT->Config->Get('WebDefaultStylesheet');
1380 }
1381
1382 =head2 WatchedQueues ROLE_LIST
1383
1384 Returns a RT::Queues object containing every queue watched by the user.
1385
1386 Takes a list of roles which is some subset of ('Cc', 'AdminCc').  Defaults to:
1387
1388 $user->WatchedQueues('Cc', 'AdminCc');
1389
1390 =cut
1391
1392 sub WatchedQueues {
1393
1394     my $self = shift;
1395     my @roles = @_ || ('Cc', 'AdminCc');
1396
1397     $RT::Logger->debug('WatcheQueues got user ' . $self->Name);
1398
1399     my $watched_queues = RT::Queues->new($self->CurrentUser);
1400
1401     my $group_alias = $watched_queues->Join(
1402                                              ALIAS1 => 'main',
1403                                              FIELD1 => 'id',
1404                                              TABLE2 => 'Groups',
1405                                              FIELD2 => 'Instance',
1406                                            );
1407
1408     $watched_queues->Limit(
1409                             ALIAS => $group_alias,
1410                             FIELD => 'Domain',
1411                             VALUE => 'RT::Queue-Role',
1412                             ENTRYAGGREGATOR => 'AND',
1413                           );
1414     if (grep { $_ eq 'Cc' } @roles) {
1415         $watched_queues->Limit(
1416                                 SUBCLAUSE => 'LimitToWatchers',
1417                                 ALIAS => $group_alias,
1418                                 FIELD => 'Type',
1419                                 VALUE => 'Cc',
1420                                 ENTRYAGGREGATOR => 'OR',
1421                               );
1422     }
1423     if (grep { $_ eq 'AdminCc' } @roles) {
1424         $watched_queues->Limit(
1425                                 SUBCLAUSE => 'LimitToWatchers',
1426                                 ALIAS => $group_alias,
1427                                 FIELD => 'Type',
1428                                 VALUE => 'AdminCc',
1429                                 ENTRYAGGREGATOR => 'OR',
1430                               );
1431     }
1432
1433     my $queues_alias = $watched_queues->Join(
1434                                               ALIAS1 => $group_alias,
1435                                               FIELD1 => 'id',
1436                                               TABLE2 => 'CachedGroupMembers',
1437                                               FIELD2 => 'GroupId',
1438                                             );
1439     $watched_queues->Limit(
1440                             ALIAS => $queues_alias,
1441                             FIELD => 'MemberId',
1442                             VALUE => $self->PrincipalId,
1443                           );
1444     $watched_queues->Limit(
1445                             ALIAS => $queues_alias,
1446                             FIELD => 'Disabled',
1447                             VALUE => 0,
1448                           );
1449
1450
1451     $RT::Logger->debug("WatchedQueues got " . $watched_queues->Count . " queues");
1452
1453     return $watched_queues;
1454
1455 }
1456
1457 sub _Set {
1458     my $self = shift;
1459
1460     my %args = (
1461         Field => undef,
1462         Value => undef,
1463     TransactionType   => 'Set',
1464     RecordTransaction => 1,
1465         @_
1466     );
1467
1468     # Nobody is allowed to futz with RT_System or Nobody
1469
1470     if ( ($self->Id == RT->SystemUser->Id )  ||
1471          ($self->Id == RT->Nobody->Id)) {
1472         return ( 0, $self->loc("Can not modify system users") );
1473     }
1474     unless ( $self->CurrentUserCanModify( $args{'Field'} ) ) {
1475         return ( 0, $self->loc("Permission Denied") );
1476     }
1477
1478     my $Old = $self->SUPER::_Value("$args{'Field'}");
1479
1480     my ($ret, $msg) = $self->SUPER::_Set( Field => $args{'Field'},
1481                       Value => $args{'Value'} );
1482
1483     #If we can't actually set the field to the value, don't record
1484     # a transaction. instead, get out of here.
1485     if ( $ret == 0 ) { return ( 0, $msg ); }
1486
1487     if ( $args{'RecordTransaction'} == 1 ) {
1488         if ($args{'Field'} eq "Password") {
1489             $args{'Value'} = $Old = '********';
1490         }
1491         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
1492                                                Type => $args{'TransactionType'},
1493                                                Field     => $args{'Field'},
1494                                                NewValue  => $args{'Value'},
1495                                                OldValue  => $Old,
1496                                                TimeTaken => $args{'TimeTaken'},
1497         );
1498         return ( $Trans, scalar $TransObj->BriefDescription );
1499     } else {
1500         return ( $ret, $msg );
1501     }
1502 }
1503
1504 =head2 _Value
1505
1506 Takes the name of a table column.
1507 Returns its value as a string, if the user passes an ACL check
1508
1509 =cut
1510
1511 sub _Value {
1512
1513     my $self  = shift;
1514     my $field = shift;
1515
1516     # Defer to the abstraction above to know if the field can be read
1517     return $self->SUPER::_Value($field) if $self->CurrentUserCanSee($field);
1518     return undef;
1519 }
1520
1521 =head2 FriendlyName
1522
1523 Return the friendly name
1524
1525 =cut
1526
1527 sub FriendlyName {
1528     my $self = shift;
1529     return $self->RealName if defined($self->RealName);
1530     return $self->Name if defined($self->Name);
1531     return "";
1532 }
1533
1534 =head2 PreferredKey
1535
1536 Returns the preferred key of the user. If none is set, then this will query
1537 GPG and set the preferred key to the maximally trusted key found (and then
1538 return it). Returns C<undef> if no preferred key can be found.
1539
1540 =cut
1541
1542 sub PreferredKey
1543 {
1544     my $self = shift;
1545     return undef unless RT->Config->Get('GnuPG')->{'Enable'};
1546
1547     if ( ($self->CurrentUser->Id != $self->Id )  &&
1548           !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1549           return undef;
1550     }
1551
1552
1553
1554     my $prefkey = $self->FirstAttribute('PreferredKey');
1555     return $prefkey->Content if $prefkey;
1556
1557     # we don't have a preferred key for this user, so now we must query GPG
1558     require RT::Crypt::GnuPG;
1559     my %res = RT::Crypt::GnuPG::GetKeysForEncryption($self->EmailAddress);
1560     return undef unless defined $res{'info'};
1561     my @keys = @{ $res{'info'} };
1562     return undef if @keys == 0;
1563
1564     if (@keys == 1) {
1565         $prefkey = $keys[0]->{'Fingerprint'};
1566     } else {
1567         # prefer the maximally trusted key
1568         @keys = sort { $b->{'TrustLevel'} <=> $a->{'TrustLevel'} } @keys;
1569         $prefkey = $keys[0]->{'Fingerprint'};
1570     }
1571
1572     $self->SetAttribute(Name => 'PreferredKey', Content => $prefkey);
1573     return $prefkey;
1574 }
1575
1576 sub PrivateKey {
1577     my $self = shift;
1578
1579
1580     #If the user wants to see their own values, let them.
1581     #If the user is an admin, let them.
1582     #Otherwwise, don't let them.
1583     #
1584     if ( ($self->CurrentUser->Id != $self->Id )  &&
1585           !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
1586           return undef;
1587     }
1588
1589     my $key = $self->FirstAttribute('PrivateKey') or return undef;
1590     return $key->Content;
1591 }
1592
1593 sub SetPrivateKey {
1594     my $self = shift;
1595     my $key = shift;
1596
1597     unless ($self->CurrentUserCanModify('PrivateKey')) {
1598         return (0, $self->loc("Permission Denied"));
1599     }
1600
1601     unless ( $key ) {
1602         my ($status, $msg) = $self->DeleteAttribute('PrivateKey');
1603         unless ( $status ) {
1604             $RT::Logger->error( "Couldn't delete attribute: $msg" );
1605             return ($status, $self->loc("Couldn't unset private key"));
1606         }
1607         return ($status, $self->loc("Unset private key"));
1608     }
1609
1610     # check that it's really private key
1611     {
1612         my %tmp = RT::Crypt::GnuPG::GetKeysForSigning( $key );
1613         return (0, $self->loc("No such key or it's not suitable for signing"))
1614             if $tmp{'exit_code'} || !$tmp{'info'};
1615     }
1616
1617     my ($status, $msg) = $self->SetAttribute(
1618         Name => 'PrivateKey',
1619         Content => $key,
1620     );
1621     return ($status, $self->loc("Couldn't set private key"))
1622         unless $status;
1623     return ($status, $self->loc("Set private key"));
1624 }
1625
1626 sub BasicColumns {
1627     (
1628     [ Name => 'Username' ],
1629     [ EmailAddress => 'Email' ],
1630     [ RealName => 'Name' ],
1631     [ Organization => 'Organization' ],
1632     );
1633 }
1634
1635 =head2 Create PARAMHASH
1636
1637 Create takes a hash of values and creates a row in the database:
1638
1639   varchar(200) 'Name'.
1640   varbinary(256) 'Password'.
1641   varchar(16) 'AuthToken'.
1642   text 'Comments'.
1643   text 'Signature'.
1644   varchar(120) 'EmailAddress'.
1645   text 'FreeformContactInfo'.
1646   varchar(200) 'Organization'.
1647   varchar(120) 'RealName'.
1648   varchar(16) 'NickName'.
1649   varchar(16) 'Lang'.
1650   varchar(16) 'EmailEncoding'.
1651   varchar(16) 'WebEncoding'.
1652   varchar(100) 'ExternalContactInfoId'.
1653   varchar(30) 'ContactInfoSystem'.
1654   varchar(100) 'ExternalAuthId'.
1655   varchar(30) 'AuthSystem'.
1656   varchar(16) 'Gecos'.
1657   varchar(30) 'HomePhone'.
1658   varchar(30) 'WorkPhone'.
1659   varchar(30) 'MobilePhone'.
1660   varchar(30) 'PagerPhone'.
1661   varchar(200) 'Address1'.
1662   varchar(200) 'Address2'.
1663   varchar(100) 'City'.
1664   varchar(100) 'State'.
1665   varchar(16) 'Zip'.
1666   varchar(50) 'Country'.
1667   varchar(50) 'Timezone'.
1668   text 'PGPKey'.
1669
1670 =cut
1671
1672
1673
1674
1675 =head2 id
1676
1677 Returns the current value of id.
1678 (In the database, id is stored as int(11).)
1679
1680
1681 =cut
1682
1683
1684 =head2 Name
1685
1686 Returns the current value of Name.
1687 (In the database, Name is stored as varchar(200).)
1688
1689
1690
1691 =head2 SetName VALUE
1692
1693
1694 Set Name to VALUE.
1695 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1696 (In the database, Name will be stored as a varchar(200).)
1697
1698
1699 =cut
1700
1701
1702 =head2 Password
1703
1704 Returns the current value of Password.
1705 (In the database, Password is stored as varchar(256).)
1706
1707
1708
1709 =head2 SetPassword VALUE
1710
1711
1712 Set Password to VALUE.
1713 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1714 (In the database, Password will be stored as a varchar(256).)
1715
1716
1717 =cut
1718
1719
1720 =head2 AuthToken
1721
1722 Returns the current value of AuthToken.
1723 (In the database, AuthToken is stored as varchar(16).)
1724
1725
1726
1727 =head2 SetAuthToken VALUE
1728
1729
1730 Set AuthToken to VALUE.
1731 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1732 (In the database, AuthToken will be stored as a varchar(16).)
1733
1734
1735 =cut
1736
1737
1738 =head2 Comments
1739
1740 Returns the current value of Comments.
1741 (In the database, Comments is stored as text.)
1742
1743
1744
1745 =head2 SetComments VALUE
1746
1747
1748 Set Comments to VALUE.
1749 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1750 (In the database, Comments will be stored as a text.)
1751
1752
1753 =cut
1754
1755
1756 =head2 Signature
1757
1758 Returns the current value of Signature.
1759 (In the database, Signature is stored as text.)
1760
1761
1762
1763 =head2 SetSignature VALUE
1764
1765
1766 Set Signature to VALUE.
1767 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1768 (In the database, Signature will be stored as a text.)
1769
1770
1771 =cut
1772
1773
1774 =head2 EmailAddress
1775
1776 Returns the current value of EmailAddress.
1777 (In the database, EmailAddress is stored as varchar(120).)
1778
1779
1780
1781 =head2 SetEmailAddress VALUE
1782
1783
1784 Set EmailAddress to VALUE.
1785 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1786 (In the database, EmailAddress will be stored as a varchar(120).)
1787
1788
1789 =cut
1790
1791
1792 =head2 FreeformContactInfo
1793
1794 Returns the current value of FreeformContactInfo.
1795 (In the database, FreeformContactInfo is stored as text.)
1796
1797
1798
1799 =head2 SetFreeformContactInfo VALUE
1800
1801
1802 Set FreeformContactInfo to VALUE.
1803 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1804 (In the database, FreeformContactInfo will be stored as a text.)
1805
1806
1807 =cut
1808
1809
1810 =head2 Organization
1811
1812 Returns the current value of Organization.
1813 (In the database, Organization is stored as varchar(200).)
1814
1815
1816
1817 =head2 SetOrganization VALUE
1818
1819
1820 Set Organization to VALUE.
1821 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1822 (In the database, Organization will be stored as a varchar(200).)
1823
1824
1825 =cut
1826
1827
1828 =head2 RealName
1829
1830 Returns the current value of RealName.
1831 (In the database, RealName is stored as varchar(120).)
1832
1833
1834
1835 =head2 SetRealName VALUE
1836
1837
1838 Set RealName to VALUE.
1839 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1840 (In the database, RealName will be stored as a varchar(120).)
1841
1842
1843 =cut
1844
1845
1846 =head2 NickName
1847
1848 Returns the current value of NickName.
1849 (In the database, NickName is stored as varchar(16).)
1850
1851
1852
1853 =head2 SetNickName VALUE
1854
1855
1856 Set NickName to VALUE.
1857 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1858 (In the database, NickName will be stored as a varchar(16).)
1859
1860
1861 =cut
1862
1863
1864 =head2 Lang
1865
1866 Returns the current value of Lang.
1867 (In the database, Lang is stored as varchar(16).)
1868
1869
1870
1871 =head2 SetLang VALUE
1872
1873
1874 Set Lang to VALUE.
1875 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1876 (In the database, Lang will be stored as a varchar(16).)
1877
1878
1879 =cut
1880
1881
1882 =head2 EmailEncoding
1883
1884 Returns the current value of EmailEncoding.
1885 (In the database, EmailEncoding is stored as varchar(16).)
1886
1887
1888
1889 =head2 SetEmailEncoding VALUE
1890
1891
1892 Set EmailEncoding to VALUE.
1893 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1894 (In the database, EmailEncoding will be stored as a varchar(16).)
1895
1896
1897 =cut
1898
1899
1900 =head2 WebEncoding
1901
1902 Returns the current value of WebEncoding.
1903 (In the database, WebEncoding is stored as varchar(16).)
1904
1905
1906
1907 =head2 SetWebEncoding VALUE
1908
1909
1910 Set WebEncoding to VALUE.
1911 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1912 (In the database, WebEncoding will be stored as a varchar(16).)
1913
1914
1915 =cut
1916
1917
1918 =head2 ExternalContactInfoId
1919
1920 Returns the current value of ExternalContactInfoId.
1921 (In the database, ExternalContactInfoId is stored as varchar(100).)
1922
1923
1924
1925 =head2 SetExternalContactInfoId VALUE
1926
1927
1928 Set ExternalContactInfoId to VALUE.
1929 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1930 (In the database, ExternalContactInfoId will be stored as a varchar(100).)
1931
1932
1933 =cut
1934
1935
1936 =head2 ContactInfoSystem
1937
1938 Returns the current value of ContactInfoSystem.
1939 (In the database, ContactInfoSystem is stored as varchar(30).)
1940
1941
1942
1943 =head2 SetContactInfoSystem VALUE
1944
1945
1946 Set ContactInfoSystem to VALUE.
1947 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1948 (In the database, ContactInfoSystem will be stored as a varchar(30).)
1949
1950
1951 =cut
1952
1953
1954 =head2 ExternalAuthId
1955
1956 Returns the current value of ExternalAuthId.
1957 (In the database, ExternalAuthId is stored as varchar(100).)
1958
1959
1960
1961 =head2 SetExternalAuthId VALUE
1962
1963
1964 Set ExternalAuthId to VALUE.
1965 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1966 (In the database, ExternalAuthId will be stored as a varchar(100).)
1967
1968
1969 =cut
1970
1971
1972 =head2 AuthSystem
1973
1974 Returns the current value of AuthSystem.
1975 (In the database, AuthSystem is stored as varchar(30).)
1976
1977
1978
1979 =head2 SetAuthSystem VALUE
1980
1981
1982 Set AuthSystem to VALUE.
1983 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
1984 (In the database, AuthSystem will be stored as a varchar(30).)
1985
1986
1987 =cut
1988
1989
1990 =head2 Gecos
1991
1992 Returns the current value of Gecos.
1993 (In the database, Gecos is stored as varchar(16).)
1994
1995
1996
1997 =head2 SetGecos VALUE
1998
1999
2000 Set Gecos to VALUE.
2001 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2002 (In the database, Gecos will be stored as a varchar(16).)
2003
2004
2005 =cut
2006
2007
2008 =head2 HomePhone
2009
2010 Returns the current value of HomePhone.
2011 (In the database, HomePhone is stored as varchar(30).)
2012
2013
2014
2015 =head2 SetHomePhone VALUE
2016
2017
2018 Set HomePhone to VALUE.
2019 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2020 (In the database, HomePhone will be stored as a varchar(30).)
2021
2022
2023 =cut
2024
2025
2026 =head2 WorkPhone
2027
2028 Returns the current value of WorkPhone.
2029 (In the database, WorkPhone is stored as varchar(30).)
2030
2031
2032
2033 =head2 SetWorkPhone VALUE
2034
2035
2036 Set WorkPhone to VALUE.
2037 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2038 (In the database, WorkPhone will be stored as a varchar(30).)
2039
2040
2041 =cut
2042
2043
2044 =head2 MobilePhone
2045
2046 Returns the current value of MobilePhone.
2047 (In the database, MobilePhone is stored as varchar(30).)
2048
2049
2050
2051 =head2 SetMobilePhone VALUE
2052
2053
2054 Set MobilePhone to VALUE.
2055 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2056 (In the database, MobilePhone will be stored as a varchar(30).)
2057
2058
2059 =cut
2060
2061
2062 =head2 PagerPhone
2063
2064 Returns the current value of PagerPhone.
2065 (In the database, PagerPhone is stored as varchar(30).)
2066
2067
2068
2069 =head2 SetPagerPhone VALUE
2070
2071
2072 Set PagerPhone to VALUE.
2073 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2074 (In the database, PagerPhone will be stored as a varchar(30).)
2075
2076
2077 =cut
2078
2079
2080 =head2 Address1
2081
2082 Returns the current value of Address1.
2083 (In the database, Address1 is stored as varchar(200).)
2084
2085
2086
2087 =head2 SetAddress1 VALUE
2088
2089
2090 Set Address1 to VALUE.
2091 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2092 (In the database, Address1 will be stored as a varchar(200).)
2093
2094
2095 =cut
2096
2097
2098 =head2 Address2
2099
2100 Returns the current value of Address2.
2101 (In the database, Address2 is stored as varchar(200).)
2102
2103
2104
2105 =head2 SetAddress2 VALUE
2106
2107
2108 Set Address2 to VALUE.
2109 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2110 (In the database, Address2 will be stored as a varchar(200).)
2111
2112
2113 =cut
2114
2115
2116 =head2 City
2117
2118 Returns the current value of City.
2119 (In the database, City is stored as varchar(100).)
2120
2121
2122
2123 =head2 SetCity VALUE
2124
2125
2126 Set City to VALUE.
2127 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2128 (In the database, City will be stored as a varchar(100).)
2129
2130
2131 =cut
2132
2133
2134 =head2 State
2135
2136 Returns the current value of State.
2137 (In the database, State is stored as varchar(100).)
2138
2139
2140
2141 =head2 SetState VALUE
2142
2143
2144 Set State to VALUE.
2145 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2146 (In the database, State will be stored as a varchar(100).)
2147
2148
2149 =cut
2150
2151
2152 =head2 Zip
2153
2154 Returns the current value of Zip.
2155 (In the database, Zip is stored as varchar(16).)
2156
2157
2158
2159 =head2 SetZip VALUE
2160
2161
2162 Set Zip to VALUE.
2163 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2164 (In the database, Zip will be stored as a varchar(16).)
2165
2166
2167 =cut
2168
2169
2170 =head2 Country
2171
2172 Returns the current value of Country.
2173 (In the database, Country is stored as varchar(50).)
2174
2175
2176
2177 =head2 SetCountry VALUE
2178
2179
2180 Set Country to VALUE.
2181 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2182 (In the database, Country will be stored as a varchar(50).)
2183
2184
2185 =cut
2186
2187
2188 =head2 Timezone
2189
2190 Returns the current value of Timezone.
2191 (In the database, Timezone is stored as varchar(50).)
2192
2193
2194
2195 =head2 SetTimezone VALUE
2196
2197
2198 Set Timezone to VALUE.
2199 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2200 (In the database, Timezone will be stored as a varchar(50).)
2201
2202
2203 =cut
2204
2205
2206 =head2 PGPKey
2207
2208 Returns the current value of PGPKey.
2209 (In the database, PGPKey is stored as text.)
2210
2211
2212
2213 =head2 SetPGPKey VALUE
2214
2215
2216 Set PGPKey to VALUE.
2217 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
2218 (In the database, PGPKey will be stored as a text.)
2219
2220
2221 =cut
2222
2223
2224 =head2 Creator
2225
2226 Returns the current value of Creator.
2227 (In the database, Creator is stored as int(11).)
2228
2229
2230 =cut
2231
2232
2233 =head2 Created
2234
2235 Returns the current value of Created.
2236 (In the database, Created is stored as datetime.)
2237
2238
2239 =cut
2240
2241
2242 =head2 LastUpdatedBy
2243
2244 Returns the current value of LastUpdatedBy.
2245 (In the database, LastUpdatedBy is stored as int(11).)
2246
2247
2248 =cut
2249
2250
2251 =head2 LastUpdated
2252
2253 Returns the current value of LastUpdated.
2254 (In the database, LastUpdated is stored as datetime.)
2255
2256
2257 =cut
2258
2259
2260 # much false laziness w/Ticket.pm.  now with RT 4!
2261 our %LINKDIRMAP = (
2262     MemberOf => { Base => 'MemberOf',
2263                   Target => 'HasMember', },
2264     RefersTo => { Base => 'RefersTo',
2265                 Target => 'ReferredToBy', },
2266     DependsOn => { Base => 'DependsOn',
2267                    Target => 'DependedOnBy', },
2268     MergedInto => { Base => 'MergedInto',
2269                    Target => 'MergedInto', },
2270
2271 );
2272
2273 sub LINKDIRMAP   { return \%LINKDIRMAP   }
2274
2275
2276 =head2 DeleteLink
2277
2278 Delete a link. takes a paramhash of Base, Target and Type.
2279 Either Base or Target must be null. The null value will
2280 be replaced with this ticket\'s id
2281
2282 =cut
2283
2284 sub DeleteLink {
2285     my $self = shift;
2286     my %args = (
2287         Base   => undef,
2288         Target => undef,
2289         Type   => undef,
2290         @_
2291     );
2292
2293     unless ( $args{'Target'} || $args{'Base'} ) {
2294         $RT::Logger->error("Base or Target must be specified\n");
2295         return ( 0, $self->loc('Either base or target must be specified') );
2296     }
2297
2298     #check acls
2299     my $right = 0;
2300     $right++ if $self->CurrentUserHasRight('AdminUsers');
2301     if ( !$right && $RT::StrictLinkACL ) {
2302         return ( 0, $self->loc("Permission Denied") );
2303     }
2304
2305 #    # If the other URI is an RT::Ticket, we want to make sure the user
2306 #    # can modify it too...
2307 #    my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
2308 #    return (0, $msg) unless $status;
2309 #    if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
2310 #        $right++;
2311 #    }
2312 #    if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
2313 #         ( $RT::StrictLinkACL && $right < 2 ) )
2314 #    {
2315 #        return ( 0, $self->loc("Permission Denied") );
2316 #    }
2317
2318     my ($val, $Msg) = $self->SUPER::_DeleteLink(%args);
2319
2320     if ( !$val ) {
2321         $RT::Logger->debug("Couldn't find that link\n");
2322         return ( 0, $Msg );
2323     }
2324
2325     my ($direction, $remote_link);
2326
2327     if ( $args{'Base'} ) {
2328        $remote_link = $args{'Base'};
2329        $direction = 'Target';
2330     }
2331     elsif ( $args{'Target'} ) {
2332        $remote_link = $args{'Target'};
2333         $direction='Base';
2334     }
2335
2336     if ( $args{'Silent'} ) {
2337         return ( $val, $Msg );
2338     }
2339     else {
2340        my $remote_uri = RT::URI->new( $self->CurrentUser );
2341        $remote_uri->FromURI( $remote_link );
2342
2343         my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
2344             Type      => 'DeleteLink',
2345             Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
2346            OldValue =>  $remote_uri->URI || $remote_link,
2347             TimeTaken => 0
2348         );
2349
2350         if ( $remote_uri->IsLocal ) {
2351
2352             my $OtherObj = $remote_uri->Object;
2353             my ( $val, $Msg ) = $OtherObj->_NewTransaction(Type  => 'DeleteLink',
2354                                                            Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
2355                                                                                            : $LINKDIRMAP{$args{'Type'}}->{Target},
2356                                                            OldValue => $self->URI,
2357                                                            ActivateScrips => ! $RT::LinkTransactionsRun1Scrip,
2358                                                            TimeTaken => 0 );
2359         }
2360
2361         return ( $Trans, $Msg );
2362     }
2363 }
2364
2365 sub AddLink {
2366     my $self = shift;
2367     my %args = ( Target => '',
2368                  Base   => '',
2369                  Type   => '',
2370                  Silent => undef,
2371                  @_ );
2372
2373     unless ( $args{'Target'} || $args{'Base'} ) {
2374         $RT::Logger->error("Base or Target must be specified\n");
2375         return ( 0, $self->loc('Either base or target must be specified') );
2376     }
2377
2378     my $right = 0;
2379     $right++ if $self->CurrentUserHasRight('AdminUsers');
2380     if ( !$right && $RT::StrictLinkACL ) {
2381         return ( 0, $self->loc("Permission Denied") );
2382     }
2383
2384 #    # If the other URI is an RT::Ticket, we want to make sure the user
2385 #    # can modify it too...
2386 #    my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
2387 #    return (0, $msg) unless $status;
2388 #    if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
2389 #        $right++;
2390 #    }
2391 #    if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
2392 #         ( $RT::StrictLinkACL && $right < 2 ) )
2393 #    {
2394 #        return ( 0, $self->loc("Permission Denied") );
2395 #    }
2396
2397     return $self->_AddLink(%args);
2398 }
2399
2400 =head2 _AddLink
2401
2402 Private non-acled variant of AddLink so that links can be added during create.
2403
2404 =cut
2405
2406 sub _AddLink {
2407     my $self = shift;
2408     my %args = ( Target => '',
2409                  Base   => '',
2410                  Type   => '',
2411                  Silent => undef,
2412                  @_ );
2413
2414     my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args);
2415     return ($val, $msg) if !$val || $exist;
2416
2417     my ($direction, $remote_link);
2418     if ( $args{'Target'} ) {
2419         $remote_link  = $args{'Target'};
2420         $direction    = 'Base';
2421     } elsif ( $args{'Base'} ) {
2422         $remote_link  = $args{'Base'};
2423         $direction    = 'Target';
2424     }
2425
2426     # Don't write the transaction if we're doing this on create
2427     if ( $args{'Silent'} ) {
2428         return ( $val, $msg );
2429     }
2430     else {
2431         my $remote_uri = RT::URI->new( $self->CurrentUser );
2432        $remote_uri->FromURI( $remote_link );
2433
2434         #Write the transaction
2435         my ( $Trans, $Msg, $TransObj ) =
2436            $self->_NewTransaction(Type  => 'AddLink',
2437                                   Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
2438                                   NewValue =>  $remote_uri->URI || $remote_link,
2439                                   TimeTaken => 0 );
2440
2441         if ( $remote_uri->IsLocal ) {
2442
2443             my $OtherObj = $remote_uri->Object;
2444             my ( $val, $Msg ) = $OtherObj->_NewTransaction(Type  => 'AddLink',
2445                                                            Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
2446                                                                                            : $LINKDIRMAP{$args{'Type'}}->{Target},
2447                                                            NewValue => $self->URI,
2448                                                            ActivateScrips => ! $RT::LinkTransactionsRun1Scrip,
2449                                                            TimeTaken => 0 );
2450         }
2451         return ( $val, $Msg );
2452     }
2453
2454 }
2455
2456
2457 sub _CoreAccessible {
2458     {
2459
2460         id =>
2461         {read => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => ''},
2462         Name =>
2463         {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
2464         Password =>
2465         {read => 1, write => 1, sql_type => 12, length => 256,  is_blob => 0,  is_numeric => 0,  type => 'varchar(256)', default => ''},
2466         AuthToken =>
2467         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2468         Comments =>
2469         {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
2470         Signature =>
2471         {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
2472         EmailAddress =>
2473         {read => 1, write => 1, sql_type => 12, length => 120,  is_blob => 0,  is_numeric => 0,  type => 'varchar(120)', default => ''},
2474         FreeformContactInfo =>
2475         {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
2476         Organization =>
2477         {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
2478         RealName =>
2479         {read => 1, write => 1, sql_type => 12, length => 120,  is_blob => 0,  is_numeric => 0,  type => 'varchar(120)', default => ''},
2480         NickName =>
2481         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2482         Lang =>
2483         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2484         EmailEncoding =>
2485         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2486         WebEncoding =>
2487         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2488         ExternalContactInfoId =>
2489         {read => 1, write => 1, sql_type => 12, length => 100,  is_blob => 0,  is_numeric => 0,  type => 'varchar(100)', default => ''},
2490         ContactInfoSystem =>
2491         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2492         ExternalAuthId =>
2493         {read => 1, write => 1, sql_type => 12, length => 100,  is_blob => 0,  is_numeric => 0,  type => 'varchar(100)', default => ''},
2494         AuthSystem =>
2495         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2496         Gecos =>
2497         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2498         HomePhone =>
2499         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2500         WorkPhone =>
2501         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2502         MobilePhone =>
2503         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2504         PagerPhone =>
2505         {read => 1, write => 1, sql_type => 12, length => 30,  is_blob => 0,  is_numeric => 0,  type => 'varchar(30)', default => ''},
2506         Address1 =>
2507         {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
2508         Address2 =>
2509         {read => 1, write => 1, sql_type => 12, length => 200,  is_blob => 0,  is_numeric => 0,  type => 'varchar(200)', default => ''},
2510         City =>
2511         {read => 1, write => 1, sql_type => 12, length => 100,  is_blob => 0,  is_numeric => 0,  type => 'varchar(100)', default => ''},
2512         State =>
2513         {read => 1, write => 1, sql_type => 12, length => 100,  is_blob => 0,  is_numeric => 0,  type => 'varchar(100)', default => ''},
2514         Zip =>
2515         {read => 1, write => 1, sql_type => 12, length => 16,  is_blob => 0,  is_numeric => 0,  type => 'varchar(16)', default => ''},
2516         Country =>
2517         {read => 1, write => 1, sql_type => 12, length => 50,  is_blob => 0,  is_numeric => 0,  type => 'varchar(50)', default => ''},
2518         Timezone =>
2519         {read => 1, write => 1, sql_type => 12, length => 50,  is_blob => 0,  is_numeric => 0,  type => 'varchar(50)', default => ''},
2520         PGPKey =>
2521         {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
2522         Creator =>
2523         {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
2524         Created =>
2525         {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
2526         LastUpdatedBy =>
2527         {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
2528         LastUpdated =>
2529         {read => 1, auto => 1, sql_type => 11, length => 0,  is_blob => 0,  is_numeric => 0,  type => 'datetime', default => ''},
2530
2531  }
2532 };
2533
2534 RT::Base->_ImportOverlays();
2535
2536
2537 1;