Lines 19-25
package C4::Auth;
Link Here
|
19 |
|
19 |
|
20 |
use strict; |
20 |
use strict; |
21 |
use warnings; |
21 |
use warnings; |
22 |
use Digest::MD5 qw(md5_base64); |
22 |
use Digest::MD5 qw(md5_base64); #@DEPRECATED Digest::MD5, don't use it or you will get hurt. |
23 |
use JSON qw/encode_json/; |
23 |
use JSON qw/encode_json/; |
24 |
use URI::Escape; |
24 |
use URI::Escape; |
25 |
use CGI::Session; |
25 |
use CGI::Session; |
Lines 34-39
use C4::Branch; # GetBranches
Link Here
|
34 |
use C4::Search::History; |
34 |
use C4::Search::History; |
35 |
use Koha; |
35 |
use Koha; |
36 |
use Koha::AuthUtils qw(hash_password); |
36 |
use Koha::AuthUtils qw(hash_password); |
|
|
37 |
use Koha::Auth; |
38 |
use Koha::Auth::Challenge::OPACMaintenance; |
39 |
use Koha::Auth::Challenge::Version; |
37 |
use POSIX qw/strftime/; |
40 |
use POSIX qw/strftime/; |
38 |
use List::MoreUtils qw/ any /; |
41 |
use List::MoreUtils qw/ any /; |
39 |
use Encode qw( encode is_utf8); |
42 |
use Encode qw( encode is_utf8); |
Lines 313-318
sub get_template_and_user {
Link Here
|
313 |
# clear out the search history from the session now that |
316 |
# clear out the search history from the session now that |
314 |
# we've saved it to the database |
317 |
# we've saved it to the database |
315 |
C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } ); |
318 |
C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } ); |
|
|
319 |
|
320 |
#If the user didn't have any search history on his account prior to entering here, |
321 |
#Make sure the anonymous search history counts. |
322 |
$template->param( EnableOpacSearchHistory => 1 ); |
316 |
} |
323 |
} |
317 |
} elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) { |
324 |
} elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) { |
318 |
$template->param( EnableSearchHistory => 1 ); |
325 |
$template->param( EnableSearchHistory => 1 ); |
Lines 630-679
has authenticated.
Link Here
|
630 |
|
637 |
|
631 |
=cut |
638 |
=cut |
632 |
|
639 |
|
|
|
640 |
=head _version_check |
641 |
#@DEPRECATED See Bug 7174 |
642 |
use Koha::Auth::Challenge::* instead |
643 |
=cut |
644 |
|
633 |
sub _version_check { |
645 |
sub _version_check { |
|
|
646 |
#@DEPRECATED See Bug 7174 |
634 |
my $type = shift; |
647 |
my $type = shift; |
635 |
my $query = shift; |
648 |
my $query = shift; |
636 |
my $version; |
649 |
my $version; |
637 |
|
650 |
|
638 |
# If version syspref is unavailable, it means Koha is being installed, |
651 |
try { |
639 |
# and so we must redirect to OPAC maintenance page or to the WebInstaller |
652 |
Koha::Auth::Challenge::OPACMaintenance::challenge() if ( $type eq 'opac' ); |
640 |
# also, if OpacMaintenance is ON, OPAC should redirect to maintenance |
653 |
Koha::Auth::Challenge::Version::challenge(); |
641 |
if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) { |
654 |
} catch { |
642 |
warn "OPAC Install required, redirecting to maintenance"; |
655 |
if (blessed($_)) { |
643 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
656 |
if ($_->isa('Koha::Exception::VersionMismatch')) { |
644 |
safe_exit; |
657 |
# check that database and koha version are the same |
645 |
} |
658 |
# there is no DB version, it's a fresh install, |
646 |
unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison |
659 |
# go to web installer |
647 |
if ( $type ne 'opac' ) { |
660 |
# there is a DB version, compare it to the code version |
648 |
warn "Install required, redirecting to Installer"; |
661 |
my $warning = $_->error()." Redirecting to %s."; |
649 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
662 |
if ( $type ne 'opac' ) { |
650 |
} else { |
663 |
warn sprintf( $warning, 'Installer' ); |
651 |
warn "OPAC Install required, redirecting to maintenance"; |
664 |
print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); |
652 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
665 |
} else { |
|
|
666 |
warn sprintf( "OPAC: " . $warning, 'maintenance' ); |
667 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
668 |
} |
669 |
safe_exit; |
670 |
} |
671 |
elsif ($_->isa('Koha::Exception::ServiceTemporarilyUnavailable')) { |
672 |
# also, if OpacMaintenance is ON, OPAC should redirect to maintenance |
673 |
warn "OPAC Install required, redirecting to maintenance"; |
674 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
675 |
safe_exit; |
676 |
} |
677 |
elsif ($_->isa('Koha::Exception::BadSystemPreference')) { |
678 |
# If version syspref is unavailable, it means Koha is being installed, |
679 |
# and so we must redirect to OPAC maintenance page or to the WebInstaller |
680 |
if ( $type ne 'opac' ) { |
681 |
warn "Install required, redirecting to Installer"; |
682 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
683 |
} else { |
684 |
warn "OPAC Install required, redirecting to maintenance"; |
685 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
686 |
} |
687 |
safe_exit; |
688 |
} |
689 |
else { |
690 |
warn "Unknown exception class ".ref($_)."\n"; |
691 |
die $_->rethrow(); #Unhandled exception case |
692 |
} |
653 |
} |
693 |
} |
654 |
safe_exit; |
694 |
else { |
655 |
} |
695 |
die $_; #Not a Koha::Exception-object, so rethrow it |
656 |
|
|
|
657 |
# check that database and koha version are the same |
658 |
# there is no DB version, it's a fresh install, |
659 |
# go to web installer |
660 |
# there is a DB version, compare it to the code version |
661 |
my $kohaversion = Koha::version(); |
662 |
|
663 |
# remove the 3 last . to have a Perl number |
664 |
$kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; |
665 |
$debug and print STDERR "kohaversion : $kohaversion\n"; |
666 |
if ( $version < $kohaversion ) { |
667 |
my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion"; |
668 |
if ( $type ne 'opac' ) { |
669 |
warn sprintf( $warning, 'Installer' ); |
670 |
print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); |
671 |
} else { |
672 |
warn sprintf( "OPAC: " . $warning, 'maintenance' ); |
673 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
674 |
} |
696 |
} |
675 |
safe_exit; |
697 |
}; |
676 |
} |
|
|
677 |
} |
698 |
} |
678 |
|
699 |
|
679 |
sub _session_log { |
700 |
sub _session_log { |
Lines 693-699
sub _timeout_syspref {
Link Here
|
693 |
return $timeout; |
714 |
return $timeout; |
694 |
} |
715 |
} |
695 |
|
716 |
|
|
|
717 |
=head checkauth |
718 |
|
719 |
Compatibility layer for old Koha authentication system. |
720 |
Tries to authenticate using Koha::Auth, but if no authentication mechanism is |
721 |
identified, falls back to the deprecated legacy behaviour. |
722 |
=cut |
723 |
|
696 |
sub checkauth { |
724 |
sub checkauth { |
|
|
725 |
my @params = @_; #Clone params so we don't accidentally change them if we fallback to checkauth_legacy() |
726 |
my $query = shift; |
727 |
my $authnotrequired = shift; |
728 |
my $flagsrequired = _changeAllPermissionsMarkerToAnyPermissionMarker(shift); #circulate => 1 is deprecated, only circulate => '*' is supported. |
729 |
my $type = shift; |
730 |
my $persona = shift; |
731 |
|
732 |
##Revert to legacy authentication for more complex authentication mechanisms. |
733 |
if ($persona && $cas && $shib) { |
734 |
return checkauth_legacy(@params); |
735 |
} |
736 |
|
737 |
my ($borrower, $cookie); |
738 |
try { |
739 |
($borrower, $cookie) = Koha::Auth::authenticate($query, $flagsrequired, {authnotrequired => $authnotrequired}); |
740 |
} catch { |
741 |
if (blessed($_)) { |
742 |
if ($_->isa('Koha::Exception::VersionMismatch')) { |
743 |
|
744 |
my $warning = $_->error()." Redirecting to %s."; |
745 |
if ( $type ne 'opac' ) { |
746 |
warn sprintf( $warning, 'Installer' ); |
747 |
print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); |
748 |
} else { |
749 |
warn sprintf( "OPAC: " . $warning, 'maintenance' ); |
750 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
751 |
} |
752 |
safe_exit; |
753 |
|
754 |
} |
755 |
elsif ($_->isa('Koha::Exception::BadSystemPreference')) { |
756 |
|
757 |
if ( $type ne 'opac' ) { |
758 |
warn $_->error()." Redirecting to installer."; |
759 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
760 |
} else { |
761 |
warn $_->error()." Redirecting to maintenance."; |
762 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
763 |
} |
764 |
safe_exit; |
765 |
|
766 |
} |
767 |
elsif ($_->isa('Koha::Exception::LoginFailed')) { |
768 |
_showLoginPage($query, $type, $query->cookie(-name => 'CGISESSID'), {invalid_username_or_password => 1}, undef); |
769 |
} |
770 |
elsif ($_->isa('Koha::Exception::NoPermission')) { |
771 |
_showLoginPage($query, $type, $query->cookie(-name => 'CGISESSID'), {nopermission => 1}, undef); |
772 |
} |
773 |
elsif ($_->isa('Koha::Exception::Logout')) { |
774 |
_showLoginPage($query, $type, $query->cookie(-name => 'CGISESSID'), {}, undef); |
775 |
} |
776 |
elsif ($_->isa('Koha::Exception::ServiceTemporarilyUnavailable')) { |
777 |
warn $_->error(); |
778 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
779 |
safe_exit; |
780 |
} |
781 |
else { |
782 |
warn "Unknown exception class ".ref($_)."\n"; |
783 |
$_->rethrow(); #Unhandled exception case |
784 |
} |
785 |
} |
786 |
else { |
787 |
die $_; #Not a Koha::Exception-object |
788 |
} |
789 |
}; |
790 |
|
791 |
if ($borrower) { #We authenticated succesfully! Emulate the legacy interface for get_template_and_user(); |
792 |
my $user = $borrower->userid; |
793 |
my $sessionID = $cookie->{value}->[0]; |
794 |
my $aa = $borrower->userid; |
795 |
my $flags = getuserflags(undef, $borrower->userid, undef) if $borrower->userid; |
796 |
return ( $user, $cookie, $sessionID, $flags ); |
797 |
} |
798 |
} |
799 |
|
800 |
=head checkauth_legacy |
801 |
@DEPRECATED See Bug 7174 |
802 |
|
803 |
We are calling this because the given authentication mechanism is not yet supported |
804 |
in Koha::Auth. |
805 |
|
806 |
See checkauth-documentation floating somewhere in this file for info about the |
807 |
legacy authentication. |
808 |
=cut |
809 |
|
810 |
sub checkauth_legacy { |
811 |
#@DEPRECATED See Bug 7174 |
697 |
my $query = shift; |
812 |
my $query = shift; |
698 |
$debug and warn "Checking Auth"; |
813 |
$debug and warn "Checking Auth"; |
699 |
|
814 |
|
Lines 983-989
sub checkauth {
Link Here
|
983 |
$info{'nopermission'} = 1; |
1098 |
$info{'nopermission'} = 1; |
984 |
C4::Context->_unset_userenv($sessionID); |
1099 |
C4::Context->_unset_userenv($sessionID); |
985 |
} |
1100 |
} |
986 |
my ( $borrowernumber, $firstname, $surname, $userflags, |
1101 |
my ( $borrowernumber, $firstname, $surname, |
987 |
$branchcode, $branchname, $branchprinter, $emailaddress ); |
1102 |
$branchcode, $branchname, $branchprinter, $emailaddress ); |
988 |
|
1103 |
|
989 |
if ( $return == 1 ) { |
1104 |
if ( $return == 1 ) { |
Lines 1014-1020
sub checkauth {
Link Here
|
1014 |
( $borrowernumber, $firstname, $surname, |
1129 |
( $borrowernumber, $firstname, $surname, |
1015 |
$branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow; |
1130 |
$branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow; |
1016 |
$debug and print STDERR "AUTH_3 results: " . |
1131 |
$debug and print STDERR "AUTH_3 results: " . |
1017 |
"$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n"; |
1132 |
"$cardnumber,$borrowernumber,$userid,$firstname,$surname,$branchcode,$emailaddress\n"; |
1018 |
} else { |
1133 |
} else { |
1019 |
print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n"; |
1134 |
print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n"; |
1020 |
} |
1135 |
} |
Lines 1030-1036
sub checkauth {
Link Here
|
1030 |
$branchname = GetBranchName($branchcode); |
1145 |
$branchname = GetBranchName($branchcode); |
1031 |
} |
1146 |
} |
1032 |
my $branches = GetBranches(); |
1147 |
my $branches = GetBranches(); |
1033 |
if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) { |
1148 |
if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) { #Why Autolocation cannot work without IndependetBranches?? |
1034 |
|
1149 |
|
1035 |
# we have to check they are coming from the right ip range |
1150 |
# we have to check they are coming from the right ip range |
1036 |
my $domain = $branches->{$branchcode}->{'branchip'}; |
1151 |
my $domain = $branches->{$branchcode}->{'branchip'}; |
Lines 1060-1066
sub checkauth {
Link Here
|
1060 |
$session->param( 'surname', $surname ); |
1175 |
$session->param( 'surname', $surname ); |
1061 |
$session->param( 'branch', $branchcode ); |
1176 |
$session->param( 'branch', $branchcode ); |
1062 |
$session->param( 'branchname', $branchname ); |
1177 |
$session->param( 'branchname', $branchname ); |
1063 |
$session->param( 'flags', $userflags ); |
|
|
1064 |
$session->param( 'emailaddress', $emailaddress ); |
1178 |
$session->param( 'emailaddress', $emailaddress ); |
1065 |
$session->param( 'ip', $session->remote_addr() ); |
1179 |
$session->param( 'ip', $session->remote_addr() ); |
1066 |
$session->param( 'lasttime', time() ); |
1180 |
$session->param( 'lasttime', time() ); |
Lines 1143-1148
sub checkauth {
Link Here
|
1143 |
# |
1257 |
# |
1144 |
|
1258 |
|
1145 |
# get the inputs from the incoming query |
1259 |
# get the inputs from the incoming query |
|
|
1260 |
_showLoginPage($query, $type, $cookie, \%info, $casparam); |
1261 |
} |
1262 |
|
1263 |
sub _showLoginPage { |
1264 |
my ($query, $type, $cookie, $info, $casparam) = @_; |
1265 |
|
1146 |
my @inputs = (); |
1266 |
my @inputs = (); |
1147 |
foreach my $name ( param $query) { |
1267 |
foreach my $name ( param $query) { |
1148 |
(next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' ); |
1268 |
(next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' ); |
Lines 1194-1200
sub checkauth {
Link Here
|
1194 |
IntranetUserJS => C4::Context->preference("IntranetUserJS"), |
1314 |
IntranetUserJS => C4::Context->preference("IntranetUserJS"), |
1195 |
IndependentBranches => C4::Context->preference("IndependentBranches"), |
1315 |
IndependentBranches => C4::Context->preference("IndependentBranches"), |
1196 |
AutoLocation => C4::Context->preference("AutoLocation"), |
1316 |
AutoLocation => C4::Context->preference("AutoLocation"), |
1197 |
wrongip => $info{'wrongip'}, |
1317 |
wrongip => $info->{'wrongip'}, |
1198 |
PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"), |
1318 |
PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"), |
1199 |
PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"), |
1319 |
PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"), |
1200 |
persona => C4::Context->preference("Persona"), |
1320 |
persona => C4::Context->preference("Persona"), |
Lines 1202-1208
sub checkauth {
Link Here
|
1202 |
); |
1322 |
); |
1203 |
|
1323 |
|
1204 |
$template->param( OpacPublic => C4::Context->preference("OpacPublic") ); |
1324 |
$template->param( OpacPublic => C4::Context->preference("OpacPublic") ); |
1205 |
$template->param( loginprompt => 1 ) unless $info{'nopermission'}; |
1325 |
$template->param( loginprompt => 1 ) unless $info->{'nopermission'}; |
1206 |
|
1326 |
|
1207 |
if ( $type eq 'opac' ) { |
1327 |
if ( $type eq 'opac' ) { |
1208 |
require C4::VirtualShelves; |
1328 |
require C4::VirtualShelves; |
Lines 1232-1238
sub checkauth {
Link Here
|
1232 |
} |
1352 |
} |
1233 |
|
1353 |
|
1234 |
$template->param( |
1354 |
$template->param( |
1235 |
invalidCasLogin => $info{'invalidCasLogin'} |
1355 |
invalidCasLogin => $info->{'invalidCasLogin'} |
1236 |
); |
1356 |
); |
1237 |
} |
1357 |
} |
1238 |
|
1358 |
|
Lines 1248-1254
sub checkauth {
Link Here
|
1248 |
url => $self_url, |
1368 |
url => $self_url, |
1249 |
LibraryName => C4::Context->preference("LibraryName"), |
1369 |
LibraryName => C4::Context->preference("LibraryName"), |
1250 |
); |
1370 |
); |
1251 |
$template->param(%info); |
1371 |
$template->param(%$info); |
1252 |
|
1372 |
|
1253 |
# $cookie = $query->cookie(CGISESSID => $session->id |
1373 |
# $cookie = $query->cookie(CGISESSID => $session->id |
1254 |
# ); |
1374 |
# ); |
Lines 1262-1267
sub checkauth {
Link Here
|
1262 |
} |
1382 |
} |
1263 |
|
1383 |
|
1264 |
=head2 check_api_auth |
1384 |
=head2 check_api_auth |
|
|
1385 |
@DEPRECATED See Bug 7174 |
1265 |
|
1386 |
|
1266 |
($status, $cookie, $sessionId) = check_api_auth($query, $userflags); |
1387 |
($status, $cookie, $sessionId) = check_api_auth($query, $userflags); |
1267 |
|
1388 |
|
Lines 1296-1301
Possible return values in C<$status> are:
Link Here
|
1296 |
=cut |
1417 |
=cut |
1297 |
|
1418 |
|
1298 |
sub check_api_auth { |
1419 |
sub check_api_auth { |
|
|
1420 |
#@DEPRECATED See Bug 7174 |
1299 |
my $query = shift; |
1421 |
my $query = shift; |
1300 |
my $flagsrequired = shift; |
1422 |
my $flagsrequired = shift; |
1301 |
|
1423 |
|
Lines 1427-1443
sub check_api_auth {
Link Here
|
1427 |
if ( $return == 1 ) { |
1549 |
if ( $return == 1 ) { |
1428 |
my ( |
1550 |
my ( |
1429 |
$borrowernumber, $firstname, $surname, |
1551 |
$borrowernumber, $firstname, $surname, |
1430 |
$userflags, $branchcode, $branchname, |
1552 |
$branchcode, $branchname, |
1431 |
$branchprinter, $emailaddress |
1553 |
$branchprinter, $emailaddress |
1432 |
); |
1554 |
); |
1433 |
my $sth = |
1555 |
my $sth = |
1434 |
$dbh->prepare( |
1556 |
$dbh->prepare( |
1435 |
"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=?" |
1557 |
"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=?" |
1436 |
); |
1558 |
); |
1437 |
$sth->execute($userid); |
1559 |
$sth->execute($userid); |
1438 |
( |
1560 |
( |
1439 |
$borrowernumber, $firstname, $surname, |
1561 |
$borrowernumber, $firstname, $surname, |
1440 |
$userflags, $branchcode, $branchname, |
1562 |
$branchcode, $branchname, |
1441 |
$branchprinter, $emailaddress |
1563 |
$branchprinter, $emailaddress |
1442 |
) = $sth->fetchrow if ( $sth->rows ); |
1564 |
) = $sth->fetchrow if ( $sth->rows ); |
1443 |
|
1565 |
|
Lines 1448-1461
sub check_api_auth {
Link Here
|
1448 |
$sth->execute($cardnumber); |
1570 |
$sth->execute($cardnumber); |
1449 |
( |
1571 |
( |
1450 |
$borrowernumber, $firstname, $surname, |
1572 |
$borrowernumber, $firstname, $surname, |
1451 |
$userflags, $branchcode, $branchname, |
1573 |
$branchcode, $branchname, |
1452 |
$branchprinter, $emailaddress |
1574 |
$branchprinter, $emailaddress |
1453 |
) = $sth->fetchrow if ( $sth->rows ); |
1575 |
) = $sth->fetchrow if ( $sth->rows ); |
1454 |
|
1576 |
|
1455 |
unless ( $sth->rows ) { |
1577 |
unless ( $sth->rows ) { |
1456 |
$sth->execute($userid); |
1578 |
$sth->execute($userid); |
1457 |
( |
1579 |
( |
1458 |
$borrowernumber, $firstname, $surname, $userflags, |
1580 |
$borrowernumber, $firstname, $surname, |
1459 |
$branchcode, $branchname, $branchprinter, $emailaddress |
1581 |
$branchcode, $branchname, $branchprinter, $emailaddress |
1460 |
) = $sth->fetchrow if ( $sth->rows ); |
1582 |
) = $sth->fetchrow if ( $sth->rows ); |
1461 |
} |
1583 |
} |
Lines 1489-1495
sub check_api_auth {
Link Here
|
1489 |
$session->param( 'surname', $surname ); |
1611 |
$session->param( 'surname', $surname ); |
1490 |
$session->param( 'branch', $branchcode ); |
1612 |
$session->param( 'branch', $branchcode ); |
1491 |
$session->param( 'branchname', $branchname ); |
1613 |
$session->param( 'branchname', $branchname ); |
1492 |
$session->param( 'flags', $userflags ); |
|
|
1493 |
$session->param( 'emailaddress', $emailaddress ); |
1614 |
$session->param( 'emailaddress', $emailaddress ); |
1494 |
$session->param( 'ip', $session->remote_addr() ); |
1615 |
$session->param( 'ip', $session->remote_addr() ); |
1495 |
$session->param( 'lasttime', time() ); |
1616 |
$session->param( 'lasttime', time() ); |
Lines 1523-1528
sub check_api_auth {
Link Here
|
1523 |
} |
1644 |
} |
1524 |
|
1645 |
|
1525 |
=head2 check_cookie_auth |
1646 |
=head2 check_cookie_auth |
|
|
1647 |
@DEPRECATED See Bug 7174 |
1526 |
|
1648 |
|
1527 |
($status, $sessionId) = check_api_auth($cookie, $userflags); |
1649 |
($status, $sessionId) = check_api_auth($cookie, $userflags); |
1528 |
|
1650 |
|
Lines 1550-1555
Possible return values in C<$status> are:
Link Here
|
1550 |
=cut |
1672 |
=cut |
1551 |
|
1673 |
|
1552 |
sub check_cookie_auth { |
1674 |
sub check_cookie_auth { |
|
|
1675 |
#@DEPRECATED See Bug 7174 |
1553 |
my $cookie = shift; |
1676 |
my $cookie = shift; |
1554 |
my $flagsrequired = shift; |
1677 |
my $flagsrequired = shift; |
1555 |
|
1678 |
|
Lines 1673-1684
sub get_session {
Link Here
|
1673 |
return $session; |
1796 |
return $session; |
1674 |
} |
1797 |
} |
1675 |
|
1798 |
|
|
|
1799 |
#@DEPRECATED See Bug 7174 |
1676 |
sub checkpw { |
1800 |
sub checkpw { |
1677 |
my ( $dbh, $userid, $password, $query, $type ) = @_; |
1801 |
my ( $dbh, $userid, $password, $query, $type ) = @_; |
1678 |
$type = 'opac' unless $type; |
1802 |
$type = 'opac' unless $type; |
1679 |
if ($ldap) { |
1803 |
if ($ldap) { |
1680 |
$debug and print STDERR "## checkpw - checking LDAP\n"; |
1804 |
$debug and print STDERR "## checkpw - checking LDAP\n"; |
1681 |
my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH |
1805 |
my ( $retval, $retcard, $retuserid ) = checkpw_ldap($userid, $password); # EXTERNAL AUTH |
1682 |
return 0 if $retval == -1; # Incorrect password for LDAP login attempt |
1806 |
return 0 if $retval == -1; # Incorrect password for LDAP login attempt |
1683 |
($retval) and return ( $retval, $retcard, $retuserid ); |
1807 |
($retval) and return ( $retval, $retcard, $retuserid ); |
1684 |
} |
1808 |
} |
Lines 1717-1722
sub checkpw {
Link Here
|
1717 |
return checkpw_internal(@_) |
1841 |
return checkpw_internal(@_) |
1718 |
} |
1842 |
} |
1719 |
|
1843 |
|
|
|
1844 |
#@DEPRECATED See Bug 7174 |
1720 |
sub checkpw_internal { |
1845 |
sub checkpw_internal { |
1721 |
my ( $dbh, $userid, $password ) = @_; |
1846 |
my ( $dbh, $userid, $password ) = @_; |
1722 |
|
1847 |
|
Lines 1742-1754
sub checkpw_internal {
Link Here
|
1742 |
$sth->execute($userid); |
1867 |
$sth->execute($userid); |
1743 |
if ( $sth->rows ) { |
1868 |
if ( $sth->rows ) { |
1744 |
my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname, |
1869 |
my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname, |
1745 |
$surname, $branchcode, $branchname, $flags ) |
1870 |
$surname, $branchcode, $branchname ) |
1746 |
= $sth->fetchrow; |
1871 |
= $sth->fetchrow; |
1747 |
|
1872 |
|
1748 |
if ( checkpw_hash( $password, $stored_hash ) ) { |
1873 |
if ( checkpw_hash( $password, $stored_hash ) ) { |
1749 |
|
1874 |
|
1750 |
C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber, |
1875 |
C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber, |
1751 |
$firstname, $surname, $branchcode, $branchname, $flags ); |
1876 |
$firstname, $surname, $branchcode, $branchname ); |
1752 |
return 1, $cardnumber, $userid; |
1877 |
return 1, $cardnumber, $userid; |
1753 |
} |
1878 |
} |
1754 |
} |
1879 |
} |
Lines 1769-1774
sub checkpw_internal {
Link Here
|
1769 |
return 1, $cardnumber, $userid; |
1894 |
return 1, $cardnumber, $userid; |
1770 |
} |
1895 |
} |
1771 |
} |
1896 |
} |
|
|
1897 |
|
1898 |
#@DEPRECATED see Bug 7174. I think the demo-user should be represented with permissions instead of a hard-coded non-borrower anomaly. |
1772 |
if ( $userid && $userid eq 'demo' |
1899 |
if ( $userid && $userid eq 'demo' |
1773 |
&& "$password" eq 'demo' |
1900 |
&& "$password" eq 'demo' |
1774 |
&& C4::Context->config('demo') ) |
1901 |
&& C4::Context->config('demo') ) |
Lines 1781-1786
sub checkpw_internal {
Link Here
|
1781 |
return 0; |
1908 |
return 0; |
1782 |
} |
1909 |
} |
1783 |
|
1910 |
|
|
|
1911 |
#@DEPRECATED See Bug 7174 |
1784 |
sub checkpw_hash { |
1912 |
sub checkpw_hash { |
1785 |
my ( $password, $stored_hash ) = @_; |
1913 |
my ( $password, $stored_hash ) = @_; |
1786 |
|
1914 |
|
Lines 1791-1796
sub checkpw_hash {
Link Here
|
1791 |
if ( substr( $stored_hash, 0, 2 ) eq '$2' ) { |
1919 |
if ( substr( $stored_hash, 0, 2 ) eq '$2' ) { |
1792 |
$hash = hash_password( $password, $stored_hash ); |
1920 |
$hash = hash_password( $password, $stored_hash ); |
1793 |
} else { |
1921 |
} else { |
|
|
1922 |
#@DEPRECATED Digest::MD5, don't use it or you will get hurt. |
1794 |
$hash = md5_base64($password); |
1923 |
$hash = md5_base64($password); |
1795 |
} |
1924 |
} |
1796 |
return $hash eq $stored_hash; |
1925 |
return $hash eq $stored_hash; |
Lines 1814-1820
sub getuserflags {
Link Here
|
1814 |
my $flags = shift; |
1943 |
my $flags = shift; |
1815 |
my $userid = shift; |
1944 |
my $userid = shift; |
1816 |
my $dbh = @_ ? shift : C4::Context->dbh; |
1945 |
my $dbh = @_ ? shift : C4::Context->dbh; |
1817 |
my $userflags; |
|
|
1818 |
{ |
1946 |
{ |
1819 |
# I don't want to do this, but if someone logs in as the database |
1947 |
# I don't want to do this, but if someone logs in as the database |
1820 |
# user, it would be preferable not to spam them to death with |
1948 |
# user, it would be preferable not to spam them to death with |
Lines 1823-1850
sub getuserflags {
Link Here
|
1823 |
$flags += 0; |
1951 |
$flags += 0; |
1824 |
} |
1952 |
} |
1825 |
return get_user_subpermissions($userid); |
1953 |
return get_user_subpermissions($userid); |
1826 |
|
|
|
1827 |
#@DEPRECATED, USE THE Koha::Auth::PermissionManager |
1828 |
my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags"); |
1829 |
$sth->execute; |
1830 |
|
1831 |
while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) { |
1832 |
if ( ( $flags & ( 2**$bit ) ) || $defaulton ) { |
1833 |
$userflags->{$flag} = 1; |
1834 |
} |
1835 |
else { |
1836 |
$userflags->{$flag} = 0; |
1837 |
} |
1838 |
} |
1839 |
|
1840 |
# get subpermissions and merge with top-level permissions |
1841 |
my $user_subperms = get_user_subpermissions($userid); |
1842 |
foreach my $module ( keys %$user_subperms ) { |
1843 |
next if $userflags->{$module} == 1; # user already has permission for everything in this module |
1844 |
$userflags->{$module} = $user_subperms->{$module}; |
1845 |
} |
1846 |
|
1847 |
return $userflags; |
1848 |
} |
1954 |
} |
1849 |
|
1955 |
|
1850 |
=head2 get_user_subpermissions |
1956 |
=head2 get_user_subpermissions |
Lines 1946-1954
sub haspermission {
Link Here
|
1946 |
|
2052 |
|
1947 |
my $flags = getuserflags( undef, $userid ); |
2053 |
my $flags = getuserflags( undef, $userid ); |
1948 |
#Sanitate 1 to * because we no longer have 1's from the koha.borrowers.flags. |
2054 |
#Sanitate 1 to * because we no longer have 1's from the koha.borrowers.flags. |
1949 |
foreach my $module (%$flagsrequired) { |
2055 |
_changeAllPermissionsMarkerToAnyPermissionMarker($flagsrequired); |
1950 |
$flagsrequired->{$module} = '*' if $flagsrequired->{$module} && $flagsrequired->{$module} eq '1'; |
|
|
1951 |
} |
1952 |
|
2056 |
|
1953 |
if ( $userid eq C4::Context->config('user') ) { |
2057 |
if ( $userid eq C4::Context->config('user') ) { |
1954 |
|
2058 |
|
Lines 1983-1989
sub haspermission {
Link Here
|
1983 |
#FIXME - This fcn should return the failed permission so a suitable error msg can be delivered. |
2087 |
#FIXME - This fcn should return the failed permission so a suitable error msg can be delivered. |
1984 |
} |
2088 |
} |
1985 |
|
2089 |
|
|
|
2090 |
=head |
2091 |
@DEPRECATED |
2092 |
Sanitate 1 to * because we no longer have 1's from the koha.borrowers.flags. |
2093 |
=cut |
2094 |
|
2095 |
sub _changeAllPermissionsMarkerToAnyPermissionMarker { |
2096 |
#@DEPRECATED |
2097 |
my ($flagsrequired) = @_; |
2098 |
foreach my $module (%$flagsrequired) { |
2099 |
$flagsrequired->{$module} = '*' if $flagsrequired->{$module} && $flagsrequired->{$module} eq '1'; |
2100 |
} |
2101 |
return $flagsrequired; |
2102 |
} |
2103 |
|
1986 |
sub getborrowernumber { |
2104 |
sub getborrowernumber { |
|
|
2105 |
#@DEPRECATED See Bug 7174 |
1987 |
my ($userid) = @_; |
2106 |
my ($userid) = @_; |
1988 |
my $userenv = C4::Context->userenv; |
2107 |
my $userenv = C4::Context->userenv; |
1989 |
if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) { |
2108 |
if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) { |