TimeWorked-like custom fields, RT#11168
[freeside.git] / rt / lib / RT / User_Overlay.pm
index db3964c..17e9645 100644 (file)
@@ -1,40 +1,40 @@
 # BEGIN BPS TAGGED BLOCK {{{
-# 
+#
 # COPYRIGHT:
-# 
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
-#                                          <jesse@bestpractical.com>
-# 
+#
+# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
 # (Except where explicitly superseded by other copyright notices)
-# 
-# 
+#
+#
 # LICENSE:
-# 
+#
 # This work is made available to you under the terms of Version 2 of
 # the GNU General Public License. A copy of that license should have
 # been provided with this software, but in any event can be snarfed
 # from www.gnu.org.
-# 
+#
 # This work is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 # General Public License for more details.
-# 
+#
 # You should have received a copy of the GNU General Public License
 # along with this program; if not, write to the Free Software
 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 # 02110-1301 or visit their web page on the internet at
 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-# 
-# 
+#
+#
 # CONTRIBUTION SUBMISSION POLICY:
-# 
+#
 # (The following paragraph is not intended to limit the rights granted
 # to you to modify and distribute this software under the terms of
 # the GNU General Public License and is only of importance to you if
 # you choose to contribute your changes and enhancements to the
 # community by submitting them to Best Practical Solutions, LLC.)
-# 
+#
 # By intentionally submitting any modifications, corrections or
 # derivatives to this work, or any other work intended for use with
 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
@@ -43,7 +43,7 @@
 # royalty-free, perpetual, license to use, copy, create derivative
 # works based on those contributions, and sublicense and distribute
 # those contributions and any derivatives thereof.
-# 
+#
 # END BPS TAGGED BLOCK }}}
 
 =head1 NAME
@@ -69,6 +69,7 @@ package RT::User;
 use strict;
 no warnings qw(redefine);
 
+use Digest::SHA;
 use Digest::MD5;
 use RT::Principals;
 use RT::ACE;
@@ -916,6 +917,42 @@ sub _GenerateRandomNextChar {
     return ($i);
 }
 
+sub SafeSetPassword {
+    my $self = shift;
+    my %args = (
+        Current      => undef,
+        New          => undef,
+        Confirmation => undef,
+        @_,
+    );
+    return (1) unless defined $args{'New'} && length $args{'New'};
+
+    my %cond = $self->CurrentUserRequireToSetPassword;
+
+    unless ( $cond{'CanSet'} ) {
+        return (0, $self->loc('You can not set password.') .' '. $cond{'Reason'} );
+    }
+
+    my $error = '';    
+    if ( $cond{'RequireCurrent'} && !$self->CurrentUser->IsPassword($args{'Current'}) ) {
+        if ( defined $args{'Current'} && length $args{'Current'} ) {
+            $error = $self->loc("Please enter your current password correctly.");
+        }
+        else {
+            $error = $self->loc("Please enter your current password.");
+        }
+    } elsif ( $args{'New'} ne $args{'Confirmation'} ) {
+        $error = $self->loc("Passwords do not match.");
+    }
+
+    if ( $error ) {
+        $error .= ' '. $self->loc('Password has not been set.');
+        return (0, $error);
+    }
+
+    return $self->SetPassword( $args{'New'} );
+}
+
 =head3 SetPassword
 
 Takes a string. Checks the string's length and sets this user's password 
@@ -952,20 +989,28 @@ sub SetPassword {
 
 }
 
-=head3 _GeneratePassword PASSWORD
+=head3 _GeneratePassword PASSWORD [, SALT]
 
-returns an MD5 hash of the password passed in, in hexadecimal encoding.
+Returns a salted SHA-256 hash of the password passed in, in base64
+encoding.
 
 =cut
 
 sub _GeneratePassword {
     my $self = shift;
-    my $password = shift;
-
-    my $md5 = Digest::MD5->new();
-    $md5->add(encode_utf8($password));
-    return ($md5->hexdigest);
-
+    my ($password, $salt) = @_;
+
+    # Generate a random 4-byte salt
+    $salt ||= pack("C4",map{int rand(256)} 1..4);
+
+    # Encode the salt, and a truncated SHA256 of the MD5 of the
+    # password.  The additional, un-necessary level of MD5 allows for
+    # transparent upgrading to this scheme, from the previous unsalted
+    # MD5 one.
+    return MIME::Base64::encode_base64(
+        $salt . substr(Digest::SHA::sha256($salt . Digest::MD5::md5($password)),0,26),
+        "" # No newline
+    );
 }
 
 =head3 _GeneratePasswordBase64 PASSWORD
@@ -1028,23 +1073,61 @@ sub IsPassword {
         return(undef);
      }
 
