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 utf8;
  28 use CGI qw(-utf8 );
  29 use C4::Context;
  30
  31 BEGIN {
  32     if ( check_install( module => 'Test::DBIx::Class' ) ) {
  33         plan tests => 17;
  34     }
  35     else {
  36         plan skip_all => "Need Test::DBIx::Class";
  37     }
  38 }
  39
  40 use Test::DBIx::Class {
  41     schema_class => 'Koha::Schema',
  42     connect_info => [ 'dbi:SQLite:dbname=:memory:', '', '' ]
  43 };
  44
  45 # Mock Variables
  46 my $matchpoint = 'userid';
  47 my $autocreate = 0;
  48 my $sync = 0;
  49 my %mapping    = (
  50     'userid'       => { 'is' => 'uid' },
  51     'surname'      => { 'is' => 'sn' },
  52     'dateexpiry'   => { 'is' => 'exp' },
  53     'categorycode' => { 'is' => 'cat' },
  54     'address'      => { 'is' => 'add' },
  55     'city'         => { 'is' => 'city' },
  56 );
  57 $ENV{'uid'}  = "test1234";
  58 $ENV{'sn'}   = undef;
  59 $ENV{'exp'}  = undef;
  60 $ENV{'cat'}  = undef;
  61 $ENV{'add'}  = undef;
  62 $ENV{'city'} = undef;
  63
  64 # Setup Mocks
  65 ## Mock Context
  66 my $context = new Test::MockModule('C4::Context');
  67
  68 ### Mock ->config
  69 $context->mock( 'config', \&mockedConfig );
  70
  71 ### Mock ->preference
  72 my $OPACBaseURL = "testopac.com";
  73 my $staffClientBaseURL = "teststaff.com";
  74 $context->mock( 'preference', \&mockedPref );
  75
  76 ### Mock ->tz
  77 $context->mock( 'timezone', sub { return 'local'; } );
  78
  79 ### Mock ->interface
  80 my $interface = 'opac';
  81 $context->mock( 'interface', \&mockedInterface );
  82
  83 ## Mock Database
  84 my $database = new Test::MockModule('Koha::Database');
  85
  86 ### Mock ->schema
  87 $database->mock( 'schema', \&mockedSchema );
  88
  89 # Tests
  90 ##############################################################
  91
  92 # Can module load
  93 use C4::Auth_with_shibboleth;
  94 require_ok('C4::Auth_with_shibboleth');
  95 $C4::Auth_with_shibboleth::debug = '0';
  96
  97 # Subroutine tests
  98 ## shib_ok
  99 subtest "shib_ok tests" => sub {
 100     plan tests => 5;
 101     my $result;
 102
 103     # correct config, no debug
 104     is( shib_ok(), '1', "good config" );
 105
 106     # bad config, no debug
 107     $matchpoint = undef;
 108     warnings_are { $result = shib_ok() }
 109     [ { carped => 'shibboleth matchpoint not defined' }, ],
 110       "undefined matchpoint = fatal config, warning given";
 111     is( $result, '0', "bad config" );
 112
 113     $matchpoint = 'email';
 114     warnings_are { $result = shib_ok() }
 115     [ { carped => 'shibboleth matchpoint not mapped' }, ],
 116       "unmapped matchpoint = fatal config, warning given";
 117     is( $result, '0', "bad config" );
 118
 119     # add test for undefined shibboleth block
 120
 121     reset_config();
 122 };
 123
 124 ## logout_shib
 125 #my $query = CGI->new();
 126 #is(logout_shib($query),"https://".$opac."/Shibboleth.sso/Logout?return="."https://".$opac,"logout_shib");
 127
 128 ## login_shib_url
 129 subtest "login_shib_url tests" => sub {
 130     plan tests => 2;
 131
 132     my $string = 'language=en-GB&param="heh❤"';
 133     my $query_string = Encode::encode('UTF-8', $string);
 134     my $query_string_uri_escaped = URI::Escape::uri_escape_utf8('?'.$string);
 135
 136     local $ENV{REQUEST_METHOD} = 'GET';
 137     local $ENV{QUERY_STRING}   = $query_string;
 138     local $ENV{SCRIPT_NAME}    = '/cgi-bin/koha/opac-user.pl';
 139     my $query = CGI->new($query_string);
 140     is(
 141         login_shib_url($query),
 142         'https://testopac.com'
 143           . '/Shibboleth.sso/Login?target='
 144           . 'https://testopac.com/cgi-bin/koha/opac-user.pl'
 145           . $query_string_uri_escaped,
 146         "login shib url"
 147     );
 148
 149     my $post_params = 'user=bob&password=wideopen';
 150     local $ENV{REQUEST_METHOD} = 'POST';
 151     local $ENV{CONTENT_LENGTH} = length($post_params);
 152
 153     my $dir = tempdir( CLEANUP => 1 );
 154     my $infile = "$dir/in.txt";
 155     open my $fh_write, '>', $infile or die "Could not open '$infile' $!";
 156     print $fh_write $post_params;
 157     close $fh_write;
 158
 159     open my $fh_read, '<', $infile or die "Could not open '$infile' $!";
 160
 161     $query = CGI->new($fh_read);
 162     is(
 163         login_shib_url($query),
 164         'https://testopac.com'
 165           . '/Shibboleth.sso/Login?target='
 166           . 'https://testopac.com/cgi-bin/koha/opac-user.pl',
 167         "login shib url"
 168     );
 169
 170     close $fh_read;
 171 };
 172
 173 ## get_login_shib
 174 subtest "get_login_shib tests" => sub {
 175     plan tests => 4;
 176     my $login;
 177
 178     # good config
 179     ## debug off
 180     $C4::Auth_with_shibboleth::debug = '0';
 181     warnings_are { $login = get_login_shib() }[],
 182       "good config with debug off, no warnings received";
 183     is( $login, "test1234",
 184         "good config with debug off, attribute value returned" );
 185
 186     ## debug on
 187     $C4::Auth_with_shibboleth::debug = '1';
 188     warnings_are { $login = get_login_shib() }[
 189         "koha borrower field to match: userid",
 190         "shibboleth attribute to match: uid",
 191         "uid value: test1234"
 192     ],
 193       "good config with debug enabled, correct warnings received";
 194     is( $login, "test1234",
 195         "good config with debug enabled, attribute value returned" );
 196
 197 # bad config - with shib_ok implemented, we should never reach this sub with a bad config
 198 };
 199
 200 ## checkpw_shib
 201 subtest "checkpw_shib tests" => sub {
 202     plan tests => 24;
 203
 204     my $shib_login;
 205     my ( $retval, $retcard, $retuserid );
 206
 207     # Setup Mock Database Data
 208     fixtures_ok [
 209         'Borrower' => [
 210             [qw/cardnumber userid surname address city email/],
 211             [qw/testcardnumber test1234 renvoize myaddress johnston  /],
 212             [qw/testcardnumber1 test12345 clamp1 myaddress quechee kid@clamp.io/],
 213             [qw/testcardnumber2 test123456 clamp2 myaddress quechee kid@clamp.io/],
 214         ],
 215         'Category' => [ [qw/categorycode default_privacy/], [qw/S never/], ]
 216       ],
 217       'Installed some custom fixtures via the Populate fixture class';
 218
 219     # debug off
 220     $C4::Auth_with_shibboleth::debug = '0';
 221
 222     # good user
 223     $shib_login = "test1234";
 224     warnings_are {
 225         ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 226     }
 227     [], "good user with no debug";
 228     is( $retval,    "1",              "user authenticated" );
 229     is( $retcard,   "testcardnumber", "expected cardnumber returned" );
 230     is( $retuserid, "test1234",       "expected userid returned" );
 231
 232     # bad user
 233     $shib_login = 'martin';
 234     warnings_are {
 235         ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 236     }
 237     [], "bad user with no debug";
 238     is( $retval, "0", "user not authenticated" );
 239
 240     # duplicated matchpoint
 241     $matchpoint = 'email';
 242     $mapping{'email'} = { is => 'email' };
 243     $shib_login = 'kid@clamp.io';
 244     warnings_are {
 245         ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 246     }
 247     [], "bad user with no debug";
 248     is( $retval, "0", "user not authenticated if duplicated matchpoint" );
 249     $C4::Auth_with_shibboleth::debug = '1';
 250     warnings_are {
 251         ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 252     }
 253     [
 254         q/checkpw_shib/,
 255         q/koha borrower field to match: email/,
 256         q/shibboleth attribute to match: email/,
 257         q/User Shibboleth-authenticated as: kid@clamp.io/,
 258         q/There are several users with email of kid@clamp.io, matchpoints must be unique/
 259     ], "duplicated matchpoint warned with debug";
 260     $C4::Auth_with_shibboleth::debug = '0';
 261     reset_config();
 262
 263     # autocreate user
 264     $autocreate  = 1;
 265     $shib_login  = 'test4321';
 266     $ENV{'uid'}  = 'test4321';
 267     $ENV{'sn'}   = "pika";
 268     $ENV{'exp'}  = "2017";
 269     $ENV{'cat'}  = "S";
 270     $ENV{'add'}  = 'Address';
 271     $ENV{'city'} = 'City';
 272     warnings_are {
 273         ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 274     }
 275     [], "new user added with no debug";
 276     is( $retval,    "1",        "user authenticated" );
 277     is( $retuserid, "test4321", "expected userid returned" );
 278     ok my $new_user = ResultSet('Borrower')
 279       ->search( { 'userid' => 'test4321' }, { rows => 1 } ), "new user found";
 280     is_fields [qw/surname dateexpiry address city/], $new_user->next,
 281       [qw/pika 2017 Address City/],
 282       'Found $new_users surname';
 283     $autocreate = 0;
 284
 285     # sync user
 286     $sync = 1;
 287     $ENV{'city'} = 'AnotherCity';
 288     warnings_are {
 289         ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 290     }
 291     [], "good user with sync";
 292
 293     ok my $sync_user = ResultSet('Borrower')
 294       ->search( { 'userid' => 'test4321' }, { rows => 1 } ), "sync user found";
 295
 296     is_fields [qw/surname dateexpiry address city/], $sync_user->next,
 297       [qw/pika 2017 Address AnotherCity/],
 298       'Found $sync_user synced city';
 299     $sync = 0;
 300
 301     # debug on
 302     $C4::Auth_with_shibboleth::debug = '1';
 303
 304     # good user
 305     $shib_login = "test1234";
 306     warnings_exist {
 307         ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 308     }
 309     [
 310         qr/checkpw_shib/,
 311         qr/koha borrower field to match: userid/,
 312         qr/shibboleth attribute to match: uid/,
 313         qr/User Shibboleth-authenticated as:/
 314     ],
 315       "good user with debug enabled";
 316     is( $retval,    "1",              "user authenticated" );
 317     is( $retcard,   "testcardnumber", "expected cardnumber returned" );
 318     is( $retuserid, "test1234",       "expected userid returned" );
 319
 320     # bad user
 321     $shib_login = "martin";
 322     warnings_exist {
 323         ( $retval, $retcard, $retuserid ) = checkpw_shib($shib_login);
 324     }
 325     [
 326         qr/checkpw_shib/,
 327         qr/koha borrower field to match: userid/,
 328         qr/shibboleth attribute to match: uid/,
 329         qr/User Shibboleth-authenticated as:/,
 330         qr/not a valid Koha user/
 331     ],
 332       "bad user with debug enabled";
 333     is( $retval, "0", "user not authenticated" );
 334
 335 };
 336
 337 ## _get_uri - opac
 338 $OPACBaseURL = "testopac.com";
 339 is( C4::Auth_with_shibboleth::_get_uri(),
 340     "https://testopac.com", "https opac uri returned" );
 341
 342 $OPACBaseURL = "http://testopac.com";
 343 my $result;
 344 warnings_are { $result = C4::Auth_with_shibboleth::_get_uri() }[
 345     "shibboleth interface: $interface",
 346 "Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!"
 347 ],
 348   "improper protocol - received expected warning";
 349 is( $result, "https://testopac.com", "https opac uri returned" );
 350
 351 $OPACBaseURL = "https://testopac.com";
 352 is( C4::Auth_with_shibboleth::_get_uri(),
 353     "https://testopac.com", "https opac uri returned" );
 354
 355 $OPACBaseURL = undef;
 356 warnings_are { $result = C4::Auth_with_shibboleth::_get_uri() }
 357 [ "shibboleth interface: $interface", "OPACBaseURL not set!" ],
 358   "undefined OPACBaseURL - received expected warning";
 359 is( $result, "https://", "https $interface uri returned" );
 360
 361 ## _get_uri - intranet
 362 $interface = 'intranet';
 363 $staffClientBaseURL = "teststaff.com";
 364 is( C4::Auth_with_shibboleth::_get_uri(),
 365     "https://teststaff.com", "https $interface uri returned" );
 366
 367 $staffClientBaseURL = "http://teststaff.com";
 368 warnings_are { $result = C4::Auth_with_shibboleth::_get_uri() }[
 369     "shibboleth interface: $interface",
 370 "Shibboleth requires OPACBaseURL/staffClientBaseURL to use the https protocol!"
 371 ],
 372   "improper protocol - received expected warning";
 373 is( $result, "https://teststaff.com", "https $interface uri returned" );
 374
 375 $staffClientBaseURL = "https://teststaff.com";
 376 is( C4::Auth_with_shibboleth::_get_uri(),
 377     "https://teststaff.com", "https $interface uri returned" );
 378
 379 $staffClientBaseURL = undef;
 380 warnings_are { $result = C4::Auth_with_shibboleth::_get_uri() }
 381 [ "shibboleth interface: $interface", "staffClientBaseURL not set!" ],
 382   "undefined staffClientBaseURL - received expected warning";
 383 is( $result, "https://", "https $interface uri returned" );
 384
 385 ## _get_shib_config
 386 # Internal helper function, covered in tests above
 387
 388 sub mockedConfig {
 389     my $param = shift;
 390
 391     my %shibboleth = (
 392         'autocreate' => $autocreate,
 393         'sync'       => $sync,
 394         'matchpoint' => $matchpoint,
 395         'mapping'    => \%mapping
 396     );
 397
 398     return \%shibboleth;
 399 }
 400
 401 sub mockedPref {
 402     my $param = $_[1];
 403     my $return;
 404
 405     if ( $param eq 'OPACBaseURL' ) {
 406         $return = $OPACBaseURL;
 407     }
 408
 409     if ( $param eq 'staffClientBaseURL' ) {
 410         $return = $staffClientBaseURL;
 411     }
 412
 413     return $return;
 414 }
 415
 416 sub mockedInterface {
 417     return $interface;
 418 }
 419
 420 sub mockedSchema {
 421     return Schema();
 422 }
 423
 424 ## Convenience method to reset config
 425 sub reset_config {
 426     $matchpoint = 'userid';
 427     $autocreate = 0;
 428     $sync = 0;
 429     %mapping    = (
 430         'userid'       => { 'is' => 'uid' },
 431         'surname'      => { 'is' => 'sn' },
 432         'dateexpiry'   => { 'is' => 'exp' },
 433         'categorycode' => { 'is' => 'cat' },
 434         'address'      => { 'is' => 'add' },
 435         'city'         => { 'is' => 'city' },
 436     );
 437     $ENV{'uid'}  = "test1234";
 438     $ENV{'sn'}   = undef;
 439     $ENV{'exp'}  = undef;
 440     $ENV{'cat'}  = undef;
 441     $ENV{'add'}  = undef;
 442     $ENV{'city'} = undef;
 443
 444     return 1;
 445 }
 446