Bug 10402: (QA followup) amend unit tests
[koha.git] / C4 / Auth.pm
index 7674691..2b8a036 100644 (file)
@@ -20,17 +20,18 @@ package C4::Auth;
 use strict;
 use warnings;
 use Digest::MD5 qw(md5_base64);
-use JSON qw/encode_json decode_json/;
+use JSON qw/encode_json/;
 use URI::Escape;
 use CGI::Session;
-use Crypt::Eksblowfish::Bcrypt qw(bcrypt en_base64);
-use Fcntl qw/O_RDONLY/; # O_RDONLY is used in generate_salt
 
 require Exporter;
 use C4::Context;
 use C4::Templates;    # to get the template
+use C4::Languages;
 use C4::Branch; # GetBranches
+use C4::Search::History;
 use C4::VirtualShelves;
+use Koha::AuthUtils qw(hash_password);
 use POSIX qw/strftime/;
 use List::MoreUtils qw/ any /;
 
@@ -48,8 +49,8 @@ BEGIN {
     $debug       = $ENV{DEBUG};
     @ISA         = qw(Exporter);
     @EXPORT      = qw(&checkauth &get_template_and_user &haspermission &get_user_subpermissions);
-    @EXPORT_OK   = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &get_all_subpermissions &get_user_subpermissions
-                      ParseSearchHistoryCookie hash_password
+    @EXPORT_OK   = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash
+                      &get_all_subpermissions &get_user_subpermissions
                    );
     %EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] );
     $ldap        = C4::Context->config('useldapserver') || 0;
@@ -81,10 +82,10 @@ C4::Auth - Authenticates Koha users
   my ($template, $borrowernumber, $cookie)
     = get_template_and_user(
         {
-            template_name   => "opac-main.tmpl",
+            template_name   => "opac-main.tt",
             query           => $query,
       type            => "opac",
-      authnotrequired => 1,
+      authnotrequired => 0,
       flagsrequired   => {borrow => 1, catalogue => '*', tools => 'import_patrons' },
   }
     );
@@ -105,10 +106,10 @@ automatically. This gets loaded into the template.
  my ($template, $borrowernumber, $cookie)
      = get_template_and_user(
        {
-         template_name   => "opac-main.tmpl",
+         template_name   => "opac-main.tt",
          query           => $query,
          type            => "opac",
-         authnotrequired => 1,
+         authnotrequired => 0,
          flagsrequired   => {borrow => 1, catalogue => '*', tools => 'import_patrons' },
        }
      );
@@ -129,16 +130,21 @@ Output.pm module.
 
 =cut
 
