t/db_dependent/Log.t

   1 #!/usr/bin/perl
   2 #
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it under the
   6 # terms of the GNU General Public License as published by the Free Software
   7 # Foundation; either version 3 of the License, or (at your option) any later
   8 # version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  11 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  12 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along
  15 # with Koha; if not, see <http://www.gnu.org/licenses>.
  16
  17 use Modern::Perl;
  18 use Test::More tests => 5;
  19
  20 use C4::Context;
  21 use C4::Log;
  22 use C4::Auth qw/checkpw/;
  23 use Koha::Database;
  24 use Koha::DateUtils;
  25
  26 use t::lib::Mocks qw/mock_preference/; # to mock CronjobLog
  27 use t::lib::TestBuilder;
  28
  29 # Make sure we can rollback.
  30 our $schema  = Koha::Database->new->schema;
  31 $schema->storage->txn_begin;
  32 our $dbh = C4::Context->dbh;
  33
  34 subtest 'Existing tests' => sub {
  35     plan tests => 6;
  36
  37     my $success;
  38     eval {
  39         # FIXME: are we sure there is an member number 1?
  40         logaction("MEMBERS","MODIFY",1,"test operation");
  41         $success = 1;
  42     } or do {
  43         diag($@);
  44         $success = 0;
  45     };
  46     ok($success, "logaction seemed to work");
  47
  48     eval {
  49         # FIXME: US formatted date hardcoded into test for now
  50         $success = scalar(@{GetLogs("","","",undef,undef,"","")});
  51     } or do {
  52         diag($@);
  53         $success = 0;
  54     };
  55     ok($success, "GetLogs returns results for an open search");
  56
  57     eval {
  58         # FIXME: US formatted date hardcoded into test for now
  59         my $date = output_pref( { dt => dt_from_string, dateonly => 1, dateformat => 'iso' } );
  60         $success = scalar(@{GetLogs( $date, $date, "", undef, undef, "", "") } );
  61     } or do {
  62         diag($@);
  63         $success = 0;
  64     };
  65     ok($success, "GetLogs accepts dates in an All-matching search");
  66
  67     eval {
  68         $success = scalar(@{GetLogs("","","",["MEMBERS"],["MODIFY"],1,"")});
  69     } or do {
  70         diag($@);
  71         $success = 0;
  72     };
  73     ok($success, "GetLogs seemed to find ".$success." like our test record in a tighter search");
  74
  75     # We want numbers to be the same between runs.
  76     $dbh->do("DELETE FROM action_logs;");
  77
  78     t::lib::Mocks::mock_preference('CronjobLog',0);
  79     cronlogaction();
  80     my $cronJobCount = $dbh->selectrow_array("SELECT COUNT(*) FROM action_logs WHERE module='CRONJOBS';",{});
  81     is($cronJobCount,0,"Cronjob not logged as expected.");
  82
  83     t::lib::Mocks::mock_preference('CronjobLog',1);
  84     cronlogaction();
  85     $cronJobCount = $dbh->selectrow_array("SELECT COUNT(*) FROM action_logs WHERE module='CRONJOBS';",{});
  86     is($cronJobCount,1,"Cronjob logged as expected.");
  87 };
  88
  89 subtest "GetLogs should return all logs if dates are not set" => sub {
  90     plan tests => 2;
  91     my $today = dt_from_string->add(minutes => -1);
  92     my $yesterday = dt_from_string->add( days => -1 );
  93     $dbh->do(q|
  94         INSERT INTO action_logs (timestamp, user, module, action, object, info)
  95         VALUES
  96         (?, 42, 'CATALOGUING', 'MODIFY', 4242, 'Record 42 has been modified by patron 4242 yesterday'),
  97         (?, 43, 'CATALOGUING', 'MODIFY', 4242, 'Record 43 has been modified by patron 4242 today')
  98     |, undef, output_pref({dt =>$yesterday, dateformat => 'iso'}), output_pref({dt => $today, dateformat => 'iso'}));
  99     my $logs = GetLogs( undef, undef, undef, ['CATALOGUING'], ['MODIFY'], 4242 );
 100     is( scalar(@$logs), 2, 'GetLogs should return all logs regardless the dates' );
 101     $logs = GetLogs( output_pref($today), undef, undef, ['CATALOGUING'], ['MODIFY'], 4242 );
 102     is( scalar(@$logs), 1, 'GetLogs should return the logs for today' );
 103 };
 104
 105 subtest 'logaction(): interface is correctly logged' => sub {
 106
 107     plan tests => 4;
 108
 109     # No interface passed, using C4::Context->interface
 110     $dbh->do("DELETE FROM action_logs;");
 111     C4::Context->interface( 'commandline' );
 112     logaction( "MEMBERS", "MODIFY", 1, "test operation");
 113     my $logs = GetLogs();
 114     is( @{$logs}[0]->{ interface }, 'commandline', 'Interface correctly deduced (commandline)');
 115
 116     # No interface passed, using C4::Context->interface
 117     $dbh->do("DELETE FROM action_logs;");
 118     C4::Context->interface( 'opac' );
 119     logaction( "MEMBERS", "MODIFY", 1, "test operation");
 120     $logs = GetLogs();
 121     is( @{$logs}[0]->{ interface }, 'opac', 'Interface correctly deduced (opac)');
 122
 123     # Explicit interfaces
 124     $dbh->do("DELETE FROM action_logs;");
 125     C4::Context->interface( 'intranet' );
 126     logaction( "MEMBERS", "MODIFY", 1, 'test info', 'intranet');
 127     $logs = GetLogs();
 128     is( @{$logs}[0]->{ interface }, 'intranet', 'Passed interface is respected (intranet)');
 129
 130     # Explicit interfaces
 131     $dbh->do("DELETE FROM action_logs;");
 132     C4::Context->interface( 'sip' );
 133     logaction( "MEMBERS", "MODIFY", 1, 'test info', 'sip');
 134     $logs = GetLogs();
 135     is( @{$logs}[0]->{ interface }, 'sip', 'Passed interface is respected (sip)');
 136 };
 137
 138 subtest 'GetLogs() respects interface filters' => sub {
 139
 140     plan tests => 5;
 141
 142     $dbh->do("DELETE FROM action_logs;");
 143
 144     logaction( 'MEMBERS', 'MODIFY', 1, 'opac info',        'opac');
 145     logaction( 'MEMBERS', 'MODIFY', 1, 'sip info',         'sip');
 146     logaction( 'MEMBERS', 'MODIFY', 1, 'intranet info',    'intranet');
 147     logaction( 'MEMBERS', 'MODIFY', 1, 'commandline info', 'commandline');
 148
 149     my $logs = scalar @{ GetLogs() };
 150     is( $logs, 4, 'If no filter on interfaces is passed, all logs are returned');
 151
 152     $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['opac']);
 153     is( @{$logs}[0]->{ interface }, 'opac', 'Interface correctly filtered (opac)');
 154
 155     $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['sip']);
 156     is( @{$logs}[0]->{ interface }, 'sip', 'Interface correctly filtered (sip)');
 157
 158     $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['intranet']);
 159     is( @{$logs}[0]->{ interface }, 'intranet', 'Interface correctly filtered (intranet)');
 160
 161     $logs = GetLogs(undef,undef,undef,undef,undef,undef,undef,['commandline']);
 162     is( @{$logs}[0]->{ interface }, 'commandline', 'Interface correctly filtered (commandline)');
 163 };
 164
 165 subtest 'GDPR logging' => sub {
 166     plan tests => 6;
 167
 168     my $builder = t::lib::TestBuilder->new;
 169     my $patron = $builder->build_object( { class => 'Koha::Patrons' } );
 170
 171     t::lib::Mocks::mock_userenv({ patron => $patron });
 172     logaction( 'AUTH', 'FAILURE', $patron->id, '', 'opac' );
 173     my $logs = GetLogs( undef, undef, $patron->id, ['AUTH'], ['FAILURE'], $patron->id );
 174     is( @$logs, 1, 'We should find one auth failure' );
 175
 176     t::lib::Mocks::mock_preference('AuthFailureLog', 1);
 177     my $strong_password = 'N0tStr0ngAnyM0reN0w:)';
 178     $patron->set_password({ password => $strong_password });
 179     my @ret = checkpw( $dbh, $patron->userid, 'WrongPassword', undef, undef, 1);
 180     is( $ret[0], 0, 'Authentication failed' );
 181     # Look for auth failure but NOT on patron id, pass userid in info parameter
 182     $logs = GetLogs( undef, undef, 0, ['AUTH'], ['FAILURE'], undef, $patron->userid );
 183     is( @$logs, 1, 'We should find one auth failure with this userid' );
 184     t::lib::Mocks::mock_preference('AuthFailureLog', 0);
 185     @ret = checkpw( $dbh, $patron->userid, 'WrongPassword', undef, undef, 1);
 186     $logs = GetLogs( undef, undef, 0, ['AUTH'], ['FAILURE'], undef, $patron->userid );
 187     is( @$logs, 1, 'Still only one failure with this userid' );
 188     t::lib::Mocks::mock_preference('AuthSuccessLog', 1);
 189     @ret = checkpw( $dbh, $patron->userid, $strong_password, undef, undef, 1);
 190     is( $ret[0], 1, 'Authentication succeeded' );
 191     # Now we can look for patron id
 192     $logs = GetLogs( undef, undef, $patron->id, ['AUTH'], ['SUCCESS'], $patron->id );
 193     is( @$logs, 1, 'We expect only one auth success line for this patron' );
 194 };
 195
 196 $schema->storage->txn_rollback;