t/Auth_with_shibboleth.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
   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.
   9 #
  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.
  14 #
  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>.
  17
  18 use Modern::Perl;
  19
  20 $| = 1;
  21 use Module::Load::Conditional qw/check_install/;
  22 use Test::More;
  23 use Test::MockModule;
  24 use Test::Warn;
  25 use File::Temp qw(tempdir);
  26
  27 use t::lib::Mocks::Logger;
  28
  29 use utf8;
  30 use CGI qw(-utf8 );
  31 use C4::Context;
  32
  33 BEGIN {
  34     if ( check_install( module => 'Test::DBIx::Class' ) ) {
  35         plan tests => 18;
  36     }
  37     else {
  38         plan skip_all => "Need Test::DBIx::Class";
  39     }
  40 }
  41
  42 use Test::DBIx::Class {
  43     schema_class => 'Koha::Schema',
  44     connect_info => [ 'dbi:SQLite:dbname=:memory:', '', '' ]
  45 };
  46
  47 # Mock Variables
  48 my $matchpoint = 'userid';
  49 my $autocreate = 0;
  50 my $welcome    = 0;
  51 my $sync       = 0;
  52 my %mapping    = (
  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' },
  60 );
  61 $ENV{'uid'}      = "test1234";
  62 $ENV{'sn'}       = undef;
  63 $ENV{'exp'}      = undef;
  64 $ENV{'cat'}      = undef;
  65 $ENV{'add'}      = undef;
  66 $ENV{'city'}     = undef;
  67 $ENV{'emailpro'} = undef;
  68
  69 # Setup Mocks
  70 ## Mock Context
  71 my $context = Test::MockModule->new('C4::Context');
  72
  73 ### Mock ->config
  74 $context->mock( 'config', \&mockedConfig );
  75
  76 ### Mock ->preference
  77 my $OPACBaseURL = "testopac.com";
  78 my $staffClientBaseURL = "teststaff.com";
  79 $context->mock( 'preference', \&mockedPref );
  80
  81 ### Mock ->tz
  82 $context->mock( 'timezone', sub { return 'local'; } );
  83
  84 ### Mock ->interface
  85 my $interface = 'opac';
  86 $context->mock( 'interface', \&mockedInterface );
  87
  88 ## Mock Database
  89 my $database = Test::MockModule->new('Koha::Database');
  90
  91 ### Mock ->schema
  92 $database->mock( 'schema', \&mockedSchema );
  93
  94 ### Mock Letters
  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";
  99     return 1;
 100 });
 101 # we don't care about EnqueueLetter for now
 102 $mocked_letters->mock( 'EnqueueLetter', sub {
 103     warn "EnqueueLetter called";
 104     # return a 'message_id'
 105     return 42;
 106 });
 107 # we don't care about EnqueueLetter for now
 108 $mocked_letters->mock( 'SendQueuedMessages', sub {
 109     my $params = shift;
 110     warn "SendQueuedMessages called with message_id: $params->{message_id}";
 111     return 1;
 112 });
 113
 114 # Tests
 115 ##############################################################
 116
 117 my $logger = t::lib::Mocks::Logger->new();
 118
 119 # Can module load
 120 use C4::Auth_with_shibboleth qw( shib_ok login_shib_url get_login_shib checkpw_shib );
 121 require_ok('C4::Auth_with_shibboleth');
 122
 123 # Subroutine tests
 124 ## shib_ok
 125 subtest "shib_ok tests" => sub {
 126     plan tests => 5;
 127     my $result;
 128
 129     # correct config, no debug
 130     is( shib_ok(), '1', "good config" );
 131
 132     # bad config, no debug
 133     $matchpoint = undef;
 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" );
 138
 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" );
 144
 145     # add test for undefined shibboleth block
 146     $logger->clear;
 147     reset_config();
 148 };
 149
 150 ## logout_shib
 151 #my $query = CGI->new();
 152 #is(logout_shib($query),"https://".$opac."/Shibboleth.sso/Logout?return="."https://".$opac,"logout_shib");
 153
 154 ## login_shib_url
 155 subtest "login_shib_url tests" => sub {
 156     plan tests => 2;
 157
 158     my $string = 'language=en-GB&param="heh❤"';
 159     my $query_string = Encode::encode('UTF-8', $string);
 160     my $query_string_uri_escaped = URI::Escape::uri_escape_utf8('?'.$string);
 161
 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);
 166     is(
 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,
 172         "login shib url"
 173     );
 174
 175     my $post_params = 'user=bob&password=wideopen';
 176     local $ENV{REQUEST_METHOD} = 'POST';
 177     local $ENV{CONTENT_LENGTH} = length($post_params);
 178
 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;
 183     close $fh_write;
 184
 185     open my $fh_read, '<', $infile or die "Could not open '$infile' $!";
 186
 187     $query = CGI->new($fh_read);
 188     is(
 189         login_shib_url($query),
 190         'https://testopac.com'
 191           . '/Shibboleth.sso/Login?target='
 192           . 'https://testopac.com/cgi-bin/koha/opac-user.pl',
 193         "login shib url"
 194     );
 195
 196     close $fh_read;
 197 };
 198
 199 ## get_login_shib
 200 subtest "get_login_shib tests" => sub {
 201
 202     plan tests => 3;
 203
 204     my $login;
 205
 206     $login = get_login_shib();
 207
 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")
 210            ->clear();
 211
 212     is( $login, "test1234", "good config, attribute value returned" );
 213 };
 214
 215 ## checkpw_shib
 216 subtest "checkpw_shib tests" => sub {
 217
 218     plan tests => 34;
 219
 220     my $shib_login;
 221     my ( $retval, $retcard, $retuserid );
 222
 223     # Setup Mock Database Data
 224     fixtures_ok [
 225         'Borrower' => [
 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/],
 230         ],
 231         'Category' => [ [qw/categorycode default_privacy/], [qw/S never/], ]
 232       ],
 233       'Installed some custom fixtures via the Populate fixture class';
 234
 235     # good user
 236     $shib_login = "test1234";
 237     ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 238
 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")
 245            ->clear();
 246
 247     # bad user
 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")
 253            ->clear();
 254
 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")
 263            ->clear();
 264
 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")
 269            ->clear();
 270
 271     reset_config();
 272
 273     # autocreate user (welcome)
 274     $autocreate      = 1;
 275     $welcome         = 1;
 276     $shib_login      = 'test4321';
 277     $ENV{'uid'}      = 'test4321';
 278     $ENV{'sn'}       = "pika";
 279     $ENV{'exp'}      = "2017";
 280     $ENV{'cat'}      = "S";
 281     $ENV{'add'}      = 'Address';
 282     $ENV{'city'}     = 'City';
 283     $ENV{'emailpro'} = 'me@myemail.com';
 284
 285     warnings_are {
 286         ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 287     }
 288     [
 289         'GetPreparedLetter called',
 290         'EnqueueLetter called',
 291         'SendQueuedMessages called with message_id: 42'
 292     ],
 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")
 298            ->clear();
 299
 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';
 305     $autocreate = 0;
 306     $welcome    = 0;
 307
 308     # sync user
 309     $sync = 1;
 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")
 314            ->clear();
 315
 316     ok my $sync_user = ResultSet('Borrower')
 317       ->search( { 'userid' => 'test4321' }, { rows => 1 } ), "sync user found";
 318
 319     is_fields [qw/surname dateexpiry address city/], $sync_user->next,
 320       [qw/pika 2017 Address AnotherCity/],
 321       'Found $sync_user synced city';
 322     $sync = 0;
 323
 324     # good user
 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")
 332            ->clear();
 333
 334     # bad user
 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");
 339 };
 340
 341 ## _get_uri - opac
 342 $OPACBaseURL = "testopac.com";
 343 is( C4::Auth_with_shibboleth::_get_uri(),
 344     "https://testopac.com", "https opac uri returned" );
 345
 346 $logger->clear;
 347
 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")
 352        ->clear();
 353
 354 $OPACBaseURL = "https://testopac.com";
 355 is( C4::Auth_with_shibboleth::_get_uri(),
 356     "https://testopac.com", "https opac uri returned" );
 357
 358 $logger->clear();
 359
 360 $OPACBaseURL = undef;
 361 $result = C4::Auth_with_shibboleth::_get_uri();
 362 is( $result, "https://", "https $interface uri returned" );
 363
 364 $logger->warn_is("Syspref staffClientBaseURL or OPACBaseURL not set!", "undefined OPACBaseURL - received expected warning")
 365        ->clear();
 366
 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" );
 372
 373
 374 $logger->clear;
 375
 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!")
 380        ->clear;
 381
 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' );
 386
 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")
 391        ->clear;
 392
 393 ## _get_shib_config
 394 # Internal helper function, covered in tests above
 395
 396 sub mockedConfig {
 397     my $param = shift;
 398
 399     my %shibboleth = (
 400         'autocreate' => $autocreate,
 401         'welcome'    => $welcome,
 402         'sync'       => $sync,
 403         'matchpoint' => $matchpoint,
 404         'mapping'    => \%mapping
 405     );
 406
 407     return \%shibboleth;
 408 }
 409
 410 sub mockedPref {
 411     my $param = $_[1];
 412     my $return;
 413
 414     if ( $param eq 'OPACBaseURL' ) {
 415         $return = $OPACBaseURL;
 416     }
 417
 418     if ( $param eq 'staffClientBaseURL' ) {
 419         $return = $staffClientBaseURL;
 420     }
 421
 422     if ( $param eq 'AutoEmailPrimaryAddress' ) {
 423         $return = 'OFF';
 424     }
 425
 426     return $return;
 427 }
 428
 429 sub mockedInterface {
 430     return $interface;
 431 }
 432
 433 sub mockedSchema {
 434     return Schema();
 435 }
 436
 437 ## Convenience method to reset config
 438 sub reset_config {
 439     $matchpoint = 'userid';
 440     $autocreate = 0;
 441     $welcome = 0;
 442     $sync = 0;
 443     %mapping = (
 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' },
 451     );
 452     $ENV{'uid'}      = "test1234";
 453     $ENV{'sn'}       = undef;
 454     $ENV{'exp'}      = undef;
 455     $ENV{'cat'}      = undef;
 456     $ENV{'add'}      = undef;
 457     $ENV{'city'}     = undef;
 458     $ENV{'emailpro'} = undef;
 459
 460     return 1;
 461 }
 462