rt/lib/RT/User.pm

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