From 6f7580f357fd8ac79433d0c5bad602abd26eb73e Mon Sep 17 00:00:00 2001
From: Marcel de Rooy <m.de.rooy@rijksmuseum.nl>
Date: Wed, 3 Oct 2018 15:36:46 +0200
Subject: [PATCH] Bug 21336: Introduce administrative lockout

As a preparation for Koha::Patron->lock, we add the concept of administrative
lockout. The account is locked just as it would have been by too much
failed login attempts.
This is handled by a negative value in borrowers.login_attempts.

Test plan:
Run t/db_dependent/Auth.t

Signed-off-by: Josef Moravec <josef.moravec@gmail.com>
Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
---
 Koha/Patron.pm        | 14 ++++++++++----
 t/db_dependent/Auth.t | 18 +++++++++++++++++-
 2 files changed, 27 insertions(+), 5 deletions(-)

diff --git a/Koha/Patron.pm b/Koha/Patron.pm
index cc1892b855..6acf0f3ed1 100644
--- a/Koha/Patron.pm
+++ b/Koha/Patron.pm
@@ -1088,18 +1088,24 @@ sub get_enrollable_clubs {
 
 my $is_locked = $patron->account_locked
 
-Return true if the patron has reach the maximum number of login attempts (see pref FailedLoginAttempts).
+Return true if the patron has reached the maximum number of login attempts
+(see pref FailedLoginAttempts). If login_attempts is < 0, this is interpreted
+as an administrative lockout (independent of FailedLoginAttempts; see also
+Koha::Patron->lock).
 Otherwise return false.
-If the pref is not set (empty string, null or 0), the feature is considered as disabled.
+If the pref is not set (empty string, null or 0), the feature is considered as
+disabled.
 
 =cut
 
 sub account_locked {
     my ($self) = @_;
     my $FailedLoginAttempts = C4::Context->preference('FailedLoginAttempts');
-    return ( $FailedLoginAttempts
+    return 1 if $FailedLoginAttempts
           and $self->login_attempts
-          and $self->login_attempts >= $FailedLoginAttempts )? 1 : 0;
+          and $self->login_attempts >= $FailedLoginAttempts;
+    return 1 if ($self->login_attempts || 0) < 0; # administrative lockout
+    return 0;
 }
 
 =head3 can_see_patron_infos
diff --git a/t/db_dependent/Auth.t b/t/db_dependent/Auth.t
index 490e4a7984..d59dfc3801 100644
--- a/t/db_dependent/Auth.t
+++ b/t/db_dependent/Auth.t
@@ -318,7 +318,7 @@ ok(C4::Auth::checkpw_hash('password', $hash1), 'password validates with first ha
 ok(C4::Auth::checkpw_hash('password', $hash2), 'password validates with second hash');
 
 subtest 'Check value of login_attempts in checkpw' => sub {
-    plan tests => 6;
+    plan tests => 11;
 
     t::lib::Mocks::mock_preference('FailedLoginAttempts', 3);
 
@@ -343,6 +343,22 @@ subtest 'Check value of login_attempts in checkpw' => sub {
     is( @test, 0, 'checkpw failed again and returns nothing now' );
     $patron->discard_changes; # refresh
     is( $patron->login_attempts, 3, 'Login attempts not increased anymore' );
+
+    # Administrative lockout cannot be undone?
+    # Pass the right password now (or: add a nice mock).
+    my $auth = Test::MockModule->new( 'C4::Auth' );
+    $auth->mock( 'checkpw_hash', sub { return 1; } ); # not for production :)
+    $patron->login_attempts(0)->store;
+    @test = checkpw( $dbh, $patron->userid, '123', undef, 'opac', 1 );
+    is( $test[0], 1, 'Build confidence in the mock' );
+    $patron->login_attempts(-1)->store;
+    is( $patron->account_locked, 1, 'Check administrative lockout' );
+    @test = checkpw( $dbh, $patron->userid, '123', undef, 'opac', 1 );
+    is( @test, 0, 'checkpw gave red' );
+    $patron->discard_changes; # refresh
+    is( $patron->login_attempts, -1, 'Still locked out' );
+    t::lib::Mocks::mock_preference('FailedLoginAttempts', ''); # disable
+    is( $patron->account_locked, 1, 'Check administrative lockout without pref' );
 };
 
 $schema->storage->txn_rollback;
-- 
2.20.1