@@ -, +, @@ ----------------------------------- -::- TEST PLAN: -::- ----------------------------------- top right of the browser window. --- C4/Auth.pm | 281 ++++++++++++++++++++++++++++------------ C4/Auth_with_ldap.pm | 11 +- C4/Context.pm | 9 +- t/db_dependent/Auth_with_ldap.t | 18 +-- 4 files changed, 224 insertions(+), 95 deletions(-) --- a/C4/Auth.pm +++ a/C4/Auth.pm @@ -19,7 +19,7 @@ package C4::Auth; use strict; use warnings; -use Digest::MD5 qw(md5_base64); +use Digest::MD5 qw(md5_base64); #@DEPRECATED Digest::MD5, don't use it or you will get hurt. use JSON qw/encode_json/; use URI::Escape; use CGI::Session; @@ -34,6 +34,9 @@ use C4::Branch; # GetBranches use C4::Search::History; use Koha; use Koha::AuthUtils qw(hash_password); +use Koha::Auth; +use Koha::Auth::Challenge::OPACMaintenance; +use Koha::Auth::Challenge::Version; use POSIX qw/strftime/; use List::MoreUtils qw/ any /; use Encode qw( encode is_utf8); @@ -313,6 +316,10 @@ sub get_template_and_user { # clear out the search history from the session now that # we've saved it to the database C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } ); + + #If the user didn't have any search history on his account prior to entering here, + #Make sure the anonymous search history counts. + $template->param( EnableOpacSearchHistory => 1 ); } } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) { $template->param( EnableSearchHistory => 1 ); @@ -630,50 +637,64 @@ has authenticated. =cut +=head _version_check +#@DEPRECATED See Bug 7174 +use Koha::Auth::Challenge::* instead +=cut + sub _version_check { + #@DEPRECATED See Bug 7174 my $type = shift; my $query = shift; my $version; - # If version syspref is unavailable, it means Koha is being installed, - # and so we must redirect to OPAC maintenance page or to the WebInstaller - # also, if OpacMaintenance is ON, OPAC should redirect to maintenance - if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) { - warn "OPAC Install required, redirecting to maintenance"; - print $query->redirect("/cgi-bin/koha/maintenance.pl"); - safe_exit; - } - unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison - if ( $type ne 'opac' ) { - warn "Install required, redirecting to Installer"; - print $query->redirect("/cgi-bin/koha/installer/install.pl"); - } else { - warn "OPAC Install required, redirecting to maintenance"; - print $query->redirect("/cgi-bin/koha/maintenance.pl"); + try { + Koha::Auth::Challenge::OPACMaintenance::challenge() if ( $type eq 'opac' ); + Koha::Auth::Challenge::Version::challenge(); + } catch { + if (blessed($_)) { + if ($_->isa('Koha::Exception::VersionMismatch')) { + # check that database and koha version are the same + # there is no DB version, it's a fresh install, + # go to web installer + # there is a DB version, compare it to the code version + my $warning = $_->error()." Redirecting to %s."; + if ( $type ne 'opac' ) { + warn sprintf( $warning, 'Installer' ); + print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); + } else { + warn sprintf( "OPAC: " . $warning, 'maintenance' ); + print $query->redirect("/cgi-bin/koha/maintenance.pl"); + } + safe_exit; + } + elsif ($_->isa('Koha::Exception::ServiceTemporarilyUnavailable')) { + # also, if OpacMaintenance is ON, OPAC should redirect to maintenance + warn "OPAC Install required, redirecting to maintenance"; + print $query->redirect("/cgi-bin/koha/maintenance.pl"); + safe_exit; + } + elsif ($_->isa('Koha::Exception::BadSystemPreference')) { + # If version syspref is unavailable, it means Koha is being installed, + # and so we must redirect to OPAC maintenance page or to the WebInstaller + if ( $type ne 'opac' ) { + warn "Install required, redirecting to Installer"; + print $query->redirect("/cgi-bin/koha/installer/install.pl"); + } else { + warn "OPAC Install required, redirecting to maintenance"; + print $query->redirect("/cgi-bin/koha/maintenance.pl"); + } + safe_exit; + } + else { + warn "Unknown exception class ".ref($_)."\n"; + die $_->rethrow(); #Unhandled exception case + } } - safe_exit; - } - - # check that database and koha version are the same - # there is no DB version, it's a fresh install, - # go to web installer - # there is a DB version, compare it to the code version - my $kohaversion = Koha::version(); - - # remove the 3 last . to have a Perl number - $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; - $debug and print STDERR "kohaversion : $kohaversion\n"; - if ( $version < $kohaversion ) { - my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion"; - if ( $type ne 'opac' ) { - warn sprintf( $warning, 'Installer' ); - print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); - } else { - warn sprintf( "OPAC: " . $warning, 'maintenance' ); - print $query->redirect("/cgi-bin/koha/maintenance.pl"); + else { + die $_; #Not a Koha::Exception-object, so rethrow it } - safe_exit; - } + }; } sub _session_log { @@ -693,7 +714,101 @@ sub _timeout_syspref { return $timeout; } +=head checkauth + +Compatibility layer for old Koha authentication system. +Tries to authenticate using Koha::Auth, but if no authentication mechanism is +identified, falls back to the deprecated legacy behaviour. +=cut + sub checkauth { + my @params = @_; #Clone params so we don't accidentally change them if we fallback to checkauth_legacy() + my $query = shift; + my $authnotrequired = shift; + my $flagsrequired = _changeAllPermissionsMarkerToAnyPermissionMarker(shift); #circulate => 1 is deprecated, only circulate => '*' is supported. + my $type = shift; + my $persona = shift; + + ##Revert to legacy authentication for more complex authentication mechanisms. + if ($persona && $cas && $shib) { + return checkauth_legacy(@params); + } + + my ($borrower, $cookie); + try { + ($borrower, $cookie) = Koha::Auth::authenticate($query, $flagsrequired, {authnotrequired => $authnotrequired}); + } catch { + if (blessed($_)) { + if ($_->isa('Koha::Exception::VersionMismatch')) { + + my $warning = $_->error()." Redirecting to %s."; + if ( $type ne 'opac' ) { + warn sprintf( $warning, 'Installer' ); + print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); + } else { + warn sprintf( "OPAC: " . $warning, 'maintenance' ); + print $query->redirect("/cgi-bin/koha/maintenance.pl"); + } + safe_exit; + + } + elsif ($_->isa('Koha::Exception::BadSystemPreference')) { + + if ( $type ne 'opac' ) { + warn $_->error()." Redirecting to installer."; + print $query->redirect("/cgi-bin/koha/installer/install.pl"); + } else { + warn $_->error()." Redirecting to maintenance."; + print $query->redirect("/cgi-bin/koha/maintenance.pl"); + } + safe_exit; + + } + elsif ($_->isa('Koha::Exception::LoginFailed')) { + _showLoginPage($query, $type, $query->cookie(-name => 'CGISESSID'), {invalid_username_or_password => 1}, undef); + } + elsif ($_->isa('Koha::Exception::NoPermission')) { + _showLoginPage($query, $type, $query->cookie(-name => 'CGISESSID'), {nopermission => 1}, undef); + } + elsif ($_->isa('Koha::Exception::Logout')) { + _showLoginPage($query, $type, $query->cookie(-name => 'CGISESSID'), {}, undef); + } + elsif ($_->isa('Koha::Exception::ServiceTemporarilyUnavailable')) { + warn $_->error(); + print $query->redirect("/cgi-bin/koha/maintenance.pl"); + safe_exit; + } + else { + warn "Unknown exception class ".ref($_)."\n"; + $_->rethrow(); #Unhandled exception case + } + } + else { + die $_; #Not a Koha::Exception-object + } + }; + + if ($borrower) { #We authenticated succesfully! Emulate the legacy interface for get_template_and_user(); + my $user = $borrower->userid; + my $sessionID = $cookie->{value}->[0]; + my $aa = $borrower->userid; + my $flags = getuserflags(undef, $borrower->userid, undef) if $borrower->userid; + return ( $user, $cookie, $sessionID, $flags ); + } +} + +=head checkauth_legacy +@DEPRECATED See Bug 7174 + +We are calling this because the given authentication mechanism is not yet supported +in Koha::Auth. + +See checkauth-documentation floating somewhere in this file for info about the +legacy authentication. +=cut + +sub checkauth_legacy { + #@DEPRECATED See Bug 7174 my $query = shift; $debug and warn "Checking Auth"; @@ -983,7 +1098,7 @@ sub checkauth { $info{'nopermission'} = 1; C4::Context->_unset_userenv($sessionID); } - my ( $borrowernumber, $firstname, $surname, $userflags, + my ( $borrowernumber, $firstname, $surname, $branchcode, $branchname, $branchprinter, $emailaddress ); if ( $return == 1 ) { @@ -1014,7 +1129,7 @@ sub checkauth { ( $borrowernumber, $firstname, $surname, $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow; $debug and print STDERR "AUTH_3 results: " . - "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n"; + "$cardnumber,$borrowernumber,$userid,$firstname,$surname,$branchcode,$emailaddress\n"; } else { print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n"; } @@ -1030,7 +1145,7 @@ sub checkauth { $branchname = GetBranchName($branchcode); } my $branches = GetBranches(); - if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) { + if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) { #Why Autolocation cannot work without IndependetBranches?? # we have to check they are coming from the right ip range my $domain = $branches->{$branchcode}->{'branchip'}; @@ -1060,7 +1175,6 @@ sub checkauth { $session->param( 'surname', $surname ); $session->param( 'branch', $branchcode ); $session->param( 'branchname', $branchname ); - $session->param( 'flags', $userflags ); $session->param( 'emailaddress', $emailaddress ); $session->param( 'ip', $session->remote_addr() ); $session->param( 'lasttime', time() ); @@ -1143,6 +1257,12 @@ sub checkauth { # # get the inputs from the incoming query + _showLoginPage($query, $type, $cookie, \%info, $casparam); +} + +sub _showLoginPage { + my ($query, $type, $cookie, $info, $casparam) = @_; + my @inputs = (); foreach my $name ( param $query) { (next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' ); @@ -1194,7 +1314,7 @@ sub checkauth { IntranetUserJS => C4::Context->preference("IntranetUserJS"), IndependentBranches => C4::Context->preference("IndependentBranches"), AutoLocation => C4::Context->preference("AutoLocation"), - wrongip => $info{'wrongip'}, + wrongip => $info->{'wrongip'}, PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"), PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"), persona => C4::Context->preference("Persona"), @@ -1202,7 +1322,7 @@ sub checkauth { ); $template->param( OpacPublic => C4::Context->preference("OpacPublic") ); - $template->param( loginprompt => 1 ) unless $info{'nopermission'}; + $template->param( loginprompt => 1 ) unless $info->{'nopermission'}; if ( $type eq 'opac' ) { require C4::VirtualShelves; @@ -1232,7 +1352,7 @@ sub checkauth { } $template->param( - invalidCasLogin => $info{'invalidCasLogin'} + invalidCasLogin => $info->{'invalidCasLogin'} ); } @@ -1248,7 +1368,7 @@ sub checkauth { url => $self_url, LibraryName => C4::Context->preference("LibraryName"), ); - $template->param(%info); + $template->param(%$info); # $cookie = $query->cookie(CGISESSID => $session->id # ); @@ -1262,6 +1382,7 @@ sub checkauth { } =head2 check_api_auth +@DEPRECATED See Bug 7174 ($status, $cookie, $sessionId) = check_api_auth($query, $userflags); @@ -1296,6 +1417,7 @@ Possible return values in C<$status> are: =cut sub check_api_auth { + #@DEPRECATED See Bug 7174 my $query = shift; my $flagsrequired = shift; @@ -1427,17 +1549,17 @@ sub check_api_auth { if ( $return == 1 ) { my ( $borrowernumber, $firstname, $surname, - $userflags, $branchcode, $branchname, + $branchcode, $branchname, $branchprinter, $emailaddress ); my $sth = $dbh->prepare( -"select borrowernumber, firstname, surname, flags, borrowers.branchcode, branches.branchname as branchname,branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?" +"select borrowernumber, firstname, surname, borrowers.branchcode, branches.branchname as branchname,branches.branchprinter as branchprinter, email from borrowers left join branches on borrowers.branchcode=branches.branchcode where userid=?" ); $sth->execute($userid); ( $borrowernumber, $firstname, $surname, - $userflags, $branchcode, $branchname, + $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow if ( $sth->rows ); @@ -1448,14 +1570,14 @@ sub check_api_auth { $sth->execute($cardnumber); ( $borrowernumber, $firstname, $surname, - $userflags, $branchcode, $branchname, + $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow if ( $sth->rows ); unless ( $sth->rows ) { $sth->execute($userid); ( - $borrowernumber, $firstname, $surname, $userflags, + $borrowernumber, $firstname, $surname, $branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow if ( $sth->rows ); } @@ -1489,7 +1611,6 @@ sub check_api_auth { $session->param( 'surname', $surname ); $session->param( 'branch', $branchcode ); $session->param( 'branchname', $branchname ); - $session->param( 'flags', $userflags ); $session->param( 'emailaddress', $emailaddress ); $session->param( 'ip', $session->remote_addr() ); $session->param( 'lasttime', time() ); @@ -1523,6 +1644,7 @@ sub check_api_auth { } =head2 check_cookie_auth +@DEPRECATED See Bug 7174 ($status, $sessionId) = check_api_auth($cookie, $userflags); @@ -1550,6 +1672,7 @@ Possible return values in C<$status> are: =cut sub check_cookie_auth { + #@DEPRECATED See Bug 7174 my $cookie = shift; my $flagsrequired = shift; @@ -1673,12 +1796,13 @@ sub get_session { return $session; } +#@DEPRECATED See Bug 7174 sub checkpw { my ( $dbh, $userid, $password, $query, $type ) = @_; $type = 'opac' unless $type; if ($ldap) { $debug and print STDERR "## checkpw - checking LDAP\n"; - my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH + my ( $retval, $retcard, $retuserid ) = checkpw_ldap($userid, $password); # EXTERNAL AUTH return 0 if $retval == -1; # Incorrect password for LDAP login attempt ($retval) and return ( $retval, $retcard, $retuserid ); } @@ -1717,6 +1841,7 @@ sub checkpw { return checkpw_internal(@_) } +#@DEPRECATED See Bug 7174 sub checkpw_internal { my ( $dbh, $userid, $password ) = @_; @@ -1742,13 +1867,13 @@ sub checkpw_internal { $sth->execute($userid); if ( $sth->rows ) { my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname, - $surname, $branchcode, $branchname, $flags ) + $surname, $branchcode, $branchname ) = $sth->fetchrow; if ( checkpw_hash( $password, $stored_hash ) ) { C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber, - $firstname, $surname, $branchcode, $branchname, $flags ); + $firstname, $surname, $branchcode, $branchname ); return 1, $cardnumber, $userid; } } @@ -1769,6 +1894,8 @@ sub checkpw_internal { return 1, $cardnumber, $userid; } } + + #@DEPRECATED see Bug 7174. I think the demo-user should be represented with permissions instead of a hard-coded non-borrower anomaly. if ( $userid && $userid eq 'demo' && "$password" eq 'demo' && C4::Context->config('demo') ) @@ -1781,6 +1908,7 @@ sub checkpw_internal { return 0; } +#@DEPRECATED See Bug 7174 sub checkpw_hash { my ( $password, $stored_hash ) = @_; @@ -1791,6 +1919,7 @@ sub checkpw_hash { if ( substr( $stored_hash, 0, 2 ) eq '$2' ) { $hash = hash_password( $password, $stored_hash ); } else { + #@DEPRECATED Digest::MD5, don't use it or you will get hurt. $hash = md5_base64($password); } return $hash eq $stored_hash; @@ -1814,7 +1943,6 @@ sub getuserflags { my $flags = shift; my $userid = shift; my $dbh = @_ ? shift : C4::Context->dbh; - my $userflags; { # I don't want to do this, but if someone logs in as the database # user, it would be preferable not to spam them to death with @@ -1823,28 +1951,6 @@ sub getuserflags { $flags += 0; } return get_user_subpermissions($userid); - - #@DEPRECATED, USE THE Koha::Auth::PermissionManager - my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags"); - $sth->execute; - - while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) { - if ( ( $flags & ( 2**$bit ) ) || $defaulton ) { - $userflags->{$flag} = 1; - } - else { - $userflags->{$flag} = 0; - } - } - - # get subpermissions and merge with top-level permissions - my $user_subperms = get_user_subpermissions($userid); - foreach my $module ( keys %$user_subperms ) { - next if $userflags->{$module} == 1; # user already has permission for everything in this module - $userflags->{$module} = $user_subperms->{$module}; - } - - return $userflags; } =head2 get_user_subpermissions @@ -1946,9 +2052,7 @@ sub haspermission { my $flags = getuserflags( undef, $userid ); #Sanitate 1 to * because we no longer have 1's from the koha.borrowers.flags. - foreach my $module (%$flagsrequired) { - $flagsrequired->{$module} = '*' if $flagsrequired->{$module} && $flagsrequired->{$module} eq '1'; - } + _changeAllPermissionsMarkerToAnyPermissionMarker($flagsrequired); if ( $userid eq C4::Context->config('user') ) { @@ -1983,7 +2087,22 @@ sub haspermission { #FIXME - This fcn should return the failed permission so a suitable error msg can be delivered. } +=head +@DEPRECATED +Sanitate 1 to * because we no longer have 1's from the koha.borrowers.flags. +=cut + +sub _changeAllPermissionsMarkerToAnyPermissionMarker { + #@DEPRECATED + my ($flagsrequired) = @_; + foreach my $module (%$flagsrequired) { + $flagsrequired->{$module} = '*' if $flagsrequired->{$module} && $flagsrequired->{$module} eq '1'; + } + return $flagsrequired; +} + sub getborrowernumber { + #@DEPRECATED See Bug 7174 my ($userid) = @_; my $userenv = C4::Context->userenv; if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) { --- a/C4/Auth_with_ldap.pm +++ a/C4/Auth_with_ldap.pm @@ -103,8 +103,17 @@ sub search_method { return $search; } +=head checkpw_ldap + +@RETURNS Integer, -1 if login failed + , 0 if connection to the LDAP server couldn't be reliably established. + or List of (-1|1|0, $cardnumber, $local_userid); + where $cardnumber is koha.borrowers.cardnumber + $local_userid is the koha.borrowers.userid +=cut + sub checkpw_ldap { - my ($dbh, $userid, $password) = @_; + my ($userid, $password) = @_; my @hosts = split(',', $prefhost); my $db = Net::LDAP->new(\@hosts); unless ( $db ) { --- a/C4/Context.pm +++ a/C4/Context.pm @@ -1055,7 +1055,7 @@ sub userenv { C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, - $userbranch, $branchname, $userflags, + $userbranch, $branchname, $superlibrarian, $emailaddress, $branchprinter, $persona); Establish a hash of user environment variables. @@ -1067,7 +1067,7 @@ set_userenv is called in Auth.pm #' sub set_userenv { shift @_; - my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter, $persona, $shibboleth)= + my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $superlibrarian, $emailaddress, $branchprinter, $persona, $shibboleth)= map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here @_; my $var=$context->{"activeuser"} || ''; @@ -1080,7 +1080,7 @@ sub set_userenv { #possibly a law problem "branch" => $userbranch, "branchname" => $branchname, - "flags" => $userflags, + "flags" => $superlibrarian, #@DEPRECATED, use Koha::Borrower->isSuperlibrarian() instead of flags "emailaddress" => $emailaddress, "branchprinter" => $branchprinter, "persona" => $persona, @@ -1195,6 +1195,7 @@ sub tz { =head2 IsSuperLibrarian +@DEPRECATED, use Koha::Borrower->isSuperlibrarian() C4::Context->IsSuperLibrarian(); @@ -1211,7 +1212,7 @@ sub IsSuperLibrarian { return 1; } - return ($userenv->{flags}//0) % 2; + return ($userenv->{flags}//0) % 2; #If flags == 1, this is true. } =head2 interface --- a/t/db_dependent/Auth_with_ldap.t +++ a/t/db_dependent/Auth_with_ldap.t @@ -74,7 +74,7 @@ subtest "checkpw_ldap tests" => sub { ## Connection fail tests $desired_connection_result = 'error'; - warning_is { $ret = C4::Auth_with_ldap::checkpw_ldap( $dbh, 'hola', password => 'hey' ) } + warning_is { $ret = C4::Auth_with_ldap::checkpw_ldap( 'hola', password => 'hey' ) } "LDAP connexion failed", "checkpw_ldap prints correct warning if LDAP conexion fails"; is( $ret, 0, "checkpw_ldap returns 0 if LDAP conexion fails"); @@ -96,7 +96,7 @@ subtest "checkpw_ldap tests" => sub { warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap( - $dbh, 'hola', password => 'hey' ) } + 'hola', password => 'hey' ) } qr/Anonymous LDAP bind failed: LDAP error #1: error_name/, "checkpw_ldap prints correct warning if LDAP anonymous bind fails"; is( $ret, 0, "checkpw_ldap returns 0 if LDAP anonymous bind fails"); @@ -108,14 +108,14 @@ subtest "checkpw_ldap tests" => sub { $desired_count_result = 0; # user auth problem $non_anonymous_bind_result = 'success'; reload_ldap_module(); - is ( C4::Auth_with_ldap::checkpw_ldap( $dbh, 'hola', password => 'hey' ), + is ( C4::Auth_with_ldap::checkpw_ldap( 'hola', password => 'hey' ), 0, "checkpw_ldap returns 0 if user lookup returns 0"); $non_anonymous_bind_result = 'error'; reload_ldap_module(); warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap( - $dbh, 'hola', password => 'hey' ) } + 'hola', password => 'hey' ) } qr/LDAP bind failed as kohauser hola: LDAP error #1: error_name/, "checkpw_ldap prints correct warning if LDAP bind fails"; is ( $ret, -1, "checkpw_ldap returns -1 LDAP bind fails for user (Bug 8148)"); @@ -130,7 +130,7 @@ subtest "checkpw_ldap tests" => sub { reload_ldap_module(); warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap( - $dbh, 'hola', password => 'hey' ) } + 'hola', password => 'hey' ) } qr/LDAP bind failed as kohauser hola: LDAP error #1: error_name/, "checkpw_ldap prints correct warning if LDAP bind fails"; is ( $ret, 0, "checkpw_ldap returns 0 LDAP bind fails for user (Bug 12831)"); @@ -150,7 +150,7 @@ subtest "checkpw_ldap tests" => sub { reload_ldap_module(); warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap( - $dbh, 'hola', password => 'hey' ) } + 'hola', password => 'hey' ) } qr/LDAP bind failed as ldapuser cn=Manager,dc=metavore,dc=com: LDAP error #1: error_name/, "checkpw_ldap prints correct warning if LDAP bind fails"; is ( $ret, 0, "checkpw_ldap returns 0 if bind fails"); @@ -162,7 +162,7 @@ subtest "checkpw_ldap tests" => sub { reload_ldap_module(); warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap( - $dbh, 'hola', password => 'hey' ) } + 'hola', password => 'hey' ) } qr/LDAP Auth rejected : invalid password for user 'hola'. LDAP error #1: error_name/, "checkpw_ldap prints correct warning if LDAP bind fails"; is ( $ret, -1, "checkpw_ldap returns -1 if bind fails (Bug 8148)"); @@ -175,7 +175,7 @@ subtest "checkpw_ldap tests" => sub { reload_ldap_module(); warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap( - $dbh, 'hola', password => 'hey' ) } + 'hola', password => 'hey' ) } qr/LDAP bind failed as ldapuser cn=Manager,dc=metavore,dc=com: LDAP error #1: error_name/, "checkpw_ldap prints correct warning if LDAP bind fails"; is ( $ret, 0, "checkpw_ldap returns 0 if bind fails"); @@ -187,7 +187,7 @@ subtest "checkpw_ldap tests" => sub { reload_ldap_module(); warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap( - $dbh, 'hola', password => 'hey' ) } + 'hola', password => 'hey' ) } qr/LDAP Auth rejected : invalid password for user 'hola'. LDAP error #1: error_name/, "checkpw_ldap prints correct warning if LDAP bind fails"; is ( $ret, -1, "checkpw_ldap returns -1 if bind fails (Bug 8148)"); --