rt/lib/RT/User.pm

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