-    # generate an md5 password 
-    if ($self->_GeneratePassword($value) eq $self->__Value('Password')) {
-        return(1);
+    my $stored = $self->__Value('Password');
+    if (length $stored == 40) {
+        # The truncated SHA256(salt,MD5(passwd)) form from 2010/12 is 40 characters long
+        my $hash = MIME::Base64::decode_base64($stored);
+        # The first 4 bytes are the salt, the rest is substr(SHA256,0,26)
+        my $salt = substr($hash, 0, 4, "");
+        return substr(Digest::SHA::sha256($salt . Digest::MD5::md5($value)), 0, 26) eq $hash;
+    } elsif (length $stored == 32) {
+        # Hex nonsalted-md5
+        return 0 unless Digest::MD5::md5_hex(encode_utf8($value)) eq $stored;
+    } elsif (length $stored == 22) {
+        # Base64 nonsalted-md5
+        return 0 unless Digest::MD5::md5_base64(encode_utf8($value)) eq $stored;
+    } elsif (length $stored == 13) {
+        # crypt() output
+        return 0 unless crypt(encode_utf8($value), $stored) eq $stored;
+    } else {
+        $RT::Logger->warn("Unknown password form");
+        return 0;
     }
 
-    #  if it's a historical password we say ok.
-    if ($self->__Value('Password') eq crypt($value, $self->__Value('Password'))
-        or $self->_GeneratePasswordBase64($value) eq $self->__Value('Password'))
-    {
-        # ...but upgrade the legacy password inplace.
-        $self->SUPER::SetPassword( $self->_GeneratePassword($value) );
-        return(1);
-    }
+    # We got here by validating successfully, but with a legacy
+    # password form.  Update to the most recent form.
+    my $obj = $self->isa("RT::CurrentUser") ? $self->UserObj : $self;
+    $obj->_Set(Field => 'Password', Value =>  $self->_GeneratePassword($value) );
+    return 1;
+}
 
-    # no password check has succeeded. get out
+sub CurrentUserRequireToSetPassword {
+    my $self = shift;
 
-    return (undef);
+    my %res = (
+        CanSet => 1,
+        Reason => '',
+        RequireCurrent => 1,
+    );
+
+    if ( RT->Config->Get('WebExternalAuth')
+        && !RT->Config->Get('WebFallbackToInternalAuth')
+    ) {
+        $res{'CanSet'} = 0;
+        $res{'Reason'} = $self->loc("External authentication enabled.");
+    }
+    elsif ( !$self->CurrentUser->HasPassword ) {
+        if ( $self->CurrentUser->id == ($self->id||0) ) {
+            # don't require current password if user has no
+            $res{'RequireCurrent'} = 0;
+        }
+        else {
+            $res{'CanSet'} = 0;
+            $res{'Reason'} = $self->loc("Your password is not set.");
+        }
+    }
+
+    return %res;
 }
 
 =head3 AuthToken
@@ -1266,6 +1349,268 @@ sub OwnGroups {
     return $groups;
 }
 
