rt/lib/RT/User.pm

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