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