+# }}}
+
+# {{{ Links
+
+#much false laziness w/Ticket_Overlay.pm.  now with RT 3.8!
+
+# A helper table for links mapping to make it easier
+# to build and parse links between tickets
+
+use vars '%LINKDIRMAP';
+
+%LINKDIRMAP = (
+    MemberOf => { Base => 'MemberOf',
+                  Target => 'HasMember', },
+    RefersTo => { Base => 'RefersTo',
+                Target => 'ReferredToBy', },
+    DependsOn => { Base => 'DependsOn',
+                   Target => 'DependedOnBy', },
+    MergedInto => { Base => 'MergedInto',
+                   Target => 'MergedInto', },
+
+);
+
+sub LINKDIRMAP   { return \%LINKDIRMAP   }
+
+#sub _Links {
+#    my $self = shift;
+#
+#    #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
+#    #tobias meant by $f
+#    my $field = shift;
+#    my $type  = shift || "";
+#
+#    unless ( $self->{"$field$type"} ) {
+#        $self->{"$field$type"} = new RT::Links( $self->CurrentUser );
+#        if ( $self->CurrentUserHasRight('ShowTicket') ) {
+#            # Maybe this ticket is a merged ticket
+#            my $Tickets = new RT::Tickets( $self->CurrentUser );
+#            # at least to myself
+#            $self->{"$field$type"}->Limit( FIELD => $field,
+#                                           VALUE => $self->URI,
+#                                           ENTRYAGGREGATOR => 'OR' );
+#            $Tickets->Limit( FIELD => 'EffectiveId',
+#                             VALUE => $self->EffectiveId );
+#            while (my $Ticket = $Tickets->Next) {
+#                $self->{"$field$type"}->Limit( FIELD => $field,
+#                                               VALUE => $Ticket->URI,
+#                                               ENTRYAGGREGATOR => 'OR' );
+#            }
+#            $self->{"$field$type"}->Limit( FIELD => 'Type',
+#                                           VALUE => $type )
+#              if ($type);
+#        }
+#    }
+#    return ( $self->{"$field$type"} );
+#}
+
+=head2 DeleteLink
+
+Delete a link. takes a paramhash of Base, Target and Type.
+Either Base or Target must be null. The null value will 
+be replaced with this ticket\'s id
+
+=cut 
+
+sub DeleteLink {
+    my $self = shift;
+    my %args = (
+        Base   => undef,
+        Target => undef,
+        Type   => undef,
+        @_
+    );
+
+    unless ( $args{'Target'} || $args{'Base'} ) {
+        $RT::Logger->error("Base or Target must be specified\n");
+        return ( 0, $self->loc('Either base or target must be specified') );
+    }
+
+    #check acls
+    my $right = 0;
+    $right++ if $self->CurrentUserHasRight('AdminUsers');
+    if ( !$right && $RT::StrictLinkACL ) {
+        return ( 0, $self->loc("Permission Denied") );
+    }
+
+#    # If the other URI is an RT::Ticket, we want to make sure the user
+#    # can modify it too...
+#    my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
+#    return (0, $msg) unless $status;
+#    if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
+#        $right++;
+#    }
+#    if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
+#         ( $RT::StrictLinkACL && $right < 2 ) )
+#    {
+#        return ( 0, $self->loc("Permission Denied") );
+#    }
+
+    my ($val, $Msg) = $self->SUPER::_DeleteLink(%args);
+
+    if ( !$val ) {
+        $RT::Logger->debug("Couldn't find that link\n");
+        return ( 0, $Msg );
+    }
+
+    my ($direction, $remote_link);
+
+    if ( $args{'Base'} ) {
+       $remote_link = $args{'Base'};
+       $direction = 'Target';
+    }
+    elsif ( $args{'Target'} ) {
+       $remote_link = $args{'Target'};
+        $direction='Base';
+    }
+
+    if ( $args{'Silent'} ) {
+        return ( $val, $Msg );
+    }
+    else {
+       my $remote_uri = RT::URI->new( $self->CurrentUser );
+       $remote_uri->FromURI( $remote_link );
+
+        my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
+            Type      => 'DeleteLink',
+            Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
+           OldValue =>  $remote_uri->URI || $remote_link,
+            TimeTaken => 0
+        );
+
+        if ( $remote_uri->IsLocal ) {
+
+            my $OtherObj = $remote_uri->Object;
+            my ( $val, $Msg ) = $OtherObj->_NewTransaction(Type  => 'DeleteLink',
+                                                           Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
+                                                                                           : $LINKDIRMAP{$args{'Type'}}->{Target},
+                                                           OldValue => $self->URI,
+                                                           ActivateScrips => ! $RT::LinkTransactionsRun1Scrip,
+                                                           TimeTaken => 0 );
+        }
+
+        return ( $Trans, $Msg );
+    }
+}
+
+sub AddLink {
+    my $self = shift;
+    my %args = ( Target => '',
+                 Base   => '',
+                 Type   => '',
+                 Silent => undef,
+                 @_ );
+
+    unless ( $args{'Target'} || $args{'Base'} ) {
+        $RT::Logger->error("Base or Target must be specified\n");
+        return ( 0, $self->loc('Either base or target must be specified') );
+    }
+
+    my $right = 0;
+    $right++ if $self->CurrentUserHasRight('AdminUsers');
+    if ( !$right && $RT::StrictLinkACL ) {
+        return ( 0, $self->loc("Permission Denied") );
+    }
+
+#    # If the other URI is an RT::Ticket, we want to make sure the user
+#    # can modify it too...
+#    my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
+#    return (0, $msg) unless $status;
+#    if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
+#        $right++;
+#    }
+#    if ( ( !$RT::StrictLinkACL && $right == 0 ) ||
+#         ( $RT::StrictLinkACL && $right < 2 ) )
+#    {
+#        return ( 0, $self->loc("Permission Denied") );
+#    }
+
+    return $self->_AddLink(%args);
+}
+
+#sub __GetTicketFromURI {
+#    my $self = shift;
+#    my %args = ( URI => '', @_ );
+#
+#    # If the other URI is an RT::Ticket, we want to make sure the user
+#    # can modify it too...
+#    my $uri_obj = RT::URI->new( $self->CurrentUser );
+#    $uri_obj->FromURI( $args{'URI'} );
+#
+#    unless ( $uri_obj->Resolver && $uri_obj->Scheme ) {
+#          my $msg = $self->loc( "Couldn't resolve '[_1]' into a URI.", $args{'URI'} );
+#        $RT::Logger->warning( "$msg\n" );
+#        return( 0, $msg );
+#    }
+#    my $obj = $uri_obj->Resolver->Object;
+#    unless ( UNIVERSAL::isa($obj, 'RT::Ticket') && $obj->id ) {
+#        return (1, 'Found not a ticket', undef);
+#    }
+#    return (1, 'Found ticket', $obj);
+#}
+
+=head2 _AddLink  
+
+Private non-acled variant of AddLink so that links can be added during create.
+
+=cut
+
+sub _AddLink {
+    my $self = shift;
+    my %args = ( Target => '',
+                 Base   => '',
+                 Type   => '',
+                 Silent => undef,
+                 @_ );
+
+    my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args);
+    return ($val, $msg) if !$val || $exist;
+
+    my ($direction, $remote_link);
+    if ( $args{'Target'} ) {
+        $remote_link  = $args{'Target'};
+        $direction    = 'Base';
+    } elsif ( $args{'Base'} ) {
+        $remote_link  = $args{'Base'};
+        $direction    = 'Target';
+    }
+
+    # Don't write the transaction if we're doing this on create
+    if ( $args{'Silent'} ) {
+        return ( $val, $msg );
+    }
+    else {
+        my $remote_uri = RT::URI->new( $self->CurrentUser );
+       $remote_uri->FromURI( $remote_link );
+
+        #Write the transaction
+        my ( $Trans, $Msg, $TransObj ) = 
+           $self->_NewTransaction(Type  => 'AddLink',
+                                  Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
+                                  NewValue =>  $remote_uri->URI || $remote_link,
+                                  TimeTaken => 0 );
+
+        if ( $remote_uri->IsLocal ) {
+
+            my $OtherObj = $remote_uri->Object;
+            my ( $val, $Msg ) = $OtherObj->_NewTransaction(Type  => 'AddLink',
+                                                           Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base} 
+                                                                                           : $LINKDIRMAP{$args{'Type'}}->{Target},
+                                                           NewValue => $self->URI,
+                                                           ActivateScrips => ! $RT::LinkTransactionsRun1Scrip,
+                                                           TimeTaken => 0 );
+        }
+        return ( $val, $Msg );
+    }
+
+}
+
+
+
+# }}}
+
 =head2 HasRight
 
 Shim around PrincipalObj->HasRight. See L<RT::Principal>.
