Putting 4.2.0 on top of 4.0.17
[usit-rt.git] / lib / RT / User.pm
index be7f21b..9500aca 100644 (file)
@@ -66,6 +66,7 @@ package RT::User;
 use strict;
 use warnings;
 
+use Scalar::Util qw(blessed);
 
 use base 'RT::Record';
 
@@ -78,6 +79,7 @@ sub Table {'Users'}
 
 use Digest::SHA;
 use Digest::MD5;
+use Crypt::Eksblowfish::Bcrypt qw();
 use RT::Principals;
 use RT::ACE;
 use RT::Interface::Email;
@@ -102,8 +104,11 @@ sub _OverlayAccessible {
           AuthSystem            => { public => 1,  admin => 1 },
           Gecos                 => { public => 1,  admin => 1 },
           PGPKey                => { public => 1,  admin => 1 },
+          SMIMECertificate      => { public => 1,  admin => 1 },
           PrivateKey            => {               admin => 1 },
-
+          City                  => { public => 1 },
+          Country               => { public => 1 },
+          Timezone              => { public => 1 },
     }
 }
 
@@ -551,8 +556,8 @@ sub LoadOrCreateByEmail {
             }
         }
     }
-    return (0, $message) unless $self->id;
-    return ($self->Id, $message);
+    return wantarray ? (0, $message) : 0 unless $self->id;
+    return wantarray ? ($self->Id, $message) : $self->Id;
 }
 
 =head2 ValidateEmailAddress ADDRESS
@@ -867,6 +872,39 @@ sub SetPassword {
 
 }
 
