t/db_dependent/Auth_with_shibboleth.t

   1 #!/usr/bin/perl
   2
   3 # Copyright 2014, 2023 Koha development team
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21 use utf8;
  22
  23 use Test::More tests => 5;
  24 use Test::MockModule;
  25 use Test::Warn;
  26 use CGI qw(-utf8 );
  27 use File::Temp qw(tempdir);
  28
  29 use t::lib::Mocks;
  30 use t::lib::Mocks::Logger;
  31 use t::lib::TestBuilder;
  32
  33 use C4::Auth_with_shibboleth qw( shib_ok login_shib_url get_login_shib checkpw_shib );
  34 use Koha::Database;
  35
  36 my $schema = Koha::Database->new->schema;
  37 $schema->storage->txn_begin;
  38 my $builder = t::lib::TestBuilder->new;
  39 my $logger = t::lib::Mocks::Logger->new();
  40
  41 # Mock variables
  42 my $shibboleth;
  43 change_config({});
  44 my $interface = 'opac';
  45
  46 # Mock few preferences
  47 t::lib::Mocks::mock_preference('OPACBaseURL', 'testopac.com' );
  48 t::lib::Mocks::mock_preference('StaffClientBaseURL', 'teststaff.com' );
  49 t::lib::Mocks::mock_preference( 'EmailFieldPrimary', 'OFF' );
  50 t::lib::Mocks::mock_preference( 'EmailFieldPrecedence', 'emailpro' );
  51
  52 # Mock Context: config, tz and interface
  53 my $context = Test::MockModule->new('C4::Context');
  54 $context->mock( 'config', sub { return $shibboleth; } ); # easier than caching by Mocks::mock_config
  55 $context->mock( 'timezone', sub { return 'local'; } );
  56 $context->mock( 'interface', sub { return $interface; } );
  57
  58 # Mock Letters: GetPreparedLetter, EnqueueLetter and SendQueuedMessages
  59 # We want to test the params
  60 my $mocked_letters = Test::MockModule->new('C4::Letters');
  61 $mocked_letters->mock( 'GetPreparedLetter', sub {
  62     warn "GetPreparedLetter called";
  63     return 1;
  64 });
  65 $mocked_letters->mock( 'EnqueueLetter', sub {
  66     warn "EnqueueLetter called";
  67     # return a 'message_id'
  68     return 42;
  69 });
  70 $mocked_letters->mock( 'SendQueuedMessages', sub {
  71     my $params = shift;
  72     warn "SendQueuedMessages called with message_id: $params->{message_id}";
  73     return 1;
  74 });
  75
  76 # Start testing ----------------------------------------------------------------
  77
  78 subtest "shib_ok tests" => sub {
  79     plan tests => 5;
  80     my $result;
  81
  82     # correct config, no debug
  83     is( shib_ok(), '1', "good config" );
  84
  85     # bad config, no debug
  86     delete $shibboleth->{matchpoint};
  87     warnings_are { $result = shib_ok() }
  88     [ { carped => 'shibboleth matchpoint not defined' }, ],
  89       "undefined matchpoint = fatal config, warning given";
  90     is( $result, '0', "bad config" );
  91
  92     change_config({ matchpoint => 'email' });
  93     warnings_are { $result = shib_ok() }
  94     [ { carped => 'shibboleth matchpoint not mapped' }, ],
  95       "unmapped matchpoint = fatal config, warning given";
  96     is( $result, '0', "bad config" );
  97
  98     # add test for undefined shibboleth block
  99     $logger->clear;
 100     change_config({});
 101 };
 102
 103 subtest "login_shib_url tests" => sub {
 104     plan tests => 2;
 105
 106     my $string = 'language=en-GB&param="heh❤"';
 107     my $query_string = Encode::encode('UTF-8', $string);
 108     my $query_string_uri_escaped = URI::Escape::uri_escape_utf8('?'.$string);
 109
 110     local $ENV{REQUEST_METHOD} = 'GET';
 111     local $ENV{QUERY_STRING}   = $query_string;
 112     local $ENV{SCRIPT_NAME}    = '/cgi-bin/koha/opac-user.pl';
 113     my $query = CGI->new($query_string);
 114     is(
 115         login_shib_url($query),
 116         'https://testopac.com'
 117           . '/Shibboleth.sso/Login?target='
 118           . 'https://testopac.com/cgi-bin/koha/opac-user.pl'
 119           . $query_string_uri_escaped,
 120         "login shib url"
 121     );
 122
 123     my $post_params = 'user=bob&password=wideopen';
 124     local $ENV{REQUEST_METHOD} = 'POST';
 125     local $ENV{CONTENT_LENGTH} = length($post_params);
 126
 127     my $dir = tempdir( CLEANUP => 1 );
 128     my $infile = "$dir/in.txt";
 129     open my $fh_write, '>', $infile or die "Could not open '$infile' $!";
 130     print $fh_write $post_params;
 131     close $fh_write;
 132
 133     open my $fh_read, '<', $infile or die "Could not open '$infile' $!";
 134
 135     $query = CGI->new($fh_read);
 136     is(
 137         login_shib_url($query),
 138         'https://testopac.com'
 139           . '/Shibboleth.sso/Login?target='
 140           . 'https://testopac.com/cgi-bin/koha/opac-user.pl',
 141         "login shib url"
 142     );
 143
 144     close $fh_read;
 145 };
 146
 147 subtest "get_login_shib tests" => sub {
 148     plan tests => 3;
 149
 150     my $login = get_login_shib();
 151     $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
 152            ->debug_is("shibboleth attribute to match: uid",   "shib match attribute debug info")
 153            ->clear();
 154     is( $login, "test1234", "good config, attribute value returned" );
 155 };
 156
 157 subtest "checkpw_shib tests" => sub {
 158     plan tests => 33;
 159
 160     # Test borrower data
 161     my $test_borrowers = [
 162         { cardnumber => 'testcardnumber', userid => 'test1234', surname => 'renvoize', address => 'myaddress', city => 'johnston', email => undef },
 163         { cardnumber => 'testcardnumber1', userid => 'test12345', surname => 'clamp1', address => 'myaddress', city => 'quechee', email => 'kid@clamp.io' },
 164         { cardnumber => 'testcardnumber2', userid => 'test123456', surname => 'clamp2', address => 'myaddress', city => 'quechee', email => 'kid@clamp.io' },
 165     ];
 166     my $category = $builder->build_object({ class => 'Koha::Patron::Categories', value => { default_privacy => 'never' }});
 167     $builder->build_object({ class => 'Koha::Patrons', value => { %$_, categorycode => $category->categorycode }}) for @$test_borrowers;
 168     my $library = $builder->build_object({ class => 'Koha::Libraries' });
 169
 170     # good user
 171     my $shib_login = "test1234";
 172     my ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 173     is( $logger->count(), 2,          "Two debugging entries");
 174     is( $retval,    "1",              "user authenticated" );
 175     is( $retcard,   "testcardnumber", "expected cardnumber returned" );
 176     is( $retuserid, "test1234",       "expected userid returned" );
 177     $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
 178            ->debug_is("shibboleth attribute to match: uid",   "shib match attribute debug info")
 179            ->clear();
 180
 181     # bad user
 182     $shib_login = 'martin';
 183     ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 184     is( $retval, "0", "user not authenticated" );
 185     $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
 186            ->debug_is("shibboleth attribute to match: uid",   "shib match attribute debug info")
 187            ->clear();
 188
 189     # duplicated matchpoint
 190     change_config({ matchpoint => 'email', mapping => { email => { is => 'email' }} });
 191     $shib_login = 'kid@clamp.io';
 192     ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 193     is( $retval, "0", "user not authenticated if duplicated matchpoint" );
 194     $logger->debug_is("koha borrower field to match: email",  "borrower match field debug info")
 195            ->debug_is("shibboleth attribute to match: email", "shib match attribute debug info")
 196            ->clear();
 197
 198     ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 199     $logger->debug_is("koha borrower field to match: email",  "borrower match field debug info")
 200            ->debug_is("shibboleth attribute to match: email", "shib match attribute debug info")
 201            ->warn_is('There are several users with email of kid@clamp.io, matchpoints must be unique', "duplicated matchpoint warned with debug")
 202            ->clear();
 203
 204     # autocreate user (welcome)
 205     change_config({ autocreate => 1, welcome => 1 });
 206     $shib_login      = 'test4321';
 207     $ENV{'uid'}      = 'test4321';
 208     $ENV{'sn'}       = "pika";
 209     $ENV{'exp'}      = "2017-01-01";
 210     $ENV{'cat'}      = $category->categorycode;
 211     $ENV{'add'}      = 'Address';
 212     $ENV{'city'}     = 'City';
 213     $ENV{'emailpro'} = 'me@myemail.com';
 214     $ENV{branchcode} = $library->branchcode; # needed since T::D::C does no longer hides the FK constraint
 215
 216     warnings_are {
 217         ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 218     }
 219     [
 220         'GetPreparedLetter called',
 221         'EnqueueLetter called',
 222         'SendQueuedMessages called with message_id: 42'
 223     ],
 224       "WELCOME notice Prepared, Enqueued and Send";
 225     is( $retval,    "1",        "user authenticated" );
 226     is( $retuserid, "test4321", "expected userid returned" );
 227     $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
 228            ->debug_is("shibboleth attribute to match: uid",   "shib match attribute debug info")
 229            ->clear();
 230
 231     ok my $new_user = $schema->resultset('Borrower')
 232       ->search( { 'userid' => 'test4321' }, { rows => 1 } ), "new user found";
 233     my $rec = $new_user->next;
 234     is_deeply( [ map { $rec->$_ } qw/surname dateexpiry address city/ ],
 235         [qw/pika 2017-01-01 Address City/],
 236         'Found $new_user surname' );
 237
 238     # sync user
 239     $shibboleth->{sync} = 1;
 240     $ENV{'city'} = 'AnotherCity';
 241     ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 242     $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
 243            ->debug_is("shibboleth attribute to match: uid",   "shib match attribute debug info")
 244            ->clear();
 245
 246     ok my $sync_user = $schema->resultset('Borrower')
 247       ->search( { 'userid' => 'test4321' }, { rows => 1 } ), "sync user found";
 248
 249     $rec = $sync_user->next;
 250     is_deeply( [ map { $rec->$_ } qw/surname dateexpiry address city/ ],
 251         [qw/pika 2017-01-01 Address AnotherCity/],
 252         'Found $sync_user synced city' );
 253     change_config({ sync => 0 });
 254
 255     # good user
 256     $shib_login = "test1234";
 257     ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 258     is( $retval,    "1",              "user authenticated" );
 259     is( $retcard,   "testcardnumber", "expected cardnumber returned" );
 260     is( $retuserid, "test1234",       "expected userid returned" );
 261     $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
 262            ->debug_is("shibboleth attribute to match: uid",   "shib match attribute debug info")
 263            ->clear();
 264
 265     # bad user
 266     $shib_login = "martin";
 267     ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 268     is( $retval, "0", "user not authenticated" );
 269     $logger->info_is("No users with userid of martin found and autocreate is disabled", "Missing matchpoint warned to info");
 270 };
 271
 272 subtest 'get_uri' => sub {
 273     plan tests => 13;
 274     # Tests for OPAC
 275     t::lib::Mocks::mock_preference('OPACBaseURL', 'testopac.com' );
 276     is( C4::Auth_with_shibboleth::_get_uri(),
 277         "https://testopac.com", "https opac uri returned" );
 278
 279     $logger->clear;
 280
 281     t::lib::Mocks::mock_preference('OPACBaseURL', 'http://testopac.com' );
 282     my $result = C4::Auth_with_shibboleth::_get_uri();
 283     is( $result, "https://testopac.com", "https opac uri returned" );
 284     $logger->warn_is("Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!", "Improper protocol logged to warn")
 285            ->clear();
 286
 287     t::lib::Mocks::mock_preference('OPACBaseURL', 'https://testopac.com' );
 288     is( C4::Auth_with_shibboleth::_get_uri(),
 289         "https://testopac.com", "https opac uri returned" );
 290
 291     $logger->clear();
 292
 293     t::lib::Mocks::mock_preference('OPACBaseURL', undef );
 294     $result = C4::Auth_with_shibboleth::_get_uri();
 295     is( $result, "https://", "https $interface uri returned" );
 296
 297     $logger->warn_is("Syspref staffClientBaseURL or OPACBaseURL not set!", "undefined OPACBaseURL - received expected warning")
 298            ->clear();
 299
 300     # Tests for staff client
 301     $interface = 'intranet';
 302     t::lib::Mocks::mock_preference('StaffClientBaseURL', 'teststaff.com' );
 303     is( C4::Auth_with_shibboleth::_get_uri(),
 304         "https://teststaff.com", "https $interface uri returned" );
 305
 306     $logger->clear;
 307
 308     t::lib::Mocks::mock_preference('StaffClientBaseURL', 'http://teststaff.com' );
 309     $result = C4::Auth_with_shibboleth::_get_uri();
 310     is( $result, "https://teststaff.com", "https $interface uri returned" );
 311     $logger->warn_is("Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!", 'check protocol warn')
 312            ->clear;
 313
 314     t::lib::Mocks::mock_preference('StaffClientBaseURL', 'https://teststaff.com' );
 315     is( C4::Auth_with_shibboleth::_get_uri(),
 316         "https://teststaff.com", "https $interface uri returned" );
 317     is( $logger->count(), 0, 'No logging' );
 318
 319     t::lib::Mocks::mock_preference('StaffClientBaseURL', undef );
 320     $result = C4::Auth_with_shibboleth::_get_uri();
 321     is( $result, "https://", "https $interface uri returned" );
 322     $logger->warn_is("Syspref staffClientBaseURL or OPACBaseURL not set!", "undefined staffClientBaseURL - received expected warning")
 323            ->clear;
 324 };
 325 $schema->storage->txn_rollback;
 326
 327 # Internal helper function
 328
 329 sub change_config {
 330     my $params = shift;
 331
 332     my %mapping = (
 333         'userid'       => { 'is' => 'uid' },
 334         'surname'      => { 'is' => 'sn' },
 335         'dateexpiry'   => { 'is' => 'exp' },
 336         'categorycode' => { 'is' => 'cat' },
 337         'address'      => { 'is' => 'add' },
 338         'city'         => { 'is' => 'city' },
 339         'emailpro'     => { 'is' => 'emailpro' },
 340         'branchcode'   => { 'is' => 'branchcode' },
 341     );
 342     if( exists $params->{mapping} ) {
 343         $mapping{$_} = $params->{mapping}->{$_} for keys %{$params->{mapping}};
 344     }
 345     $shibboleth = {
 346         autocreate => $params->{autocreate} // 0,
 347         welcome    => $params->{welcome} // 0,
 348         sync       => $params->{sync} // 0,
 349         matchpoint => $params->{matchpoint} // 'userid',
 350         mapping    => \%mapping,
 351     };
 352
 353     # Change environment too
 354     $ENV{'uid'}      = "test1234";
 355     $ENV{'sn'}       = undef;
 356     $ENV{'exp'}      = undef;
 357     $ENV{'cat'}      = undef;
 358     $ENV{'add'}      = undef;
 359     $ENV{'city'}     = undef;
 360     $ENV{'emailpro'} = undef;
 361 }