@@ -1287,7 +1632,7 @@ admin right) 'ModifySelf', return 1. otherwise, return undef.
 
 sub CurrentUserCanModify {
     my $self  = shift;
-    my $right = shift;
+    my $field = shift;
 
     if ( $self->CurrentUser->HasRight(Right => 'AdminUsers', Object => $RT::System) ) {
         return (1);
@@ -1295,7 +1640,7 @@ sub CurrentUserCanModify {
 
     #If the field is marked as an "administrators only" field, 
     # don\'t let the user touch it.
-    elsif ( $self->_Accessible( $right, 'admin' ) ) {
+    elsif ( $self->_Accessible( $field, 'admin' ) ) {
         return (undef);
     }
 
@@ -1641,6 +1986,14 @@ sub PreferredKey
 {
     my $self = shift;
     return undef unless RT->Config->Get('GnuPG')->{'Enable'};
+
+    if ( ($self->CurrentUser->Id != $self->Id )  &&
+          !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
+          return undef;
+    }
+
+
+
     my $prefkey = $self->FirstAttribute('PreferredKey');
     return $prefkey->Content if $prefkey;
 
@@ -1667,6 +2020,16 @@ sub PreferredKey
 sub PrivateKey {
     my $self = shift;
 
+
+    #If the user wants to see their own values, let them.
+    #If the user is an admin, let them.
+    #Otherwwise, don't let them.
+    #
+    if ( ($self->CurrentUser->Id != $self->Id )  &&
+          !$self->CurrentUser->HasRight(Right =>'AdminUsers', Object => $RT::System) ) {
+          return undef;
+    }
+
     my $key = $self->FirstAttribute('PrivateKey') or return undef;
     return $key->Content;
 }
@@ -1674,7 +2037,11 @@ sub PrivateKey {
 sub SetPrivateKey {
     my $self = shift;
     my $key = shift;
-    # XXX: ACL
+
+    unless ($self->CurrentUserCanModify('PrivateKey')) {
+        return (0, $self->loc("Permission Denied"));
+    }
+
     unless ( $key ) {
         my ($status, $msg) = $self->DeleteAttribute('PrivateKey');
         unless ( $status ) {
@@ -1697,7 +2064,7 @@ sub SetPrivateKey {
     );
     return ($status, $self->loc("Couldn't set private key"))    
         unless $status;
-    return ($status, $self->loc("Unset private key"));
+    return ($status, $self->loc("Set private key"));
 }
 
 sub BasicColumns {