+sub _GeneratePassword_bcrypt {
+    my $self = shift;
+    my ($password, @rest) = @_;
+
+    my $salt;
+    my $rounds;
+    if (@rest) {
+        # The first split is the number of rounds
+        $rounds = $rest[0];
+
+        # The salt is the first 22 characters, b64 encoded usign the
+        # special bcrypt base64.
+        $salt = Crypt::Eksblowfish::Bcrypt::de_base64( substr($rest[1], 0, 22) );
+    } else {
+        $rounds = RT->Config->Get('BcryptCost');
+
+        # Generate a random 16-octet base64 salt
+        $salt = "";
+        $salt .= pack("C", int rand(256)) for 1..16;
+    }
+
+    my $hash = Crypt::Eksblowfish::Bcrypt::bcrypt_hash({
+        key_nul => 1,
+        cost    => $rounds,
+        salt    => $salt,
+    }, Digest::SHA::sha512( encode_utf8($password) ) );
+
+    return join("!", "", "bcrypt", sprintf("%02d", $rounds),
+                Crypt::Eksblowfish::Bcrypt::en_base64( $salt ).
+                Crypt::Eksblowfish::Bcrypt::en_base64( $hash )
+              );
+}
+
 sub _GeneratePassword_sha512 {
     my $self = shift;
     my ($password, $salt) = @_;
@@ -890,13 +928,13 @@ Returns a string to store in the database.  This string takes the form:
 
    !method!salt!hash
 
-By default, the method is currently C<sha512>.
+By default, the method is currently C<bcrypt>.
 
 =cut
 
 sub _GeneratePassword {
     my $self = shift;
-    return $self->_GeneratePassword_sha512(@_);
+    return $self->_GeneratePassword_bcrypt(@_);
 }
 
 =head3 HasPassword
@@ -945,9 +983,13 @@ sub IsPassword {
     my $stored = $self->__Value('Password');
     if ($stored =~ /^!/) {
         # If it's a new-style (>= RT 4.0) password, it starts with a '!'
-        my (undef, $method, $salt, undef) = split /!/, $stored;
-        if ($method eq "sha512") {
-            return $self->_GeneratePassword_sha512($value, $salt) eq $stored;
+        my (undef, $method, @rest) = split /!/, $stored;
+        if ($method eq "bcrypt") {
+            return 0 unless $self->_GeneratePassword_bcrypt($value, @rest) eq $stored;
+            # Upgrade to a larger number of rounds if necessary
+            return 1 unless $rest[0] < RT->Config->Get('BcryptCost');
+        } elsif ($method eq "sha512") {
+            return 0 unless $self->_GeneratePassword_sha512($value, @rest) eq $stored;
         } else {
             $RT::Logger->warn("Unknown hash method $method");
             return 0;
@@ -988,8 +1030,8 @@ sub CurrentUserRequireToSetPassword {
         RequireCurrent => 1,
     );
 
-    if ( RT->Config->Get('WebExternalAuth')
-        && !RT->Config->Get('WebFallbackToInternalAuth')
+    if ( RT->Config->Get('WebRemoteUserAuth')
+        && !RT->Config->Get('WebFallbackToRTLogin')
     ) {
         $res{'CanSet'} = 0;
         $res{'Reason'} = $self->loc("External authentication enabled.");
@@ -1096,11 +1138,11 @@ sub SetDisabled {
     }
 
     $RT::Handle->BeginTransaction();
-    my $set_err = $self->PrincipalObj->SetDisabled($val);
-    unless ($set_err) {
+    my ($status, $msg) = $self->PrincipalObj->SetDisabled($val);
+    unless ($status) {
         $RT::Handle->Rollback();
         $RT::Logger->warning(sprintf("Couldn't %s user %s", ($val == 1) ? "disable" : "enable", $self->PrincipalObj->Id));
-        return (undef);
+        return ($status, $msg);
     }
     $self->_NewTransaction( Type => ($val == 1) ? "Disabled" : "Enabled" );
 
@@ -1251,26 +1293,29 @@ public, ourself, or we have AdminUsers
 
 sub CurrentUserCanSee {
     my $self = shift;
-    my ($what) = @_;
+    my ($what, $txn) = @_;
 
-    # If it's public, fine.  Note that $what may be "transaction", which
-    # doesn't have an Accessible value, and thus falls through below.
-    if ( $self->_Accessible( $what, 'public' ) ) {
-        return 1;
-    }
+    # If it's a public property, fine
+    return 1 if $self->_Accessible( $what, 'public' );
 
-    # Users can see their own properties
-    elsif ( defined($self->Id) && $self->CurrentUser->Id == $self->Id ) {
-        return 1;
-    }
+    # Users can see all of their own properties
+    return 1 if defined($self->Id) and $self->CurrentUser->Id == $self->Id;
 
     # If the user has the admin users right, that's also enough
-    elsif ( $self->CurrentUser->HasRight( Right => 'AdminUsers', Object => $RT::System) ) {
-        return 1;
-    }
-    else {
-        return 0;
+    return 1 if $self->CurrentUserHasRight( 'AdminUsers' );
+
+    # Transactions of public properties are visible to users with ShowUserHistory
+    if ($what eq "Transaction" and $self->CurrentUserHasRight( 'ShowUserHistory' )) {
+        my $type = $txn->__Value('Type');
+        my $field = $txn->__Value('Field');
+        return 1 if $type eq "Set" and $self->CurrentUserCanSee($field, $txn);
+
+        # RT::Transaction->CurrentUserCanSee deals with ensuring we meet
+        # the ACLs on CFs, so allow them here
+        return 1 if $type eq "CustomField";
     }
+
+    return 0;
 }
 
 =head2 CurrentUserCanModify RIGHT
@@ -1330,7 +1375,7 @@ sub _PrefName {
         $name = ref($name).'-'.$name->Id;
     }
 
-    return 'Pref-'.$name;
+    return 'Pref-'. $name;
 }
 
 =head2 Preferences NAME/OBJ DEFAULT
@@ -1341,15 +1386,24 @@ override the entries with user preferences.
 
 =cut
 
+our %PREFERENCES_CACHE = ();
+
 sub Preferences {
     my $self  = shift;
-    my $name = _PrefName (shift);
+    my $name = _PrefName(shift);
     my $default = shift;
 
-    my $attr = RT::Attribute->new( $self->CurrentUser );
-    $attr->LoadByNameAndObject( Object => $self, Name => $name );
+    my $content;
+    if ( exists $PREFERENCES_CACHE{ $self->id }{ $name } ) {
+        $content = $PREFERENCES_CACHE{ $self->id }{ $name };
+    }
+    else {
+        my $attr = RT::Attribute->new( $self->CurrentUser );
+        $attr->LoadByNameAndObject( Object => $self, Name => $name );
+        $PREFERENCES_CACHE{ $self->id }{ $name } = $content
+            = $attr->Id ? $attr->Content : undef;
+    }
 
-    my $content = $attr->Id ? $attr->Content : undef;
     unless ( ref $content eq 'HASH' ) {
         return defined $content ? $content : $default;
     }
@@ -1359,7 +1413,7 @@ sub Preferences {
             exists $content->{$_} or $content->{$_} = $default->{$_};
         }
     } elsif (defined $default) {
-        $RT::Logger->error("Preferences $name for user".$self->Id." is hash but default is not");
+        $RT::Logger->error("Preferences $name for user #".$self->Id." is hash but default is not");
     }
     return $content;
 }
@@ -1378,6 +1432,8 @@ sub SetPreferences {
     return (0, $self->loc("No permission to set preferences"))
         unless $self->CurrentUserCanModify('Preferences');
 
+    # we clear cache in RT::Attribute
+
     my $attr = RT::Attribute->new( $self->CurrentUser );
     $attr->LoadByNameAndObject( Object => $self, Name => $name );
     if ( $attr->Id ) {
@@ -1402,10 +1458,8 @@ sub Stylesheet {
     my $style = RT->Config->Get('WebDefaultStylesheet', $self->CurrentUser);
 
     if (RT::Interface::Web->ComponentPathIsSafe($style)) {
-        my @css_paths = map { $_ . '/NoAuth/css' } RT::Interface::Web->ComponentRoots;
-
-        for my $css_path (@css_paths) {
-            if (-d "$css_path/$style") {
+        for my $root (RT::Interface::Web->StaticRoots) {
+            if (-d "$root/css/$style") {
                 return $style
             }
         }
@@ -1446,12 +1500,13 @@ sub WatchedQueues {
                             FIELD => 'Domain',
                             VALUE => 'RT::Queue-Role',
                             ENTRYAGGREGATOR => 'AND',
+                            CASESENSITIVE => 0,
                           );
     if (grep { $_ eq 'Cc' } @roles) {
         $watched_queues->Limit(
                                 SUBCLAUSE => 'LimitToWatchers',
                                 ALIAS => $group_alias,
-                                FIELD => 'Type',
+                                FIELD => 'Name',
                                 VALUE => 'Cc',
                                 ENTRYAGGREGATOR => 'OR',
                               );
@@ -1460,7 +1515,7 @@ sub WatchedQueues {
         $watched_queues->Limit(
                                 SUBCLAUSE => 'LimitToWatchers',
                                 ALIAS => $group_alias,
-                                FIELD => 'Type',
+                                FIELD => 'Name',
                                 VALUE => 'AdminCc',
                                 ENTRYAGGREGATOR => 'OR',
                               );
@@ -1562,9 +1617,134 @@ Return the friendly name
 
 sub FriendlyName {
     my $self = shift;
-    return $self->RealName if defined($self->RealName);
-    return $self->Name if defined($self->Name);
-    return "";
+    return $self->RealName if defined $self->RealName and length $self->RealName;
+    return $self->Name;
+}
+
+=head2 Format
+
+Class or object method.
+
+Returns a string describing a user in the current user's preferred format.
+
+May be invoked in three ways:
+
+    $UserObj->Format;
+    RT::User->Format( User => $UserObj );   # same as above
+    RT::User->Format( Address => $AddressObj, CurrentUser => $CurrentUserObj );
+
+Possible arguments are:
+
+=over
+
+=item User
+
+An L<RT::User> object representing the user to format.  Preferred to Address.
+
+=item Address
+
+An L<Email::Address> object representing the user address to format.  Address
+will be used to lookup an L<RT::User> if possible.
+
+=item CurrentUser
+
+Required when Format is called as a class method with an Address argument.
+Otherwise, this argument is ignored in preference to the CurrentUser of the
+involved L<RT::User> object.
+
+=item Format
+
+Specifies the format to use, overriding any set from the config or current
+user's preferences.
+
+=back
+
+=cut
+
+sub Format {
+    my $self = shift;
+    my %args = (
+        User        => undef,
+        Address     => undef,
+        CurrentUser => undef,
+        Format      => undef,
+        @_
+    );
+
+    if (blessed($self) and $self->id) {
+        @args{"User", "CurrentUser"} = ($self, $self->CurrentUser);
+    }
+    elsif ($args{User} and $args{User}->id) {
+        $args{CurrentUser} = $args{User}->CurrentUser;
+    }
+    elsif ($args{Address} and $args{CurrentUser}) {
+        $args{User} = RT::User->new( $args{CurrentUser} );
+        $args{User}->LoadByEmail( $args{Address}->address );
+        if ($args{User}->id) {
+            delete $args{Address};
+        } else {
+            delete $args{User};
+        }
+    }
+    else {
+        RT->Logger->warning("Invalid arguments to RT::User->Format at @{[join '/', caller]}");
+        return "";
+    }
+
+    $args{Format} ||= RT->Config->Get("UsernameFormat", $args{CurrentUser});
+    $args{Format} =~ s/[^A-Za-z0-9_]+//g;
+
+    my $method    = "_FormatUser" . ucfirst lc $args{Format};
+    my $formatter = $self->can($method);
+
+    unless ($formatter) {
+        RT->Logger->error(
+            "Either system config or user #" . $args{CurrentUser}->id .
+            " picked UsernameFormat $args{Format}, but RT::User->$method doesn't exist"
+        );
+        $formatter = $self->can("_FormatUserRole");
+    }
+    return $formatter->( $self, map { $_ => $args{$_} } qw(User Address) );
+}
+
+sub _FormatUserRole {
+    my $self = shift;
+    my %args = @_;
+
+    my $user = $args{User};
+    return $self->_FormatUserVerbose(@_)
+        unless $user and $user->Privileged;
+
+    my $name = $user->Name;
+    $name .= " (".$user->RealName.")"
+        if $user->RealName and lc $user->RealName ne lc $user->Name;
+    return $name;
+}
+
+sub _FormatUserConcise {
+    my $self = shift;
+    my %args = @_;
+    return $args{User} ? $args{User}->FriendlyName : $args{Address}->address;
+}
+
+sub _FormatUserVerbose {
+    my $self = shift;
+    my %args = @_;
+    my ($user, $address) = @args{"User", "Address"};
+
+    my $email   = '';
+    my $phrase  = '';
+    my $comment = '';
+
+    if ($user) {
+        $email   = $user->EmailAddress || '';
+        $phrase  = $user->RealName  if $user->RealName and lc $user->RealName ne lc $email;
+        $comment = $user->Name      if lc $user->Name ne lc $email;
+    } else {
+        ($email, $phrase, $comment) = (map { $address->$_ } "address", "phrase", "comment");
+    }
+
+    return join " ", grep { $_ } ($phrase || $comment || ''), ($email ? "<$email>" : "");
 }
 
 =head2 PreferredKey
@@ -1591,18 +1771,17 @@ sub PreferredKey
     return $prefkey->Content if $prefkey;
 
     # we don't have a preferred key for this user, so now we must query GPG
-    require RT::Crypt::GnuPG;
-    my %res = RT::Crypt::GnuPG::GetKeysForEncryption($self->EmailAddress);
+    my %res = RT::Crypt->GetKeysForEncryption($self->EmailAddress);
     return undef unless defined $res{'info'};
     my @keys = @{ $res{'info'} };
     return undef if @keys == 0;
 
     if (@keys == 1) {
-        $prefkey = $keys[0]->{'Fingerprint'};
+        $prefkey = $keys[0]->{'id'} || $keys[0]->{'Fingerprint'};
     } else {
         # prefer the maximally trusted key
         @keys = sort { $b->{'TrustLevel'} <=> $a->{'TrustLevel'} } @keys;
-        $prefkey = $keys[0]->{'Fingerprint'};
+        $prefkey = $keys[0]->{'id'} || $keys[0]->{'Fingerprint'};
     }
 
     $self->SetAttribute(Name => 'PreferredKey', Content => $prefkey);
@@ -1645,7 +1824,7 @@ sub SetPrivateKey {
 
     # check that it's really private key
     {
-        my %tmp = RT::Crypt::GnuPG::GetKeysForSigning( $key );
+        my %tmp = RT::Crypt->GetKeysForSigning( Signer => $key, Protocol => 'GnuPG' );
         return (0, $self->loc("No such key or it's not suitable for signing"))
             if $tmp{'exit_code'} || !$tmp{'info'};
     }
@@ -1659,6 +1838,21 @@ sub SetPrivateKey {
     return ($status, $self->loc("Set private key"));
 }
 
+sub SetLang {
+    my $self = shift;
+    my ($lang) = @_;
+
+    unless ($self->CurrentUserCanModify('Lang')) {
+        return (0, $self->loc("Permission Denied"));
+    }
+
+    # Local hack to cause the result message to be in the _new_ language
+    # if we're updating ourselves
+    $self->CurrentUser->{LangHandle} = RT::I18N->get_handle( $lang )
+        if $self->CurrentUser->id == $self->id;
+    return $self->_Set( Field => 'Lang', Value => $lang );
+}
+
 sub BasicColumns {
     (
     [ Name => 'Username' ],
@@ -1668,6 +1862,79 @@ sub BasicColumns {
     );
 }
 
+=head2 Bookmarks
+
+Returns an unordered list of IDs representing the user's bookmarked tickets.
+
+=cut
+
+sub Bookmarks {
+    my $self = shift;
+    my $bookmarks = $self->FirstAttribute('Bookmarks');
+    return if !$bookmarks;
+
+    $bookmarks = $bookmarks->Content;
+    return if !$bookmarks;
+
+    return keys %$bookmarks;
+}
+
+=head2 HasBookmark TICKET
+
+Returns whether the provided ticket is bookmarked by the user.
+
+=cut
+
+sub HasBookmark {
+    my $self   = shift;
+    my $ticket = shift;
+    my $id     = $ticket->id;
+
+    # maintain bookmarks across merges
+    my @ids = ($id, $ticket->Merged);
+
+    my $bookmarks = $self->FirstAttribute('Bookmarks');
+    $bookmarks = $bookmarks ? $bookmarks->Content : {};
+
+    my @bookmarked = grep { $bookmarks->{ $_ } } @ids;
+    return @bookmarked ? 1 : 0;
+}
+
+=head2 ToggleBookmark TICKET
+
+Toggles whether the provided ticket is bookmarked by the user.
+
+=cut
+
+sub ToggleBookmark {
+    my $self   = shift;
+    my $ticket = shift;
+    my $id     = $ticket->id;
+
+    # maintain bookmarks across merges
+    my @ids = ($id, $ticket->Merged);
+
+    my $bookmarks = $self->FirstAttribute('Bookmarks');
+    $bookmarks = $bookmarks ? $bookmarks->Content : {};
+
+    my $is_bookmarked;
+
+    if ( grep { $bookmarks->{ $_ } } @ids ) {
+        delete $bookmarks->{ $_ } foreach @ids;
+        $is_bookmarked = 0;
+    } else {
+        $bookmarks->{ $id } = 1;
+        $is_bookmarked = 1;
+    }
+
+    $self->SetAttribute(
+        Name    => 'Bookmarks',
+        Content => $bookmarks,
+    );
+
+    return $is_bookmarked;
+}
+
 =head2 Create PARAMHASH
 
 Create takes a hash of values and creates a row in the database:
@@ -2257,6 +2524,24 @@ Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 =cut
 
 
+=head2 SMIMECertificate
+
+Returns the current value of SMIMECertificate. 
+(In the database, SMIMECertificate is stored as text.)
+
+
+
+=head2 SetSMIMECertificate VALUE
+
+
+Set SMIMECertificate to VALUE. 
+Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
+(In the database, SMIMECertificate will be stored as a text.)
+
+
+=cut
+
+
 =head2 Creator
 
 Returns the current value of Creator. 
@@ -2359,6 +2644,8 @@ sub _CoreAccessible {
         {read => 1, write => 1, sql_type => 12, length => 50,  is_blob => 0,  is_numeric => 0,  type => 'varchar(50)', default => ''},
         PGPKey => 
         {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
+        SMIMECertificate =>
+        {read => 1, write => 1, sql_type => -4, length => 0,  is_blob => 1,  is_numeric => 0,  type => 'text', default => ''},
         Creator => 
         {read => 1, auto => 1, sql_type => 4, length => 11,  is_blob => 0,  is_numeric => 1,  type => 'int(11)', default => '0'},
         Created => 
@@ -2371,6 +2658,115 @@ sub _CoreAccessible {
  }
 };
 
+sub UID {
+    my $self = shift;
+    return undef unless defined $self->Name;
+    return "@{[ref $self]}-@{[$self->Name]}";
+}
+
+sub FindDependencies {
+    my $self = shift;
+    my ($walker, $deps) = @_;
+
+    $self->SUPER::FindDependencies($walker, $deps);
+
+    # ACL equivalence group
+    my $objs = RT::Groups->new( $self->CurrentUser );
+    $objs->Limit( FIELD => 'Domain', VALUE => 'ACLEquivalence' );
+    $objs->Limit( FIELD => 'Instance', VALUE => $self->Id );
+    $deps->Add( in => $objs );
+
+    # Memberships in SystemInternal groups
+    $objs = RT::GroupMembers->new( $self->CurrentUser );
+    $objs->Limit( FIELD => 'MemberId', VALUE => $self->Id );
+    my $principals = $objs->Join(
+        ALIAS1 => 'main',
+        FIELD1 => 'GroupId',
+        TABLE2 => 'Principals',
+        FIELD2 => 'id',
+    );
+    my $groups = $objs->Join(
+        ALIAS1 => $principals,
+        FIELD1 => 'ObjectId',
+        TABLE2 => 'Groups',
+        FIELD2 => 'Id',
+    );
+    $objs->Limit(
+        ALIAS => $groups,
+        FIELD => 'Domain',
+        VALUE => 'SystemInternal',
+    );
+    $deps->Add( in => $objs );
+
+    # XXX: This ignores the myriad of "in" references from the Creator
+    # and LastUpdatedBy columns.
+}
+
+sub Serialize {
+    my $self = shift;
+    return (
+        Disabled => $self->PrincipalObj->Disabled,
+        Principal => $self->PrincipalObj->UID,
+        PrincipalId => $self->PrincipalObj->Id,
+        $self->SUPER::Serialize(@_),
+    );
+}
+
+sub PreInflate {
+    my $class = shift;
+    my ($importer, $uid, $data) = @_;
+
+    my $principal_uid = delete $data->{Principal};
+    my $principal_id  = delete $data->{PrincipalId};
+    my $disabled      = delete $data->{Disabled};
+
+    my $obj = RT::User->new( RT->SystemUser );
+    $obj->LoadByCols( Name => $data->{Name} );
+    $obj->LoadByEmail( $data->{EmailAddress} ) unless $obj->Id;
+    if ($obj->Id) {
+        # User already exists -- merge
+
+        # XXX: We might be merging a privileged user into an unpriv one,
+        # in which case we should probably promote the unpriv user to
+        # being privileged.  Of course, we don't know if the user being
+        # imported is privileged yet, as its group memberships show up
+        # later in the stream...
+        $importer->MergeValues($obj, $data);
+        $importer->SkipTransactions( $uid );
+
+        # Mark both the principal and the user object as resolved
+        $importer->Resolve(
+            $principal_uid,
+            ref($obj->PrincipalObj),
+            $obj->PrincipalObj->Id
+        );
+        $importer->Resolve( $uid => ref($obj) => $obj->Id );
+        return;
+    }
+
+    # Create a principal first, so we know what ID to use
+    my $principal = RT::Principal->new( RT->SystemUser );
+    my ($id) = $principal->Create(
+        PrincipalType => 'User',
+        Disabled => $disabled,
+        ObjectId => 0,
+    );
+    $importer->Resolve( $principal_uid => ref($principal), $id );
+
+    $importer->Postpone(
+        for => $uid,
+        uid => $principal_uid,
+        column => "ObjectId",
+    );
+
+    return $class->SUPER::PreInflate( $importer, $uid, $data );
+}
+
+sub PostInflate {
+    my $self = shift;
+    RT->InitSystemObjects if $self->Name eq "RT_System";
+}
+
 RT::Base->_ImportOverlays();