|
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 317-322
sub get_template_and_user {
Link Here
|
| 317 |
# clear out the search history from the session now that |
320 |
# clear out the search history from the session now that |
| 318 |
# we've saved it to the database |
321 |
# we've saved it to the database |
| 319 |
C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } ); |
322 |
C4::Search::History::set_to_session( { cgi => $in->{'query'}, search_history => [] } ); |
|
|
323 |
|
| 324 |
#If the user didn't have any search history on his account prior to entering here, |
| 325 |
#Make sure the anonymous search history counts. |
| 326 |
$template->param( EnableOpacSearchHistory => 1 ); |
| 320 |
} |
327 |
} |
| 321 |
} elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) { |
328 |
} elsif ( $in->{type} eq 'intranet' and C4::Context->preference('EnableSearchHistory') ) { |
| 322 |
$template->param( EnableSearchHistory => 1 ); |
329 |
$template->param( EnableSearchHistory => 1 ); |
|
Lines 636-685
has authenticated.
Link Here
|
| 636 |
|
643 |
|
| 637 |
=cut |
644 |
=cut |
| 638 |
|
645 |
|
|
|
646 |
=head _version_check |
| 647 |
#@DEPRECATED See Bug 7174 |
| 648 |
use Koha::Auth::Challenge::* instead |
| 649 |
=cut |
| 650 |
|
| 639 |
sub _version_check { |
651 |
sub _version_check { |
|
|
652 |
#@DEPRECATED See Bug 7174 |
| 640 |
my $type = shift; |
653 |
my $type = shift; |
| 641 |
my $query = shift; |
654 |
my $query = shift; |
| 642 |
my $version; |
655 |
my $version; |
| 643 |
|
656 |
|
| 644 |
# If version syspref is unavailable, it means Koha is being installed, |
657 |
try { |
| 645 |
# and so we must redirect to OPAC maintenance page or to the WebInstaller |
658 |
Koha::Auth::Challenge::OPACMaintenance::challenge() if ( $type eq 'opac' ); |
| 646 |
# also, if OpacMaintenance is ON, OPAC should redirect to maintenance |
659 |
Koha::Auth::Challenge::Version::challenge(); |
| 647 |
if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) { |
660 |
} catch { |
| 648 |
warn "OPAC Install required, redirecting to maintenance"; |
661 |
if (blessed($_)) { |
| 649 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
662 |
if ($_->isa('Koha::Exception::VersionMismatch')) { |
| 650 |
safe_exit; |
663 |
# check that database and koha version are the same |
| 651 |
} |
664 |
# there is no DB version, it's a fresh install, |
| 652 |
unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison |
665 |
# go to web installer |
| 653 |
if ( $type ne 'opac' ) { |
666 |
# there is a DB version, compare it to the code version |
| 654 |
warn "Install required, redirecting to Installer"; |
667 |
my $warning = $_->error()." Redirecting to %s."; |
| 655 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
668 |
if ( $type ne 'opac' ) { |
| 656 |
} else { |
669 |
warn sprintf( $warning, 'Installer' ); |
| 657 |
warn "OPAC Install required, redirecting to maintenance"; |
670 |
print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); |
| 658 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
671 |
} else { |
|
|
672 |
warn sprintf( "OPAC: " . $warning, 'maintenance' ); |
| 673 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 674 |
} |
| 675 |
safe_exit; |
| 676 |
} |
| 677 |
elsif ($_->isa('Koha::Exception::ServiceTemporarilyUnavailable')) { |
| 678 |
# also, if OpacMaintenance is ON, OPAC should redirect to maintenance |
| 679 |
warn "OPAC Install required, redirecting to maintenance"; |
| 680 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 681 |
safe_exit; |
| 682 |
} |
| 683 |
elsif ($_->isa('Koha::Exception::BadSystemPreference')) { |
| 684 |
# If version syspref is unavailable, it means Koha is being installed, |
| 685 |
# and so we must redirect to OPAC maintenance page or to the WebInstaller |
| 686 |
if ( $type ne 'opac' ) { |
| 687 |
warn "Install required, redirecting to Installer"; |
| 688 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
| 689 |
} else { |
| 690 |
warn "OPAC Install required, redirecting to maintenance"; |
| 691 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 692 |
} |
| 693 |
safe_exit; |
| 694 |
} |
| 695 |
else { |
| 696 |
warn "Unknown exception class ".ref($_)."\n"; |
| 697 |
die $_->rethrow(); #Unhandled exception case |
| 698 |
} |
| 659 |
} |
699 |
} |
| 660 |
safe_exit; |
700 |
else { |
| 661 |
} |
701 |
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 |
} |
702 |
} |
| 681 |
safe_exit; |
703 |
}; |
| 682 |
} |
|
|
| 683 |
} |
704 |
} |
| 684 |
|
705 |
|
| 685 |
sub _session_log { |
706 |
sub _session_log { |
|
Lines 699-705
sub _timeout_syspref {
Link Here
|
| 699 |
return $timeout; |
720 |
return $timeout; |
| 700 |
} |
721 |
} |
| 701 |
|
722 |
|
|
|
723 |
=head checkauth |
| 724 |
|
| 725 |
Compatibility layer for old Koha authentication system. |
| 726 |
Tries to authenticate using Koha::Auth, but if no authentication mechanism is |
| 727 |
identified, falls back to the deprecated legacy behaviour. |
| 728 |
=cut |
| 729 |
|
| 702 |
sub checkauth { |
730 |
sub checkauth { |
|
|
731 |
my @params = @_; #Clone params so we don't accidentally change them if we fallback to checkauth_legacy() |
| 732 |
my $query = shift; |
| 733 |
my $authnotrequired = shift; |
| 734 |
my $flagsrequired = _changeAllPermissionsMarkerToAnyPermissionMarker(shift); #circulate => 1 is deprecated, only circulate => '*' is supported. |
| 735 |
my $type = shift; |
| 736 |
my $persona = shift; |
| 737 |
|
| 738 |
##Revert to legacy authentication for more complex authentication mechanisms. |
| 739 |
if ($persona && $cas && $shib) { |
| 740 |
return checkauth_legacy(@params); |
| 741 |
} |
| 742 |
|
| 743 |
my ($borrower, $cookie); |
| 744 |
try { |
| 745 |
($borrower, $cookie) = Koha::Auth::authenticate($query, $flagsrequired, {authnotrequired => $authnotrequired}); |
| 746 |
} catch { |
| 747 |
if (blessed($_)) { |
| 748 |
if ($_->isa('Koha::Exception::VersionMismatch')) { |
| 749 |
|
| 750 |
my $warning = $_->error()." Redirecting to %s."; |
| 751 |
if ( $type ne 'opac' ) { |
| 752 |
warn sprintf( $warning, 'Installer' ); |
| 753 |
print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); |
| 754 |
} else { |
| 755 |
warn sprintf( "OPAC: " . $warning, 'maintenance' ); |
| 756 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 757 |
} |
| 758 |
safe_exit; |
| 759 |
|
| 760 |
} |
| 761 |
elsif ($_->isa('Koha::Exception::BadSystemPreference')) { |
| 762 |
|
| 763 |
if ( $type ne 'opac' ) { |
| 764 |
warn $_->error()." Redirecting to installer."; |
| 765 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
| 766 |
} else { |
| 767 |
warn $_->error()." Redirecting to maintenance."; |
| 768 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 769 |
} |
| 770 |
safe_exit; |
| 771 |
|
| 772 |
} |
| 773 |
elsif ($_->isa('Koha::Exception::LoginFailed')) { |
| 774 |
_showLoginPage($query, $type, $query->cookie(-name => 'CGISESSID'), {invalid_username_or_password => 1}, undef); |
| 775 |
} |
| 776 |
elsif ($_->isa('Koha::Exception::NoPermission')) { |
| 777 |
_showLoginPage($query, $type, $query->cookie(-name => 'CGISESSID'), {nopermission => 1}, undef); |
| 778 |
} |
| 779 |
elsif ($_->isa('Koha::Exception::Logout')) { |
| 780 |
_showLoginPage($query, $type, $query->cookie(-name => 'CGISESSID'), {}, undef); |
| 781 |
} |
| 782 |
elsif ($_->isa('Koha::Exception::ServiceTemporarilyUnavailable')) { |
| 783 |
warn $_->error(); |
| 784 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 785 |
safe_exit; |
| 786 |
} |
| 787 |
else { |
| 788 |
warn "Unknown exception class ".ref($_)."\n"; |
| 789 |
$_->rethrow(); #Unhandled exception case |
| 790 |
} |
| 791 |
} |
| 792 |
else { |
| 793 |
die $_; #Not a Koha::Exception-object |
| 794 |
} |
| 795 |
}; |
| 796 |
|
| 797 |
if ($borrower) { #We authenticated succesfully! Emulate the legacy interface for get_template_and_user(); |
| 798 |
my $user = $borrower->userid; |
| 799 |
my $sessionID = $cookie->{value}->[0]; |
| 800 |
my $aa = $borrower->userid; |
| 801 |
my $flags = getuserflags(undef, $borrower->userid, undef) if $borrower->userid; |
| 802 |
return ( $user, $cookie, $sessionID, $flags ); |
| 803 |
} |
| 804 |
} |
| 805 |
|
| 806 |
=head checkauth_legacy |
| 807 |
@DEPRECATED See Bug 7174 |
| 808 |
|
| 809 |
We are calling this because the given authentication mechanism is not yet supported |
| 810 |
in Koha::Auth. |
| 811 |
|
| 812 |
See checkauth-documentation floating somewhere in this file for info about the |
| 813 |
legacy authentication. |
| 814 |
=cut |
| 815 |
|
| 816 |
sub checkauth_legacy { |
| 817 |
#@DEPRECATED See Bug 7174 |
| 703 |
my $query = shift; |
818 |
my $query = shift; |
| 704 |
$debug and warn "Checking Auth"; |
819 |
$debug and warn "Checking Auth"; |
| 705 |
|
820 |
|
|
Lines 989-995
sub checkauth {
Link Here
|
| 989 |
$info{'nopermission'} = 1; |
1104 |
$info{'nopermission'} = 1; |
| 990 |
C4::Context->_unset_userenv($sessionID); |
1105 |
C4::Context->_unset_userenv($sessionID); |
| 991 |
} |
1106 |
} |
| 992 |
my ( $borrowernumber, $firstname, $surname, $userflags, |
1107 |
my ( $borrowernumber, $firstname, $surname, |
| 993 |
$branchcode, $branchname, $branchprinter, $emailaddress ); |
1108 |
$branchcode, $branchname, $branchprinter, $emailaddress ); |
| 994 |
|
1109 |
|
| 995 |
if ( $return == 1 ) { |
1110 |
if ( $return == 1 ) { |
|
Lines 1020-1026
sub checkauth {
Link Here
|
| 1020 |
( $borrowernumber, $firstname, $surname, |
1135 |
( $borrowernumber, $firstname, $surname, |
| 1021 |
$branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow; |
1136 |
$branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow; |
| 1022 |
$debug and print STDERR "AUTH_3 results: " . |
1137 |
$debug and print STDERR "AUTH_3 results: " . |
| 1023 |
"$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n"; |
1138 |
"$cardnumber,$borrowernumber,$userid,$firstname,$surname,$branchcode,$emailaddress\n"; |
| 1024 |
} else { |
1139 |
} else { |
| 1025 |
print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n"; |
1140 |
print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n"; |
| 1026 |
} |
1141 |
} |
|
Lines 1036-1042
sub checkauth {
Link Here
|
| 1036 |
$branchname = GetBranchName($branchcode); |
1151 |
$branchname = GetBranchName($branchcode); |
| 1037 |
} |
1152 |
} |
| 1038 |
my $branches = GetBranches(); |
1153 |
my $branches = GetBranches(); |
| 1039 |
if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) { |
1154 |
if ( C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) { #Why Autolocation cannot work without IndependetBranches?? |
| 1040 |
|
1155 |
|
| 1041 |
# we have to check they are coming from the right ip range |
1156 |
# we have to check they are coming from the right ip range |
| 1042 |
my $domain = $branches->{$branchcode}->{'branchip'}; |
1157 |
my $domain = $branches->{$branchcode}->{'branchip'}; |
|
Lines 1066-1072
sub checkauth {
Link Here
|
| 1066 |
$session->param( 'surname', $surname ); |
1181 |
$session->param( 'surname', $surname ); |
| 1067 |
$session->param( 'branch', $branchcode ); |
1182 |
$session->param( 'branch', $branchcode ); |
| 1068 |
$session->param( 'branchname', $branchname ); |
1183 |
$session->param( 'branchname', $branchname ); |
| 1069 |
$session->param( 'flags', $userflags ); |
|
|
| 1070 |
$session->param( 'emailaddress', $emailaddress ); |
1184 |
$session->param( 'emailaddress', $emailaddress ); |
| 1071 |
$session->param( 'ip', $session->remote_addr() ); |
1185 |
$session->param( 'ip', $session->remote_addr() ); |
| 1072 |
$session->param( 'lasttime', time() ); |
1186 |
$session->param( 'lasttime', time() ); |
|
Lines 1149-1154
sub checkauth {
Link Here
|
| 1149 |
# |
1263 |
# |
| 1150 |
|
1264 |
|
| 1151 |
# get the inputs from the incoming query |
1265 |
# get the inputs from the incoming query |
|
|
1266 |
_showLoginPage($query, $type, $cookie, \%info, $casparam); |
| 1267 |
} |
| 1268 |
|
| 1269 |
sub _showLoginPage { |
| 1270 |
my ($query, $type, $cookie, $info, $casparam) = @_; |
| 1271 |
|
| 1152 |
my @inputs = (); |
1272 |
my @inputs = (); |
| 1153 |
foreach my $name ( param $query) { |
1273 |
foreach my $name ( param $query) { |
| 1154 |
(next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' ); |
1274 |
(next) if ( $name eq 'userid' || $name eq 'password' || $name eq 'ticket' ); |
|
Lines 1200-1206
sub checkauth {
Link Here
|
| 1200 |
IntranetUserJS => C4::Context->preference("IntranetUserJS"), |
1320 |
IntranetUserJS => C4::Context->preference("IntranetUserJS"), |
| 1201 |
IndependentBranches => C4::Context->preference("IndependentBranches"), |
1321 |
IndependentBranches => C4::Context->preference("IndependentBranches"), |
| 1202 |
AutoLocation => C4::Context->preference("AutoLocation"), |
1322 |
AutoLocation => C4::Context->preference("AutoLocation"), |
| 1203 |
wrongip => $info{'wrongip'}, |
1323 |
wrongip => $info->{'wrongip'}, |
| 1204 |
PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"), |
1324 |
PatronSelfRegistration => C4::Context->preference("PatronSelfRegistration"), |
| 1205 |
PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"), |
1325 |
PatronSelfRegistrationDefaultCategory => C4::Context->preference("PatronSelfRegistrationDefaultCategory"), |
| 1206 |
persona => C4::Context->preference("Persona"), |
1326 |
persona => C4::Context->preference("Persona"), |
|
Lines 1208-1214
sub checkauth {
Link Here
|
| 1208 |
); |
1328 |
); |
| 1209 |
|
1329 |
|
| 1210 |
$template->param( OpacPublic => C4::Context->preference("OpacPublic") ); |
1330 |
$template->param( OpacPublic => C4::Context->preference("OpacPublic") ); |
| 1211 |
$template->param( loginprompt => 1 ) unless $info{'nopermission'}; |
1331 |
$template->param( loginprompt => 1 ) unless $info->{'nopermission'}; |
| 1212 |
|
1332 |
|
| 1213 |
if ( $type eq 'opac' ) { |
1333 |
if ( $type eq 'opac' ) { |
| 1214 |
require C4::VirtualShelves; |
1334 |
require C4::VirtualShelves; |
|
Lines 1238-1244
sub checkauth {
Link Here
|
| 1238 |
} |
1358 |
} |
| 1239 |
|
1359 |
|
| 1240 |
$template->param( |
1360 |
$template->param( |
| 1241 |
invalidCasLogin => $info{'invalidCasLogin'} |
1361 |
invalidCasLogin => $info->{'invalidCasLogin'} |
| 1242 |
); |
1362 |
); |
| 1243 |
} |
1363 |
} |
| 1244 |
|
1364 |
|
|
Lines 1254-1260
sub checkauth {
Link Here
|
| 1254 |
url => $self_url, |
1374 |
url => $self_url, |
| 1255 |
LibraryName => C4::Context->preference("LibraryName"), |
1375 |
LibraryName => C4::Context->preference("LibraryName"), |
| 1256 |
); |
1376 |
); |
| 1257 |
$template->param(%info); |
1377 |
$template->param(%$info); |
| 1258 |
|
1378 |
|
| 1259 |
# $cookie = $query->cookie(CGISESSID => $session->id |
1379 |
# $cookie = $query->cookie(CGISESSID => $session->id |
| 1260 |
# ); |
1380 |
# ); |
|
Lines 1268-1273
sub checkauth {
Link Here
|
| 1268 |
} |
1388 |
} |
| 1269 |
|
1389 |
|
| 1270 |
=head2 check_api_auth |
1390 |
=head2 check_api_auth |
|
|
1391 |
@DEPRECATED See Bug 7174 |
| 1271 |
|
1392 |
|
| 1272 |
($status, $cookie, $sessionId) = check_api_auth($query, $userflags); |
1393 |
($status, $cookie, $sessionId) = check_api_auth($query, $userflags); |
| 1273 |
|
1394 |
|
|
Lines 1302-1307
Possible return values in C<$status> are:
Link Here
|
| 1302 |
=cut |
1423 |
=cut |
| 1303 |
|
1424 |
|
| 1304 |
sub check_api_auth { |
1425 |
sub check_api_auth { |
|
|
1426 |
#@DEPRECATED See Bug 7174 |
| 1305 |
my $query = shift; |
1427 |
my $query = shift; |
| 1306 |
my $flagsrequired = shift; |
1428 |
my $flagsrequired = shift; |
| 1307 |
|
1429 |
|
|
Lines 1433-1449
sub check_api_auth {
Link Here
|
| 1433 |
if ( $return == 1 ) { |
1555 |
if ( $return == 1 ) { |
| 1434 |
my ( |
1556 |
my ( |
| 1435 |
$borrowernumber, $firstname, $surname, |
1557 |
$borrowernumber, $firstname, $surname, |
| 1436 |
$userflags, $branchcode, $branchname, |
1558 |
$branchcode, $branchname, |
| 1437 |
$branchprinter, $emailaddress |
1559 |
$branchprinter, $emailaddress |
| 1438 |
); |
1560 |
); |
| 1439 |
my $sth = |
1561 |
my $sth = |
| 1440 |
$dbh->prepare( |
1562 |
$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=?" |
1563 |
"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 |
); |
1564 |
); |
| 1443 |
$sth->execute($userid); |
1565 |
$sth->execute($userid); |
| 1444 |
( |
1566 |
( |
| 1445 |
$borrowernumber, $firstname, $surname, |
1567 |
$borrowernumber, $firstname, $surname, |
| 1446 |
$userflags, $branchcode, $branchname, |
1568 |
$branchcode, $branchname, |
| 1447 |
$branchprinter, $emailaddress |
1569 |
$branchprinter, $emailaddress |
| 1448 |
) = $sth->fetchrow if ( $sth->rows ); |
1570 |
) = $sth->fetchrow if ( $sth->rows ); |
| 1449 |
|
1571 |
|
|
Lines 1454-1467
sub check_api_auth {
Link Here
|
| 1454 |
$sth->execute($cardnumber); |
1576 |
$sth->execute($cardnumber); |
| 1455 |
( |
1577 |
( |
| 1456 |
$borrowernumber, $firstname, $surname, |
1578 |
$borrowernumber, $firstname, $surname, |
| 1457 |
$userflags, $branchcode, $branchname, |
1579 |
$branchcode, $branchname, |
| 1458 |
$branchprinter, $emailaddress |
1580 |
$branchprinter, $emailaddress |
| 1459 |
) = $sth->fetchrow if ( $sth->rows ); |
1581 |
) = $sth->fetchrow if ( $sth->rows ); |
| 1460 |
|
1582 |
|
| 1461 |
unless ( $sth->rows ) { |
1583 |
unless ( $sth->rows ) { |
| 1462 |
$sth->execute($userid); |
1584 |
$sth->execute($userid); |
| 1463 |
( |
1585 |
( |
| 1464 |
$borrowernumber, $firstname, $surname, $userflags, |
1586 |
$borrowernumber, $firstname, $surname, |
| 1465 |
$branchcode, $branchname, $branchprinter, $emailaddress |
1587 |
$branchcode, $branchname, $branchprinter, $emailaddress |
| 1466 |
) = $sth->fetchrow if ( $sth->rows ); |
1588 |
) = $sth->fetchrow if ( $sth->rows ); |
| 1467 |
} |
1589 |
} |
|
Lines 1495-1501
sub check_api_auth {
Link Here
|
| 1495 |
$session->param( 'surname', $surname ); |
1617 |
$session->param( 'surname', $surname ); |
| 1496 |
$session->param( 'branch', $branchcode ); |
1618 |
$session->param( 'branch', $branchcode ); |
| 1497 |
$session->param( 'branchname', $branchname ); |
1619 |
$session->param( 'branchname', $branchname ); |
| 1498 |
$session->param( 'flags', $userflags ); |
|
|
| 1499 |
$session->param( 'emailaddress', $emailaddress ); |
1620 |
$session->param( 'emailaddress', $emailaddress ); |
| 1500 |
$session->param( 'ip', $session->remote_addr() ); |
1621 |
$session->param( 'ip', $session->remote_addr() ); |
| 1501 |
$session->param( 'lasttime', time() ); |
1622 |
$session->param( 'lasttime', time() ); |
|
Lines 1529-1534
sub check_api_auth {
Link Here
|
| 1529 |
} |
1650 |
} |
| 1530 |
|
1651 |
|
| 1531 |
=head2 check_cookie_auth |
1652 |
=head2 check_cookie_auth |
|
|
1653 |
@DEPRECATED See Bug 7174 |
| 1532 |
|
1654 |
|
| 1533 |
($status, $sessionId) = check_api_auth($cookie, $userflags); |
1655 |
($status, $sessionId) = check_api_auth($cookie, $userflags); |
| 1534 |
|
1656 |
|
|
Lines 1556-1561
Possible return values in C<$status> are:
Link Here
|
| 1556 |
=cut |
1678 |
=cut |
| 1557 |
|
1679 |
|
| 1558 |
sub check_cookie_auth { |
1680 |
sub check_cookie_auth { |
|
|
1681 |
#@DEPRECATED See Bug 7174 |
| 1559 |
my $cookie = shift; |
1682 |
my $cookie = shift; |
| 1560 |
my $flagsrequired = shift; |
1683 |
my $flagsrequired = shift; |
| 1561 |
|
1684 |
|
|
Lines 1679-1690
sub get_session {
Link Here
|
| 1679 |
return $session; |
1802 |
return $session; |
| 1680 |
} |
1803 |
} |
| 1681 |
|
1804 |
|
|
|
1805 |
#@DEPRECATED See Bug 7174 |
| 1682 |
sub checkpw { |
1806 |
sub checkpw { |
| 1683 |
my ( $dbh, $userid, $password, $query, $type ) = @_; |
1807 |
my ( $dbh, $userid, $password, $query, $type ) = @_; |
| 1684 |
$type = 'opac' unless $type; |
1808 |
$type = 'opac' unless $type; |
| 1685 |
if ($ldap) { |
1809 |
if ($ldap) { |
| 1686 |
$debug and print STDERR "## checkpw - checking LDAP\n"; |
1810 |
$debug and print STDERR "## checkpw - checking LDAP\n"; |
| 1687 |
my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH |
1811 |
my ( $retval, $retcard, $retuserid ) = checkpw_ldap($userid, $password); # EXTERNAL AUTH |
| 1688 |
return 0 if $retval == -1; # Incorrect password for LDAP login attempt |
1812 |
return 0 if $retval == -1; # Incorrect password for LDAP login attempt |
| 1689 |
($retval) and return ( $retval, $retcard, $retuserid ); |
1813 |
($retval) and return ( $retval, $retcard, $retuserid ); |
| 1690 |
} |
1814 |
} |
|
Lines 1723-1728
sub checkpw {
Link Here
|
| 1723 |
return checkpw_internal(@_) |
1847 |
return checkpw_internal(@_) |
| 1724 |
} |
1848 |
} |
| 1725 |
|
1849 |
|
|
|
1850 |
#@DEPRECATED See Bug 7174 |
| 1726 |
sub checkpw_internal { |
1851 |
sub checkpw_internal { |
| 1727 |
my ( $dbh, $userid, $password ) = @_; |
1852 |
my ( $dbh, $userid, $password ) = @_; |
| 1728 |
|
1853 |
|
|
Lines 1748-1760
sub checkpw_internal {
Link Here
|
| 1748 |
$sth->execute($userid); |
1873 |
$sth->execute($userid); |
| 1749 |
if ( $sth->rows ) { |
1874 |
if ( $sth->rows ) { |
| 1750 |
my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname, |
1875 |
my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname, |
| 1751 |
$surname, $branchcode, $branchname, $flags ) |
1876 |
$surname, $branchcode, $branchname ) |
| 1752 |
= $sth->fetchrow; |
1877 |
= $sth->fetchrow; |
| 1753 |
|
1878 |
|
| 1754 |
if ( checkpw_hash( $password, $stored_hash ) ) { |
1879 |
if ( checkpw_hash( $password, $stored_hash ) ) { |
| 1755 |
|
1880 |
|
| 1756 |
C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber, |
1881 |
C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber, |
| 1757 |
$firstname, $surname, $branchcode, $branchname, $flags ); |
1882 |
$firstname, $surname, $branchcode, $branchname ); |
| 1758 |
return 1, $cardnumber, $userid; |
1883 |
return 1, $cardnumber, $userid; |
| 1759 |
} |
1884 |
} |
| 1760 |
} |
1885 |
} |
|
Lines 1775-1780
sub checkpw_internal {
Link Here
|
| 1775 |
return 1, $cardnumber, $userid; |
1900 |
return 1, $cardnumber, $userid; |
| 1776 |
} |
1901 |
} |
| 1777 |
} |
1902 |
} |
|
|
1903 |
|
| 1904 |
#@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' |
1905 |
if ( $userid && $userid eq 'demo' |
| 1779 |
&& "$password" eq 'demo' |
1906 |
&& "$password" eq 'demo' |
| 1780 |
&& C4::Context->config('demo') ) |
1907 |
&& C4::Context->config('demo') ) |
|
Lines 1787-1792
sub checkpw_internal {
Link Here
|
| 1787 |
return 0; |
1914 |
return 0; |
| 1788 |
} |
1915 |
} |
| 1789 |
|
1916 |
|
|
|
1917 |
#@DEPRECATED See Bug 7174 |
| 1790 |
sub checkpw_hash { |
1918 |
sub checkpw_hash { |
| 1791 |
my ( $password, $stored_hash ) = @_; |
1919 |
my ( $password, $stored_hash ) = @_; |
| 1792 |
|
1920 |
|
|
Lines 1797-1802
sub checkpw_hash {
Link Here
|
| 1797 |
if ( substr( $stored_hash, 0, 2 ) eq '$2' ) { |
1925 |
if ( substr( $stored_hash, 0, 2 ) eq '$2' ) { |
| 1798 |
$hash = hash_password( $password, $stored_hash ); |
1926 |
$hash = hash_password( $password, $stored_hash ); |
| 1799 |
} else { |
1927 |
} else { |
|
|
1928 |
#@DEPRECATED Digest::MD5, don't use it or you will get hurt. |
| 1800 |
$hash = md5_base64($password); |
1929 |
$hash = md5_base64($password); |
| 1801 |
} |
1930 |
} |
| 1802 |
return $hash eq $stored_hash; |
1931 |
return $hash eq $stored_hash; |
|
Lines 1820-1826
sub getuserflags {
Link Here
|
| 1820 |
my $flags = shift; |
1949 |
my $flags = shift; |
| 1821 |
my $userid = shift; |
1950 |
my $userid = shift; |
| 1822 |
my $dbh = @_ ? shift : C4::Context->dbh; |
1951 |
my $dbh = @_ ? shift : C4::Context->dbh; |
| 1823 |
my $userflags; |
|
|
| 1824 |
{ |
1952 |
{ |
| 1825 |
# I don't want to do this, but if someone logs in as the database |
1953 |
# 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 |
1954 |
# user, it would be preferable not to spam them to death with |
|
Lines 1829-1856
sub getuserflags {
Link Here
|
| 1829 |
$flags += 0; |
1957 |
$flags += 0; |
| 1830 |
} |
1958 |
} |
| 1831 |
return get_user_subpermissions($userid); |
1959 |
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 |
} |
1960 |
} |
| 1855 |
|
1961 |
|
| 1856 |
=head2 get_user_subpermissions |
1962 |
=head2 get_user_subpermissions |
|
Lines 1952-1960
sub haspermission {
Link Here
|
| 1952 |
|
2058 |
|
| 1953 |
my $flags = getuserflags( undef, $userid ); |
2059 |
my $flags = getuserflags( undef, $userid ); |
| 1954 |
#Sanitate 1 to * because we no longer have 1's from the koha.borrowers.flags. |
2060 |
#Sanitate 1 to * because we no longer have 1's from the koha.borrowers.flags. |
| 1955 |
foreach my $module (%$flagsrequired) { |
2061 |
_changeAllPermissionsMarkerToAnyPermissionMarker($flagsrequired); |
| 1956 |
$flagsrequired->{$module} = '*' if $flagsrequired->{$module} && $flagsrequired->{$module} eq '1'; |
|
|
| 1957 |
} |
| 1958 |
|
2062 |
|
| 1959 |
if ( $userid eq C4::Context->config('user') ) { |
2063 |
if ( $userid eq C4::Context->config('user') ) { |
| 1960 |
|
2064 |
|
|
Lines 1989-1995
sub haspermission {
Link Here
|
| 1989 |
#FIXME - This fcn should return the failed permission so a suitable error msg can be delivered. |
2093 |
#FIXME - This fcn should return the failed permission so a suitable error msg can be delivered. |
| 1990 |
} |
2094 |
} |
| 1991 |
|
2095 |
|
|
|
2096 |
=head |
| 2097 |
@DEPRECATED |
| 2098 |
Sanitate 1 to * because we no longer have 1's from the koha.borrowers.flags. |
| 2099 |
=cut |
| 2100 |
|
| 2101 |
sub _changeAllPermissionsMarkerToAnyPermissionMarker { |
| 2102 |
#@DEPRECATED |
| 2103 |
my ($flagsrequired) = @_; |
| 2104 |
foreach my $module (%$flagsrequired) { |
| 2105 |
$flagsrequired->{$module} = '*' if $flagsrequired->{$module} && $flagsrequired->{$module} eq '1'; |
| 2106 |
} |
| 2107 |
return $flagsrequired; |
| 2108 |
} |
| 2109 |
|
| 1992 |
sub getborrowernumber { |
2110 |
sub getborrowernumber { |
|
|
2111 |
#@DEPRECATED See Bug 7174 |
| 1993 |
my ($userid) = @_; |
2112 |
my ($userid) = @_; |
| 1994 |
my $userenv = C4::Context->userenv; |
2113 |
my $userenv = C4::Context->userenv; |
| 1995 |
if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) { |
2114 |
if ( defined($userenv) && ref($userenv) eq 'HASH' && $userenv->{number} ) { |