rt/lib/RT/User.pm

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