3 # This file is part of Koha.
5 # Koha is free software; you can redistribute it and/or modify it
6 # under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 3 of the License, or
8 # (at your option) any later version.
10 # Koha is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with Koha; if not, see <http://www.gnu.org/licenses>.
21 use Module::Load::Conditional qw/check_install/;
25 use File::Temp qw(tempdir);
27 use t::lib::Mocks::Logger;
34 if ( check_install( module => 'Test::DBIx::Class' ) ) {
38 plan skip_all => "Need Test::DBIx::Class";
42 use Test::DBIx::Class {
43 schema_class => 'Koha::Schema',
44 connect_info => [ 'dbi:SQLite:dbname=:memory:', '', '' ]
48 my $matchpoint = 'userid';
53 'userid' => { 'is' => 'uid' },
54 'surname' => { 'is' => 'sn' },
55 'dateexpiry' => { 'is' => 'exp' },
56 'categorycode' => { 'is' => 'cat' },
57 'address' => { 'is' => 'add' },
58 'city' => { 'is' => 'city' },
59 'emailpro' => { 'is' => 'emailpro' },
61 $ENV{'uid'} = "test1234";
67 $ENV{'emailpro'} = undef;
71 my $context = Test::MockModule->new('C4::Context');
74 $context->mock( 'config', \&mockedConfig );
77 my $OPACBaseURL = "testopac.com";
78 my $staffClientBaseURL = "teststaff.com";
79 $context->mock( 'preference', \&mockedPref );
82 $context->mock( 'timezone', sub { return 'local'; } );
85 my $interface = 'opac';
86 $context->mock( 'interface', \&mockedInterface );
89 my $database = Test::MockModule->new('Koha::Database');
92 $database->mock( 'schema', \&mockedSchema );
95 my $mocked_letters = Test::MockModule->new('C4::Letters');
96 # we want to test the params
97 $mocked_letters->mock( 'GetPreparedLetter', sub {
98 warn "GetPreparedLetter called";
101 # we don't care about EnqueueLetter for now
102 $mocked_letters->mock( 'EnqueueLetter', sub {
103 warn "EnqueueLetter called";
104 # return a 'message_id'
107 # we don't care about EnqueueLetter for now
108 $mocked_letters->mock( 'SendQueuedMessages', sub {
110 warn "SendQueuedMessages called with message_id: $params->{message_id}";
115 ##############################################################
117 my $logger = t::lib::Mocks::Logger->new();
120 use C4::Auth_with_shibboleth qw( shib_ok login_shib_url get_login_shib checkpw_shib );
121 require_ok('C4::Auth_with_shibboleth');
125 subtest "shib_ok tests" => sub {
129 # correct config, no debug
130 is( shib_ok(), '1', "good config" );
132 # bad config, no debug
134 warnings_are { $result = shib_ok() }
135 [ { carped => 'shibboleth matchpoint not defined' }, ],
136 "undefined matchpoint = fatal config, warning given";
137 is( $result, '0', "bad config" );
139 $matchpoint = 'email';
140 warnings_are { $result = shib_ok() }
141 [ { carped => 'shibboleth matchpoint not mapped' }, ],
142 "unmapped matchpoint = fatal config, warning given";
143 is( $result, '0', "bad config" );
145 # add test for undefined shibboleth block
151 #my $query = CGI->new();
152 #is(logout_shib($query),"https://".$opac."/Shibboleth.sso/Logout?return="."https://".$opac,"logout_shib");
155 subtest "login_shib_url tests" => sub {
158 my $string = 'language=en-GB¶m="heh❤"';
159 my $query_string = Encode::encode('UTF-8', $string);
160 my $query_string_uri_escaped = URI::Escape::uri_escape_utf8('?'.$string);
162 local $ENV{REQUEST_METHOD} = 'GET';
163 local $ENV{QUERY_STRING} = $query_string;
164 local $ENV{SCRIPT_NAME} = '/cgi-bin/koha/opac-user.pl';
165 my $query = CGI->new($query_string);
167 login_shib_url($query),
168 'https://testopac.com'
169 . '/Shibboleth.sso/Login?target='
170 . 'https://testopac.com/cgi-bin/koha/opac-user.pl'
171 . $query_string_uri_escaped,
175 my $post_params = 'user=bob&password=wideopen';
176 local $ENV{REQUEST_METHOD} = 'POST';
177 local $ENV{CONTENT_LENGTH} = length($post_params);
179 my $dir = tempdir( CLEANUP => 1 );
180 my $infile = "$dir/in.txt";
181 open my $fh_write, '>', $infile or die "Could not open '$infile' $!";
182 print $fh_write $post_params;
185 open my $fh_read, '<', $infile or die "Could not open '$infile' $!";
187 $query = CGI->new($fh_read);
189 login_shib_url($query),
190 'https://testopac.com'
191 . '/Shibboleth.sso/Login?target='
192 . 'https://testopac.com/cgi-bin/koha/opac-user.pl',
200 subtest "get_login_shib tests" => sub {
206 $login = get_login_shib();
208 $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
209 ->debug_is("shibboleth attribute to match: uid", "shib match attribute debug info")
212 is( $login, "test1234", "good config, attribute value returned" );
216 subtest "checkpw_shib tests" => sub {
221 my ( $retval, $retcard, $retuserid );
223 # Setup Mock Database Data
226 [qw/cardnumber userid surname address city email/],
227 [qw/testcardnumber test1234 renvoize myaddress johnston /],
228 [qw/testcardnumber1 test12345 clamp1 myaddress quechee kid@clamp.io/],
229 [qw/testcardnumber2 test123456 clamp2 myaddress quechee kid@clamp.io/],
231 'Category' => [ [qw/categorycode default_privacy/], [qw/S never/], ]
233 'Installed some custom fixtures via the Populate fixture class';
236 $shib_login = "test1234";
237 ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
239 is( $logger->count(), 2, "Two debugging entries");
240 is( $retval, "1", "user authenticated" );
241 is( $retcard, "testcardnumber", "expected cardnumber returned" );
242 is( $retuserid, "test1234", "expected userid returned" );
243 $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
244 ->debug_is("shibboleth attribute to match: uid", "shib match attribute debug info")
248 $shib_login = 'martin';
249 ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
250 is( $retval, "0", "user not authenticated" );
251 $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
252 ->debug_is("shibboleth attribute to match: uid", "shib match attribute debug info")
255 # duplicated matchpoint
256 $matchpoint = 'email';
257 $mapping{'email'} = { is => 'email' };
258 $shib_login = 'kid@clamp.io';
259 ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
260 is( $retval, "0", "user not authenticated if duplicated matchpoint" );
261 $logger->debug_is("koha borrower field to match: email", "borrower match field debug info")
262 ->debug_is("shibboleth attribute to match: email", "shib match attribute debug info")
265 ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
266 $logger->debug_is("koha borrower field to match: email", "borrower match field debug info")
267 ->debug_is("shibboleth attribute to match: email", "shib match attribute debug info")
268 ->warn_is('There are several users with email of kid@clamp.io, matchpoints must be unique', "duplicated matchpoint warned with debug")
273 # autocreate user (welcome)
276 $shib_login = 'test4321';
277 $ENV{'uid'} = 'test4321';
279 $ENV{'exp'} = "2017";
281 $ENV{'add'} = 'Address';
282 $ENV{'city'} = 'City';
283 $ENV{'emailpro'} = 'me@myemail.com';
286 ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
289 'GetPreparedLetter called',
290 'EnqueueLetter called',
291 'SendQueuedMessages called with message_id: 42'
293 "WELCOME notice Prepared, Enqueued and Send";
294 is( $retval, "1", "user authenticated" );
295 is( $retuserid, "test4321", "expected userid returned" );
296 $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
297 ->debug_is("shibboleth attribute to match: uid", "shib match attribute debug info")
300 ok my $new_user = ResultSet('Borrower')
301 ->search( { 'userid' => 'test4321' }, { rows => 1 } ), "new user found";
302 is_fields [qw/surname dateexpiry address city/], $new_user->next,
303 [qw/pika 2017 Address City/],
304 'Found $new_users surname';
310 $ENV{'city'} = 'AnotherCity';
311 ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
312 $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
313 ->debug_is("shibboleth attribute to match: uid", "shib match attribute debug info")
316 ok my $sync_user = ResultSet('Borrower')
317 ->search( { 'userid' => 'test4321' }, { rows => 1 } ), "sync user found";
319 is_fields [qw/surname dateexpiry address city/], $sync_user->next,
320 [qw/pika 2017 Address AnotherCity/],
321 'Found $sync_user synced city';
325 $shib_login = "test1234";
326 ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
327 is( $retval, "1", "user authenticated" );
328 is( $retcard, "testcardnumber", "expected cardnumber returned" );
329 is( $retuserid, "test1234", "expected userid returned" );
330 $logger->debug_is("koha borrower field to match: userid", "borrower match field debug info")
331 ->debug_is("shibboleth attribute to match: uid", "shib match attribute debug info")
335 $shib_login = "martin";
336 ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
337 is( $retval, "0", "user not authenticated" );
338 $logger->info_is("There are several users with userid of martin, matchpoints must be unique", "Duplicated matchpoint warned to info");
342 $OPACBaseURL = "testopac.com";
343 is( C4::Auth_with_shibboleth::_get_uri(),
344 "https://testopac.com", "https opac uri returned" );
348 $OPACBaseURL = "http://testopac.com";
349 my $result = C4::Auth_with_shibboleth::_get_uri();
350 is( $result, "https://testopac.com", "https opac uri returned" );
351 $logger->warn_is("Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!", "Improper protocol logged to warn")
354 $OPACBaseURL = "https://testopac.com";
355 is( C4::Auth_with_shibboleth::_get_uri(),
356 "https://testopac.com", "https opac uri returned" );
360 $OPACBaseURL = undef;
361 $result = C4::Auth_with_shibboleth::_get_uri();
362 is( $result, "https://", "https $interface uri returned" );
364 $logger->warn_is("Syspref staffClientBaseURL or OPACBaseURL not set!", "undefined OPACBaseURL - received expected warning")
367 ## _get_uri - intranet
368 $interface = 'intranet';
369 $staffClientBaseURL = "teststaff.com";
370 is( C4::Auth_with_shibboleth::_get_uri(),
371 "https://teststaff.com", "https $interface uri returned" );
376 $staffClientBaseURL = "http://teststaff.com";
377 $result = C4::Auth_with_shibboleth::_get_uri();
378 is( $result, "https://teststaff.com", "https $interface uri returned" );
379 $logger->warn_is("Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!")
382 $staffClientBaseURL = "https://teststaff.com";
383 is( C4::Auth_with_shibboleth::_get_uri(),
384 "https://teststaff.com", "https $interface uri returned" );
385 is( $logger->count(), 0, 'No logging' );
387 $staffClientBaseURL = undef;
388 $result = C4::Auth_with_shibboleth::_get_uri();
389 is( $result, "https://", "https $interface uri returned" );
390 $logger->warn_is("Syspref staffClientBaseURL or OPACBaseURL not set!", "undefined staffClientBaseURL - received expected warning")
394 # Internal helper function, covered in tests above
400 'autocreate' => $autocreate,
401 'welcome' => $welcome,
403 'matchpoint' => $matchpoint,
404 'mapping' => \%mapping
414 if ( $param eq 'OPACBaseURL' ) {
415 $return = $OPACBaseURL;
418 if ( $param eq 'staffClientBaseURL' ) {
419 $return = $staffClientBaseURL;
422 if ( $param eq 'AutoEmailPrimaryAddress' ) {
429 sub mockedInterface {
437 ## Convenience method to reset config
439 $matchpoint = 'userid';
444 'userid' => { 'is' => 'uid' },
445 'surname' => { 'is' => 'sn' },
446 'dateexpiry' => { 'is' => 'exp' },
447 'categorycode' => { 'is' => 'cat' },
448 'address' => { 'is' => 'add' },
449 'city' => { 'is' => 'city' },
450 'emailpro' => { 'is' => 'emailpro' },
452 $ENV{'uid'} = "test1234";
457 $ENV{'city'} = undef;
458 $ENV{'emailpro'} = undef;