-my $SEARCH_HISTORY_INSERT_SQL =<<EOQ;
-INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, total, time            )
-VALUES                    (     ?,         ?,          ?,         ?,          ?, FROM_UNIXTIME(?))
-EOQ
-
 sub get_template_and_user {
+
     my $in       = shift;
-    my $template =
-      C4::Templates::gettemplate( $in->{'template_name'}, $in->{'type'}, $in->{'query'}, $in->{'is_plugin'} );
     my ( $user, $cookie, $sessionID, $flags );
+
+    C4::Context->interface($in->{type});
+
+    $in->{'authnotrequired'} ||= 0;
+    my $template = C4::Templates::gettemplate(
+        $in->{'template_name'},
+        $in->{'type'},
+        $in->{'query'},
+        $in->{'is_plugin'}
+    );
+
     if ( $in->{'template_name'} !~m/maintenance/ ) {
         ( $user, $cookie, $sessionID, $flags ) = checkauth(
             $in->{'query'},
@@ -249,32 +255,36 @@ sub get_template_and_user {
 
             # If at least one search has already been performed
             if ($sth->fetchrow_array > 0) {
-            # We show the link in opac
-            $template->param(ShowOpacRecentSearchLink => 1);
+                # We show the link in opac
+                $template->param( EnableOpacSearchHistory => 1 );
             }
 
-            # And if there's a cookie with searches performed when the user was not logged in,
+            # And if there are searches performed when the user was not logged in,
             # we add them to the logged-in search history
-            my @recentSearches = ParseSearchHistoryCookie($in->{'query'});
+            my @recentSearches = C4::Search::History::get_from_session({ cgi => $in->{'query'} });
             if (@recentSearches) {
-                my $sth = $dbh->prepare($SEARCH_HISTORY_INSERT_SQL);
+                my $dbh = C4::Context->dbh;
+                my $query = q{
+                    INSERT INTO search_history(userid, sessionid, query_desc, query_cgi, type,  total, time )
+                    VALUES (?, ?, ?, ?, ?, ?, ?)
+                };
+
+                my $sth = $dbh->prepare($query);
                 $sth->execute( $borrowernumber,
-                           $in->{'query'}->cookie("CGISESSID"),
-                           $_->{'query_desc'},
-                           $_->{'query_cgi'},
-                           $_->{'total'},
-                           $_->{'time'},
+                           $in->{query}->cookie("CGISESSID"),
+                           $_->{query_desc},
+                           $_->{query_cgi},
+                           $_->{type} || 'biblio',
+                           $_->{total},
+                           $_->{time},
                         ) foreach @recentSearches;
 
-                # And then, delete the cookie's content
-                my $newsearchcookie = $in->{'query'}->cookie(
-                                            -name => 'KohaOpacRecentSearches',
-                                            -value => encode_json([]),
-                                            -HttpOnly => 1,
-                                            -expires => ''
-                                         );
-                $cookie = [$cookie, $newsearchcookie];
+                # 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 => [] });
             }
+        } elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) {
+            $template->param( EnableSearchHistory => 1 );
         }
     }
     else {    # if this is an anonymous session, setup to display public lists...
@@ -282,17 +292,17 @@ sub get_template_and_user {
         $template->param( sessionID        => $sessionID );
         
         my ($total, $pubshelves) = C4::VirtualShelves::GetSomeShelfNames(undef, 'MASTHEAD');
-    $template->param(
-        pubshelves     => $total->{pubtotal},
-        pubshelvesloop => $pubshelves,
-    );
+        $template->param(
+            pubshelves     => $total->{pubtotal},
+            pubshelvesloop => $pubshelves,
+        );
     }
      # Anonymous opac search history
      # If opac search history is enabled and at least one search has already been performed
      if (C4::Context->preference('EnableOpacSearchHistory')) {
-        my @recentSearches = ParseSearchHistoryCookie($in->{'query'}); 
+        my @recentSearches = C4::Search::History::get_from_session({ cgi => $in->{'query'} });
         if (@recentSearches) {
-            $template->param(ShowOpacRecentSearchLink => 1);
+            $template->param(EnableOpacSearchHistory => 1);
         }
      }
 
@@ -301,6 +311,12 @@ sub get_template_and_user {
     }
 
     # these template parameters are set the same regardless of $in->{'type'}
+
+    # Set the using_https variable for templates
+    # FIXME Under Plack the CGI->https method always returns 'OFF'
+    my $https = $in->{query}->https();
+    my $using_https = (defined $https and $https ne 'OFF') ? 1 : 0;
+
     $template->param(
             "BiblioDefaultView".C4::Context->preference("BiblioDefaultView")         => 1,
             EnhancedMessagingPreferences => C4::Context->preference('EnhancedMessagingPreferences'),
@@ -319,7 +335,7 @@ sub get_template_and_user {
             singleBranchMode             => C4::Context->preference("singleBranchMode"),
             XSLTDetailsDisplay           => C4::Context->preference("XSLTDetailsDisplay"),
             XSLTResultsDisplay           => C4::Context->preference("XSLTResultsDisplay"),
-            using_https                  => $in->{'query'}->https() ? 1 : 0,
+            using_https                  => $using_https,
             noItemTypeImages             => C4::Context->preference("noItemTypeImages"),
             marcflavour                  => C4::Context->preference("marcflavour"),
             persona                      => C4::Context->preference("persona"),
@@ -364,22 +380,36 @@ sub get_template_and_user {
         my $LibraryNameTitle = C4::Context->preference("LibraryName");
         $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
         $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
-        # clean up the busc param in the session if the page is not opac-detail
-        if (C4::Context->preference("OpacBrowseResults") && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ && $1 !~ /^(?:MARC|ISBD)?detail$/) {
-            my $sessionSearch = get_session($sessionID || $in->{'query'}->cookie("CGISESSID"));
-            $sessionSearch->clear(["busc"]) if ($sessionSearch->param("busc"));
+        # clean up the busc param in the session if the page is not opac-detail and not the "add to list" page
+        if (   C4::Context->preference("OpacBrowseResults")
+            && $in->{'template_name'} =~ /opac-(.+)\.(?:tt|tmpl)$/ ) {
+            my $pagename = $1;
+            unless (   $pagename =~ /^(?:MARC|ISBD)?detail$/
+                    or $pagename =~ /^addbybiblionumber$/ ) {
+                my $sessionSearch = get_session($sessionID || $in->{'query'}->cookie("CGISESSID"));
+                $sessionSearch->clear(["busc"]) if ($sessionSearch->param("busc"));
+            }
         }
         # variables passed from CGI: opac_css_override and opac_search_limits.
         my $opac_search_limit = $ENV{'OPAC_SEARCH_LIMIT'};
         my $opac_limit_override = $ENV{'OPAC_LIMIT_OVERRIDE'};
         my $opac_name = '';
-        if (($opac_search_limit && $opac_search_limit =~ /branch:(\w+)/ && $opac_limit_override) || ($in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:(\w+)/)){
+        if (
+            ($opac_limit_override && $opac_search_limit && $opac_search_limit =~ /branch:(\w+)/) ||
+            ($in->{'query'}->param('limit') && $in->{'query'}->param('limit') =~ /branch:(\w+)/) ||
+            ($in->{'query'}->param('multibranchlimit') && $in->{'query'}->param('multibranchlimit') =~ /multibranchlimit-(\w+)/)
+        ) {
             $opac_name = $1;   # opac_search_limit is a branch, so we use it.
         } elsif ( $in->{'query'}->param('multibranchlimit') ) {
             $opac_name = $in->{'query'}->param('multibranchlimit');
         } elsif (C4::Context->preference("SearchMyLibraryFirst") && C4::Context->userenv && C4::Context->userenv->{'branch'}) {
             $opac_name = C4::Context->userenv->{'branch'};
         }
+        # FIXME Under Plack the CGI->https method always returns 'OFF' ($using_https will be set to 0 in this case)
+        my $opac_base_url = C4::Context->preference("OPACBaseURL"); #FIXME uses $using_https below as well
+        if (!$opac_base_url){
+            $opac_base_url = $ENV{'SERVER_NAME'} . ($ENV{'SERVER_PORT'} eq ($using_https ? "443" : "80") ? '' : ":$ENV{'SERVER_PORT'}");
+        }
         $template->param(
             opaccolorstylesheet       => C4::Context->preference("opaccolorstylesheet"),
             AnonSuggestions           => "" . C4::Context->preference("AnonSuggestions"),
@@ -400,8 +430,7 @@ sub get_template_and_user {
             OPACMobileUserCSS         => "". C4::Context->preference("OPACMobileUserCSS"),
             OPACViewOthersSuggestions => "" . C4::Context->preference("OPACViewOthersSuggestions"),
             OpacAuthorities           => C4::Context->preference("OpacAuthorities"),
-            OPACBaseURL               => ($in->{'query'}->https() ? "https://" : "http://") . $ENV{'SERVER_NAME'} .
-                   ($ENV{'SERVER_PORT'} eq ($in->{'query'}->https() ? "443" : "80") ? '' : ":$ENV{'SERVER_PORT'}"),
+            OPACBaseURL               => ($using_https ? "https://" : "http://") . $opac_base_url,
             opac_css_override         => $ENV{'OPAC_CSS_OVERRIDE'},
             opac_search_limit         => $opac_search_limit,
             opac_limit_override       => $opac_limit_override,
@@ -410,7 +439,6 @@ sub get_template_and_user {
             OpacKohaUrl               => C4::Context->preference("OpacKohaUrl"),
             OpacMainUserBlock         => "" . C4::Context->preference("OpacMainUserBlock"),
             OpacMainUserBlockMobile   => "" . C4::Context->preference("OpacMainUserBlockMobile"),
-            OpacShowFiltersPulldownMobile => C4::Context->preference("OpacShowFiltersPulldownMobile"),
             OpacShowLibrariesPulldownMobile => C4::Context->preference("OpacShowLibrariesPulldownMobile"),
             OpacNav                   => "" . C4::Context->preference("OpacNav"),
             OpacNavRight              => "" . C4::Context->preference("OpacNavRight"),
@@ -431,7 +459,6 @@ sub get_template_and_user {
             opacheader                => "" . C4::Context->preference("opacheader"),
             opaclanguagesdisplay      => "" . C4::Context->preference("opaclanguagesdisplay"),
             opacreadinghistory        => C4::Context->preference("opacreadinghistory"),
-            opacsmallimage            => "" . C4::Context->preference("opacsmallimage"),
             opacuserjs                => C4::Context->preference("opacuserjs"),
             opacuserlogin             => "" . C4::Context->preference("opacuserlogin"),
             ShowReviewer              => C4::Context->preference("ShowReviewer"),
@@ -460,6 +487,20 @@ sub get_template_and_user {
 
         $template->param(OpacPublic => '1') if ($user || C4::Context->preference("OpacPublic"));
     }
+
+    # Check if we were asked using parameters to force a specific language
+    if ( defined $in->{'query'}->param('language') ) {
+        # Extract the language, let C4::Languages::getlanguage choose
+        # what to do
+        my $language = C4::Languages::getlanguage($in->{'query'});
+        my $languagecookie = C4::Templates::getlanguagecookie($in->{'query'},$language);
+        if ( ref $cookie eq 'ARRAY' ) {
+            push @{ $cookie }, $languagecookie;
+        } else {
+            $cookie = [$cookie, $languagecookie];
+        }
+    }
+
     return ( $template, $borrowernumber, $cookie, $flags);
 }
 
@@ -621,9 +662,12 @@ sub checkauth {
     my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves );
     my $logout = $query->param('logout.x');
 
+    my $anon_search_history;
+
     # This parameter is the name of the CAS server we want to authenticate against,
     # when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml
     my $casparam = $query->param('cas');
+    my $q_userid = $query->param('userid') // '';
 
     if ( $userid = $ENV{'REMOTE_USER'} ) {
             # Using Basic Authentication, no cookies required
@@ -643,9 +687,11 @@ sub checkauth {
         my $session = get_session($sessionID);
         C4::Context->_new_userenv($sessionID);
         my ($ip, $lasttime, $sessiontype);
+        my $s_userid = '';
         if ($session){
+            $s_userid = $session->param('id') // '';
             C4::Context::set_userenv(
-                $session->param('number'),       $session->param('id'),
+                $session->param('number'),       $s_userid,
                 $session->param('cardnumber'),   $session->param('firstname'),
                 $session->param('surname'),      $session->param('branch'),
                 $session->param('branchname'),   $session->param('flags'),
@@ -658,24 +704,25 @@ sub checkauth {
             $debug and printf STDERR "AUTH_SESSION: (%s)\t%s %s - %s\n", map {$session->param($_)} qw(cardnumber firstname surname branch) ;
             $ip       = $session->param('ip');
             $lasttime = $session->param('lasttime');
-            $userid   = $session->param('id');
+            $userid   = $s_userid;
             $sessiontype = $session->param('sessiontype') || '';
         }
-        if ( ( ($query->param('koha_login_context')) && ($query->param('userid') ne $session->param('id')) )
+        if ( ( $query->param('koha_login_context') && ($q_userid ne $s_userid) )
           || ( $cas && $query->param('ticket') ) ) {
             #if a user enters an id ne to the id in the current session, we need to log them in...
             #first we need to clear the anonymous session...
-            $debug and warn "query id = " . $query->param('userid') . " but session id = " . $session->param('id');
-            $session->flush;      
+            $debug and warn "query id = $q_userid but session id = $s_userid";
+            $anon_search_history = $session->param('search_history');
             $session->delete();
+            $session->flush;
             C4::Context->_unset_userenv($sessionID);
             $sessionID = undef;
             $userid = undef;
         }
         elsif ($logout) {
             # voluntary logout the user
-            $session->flush;
             $session->delete();
+            $session->flush;
             C4::Context->_unset_userenv($sessionID);
             #_session_log(sprintf "%20s from %16s logged out at %30s (manually).\n", $userid,$ip,(strftime "%c",localtime));
             $sessionID = undef;
@@ -685,10 +732,13 @@ sub checkauth {
         logout_cas($query);
         }
         }
-        elsif ( $lasttime < time() - $timeout ) {
+        elsif ( !$lasttime || ($lasttime < time() - $timeout) ) {
             # timed logout
             $info{'timed_out'} = 1;
-            $session->delete() if $session;
+            if ($session) {
+                $session->delete();
+                $session->flush;
+            }
             C4::Context->_unset_userenv($sessionID);
             #_session_log(sprintf "%20s from %16s logged out at %30s (inactivity).\n", $userid,$ip,(strftime "%c",localtime));
             $userid    = undef;
@@ -700,6 +750,7 @@ sub checkauth {
             $info{'newip'}        = $ENV{'REMOTE_ADDR'};
             $info{'different_ip'} = 1;
             $session->delete();
+            $session->flush;
             C4::Context->_unset_userenv($sessionID);
             #_session_log(sprintf "%20s from %16s logged out at %30s (ip changed to %16s).\n", $userid,$ip,(strftime "%c",localtime), $info{'newip'});
             $sessionID = undef;
@@ -726,6 +777,14 @@ sub checkauth {
 
         #we initiate a session prior to checking for a username to allow for anonymous sessions...
         my $session = get_session("") or die "Auth ERROR: Cannot get_session()";
+
+        # Save anonymous search history in new session so it can be retrieved
+        # by get_template_and_user to store it in user's search history after
+        # a successful login.
+        if ($anon_search_history) {
+            $session->param('search_history', $anon_search_history);
+        }
+
         my $sessionID = $session->id;
         C4::Context->_new_userenv($sessionID);
         $cookie = $query->cookie(
@@ -733,11 +792,16 @@ sub checkauth {
             -value    => $session->id,
             -HttpOnly => 1
         );
-    $userid = $query->param('userid');
+        $userid = $q_userid;
+        my $pki_field = C4::Context->preference('AllowPKIAuth');
+        if (! defined($pki_field) ) {
+            print STDERR "ERROR: Missing system preference AllowPKIAuth.\n";
+            $pki_field = 'None';
+        }
         if (   ( $cas && $query->param('ticket') )
             || $userid
-            || ( my $pki_field = C4::Context->preference('AllowPKIAuth') ) ne
-            'None' || $persona )
+            || $pki_field ne 'None'
+            || $persona )
         {
             my $password = $query->param('password');
 
@@ -808,7 +872,7 @@ sub checkauth {
                 my $retuserid;
                 ( $return, $cardnumber, $retuserid ) =
                   checkpw( $dbh, $userid, $password, $query );
-                $userid = $retuserid if ( $retuserid ne '' );
+                $userid = $retuserid if ( $retuserid );
         }
         if ($return) {
                #_session_log(sprintf "%20s from %16s logged in  at %30s.\n", $userid,$ENV{'REMOTE_ADDR'},(strftime '%c', localtime));
@@ -932,6 +996,8 @@ sub checkauth {
                     $info{'invalid_username_or_password'} = 1;
                     C4::Context->_unset_userenv($sessionID);
                 }
+                $session->param('lasttime',time());
+                $session->param('ip',$session->remote_addr());
             }
         }    # END if ( $userid    = $query->param('userid') )
         elsif ($type eq "opac") {
@@ -978,7 +1044,7 @@ sub checkauth {
     $LibraryNameTitle =~ s/<(?:\/?)(?:br|p)\s*(?:\/?)>/ /sgi;
     $LibraryNameTitle =~ s/<(?:[^<>'"]|'(?:[^']*)'|"(?:[^"]*)")*>//sg;
 
-    my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tmpl' : 'auth.tmpl';
+    my $template_name = ( $type eq 'opac' ) ? 'opac-auth.tt' : 'auth.tt';
     my $template = C4::Templates::gettemplate($template_name, $type, $query );
     $template->param(
         branchloop           => GetBranchesLoop(),
@@ -998,7 +1064,6 @@ sub checkauth {
         opaccredits          => C4::Context->preference("opaccredits"),
         OpacFavicon          => C4::Context->preference("OpacFavicon"),
         opacreadinghistory   => C4::Context->preference("opacreadinghistory"),
-        opacsmallimage       => C4::Context->preference("opacsmallimage"),
         opaclanguagesdisplay => C4::Context->preference("opaclanguagesdisplay"),
         opacuserjs           => C4::Context->preference("opacuserjs"),
         opacbookbag          => "" . C4::Context->preference("opacbookbag"),
@@ -1162,6 +1227,7 @@ sub check_api_auth {
             if ( $lasttime < time() - $timeout ) {
                 # time out
                 $session->delete();
+                $session->flush;
                 C4::Context->_unset_userenv($sessionID);
                 $userid    = undef;
                 $sessionID = undef;
@@ -1169,6 +1235,7 @@ sub check_api_auth {
             } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
                 # IP address changed
                 $session->delete();
+                $session->flush;
                 C4::Context->_unset_userenv($sessionID);
                 $userid    = undef;
                 $sessionID = undef;
@@ -1185,6 +1252,7 @@ sub check_api_auth {
                     return ("ok", $cookie, $sessionID);
                 } else {
                     $session->delete();
+                    $session->flush;
                     C4::Context->_unset_userenv($sessionID);
                     $userid    = undef;
                     $sessionID = undef;
@@ -1401,6 +1469,7 @@ sub check_cookie_auth {
         if ( $lasttime < time() - $timeout ) {
             # time out
             $session->delete();
+            $session->flush;
             C4::Context->_unset_userenv($sessionID);
             $userid    = undef;
             $sessionID = undef;
@@ -1408,6 +1477,7 @@ sub check_cookie_auth {
         } elsif ( $ip ne $ENV{'REMOTE_ADDR'} ) {
             # IP address changed
             $session->delete();
+            $session->flush;
             C4::Context->_unset_userenv($sessionID);
             $userid    = undef;
             $sessionID = undef;
@@ -1419,6 +1489,7 @@ sub check_cookie_auth {
                 return ("ok", $sessionID);
             } else {
                 $session->delete();
+                $session->flush;
                 C4::Context->_unset_userenv($sessionID);
                 $userid    = undef;
                 $sessionID = undef;
@@ -1466,110 +1537,43 @@ sub get_session {
     return $session;
 }
 
-# Using Bcrypt method for hashing. This can be changed to something else in future, if needed.
-sub hash_password {
-    my $password = shift;
-
-    # Generate a salt if one is not passed
-    my $settings = shift;
-    unless( defined $settings ){ # if there are no settings, we need to create a salt and append settings
-    # Set the cost to 8 and append a NULL
-        $settings = '$2a$08$'.en_base64(generate_salt('weak', 16));
-    }
-    # Encrypt it
-    return bcrypt($password, $settings);
-}
-
-=head2 generate_salt
-
-    use C4::Auth;
-    my $salt = C4::Auth::generate_salt($strength, $length);
-
-=item strength
-
-For general password salting a C<$strength> of C<weak> is recommend,
-For generating a server-salt a C<$strength> of C<strong> is recommended
-
-'strong' uses /dev/random which may block until sufficient entropy is acheived.
-'weak' uses /dev/urandom and is non-blocking.
-
-=back
-
-=item length
-
-C<$length> is a positive integer which specifies the desired length of the returned string
-
-=back
-
-=cut
-
-
-# the implementation of generate_salt is loosely based on Crypt::Random::Provider::File
-sub generate_salt {
-    # strength is 'strong' or 'weak'
-    # length is number of bytes to read, positive integer
-    my ($strength, $length) = @_;
-
-    my $source;
-
-    if( $length < 1 ){
-        die "non-positive strength of '$strength' passed to C4::Auth::generate_salt\n";
-    }
-
-    if( $strength eq "strong" ){
-        $source = '/dev/random'; # blocking
-    } else {
-        unless( $strength eq 'weak' ){
-            warn "unsuppored strength of '$strength' passed to C4::Auth::generate_salt, defaulting to 'weak'\n";
-        }
-        $source = '/dev/urandom'; # non-blocking
-    }
-
-    sysopen SOURCE, $source, O_RDONLY
-        or die "failed to open source '$source' in C4::Auth::generate_salt\n";
-
-    # $bytes is the bytes just read
-    # $string is the concatenation of all the bytes read so far
-    my( $bytes, $string ) = ("", "");
-
-    # keep reading until we have $length bytes in $strength
-    while( length($string) < $length ){
-        # return the number of bytes read, 0 (EOF), or -1 (ERROR)
-        my $return = sysread SOURCE, $bytes, $length - length($string);
-
-        # if no bytes were read, keep reading (if using /dev/random it is possible there was insufficient entropy so this may block)
-        next unless $return;
-        if( $return == -1 ){
-            die "error while reading from $source in C4::Auth::generate_salt\n";
-        }
-
-        $string .= $bytes;
-    }
-
-    close SOURCE;
-    return $string;
-}
-
-
 sub checkpw {
-
     my ( $dbh, $userid, $password, $query ) = @_;
+
     if ($ldap) {
         $debug and print STDERR "## checkpw - checking LDAP\n";
         my ($retval,$retcard,$retuserid) = checkpw_ldap(@_);    # EXTERNAL AUTH
+        return 0 if $retval == -1; # Incorrect password for LDAP login attempt
         ($retval) and return ($retval,$retcard,$retuserid);
     }
 
     if ($cas && $query && $query->param('ticket')) {
         $debug and print STDERR "## checkpw - checking CAS\n";
     # In case of a CAS authentication, we use the ticket instead of the password
-    my $ticket = $query->param('ticket');
+        my $ticket = $query->param('ticket');
+        $query->delete('ticket'); # remove ticket to come back to original URL
         my ($retval,$retcard,$retuserid) = checkpw_cas($dbh, $ticket, $query);    # EXTERNAL AUTH
         ($retval) and return ($retval,$retcard,$retuserid);
-    return 0;
+        return 0;
+    }
+
+    return checkpw_internal(@_)
+}
+
+sub checkpw_internal {
+    my ( $dbh, $userid, $password ) = @_;
+
+    if ( $userid && $userid eq C4::Context->config('user') ) {
+        if ( $password && $password eq C4::Context->config('pass') ) {
+        # Koha superuser account
+#     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
+            return 2;
+        }
+        else {
+            return 0;
+        }
     }
 
-    # INTERNAL AUTH
     my $sth =
       $dbh->prepare(
 "select password,cardnumber,borrowernumber,userid,firstname,surname,branchcode,flags from borrowers where userid=?"
@@ -1580,14 +1584,7 @@ sub checkpw {
             $surname, $branchcode, $flags )
           = $sth->fetchrow;
 
-        # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
-        my $hash;
-        if ( substr($stored_hash,0,2) eq '$2') {
-            $hash = hash_password($password, $stored_hash);
-        } else {
-            $hash = md5_base64($password);
-        }
-        if ( $hash eq $stored_hash and $stored_hash ne "!") {
+        if ( checkpw_hash($password, $stored_hash) ) {
 
             C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber,
                 $firstname, $surname, $branchcode, $flags );
@@ -1604,29 +1601,13 @@ sub checkpw {
             $surname, $branchcode, $flags )
           = $sth->fetchrow;
 
-        # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
-        my $hash;
-        if ( substr($stored_hash,0,2) eq '$2') {
-            $hash = hash_password($password, $stored_hash);
-        } else {
-            $hash = md5_base64($password);
-        }
-
-        if ( $hash eq $stored_hash ) {
+        if ( checkpw_hash($password, $stored_hash) ) {
 
             C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber,
                 $firstname, $surname, $branchcode, $flags );
             return 1, $cardnumber, $userid;
         }
     }
-    if (   $userid && $userid eq C4::Context->config('user')
-        && "$password" eq C4::Context->config('pass') )
-    {
-
-# Koha superuser account
-#     C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
-        return 2;
-    }
     if (   $userid && $userid eq 'demo'
         && "$password" eq 'demo'
         && C4::Context->config('demo') )
@@ -1639,6 +1620,21 @@ sub checkpw {
     return 0;
 }
 
+sub checkpw_hash {
+    my ( $password, $stored_hash ) = @_;
+
+    return if $stored_hash eq '!';
+
+    # check what encryption algorithm was implemented: Bcrypt - if the hash starts with '$2' it is Bcrypt else md5
+    my $hash;
+    if ( substr($stored_hash,0,2) eq '$2') {
+        $hash = hash_password($password, $stored_hash);
+    } else {
+        $hash = md5_base64($password);
+    }
+    return $hash eq $stored_hash;
+}
+
 =head2 getuserflags
 
     my $authflags = getuserflags($flags, $userid, [$dbh]);
@@ -1674,7 +1670,6 @@ sub getuserflags {
             $userflags->{$flag} = 0;
         }
     }
-
     # get subpermissions and merge with top-level permissions
     my $user_subperms = get_user_subpermissions($userid);
     foreach my $module (keys %$user_subperms) {
@@ -1770,7 +1765,8 @@ sub haspermission {
     my ($userid, $flagsrequired) = @_;
     my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?");
     $sth->execute($userid);
-    my $flags = getuserflags($sth->fetchrow(), $userid);
+    my $row = $sth->fetchrow();
+    my $flags = getuserflags($row, $userid);
     if ( $userid eq C4::Context->config('user') ) {
         # Super User Account from /etc/koha.conf
         $flags->{'superlibrarian'} = 1;
@@ -1819,16 +1815,6 @@ sub getborrowernumber {
     return 0;
 }
 
-sub ParseSearchHistoryCookie {
-    my $input = shift;
-    my $search_cookie = $input->cookie('KohaOpacRecentSearches');
-    return () unless $search_cookie;
-    my $obj = eval { decode_json(uri_unescape($search_cookie)) };
-    return () unless defined $obj;
-    return () unless ref $obj eq 'ARRAY';
-    return @{ $obj };
-}
-
 END { }    # module clean-up code here (global destructor)
 1;
 __END__
@@ -1839,6 +1825,8 @@ CGI(3)
 
 C4::Output(3)
 
+Crypt::Eksblowfish::Bcrypt(3)
+
 Digest::MD5(3)
 
 =cut