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::Component; |
37 |
use POSIX qw/strftime/; |
39 |
use POSIX qw/strftime/; |
38 |
use List::MoreUtils qw/ any /; |
40 |
use List::MoreUtils qw/ any /; |
39 |
use Encode qw( encode is_utf8); |
41 |
use Encode qw( encode is_utf8); |
Lines 636-685
has authenticated.
Link Here
|
636 |
|
638 |
|
637 |
=cut |
639 |
=cut |
638 |
|
640 |
|
|
|
641 |
=head _version_check |
642 |
#@DEPRECATED See Bug 7174 |
643 |
use Koha::Auth::Component::* instead |
644 |
=cut |
645 |
|
639 |
sub _version_check { |
646 |
sub _version_check { |
|
|
647 |
#@DEPRECATED See Bug 7174 |
640 |
my $type = shift; |
648 |
my $type = shift; |
641 |
my $query = shift; |
649 |
my $query = shift; |
642 |
my $version; |
650 |
my $version; |
643 |
|
651 |
|
644 |
# If version syspref is unavailable, it means Koha is being installed, |
652 |
try { |
645 |
# and so we must redirect to OPAC maintenance page or to the WebInstaller |
653 |
Koha::Auth::Component::checkOPACMaintenance() if ( $type eq 'opac' ); |
646 |
# also, if OpacMaintenance is ON, OPAC should redirect to maintenance |
654 |
Koha::Auth::Component::checkVersion(); |
647 |
if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) { |
655 |
} catch { |
648 |
warn "OPAC Install required, redirecting to maintenance"; |
656 |
if (blessed($_)) { |
649 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
657 |
if ($_->isa('Koha::Exception::VersionMismatch')) { |
650 |
safe_exit; |
658 |
# check that database and koha version are the same |
651 |
} |
659 |
# there is no DB version, it's a fresh install, |
652 |
unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison |
660 |
# go to web installer |
653 |
if ( $type ne 'opac' ) { |
661 |
# there is a DB version, compare it to the code version |
654 |
warn "Install required, redirecting to Installer"; |
662 |
my $warning = $_->error()." Redirecting to %s."; |
655 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
663 |
if ( $type ne 'opac' ) { |
656 |
} else { |
664 |
warn sprintf( $warning, 'Installer' ); |
657 |
warn "OPAC Install required, redirecting to maintenance"; |
665 |
print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); |
658 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
666 |
} else { |
|
|
667 |
warn sprintf( "OPAC: " . $warning, 'maintenance' ); |
668 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
669 |
} |
670 |
safe_exit; |
671 |
} |
672 |
elsif ($_->isa('Koha::Exception::ServiceTemporarilyUnavailable')) { |
673 |
# also, if OpacMaintenance is ON, OPAC should redirect to maintenance |
674 |
warn "OPAC Install required, redirecting to maintenance"; |
675 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
676 |
safe_exit; |
677 |
} |
678 |
elsif ($_->isa('Koha::Exception::BadSystemPreference')) { |
679 |
# If version syspref is unavailable, it means Koha is being installed, |
680 |
# and so we must redirect to OPAC maintenance page or to the WebInstaller |
681 |
if ( $type ne 'opac' ) { |
682 |
warn "Install required, redirecting to Installer"; |
683 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
684 |
} else { |
685 |
warn "OPAC Install required, redirecting to maintenance"; |
686 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
687 |
} |
688 |
safe_exit; |
689 |
} |
690 |
else { |
691 |
warn "Unknown exception class ".ref($_)."\n"; |
692 |
die $_->rethrow(); #Unhandled exception case |
693 |
} |
659 |
} |
694 |
} |
660 |
safe_exit; |
695 |
else { |
661 |
} |
696 |
die $_; #Not a Koha::Exception-object, so rethrow it |
662 |
|
|
|
663 |
# check that database and koha version are the same |
664 |
# there is no DB version, it's a fresh install, |
665 |
# go to web installer |
666 |
# there is a DB version, compare it to the code version |
667 |
my $kohaversion = Koha::version(); |
668 |
|
669 |
# remove the 3 last . to have a Perl number |
670 |
$kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; |
671 |
$debug and print STDERR "kohaversion : $kohaversion\n"; |
672 |
if ( $version < $kohaversion ) { |
673 |
my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion"; |
674 |
if ( $type ne 'opac' ) { |
675 |
warn sprintf( $warning, 'Installer' ); |
676 |
print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); |
677 |
} else { |
678 |
warn sprintf( "OPAC: " . $warning, 'maintenance' ); |
679 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
680 |
} |
697 |
} |
681 |
safe_exit; |
698 |
}; |
682 |
} |
|
|
683 |
} |
699 |
} |
684 |
|
700 |
|
685 |
sub _session_log { |
701 |
sub _session_log { |
Lines 699-705
sub _timeout_syspref {
Link Here
|
699 |
return $timeout; |
715 |
return $timeout; |
700 |
} |
716 |
} |
701 |
|
717 |
|
|
|
718 |
=head checkauth |
719 |
|
720 |
Compatibility layer for old Koha authentication system. |
721 |
Tries to authenticate using Koha::Auth, but if no authentication mechanism is |
722 |
identified, falls back to the deprecated legacy behaviour. |
723 |
=cut |
724 |
|
702 |
sub checkauth { |
725 |
sub checkauth { |
|
|
726 |
my @params = @_; #Clone params so we don't accidentally change them if we fallback to checkauth_legacy() |
727 |
my $query = shift; |
728 |
my $authnotrequired = shift; |
729 |
my $flagsrequired = _changeAllPermissionsMarkerToAnyPermissionMarker(shift); #circulate => 1 is deprecated, only circulate => '*' is supported. |
730 |
my $type = shift; |
731 |
my $persona = shift; |
732 |
|
733 |
##Revert to legacy authentication for more complex authentication mechanisms. |
734 |
if ($persona && $cas && $shib) { |
735 |
return checkauth_legacy(@params); |
736 |
} |
737 |
|
738 |
my ($borrower, $cookie); |
739 |
try { |
740 |
($borrower, $cookie) = Koha::Auth::authenticate($query, $flagsrequired, {authnotrequired => $authnotrequired}); |
741 |
} catch { |
742 |
if (blessed($_)) { |
743 |
if ($_->isa('Koha::Exception::VersionMismatch')) { |
744 |
|
745 |
my $warning = $_->error()." Redirecting to %s."; |
746 |
if ( $type ne 'opac' ) { |
747 |
warn sprintf( $warning, 'Installer' ); |
748 |
print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); |
749 |
} else { |
750 |
warn sprintf( "OPAC: " . $warning, 'maintenance' ); |
751 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
752 |
} |
753 |
safe_exit; |
754 |
|
755 |
} |
756 |
elsif ($_->isa('Koha::Exception::BadSystemPreference')) { |
757 |
|
758 |
if ( $type ne 'opac' ) { |
759 |
warn $_->error()." Redirecting to installer."; |
760 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
761 |
} else { |
762 |
warn $_->error()." Redirecting to maintenance."; |
763 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
764 |
} |
765 |
safe_exit; |
766 |
|
767 |
} |
768 |
elsif ($_->isa('Koha::Exception::LoginFailed')) { |
769 |
_showLoginPage($query, $type, {}, {invalid_username_or_password => 1}, undef); |
770 |
} |
771 |
elsif ($_->isa('Koha::Exception::NoPermission')) { |
772 |
_showLoginPage($query, $type, {}, {nopermission => 1}, undef); |
773 |
} |
774 |
elsif ($_->isa('Koha::Exception::Logout')) { |
775 |
_showLoginPage($query, $type, {}, {}, undef); |
776 |
} |
777 |
elsif ($_->isa('Koha::Exception::ServiceTemporarilyUnavailable')) { |
778 |
warn $_->error(); |
779 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
780 |
safe_exit; |
781 |
} |
782 |
else { |
783 |
warn "Unknown exception class ".ref($_)."\n"; |
784 |
$_->rethrow(); #Unhandled exception case |
785 |
} |
786 |
} |
787 |
else { |
788 |
die $_; #Not a Koha::Exception-object |
789 |
} |
790 |
}; |
791 |
|
792 |
if ($borrower) { #We authenticated succesfully! Emulate the legacy interface for get_template_and_user(); |
793 |
my $user = $borrower->userid; |
794 |
my $sessionID = $cookie->{value}->[0]; |
795 |
my $aa = $borrower->userid; |
796 |
my $flags = getuserflags(undef, $borrower->userid, undef) if $borrower->userid; |
797 |
return ( $user, $cookie, $sessionID, $flags ); |
798 |
} |
799 |
} |
800 |
|
801 |
=head checkauth_legacy |
802 |
@DEPRECATED See Bug 7174 |
803 |
|
804 |
We are calling this because the given authentication mechanism is not yet supported |
805 |
in Koha::Auth. |
806 |
|
807 |
See checkauth-documentation floating somewhere in this file for info about the |
808 |
legacy authentication. |
809 |
=cut |
810 |
|
811 |
sub checkauth_legacy { |
812 |
#@DEPRECATED See Bug 7174 |
703 |
my $query = shift; |
813 |
my $query = shift; |
704 |
$debug and warn "Checking Auth"; |
814 |
$debug and warn "Checking Auth"; |
705 |
|
815 |
|
Lines 721-728
sub checkauth {
Link Here
|
721 |
my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves ); |
831 |
my ( $userid, $cookie, $sessionID, $flags, $barshelves, $pubshelves ); |
722 |
my $logout = $query->param('logout.x'); |
832 |
my $logout = $query->param('logout.x'); |
723 |
|
833 |
|
724 |
my $anon_search_history; |
|
|
725 |
|
726 |
# This parameter is the name of the CAS server we want to authenticate against, |
834 |
# This parameter is the name of the CAS server we want to authenticate against, |
727 |
# when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml |
835 |
# when using authentication against multiple CAS servers, as configured in Auth_cas_servers.yaml |
728 |
my $casparam = $query->param('cas'); |
836 |
my $casparam = $query->param('cas'); |
Lines 783-789
sub checkauth {
Link Here
|
783 |
#if a user enters an id ne to the id in the current session, we need to log them in... |
891 |
#if a user enters an id ne to the id in the current session, we need to log them in... |
784 |
#first we need to clear the anonymous session... |
892 |
#first we need to clear the anonymous session... |
785 |
$debug and warn "query id = $q_userid but session id = $s_userid"; |
893 |
$debug and warn "query id = $q_userid but session id = $s_userid"; |
786 |
$anon_search_history = $session->param('search_history'); |
|
|
787 |
$session->delete(); |
894 |
$session->delete(); |
788 |
$session->flush; |
895 |
$session->flush; |
789 |
C4::Context->_unset_userenv($sessionID); |
896 |
C4::Context->_unset_userenv($sessionID); |
Lines 864-876
sub checkauth {
Link Here
|
864 |
#we initiate a session prior to checking for a username to allow for anonymous sessions... |
971 |
#we initiate a session prior to checking for a username to allow for anonymous sessions... |
865 |
my $session = get_session("") or die "Auth ERROR: Cannot get_session()"; |
972 |
my $session = get_session("") or die "Auth ERROR: Cannot get_session()"; |
866 |
|
973 |
|
867 |
# Save anonymous search history in new session so it can be retrieved |
|
|
868 |
# by get_template_and_user to store it in user's search history after |
869 |
# a successful login. |
870 |
if ($anon_search_history) { |
871 |
$session->param( 'search_history', $anon_search_history ); |
872 |
} |
873 |
|
874 |
my $sessionID = $session->id; |
974 |
my $sessionID = $session->id; |
875 |
C4::Context->_new_userenv($sessionID); |
975 |
C4::Context->_new_userenv($sessionID); |
876 |
$cookie = $query->cookie( |
976 |
$cookie = $query->cookie( |
Lines 989-1000
sub checkauth {
Link Here
|
989 |
$info{'nopermission'} = 1; |
1089 |
$info{'nopermission'} = 1; |
990 |
C4::Context->_unset_userenv($sessionID); |
1090 |
C4::Context->_unset_userenv($sessionID); |
991 |
} |
1091 |
} |
992 |
my ( $borrowernumber, $firstname, $surname, $userflags, |
1092 |
my ( $borrowernumber, $firstname, $surname, |
993 |
$branchcode, $branchname, $branchprinter, $emailaddress ); |
1093 |
$branchcode, $branchname, $branchprinter, $emailaddress ); |
994 |
|
1094 |
|
995 |
if ( $return == 1 ) { |
1095 |
if ( $return == 1 ) { |
996 |
my $select = " |
1096 |
my $select = " |
997 |
SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode, |
1097 |
SELECT borrowernumber, firstname, surname, borrowers.branchcode, |
998 |
branches.branchname as branchname, |
1098 |
branches.branchname as branchname, |
999 |
branches.branchprinter as branchprinter, |
1099 |
branches.branchprinter as branchprinter, |
1000 |
email |
1100 |
email |
Lines 1017-1026
sub checkauth {
Link Here
|
1017 |
} |
1117 |
} |
1018 |
} |
1118 |
} |
1019 |
if ( $sth->rows ) { |
1119 |
if ( $sth->rows ) { |
1020 |
( $borrowernumber, $firstname, $surname, $userflags, |
1120 |
( $borrowernumber, $firstname, $surname, |
1021 |
$branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow; |
1121 |
$branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow; |
1022 |
$debug and print STDERR "AUTH_3 results: " . |
1122 |
$debug and print STDERR "AUTH_3 results: " . |
1023 |
"$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n"; |
1123 |
"$cardnumber,$borrowernumber,$userid,$firstname,$surname,$branchcode,$emailaddress\n"; |
1024 |
} else { |
1124 |
} else { |
1025 |
print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n"; |
1125 |
print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n"; |
1026 |
} |
1126 |
} |
Lines 1036-1042
sub checkauth {
Link Here
|
1036 |
$branchname = GetBranchName($branchcode); |
1136 |
$branchname = GetBranchName($branchcode); |
1037 |
} |
1137 |
} |
1038 |
my $branches = GetBranches(); |
1138 |
my $branches = GetBranches(); |
1039 |
if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) { |
1139 |
if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) { #Why Autolocation cannot work without IndependetBranches?? |
1040 |
|
1140 |
|
1041 |
# we have to check they are coming from the right ip range |
1141 |
# we have to check they are coming from the right ip range |
1042 |
my $domain = $branches->{$branchcode}->{'branchip'}; |
1142 |
my $domain = $branches->{$branchcode}->{'branchip'}; |
Lines 1066-1072
sub checkauth {
Link Here
|
1066 |
$session->param( 'surname', $surname ); |
1166 |
$session->param( 'surname', $surname ); |
1067 |
$session->param( 'branch', $branchcode ); |
1167 |
$session->param( 'branch', $branchcode ); |
1068 |
$session->param( 'branchname', $branchname ); |
1168 |
$session->param( 'branchname', $branchname ); |
1069 |
$session->param( 'flags', $userflags ); |
|
|
1070 |
$session->param( 'emailaddress', $emailaddress ); |
1169 |
$session->param( 'emailaddress', $emailaddress ); |
1071 |
$session->param( 'ip', $session->remote_addr() ); |
1170 |
$session->param( 'ip', $session->remote_addr() ); |
1072 |
$session->param( 'lasttime', time() ); |
1171 |
$session->param( 'lasttime', time() ); |
Lines 1149-1154
sub checkauth {
Link Here
|
1149 |
# |
1248 |
# |
1150 |
|
1249 |
|
1151 |
# get the inputs from the incoming query |
1250 |
# get the inputs from the incoming query |
|
|
1251 |
_showLoginPage($query, $type, $cookie, \%info, $casparam); |
1252 |
} |
1253 |
|
1254 |
sub _showLoginPage { |
1255 |
my ($query, $type, $cookie, $info, $casparam) = @_; |
1256 |
|
1152 |
my @inputs = (); |
1257 |
my @inputs = (); |
1153 |
foreach my $name ( param $query) { |
1258 |
foreach my $name ( param $query) { |
1154 |
(next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' ); |
1259 |
(next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' ); |
Lines 1200-1206
sub checkauth {
Link Here
|
1200 |
IntranetUserJS => C4::Context->preference("IntranetUserJS"), |
1305 |
IntranetUserJS => C4::Context->preference("IntranetUserJS"), |
1201 |
IndependentBranches => C4::Context->preference("IndependentBranches"), |
1306 |
IndependentBranches => C4::Context->preference("IndependentBranches"), |
1202 |
AutoLocation => C4::Context->preference("AutoLocation"), |
1307 |
AutoLocation => C4::Context->preference("AutoLocation"), |
1203 |
wrongip => $info{'wrongip'}, |
1308 |
wrongip => $info->{'wrongip'}, |
1204 |
PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"), |
1309 |
PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"), |
1205 |
PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"), |
1310 |
PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"), |
1206 |
persona => C4::Context->preference("Persona"), |
1311 |
persona => C4::Context->preference("Persona"), |
Lines 1208-1214
sub checkauth {
Link Here
|
1208 |
); |
1313 |
); |
1209 |
|
1314 |
|
1210 |
$template->param( OpacPublic => C4::Context->preference("OpacPublic") ); |
1315 |
$template->param( OpacPublic => C4::Context->preference("OpacPublic") ); |
1211 |
$template->param( loginprompt => 1 ) unless $info{'nopermission'}; |
1316 |
$template->param( loginprompt => 1 ) unless $info->{'nopermission'}; |
1212 |
|
1317 |
|
1213 |
if ( $type eq 'opac' ) { |
1318 |
if ( $type eq 'opac' ) { |
1214 |
require C4::VirtualShelves; |
1319 |
require C4::VirtualShelves; |
Lines 1238-1244
sub checkauth {
Link Here
|
1238 |
} |
1343 |
} |
1239 |
|
1344 |
|
1240 |
$template->param( |
1345 |
$template->param( |
1241 |
invalidCasLogin => $info{'invalidCasLogin'} |
1346 |
invalidCasLogin => $info->{'invalidCasLogin'} |
1242 |
); |
1347 |
); |
1243 |
} |
1348 |
} |
1244 |
|
1349 |
|
Lines 1254-1260
sub checkauth {
Link Here
|
1254 |
url => $self_url, |
1359 |
url => $self_url, |
1255 |
LibraryName => C4::Context->preference("LibraryName"), |
1360 |
LibraryName => C4::Context->preference("LibraryName"), |
1256 |
); |
1361 |
); |
1257 |
$template->param(%info); |
1362 |
$template->param(%$info); |
1258 |
|
1363 |
|
1259 |
# $cookie = $query->cookie(CGISESSID => $session->id |
1364 |
# $cookie = $query->cookie(CGISESSID => $session->id |
1260 |
# ); |
1365 |
# ); |
Lines 1268-1273
sub checkauth {
Link Here
|
1268 |
} |
1373 |
} |
1269 |
|
1374 |
|
1270 |
=head2 check_api_auth |
1375 |
=head2 check_api_auth |
|
|
1376 |
@DEPRECATED See Bug 7174 |
1271 |
|
1377 |
|
1272 |
($status, $cookie, $sessionId) = check_api_auth($query, $userflags); |
1378 |
($status, $cookie, $sessionId) = check_api_auth($query, $userflags); |
1273 |
|
1379 |
|
Lines 1302-1307
Possible return values in C<$status> are:
Link Here
|
1302 |
=cut |
1408 |
=cut |
1303 |
|
1409 |
|
1304 |
sub check_api_auth { |
1410 |
sub check_api_auth { |
|
|
1411 |
#@DEPRECATED See Bug 7174 |
1305 |
my $query = shift; |
1412 |
my $query = shift; |
1306 |
my $flagsrequired = shift; |
1413 |
my $flagsrequired = shift; |
1307 |
|
1414 |
|
Lines 1433-1449
sub check_api_auth {
Link Here
|
1433 |
if ( $return == 1 ) { |
1540 |
if ( $return == 1 ) { |
1434 |
my ( |
1541 |
my ( |
1435 |
$borrowernumber, $firstname, $surname, |
1542 |
$borrowernumber, $firstname, $surname, |
1436 |
$userflags, $branchcode, $branchname, |
1543 |
$branchcode, $branchname, |
1437 |
$branchprinter, $emailaddress |
1544 |
$branchprinter, $emailaddress |
1438 |
); |
1545 |
); |
1439 |
my $sth = |
1546 |
my $sth = |
1440 |
$dbh->prepare( |
1547 |
$dbh->prepare( |
1441 |
"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=?" |
1548 |
"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=?" |
1442 |
); |
1549 |
); |
1443 |
$sth->execute($userid); |
1550 |
$sth->execute($userid); |
1444 |
( |
1551 |
( |
1445 |
$borrowernumber, $firstname, $surname, |
1552 |
$borrowernumber, $firstname, $surname, |
1446 |
$userflags, $branchcode, $branchname, |
1553 |
$branchcode, $branchname, |
1447 |
$branchprinter, $emailaddress |
1554 |
$branchprinter, $emailaddress |
1448 |
) = $sth->fetchrow if ( $sth->rows ); |
1555 |
) = $sth->fetchrow if ( $sth->rows ); |
1449 |
|
1556 |
|
Lines 1454-1467
sub check_api_auth {
Link Here
|
1454 |
$sth->execute($cardnumber); |
1561 |
$sth->execute($cardnumber); |
1455 |
( |
1562 |
( |
1456 |
$borrowernumber, $firstname, $surname, |
1563 |
$borrowernumber, $firstname, $surname, |
1457 |
$userflags, $branchcode, $branchname, |
1564 |
$branchcode, $branchname, |
1458 |
$branchprinter, $emailaddress |
1565 |
$branchprinter, $emailaddress |
1459 |
) = $sth->fetchrow if ( $sth->rows ); |
1566 |
) = $sth->fetchrow if ( $sth->rows ); |
1460 |
|
1567 |
|
1461 |
unless ( $sth->rows ) { |
1568 |
unless ( $sth->rows ) { |
1462 |
$sth->execute($userid); |
1569 |
$sth->execute($userid); |
1463 |
( |
1570 |
( |
1464 |
$borrowernumber, $firstname, $surname, $userflags, |
1571 |
$borrowernumber, $firstname, $surname, |
1465 |
$branchcode, $branchname, $branchprinter, $emailaddress |
1572 |
$branchcode, $branchname, $branchprinter, $emailaddress |
1466 |
) = $sth->fetchrow if ( $sth->rows ); |
1573 |
) = $sth->fetchrow if ( $sth->rows ); |
1467 |
} |
1574 |
} |
Lines 1495-1501
sub check_api_auth {
Link Here
|
1495 |
$session->param( 'surname', $surname ); |
1602 |
$session->param( 'surname', $surname ); |
1496 |
$session->param( 'branch', $branchcode ); |
1603 |
$session->param( 'branch', $branchcode ); |
1497 |
$session->param( 'branchname', $branchname ); |
1604 |
$session->param( 'branchname', $branchname ); |
1498 |
$session->param( 'flags', $userflags ); |
|
|
1499 |
$session->param( 'emailaddress', $emailaddress ); |
1605 |
$session->param( 'emailaddress', $emailaddress ); |
1500 |
$session->param( 'ip', $session->remote_addr() ); |
1606 |
$session->param( 'ip', $session->remote_addr() ); |
1501 |
$session->param( 'lasttime', time() ); |
1607 |
$session->param( 'lasttime', time() ); |
Lines 1529-1534
sub check_api_auth {
Link Here
|
1529 |
} |
1635 |
} |
1530 |
|
1636 |
|
1531 |
=head2 check_cookie_auth |
1637 |
=head2 check_cookie_auth |
|
|
1638 |
@DEPRECATED See Bug 7174 |
1532 |
|
1639 |
|
1533 |
($status, $sessionId) = check_api_auth($cookie, $userflags); |
1640 |
($status, $sessionId) = check_api_auth($cookie, $userflags); |
1534 |
|
1641 |
|
Lines 1556-1561
Possible return values in C<$status> are:
Link Here
|
1556 |
=cut |
1663 |
=cut |
1557 |
|
1664 |
|
1558 |
sub check_cookie_auth { |
1665 |
sub check_cookie_auth { |
|
|
1666 |
#@DEPRECATED See Bug 7174 |
1559 |
my $cookie = shift; |
1667 |
my $cookie = shift; |
1560 |
my $flagsrequired = shift; |
1668 |
my $flagsrequired = shift; |
1561 |
|
1669 |
|
Lines 1679-1690
sub get_session {
Link Here
|
1679 |
return $session; |
1787 |
return $session; |
1680 |
} |
1788 |
} |
1681 |
|
1789 |
|
|
|
1790 |
#@DEPRECATED See Bug 7174 |
1682 |
sub checkpw { |
1791 |
sub checkpw { |
1683 |
my ( $dbh, $userid, $password, $query, $type ) = @_; |
1792 |
my ( $dbh, $userid, $password, $query, $type ) = @_; |
1684 |
$type = 'opac' unless $type; |
1793 |
$type = 'opac' unless $type; |
1685 |
if ($ldap) { |
1794 |
if ($ldap) { |
1686 |
$debug and print STDERR "## checkpw - checking LDAP\n"; |
1795 |
$debug and print STDERR "## checkpw - checking LDAP\n"; |
1687 |
my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH |
1796 |
my ( $retval, $retcard, $retuserid ) = checkpw_ldap($userid, $password); # EXTERNAL AUTH |
1688 |
return 0 if $retval == -1; # Incorrect password for LDAP login attempt |
1797 |
return 0 if $retval == -1; # Incorrect password for LDAP login attempt |
1689 |
($retval) and return ( $retval, $retcard, $retuserid ); |
1798 |
($retval) and return ( $retval, $retcard, $retuserid ); |
1690 |
} |
1799 |
} |
Lines 1723-1728
sub checkpw {
Link Here
|
1723 |
return checkpw_internal(@_) |
1832 |
return checkpw_internal(@_) |
1724 |
} |
1833 |
} |
1725 |
|
1834 |
|
|
|
1835 |
#@DEPRECATED See Bug 7174 |
1726 |
sub checkpw_internal { |
1836 |
sub checkpw_internal { |
1727 |
my ( $dbh, $userid, $password ) = @_; |
1837 |
my ( $dbh, $userid, $password ) = @_; |
1728 |
|
1838 |
|
Lines 1748-1760
sub checkpw_internal {
Link Here
|
1748 |
$sth->execute($userid); |
1858 |
$sth->execute($userid); |
1749 |
if ( $sth->rows ) { |
1859 |
if ( $sth->rows ) { |
1750 |
my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname, |
1860 |
my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname, |
1751 |
$surname, $branchcode, $branchname, $flags ) |
1861 |
$surname, $branchcode, $branchname ) |
1752 |
= $sth->fetchrow; |
1862 |
= $sth->fetchrow; |
1753 |
|
1863 |
|
1754 |
if ( checkpw_hash( $password, $stored_hash ) ) { |
1864 |
if ( checkpw_hash( $password, $stored_hash ) ) { |
1755 |
|
1865 |
|
1756 |
C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber, |
1866 |
C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber, |
1757 |
$firstname, $surname, $branchcode, $branchname, $flags ); |
1867 |
$firstname, $surname, $branchcode, $branchname ); |
1758 |
return 1, $cardnumber, $userid; |
1868 |
return 1, $cardnumber, $userid; |
1759 |
} |
1869 |
} |
1760 |
} |
1870 |
} |
Lines 1775-1780
sub checkpw_internal {
Link Here
|
1775 |
return 1, $cardnumber, $userid; |
1885 |
return 1, $cardnumber, $userid; |
1776 |
} |
1886 |
} |
1777 |
} |
1887 |
} |
|
|
1888 |
|
1889 |
#@DEPRECATED see Bug 7174. I think the demo-user should be represented with permissions instead of a hard-coded non-borrower anomaly. |
1778 |
if ( $userid && $userid eq 'demo' |
1890 |
if ( $userid && $userid eq 'demo' |
1779 |
&& "$password" eq 'demo' |
1891 |
&& "$password" eq 'demo' |
1780 |
&& C4::Context->config('demo') ) |
1892 |
&& C4::Context->config('demo') ) |
Lines 1787-1792
sub checkpw_internal {
Link Here
|
1787 |
return 0; |
1899 |
return 0; |
1788 |
} |
1900 |
} |
1789 |
|
1901 |
|
|
|
1902 |
#@DEPRECATED See Bug 7174 |
1790 |
sub checkpw_hash { |
1903 |
sub checkpw_hash { |
1791 |
my ( $password, $stored_hash ) = @_; |
1904 |
my ( $password, $stored_hash ) = @_; |
1792 |
|
1905 |
|
Lines 1797-1802
sub checkpw_hash {
Link Here
|
1797 |
if ( substr( $stored_hash, 0, 2 ) eq '$2' ) { |
1910 |
if ( substr( $stored_hash, 0, 2 ) eq '$2' ) { |
1798 |
$hash = hash_password( $password, $stored_hash ); |
1911 |
$hash = hash_password( $password, $stored_hash ); |
1799 |
} else { |
1912 |
} else { |
|
|
1913 |
#@DEPRECATED Digest::MD5, don't use it or you will get hurt. |
1800 |
$hash = md5_base64($password); |
1914 |
$hash = md5_base64($password); |
1801 |
} |
1915 |
} |
1802 |
return $hash eq $stored_hash; |
1916 |
return $hash eq $stored_hash; |
Lines 1820-1826
sub getuserflags {
Link Here
|
1820 |
my $flags = shift; |
1934 |
my $flags = shift; |
1821 |
my $userid = shift; |
1935 |
my $userid = shift; |
1822 |
my $dbh = @_ ? shift : C4::Context->dbh; |
1936 |
my $dbh = @_ ? shift : C4::Context->dbh; |
1823 |
my $userflags; |
|
|
1824 |
{ |
1937 |
{ |
1825 |
# I don't want to do this, but if someone logs in as the database |
1938 |
# I don't want to do this, but if someone logs in as the database |
1826 |
# user, it would be preferable not to spam them to death with |
1939 |
# user, it would be preferable not to spam them to death with |
Lines 1829-1856
sub getuserflags {
Link Here
|
1829 |
$flags += 0; |
1942 |
$flags += 0; |
1830 |
} |
1943 |
} |
1831 |
return get_user_subpermissions($userid); |
1944 |
return get_user_subpermissions($userid); |
1832 |
|
|
|
1833 |
#@DEPRECATED, USE THE Koha::Auth::PermissionManager |
1834 |
my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags"); |
1835 |
$sth->execute; |
1836 |
|
1837 |
while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) { |
1838 |
if ( ( $flags & ( 2**$bit ) ) || $defaulton ) { |
1839 |
$userflags->{$flag} = 1; |
1840 |
} |
1841 |
else { |
1842 |
$userflags->{$flag} = 0; |
1843 |
} |
1844 |
} |
1845 |
|
1846 |
# get subpermissions and merge with top-level permissions |
1847 |
my $user_subperms = get_user_subpermissions($userid); |
1848 |
foreach my $module ( keys %$user_subperms ) { |
1849 |
next if $userflags->{$module} == 1; # user already has permission for everything in this module |
1850 |
$userflags->{$module} = $user_subperms->{$module}; |
1851 |
} |
1852 |
|
1853 |
return $userflags; |
1854 |
} |
1945 |
} |
1855 |
|
1946 |
|
1856 |
=head2 get_user_subpermissions |
1947 |
=head2 get_user_subpermissions |
Lines 1952-1960
sub haspermission {
Link Here
|
1952 |
|
2043 |
|
1953 |
my $flags = getuserflags( undef, $userid ); |
2044 |
my $flags = getuserflags( undef, $userid ); |
1954 |
#Sanitate 1 to * because we no longer have 1's from the koha.borrowers.flags. |
2045 |
#Sanitate 1 to * because we no longer have 1's from the koha.borrowers.flags. |
1955 |
foreach my $module (%$flagsrequired) { |
2046 |
_changeAllPermissionsMarkerToAnyPermissionMarker($flagsrequired); |
1956 |
$flagsrequired->{$module} = '*' if $flagsrequired->{$module} && $flagsrequired->{$module} eq '1'; |
|
|
1957 |
} |
1958 |
|
2047 |
|
1959 |
if ( $userid eq C4::Context->config('user') ) { |
2048 |
if ( $userid eq C4::Context->config('user') ) { |
1960 |
|
2049 |
|
Lines 1989-1995
sub haspermission {
Link Here
|
1989 |
#FIXME - This fcn should return the failed permission so a suitable error msg can be delivered. |
2078 |
#FIXME - This fcn should return the failed permission so a suitable error msg can be delivered. |
1990 |
} |
2079 |
} |
1991 |
|
2080 |
|
|
|
2081 |
=head |
2082 |
@DEPRECATED |
2083 |
Sanitate 1 to * because we no longer have 1's from the koha.borrowers.flags. |
2084 |
=cut |
2085 |
|
2086 |
sub _changeAllPermissionsMarkerToAnyPermissionMarker { |
2087 |
#@DEPRECATED |
2088 |
my ($flagsrequired) = @_; |
2089 |
foreach my $module (%$flagsrequired) { |
2090 |
$flagsrequired->{$module} = '*' if $flagsrequired->{$module} && $flagsrequired->{$module} eq '1'; |
2091 |
} |
2092 |
return $flagsrequired; |
2093 |
} |
2094 |
|
1992 |
sub getborrowernumber { |
2095 |
sub getborrowernumber { |
|
|
2096 |
#@DEPRECATED See Bug 7174 |
1993 |
my ($userid) = @_; |
2097 |
my ($userid) = @_; |
1994 |
my $userenv = C4::Context->userenv; |
2098 |
my $userenv = C4::Context->userenv; |
1995 |
if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) { |
2099 |
if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) { |