3 # Copyright 2014, 2023 Koha development team
5 # This file is part of Koha.
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.
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.
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>.
23 use Test::More tests => 5;
27 use File::Temp qw(tempdir);
30 use t::lib::Mocks::Logger;
31 use t::lib::TestBuilder;
33 use C4::Auth_with_shibboleth qw( shib_ok login_shib_url get_login_shib checkpw_shib );
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();
44 my $interface = 'opac';
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' );
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; } );
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";
65 $mocked_letters->mock( 'EnqueueLetter', sub {
66 warn "EnqueueLetter called";
67 # return a 'message_id'
70 $mocked_letters->mock( 'SendQueuedMessages', sub {
72 warn "SendQueuedMessages called with message_id: $params->{message_id}";
76 # Start testing ----------------------------------------------------------------
78 subtest "shib_ok tests" => sub {
82 # correct config, no debug
83 is( shib_ok(), '1', "good config" );
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" );
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" );
98 # add test for undefined shibboleth block
103 subtest "login_shib_url tests" => sub {
106 my $string = 'language=en-GB¶m="hehâ¤"';
107 my $query_string = Encode::encode('UTF-8', $string);
108 my $query_string_uri_escaped = URI::Escape::uri_escape_utf8('?'.$string);
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);
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,
123 my $post_params = 'user=bob&password=wideopen';
124 local $ENV{REQUEST_METHOD} = 'POST';
125 local $ENV{CONTENT_LENGTH} = length($post_params);
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;
133 open my $fh_read, '<', $infile or die "Could not open '$infile' $!";
135 $query = CGI->new($fh_read);
137 login_shib_url($query),
138 'https://testopac.com'
139 . '/Shibboleth.sso/Login?target='
140 . 'https://testopac.com/cgi-bin/koha/opac-user.pl',
147 subtest "get_login_shib tests" => sub {
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")
154 is( $login, "test1234", "good config, attribute value returned" );
157 subtest "checkpw_shib tests" => sub {
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' },
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' });
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")
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")
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")
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")
204 # autocreate user (welcome)
205 change_config({ autocreate => 1, welcome => 1 });
206 $shib_login = 'test4321';
207 $ENV{'uid'} = 'test4321';
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
217 ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
220 'GetPreparedLetter called',
221 'EnqueueLetter called',
222 'SendQueuedMessages called with message_id: 42'
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")
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' );
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")
246 ok my $sync_user = $schema->resultset('Borrower')
247 ->search( { 'userid' => 'test4321' }, { rows => 1 } ), "sync user found";
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 });
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")
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");
272 subtest 'get_uri' => sub {
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" );
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")
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" );
293 t::lib::Mocks::mock_preference('OPACBaseURL', undef );
294 $result = C4::Auth_with_shibboleth::_get_uri();
295 is( $result, "https://", "https $interface uri returned" );
297 $logger->warn_is("Syspref staffClientBaseURL or OPACBaseURL not set!", "undefined OPACBaseURL - received expected warning")
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" );
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')
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' );
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")
325 $schema->storage->txn_rollback;
327 # Internal helper function
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' },
342 if( exists $params->{mapping} ) {
343 $mapping{$_} = $params->{mapping}->{$_} for keys %{$params->{mapping}};
346 autocreate => $params->{autocreate} // 0,
347 welcome => $params->{welcome} // 0,
348 sync => $params->{sync} // 0,
349 matchpoint => $params->{matchpoint} // 'userid',
350 mapping => \%mapping,
353 # Change environment too
354 $ENV{'uid'} = "test1234";
359 $ENV{'city'} = undef;
360 $ENV{'emailpro'} = undef;