|
Lines 19-29
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; |
| 26 |
use Scalar::Util qw(blessed); |
26 |
use Scalar::Util qw(blessed); |
|
|
27 |
use Try::Tiny; |
| 27 |
|
28 |
|
| 28 |
require Exporter; |
29 |
require Exporter; |
| 29 |
use C4::Context; |
30 |
use C4::Context; |
|
Lines 34-39
use C4::Search::History;
Link Here
|
| 34 |
use Koha; |
35 |
use Koha; |
| 35 |
use Koha::Borrowers; |
36 |
use Koha::Borrowers; |
| 36 |
use Koha::AuthUtils qw(hash_password); |
37 |
use Koha::AuthUtils qw(hash_password); |
|
|
38 |
use Koha::Auth; |
| 39 |
use Koha::Auth::Component; |
| 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 639-688
has authenticated.
Link Here
|
| 639 |
|
642 |
|
| 640 |
=cut |
643 |
=cut |
| 641 |
|
644 |
|
|
|
645 |
=head _version_check |
| 646 |
#@DEPRECATED See Bug 7174 |
| 647 |
use Koha::Auth::Component::* instead |
| 648 |
=cut |
| 649 |
|
| 642 |
sub _version_check { |
650 |
sub _version_check { |
| 643 |
my $type = shift; |
651 |
my $type = shift; |
| 644 |
my $query = shift; |
652 |
my $query = shift; |
| 645 |
my $version; |
653 |
my $version; |
| 646 |
|
654 |
|
| 647 |
# If version syspref is unavailable, it means Koha is being installed, |
655 |
try { |
| 648 |
# and so we must redirect to OPAC maintenance page or to the WebInstaller |
656 |
Koha::Auth::Component::checkOPACMaintenance() if ( $type eq 'opac' ); |
| 649 |
# also, if OpacMaintenance is ON, OPAC should redirect to maintenance |
657 |
Koha::Auth::Component::checkVersion(); |
| 650 |
if ( C4::Context->preference('OpacMaintenance') && $type eq 'opac' ) { |
658 |
} catch { |
| 651 |
warn "OPAC Install required, redirecting to maintenance"; |
659 |
if (blessed($_)) { |
| 652 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
660 |
if ($_->isa('Koha::Exception::VersionMismatch')) { |
| 653 |
safe_exit; |
661 |
# check that database and koha version are the same |
| 654 |
} |
662 |
# there is no DB version, it's a fresh install, |
| 655 |
unless ( $version = C4::Context->preference('Version') ) { # assignment, not comparison |
663 |
# go to web installer |
| 656 |
if ( $type ne 'opac' ) { |
664 |
# there is a DB version, compare it to the code version |
| 657 |
warn "Install required, redirecting to Installer"; |
665 |
my $warning = $_->error()." Redirecting to %s."; |
| 658 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
666 |
if ( $type ne 'opac' ) { |
| 659 |
} else { |
667 |
warn sprintf( $warning, 'Installer' ); |
| 660 |
warn "OPAC Install required, redirecting to maintenance"; |
668 |
print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); |
| 661 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
669 |
} else { |
|
|
670 |
warn sprintf( "OPAC: " . $warning, 'maintenance' ); |
| 671 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 672 |
} |
| 673 |
safe_exit; |
| 674 |
} |
| 675 |
elsif ($_->isa('Koha::Exception::ServiceTemporarilyUnavailable')) { |
| 676 |
# also, if OpacMaintenance is ON, OPAC should redirect to maintenance |
| 677 |
warn "OPAC Install required, redirecting to maintenance"; |
| 678 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 679 |
safe_exit; |
| 680 |
} |
| 681 |
elsif ($_->isa('Koha::Exception::BadSystemPreference')) { |
| 682 |
# If version syspref is unavailable, it means Koha is being installed, |
| 683 |
# and so we must redirect to OPAC maintenance page or to the WebInstaller |
| 684 |
if ( $type ne 'opac' ) { |
| 685 |
warn "Install required, redirecting to Installer"; |
| 686 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
| 687 |
} else { |
| 688 |
warn "OPAC Install required, redirecting to maintenance"; |
| 689 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 690 |
} |
| 691 |
safe_exit; |
| 692 |
} |
| 693 |
else { |
| 694 |
warn "Unknown exception class ".ref($_)."\n"; |
| 695 |
die $_; #Unhandled exception case |
| 696 |
} |
| 662 |
} |
697 |
} |
| 663 |
safe_exit; |
698 |
else { |
| 664 |
} |
699 |
die $_; #Not a Koha::Exception-object, so rethrow it |
| 665 |
|
|
|
| 666 |
# check that database and koha version are the same |
| 667 |
# there is no DB version, it's a fresh install, |
| 668 |
# go to web installer |
| 669 |
# there is a DB version, compare it to the code version |
| 670 |
my $kohaversion = Koha::version(); |
| 671 |
|
| 672 |
# remove the 3 last . to have a Perl number |
| 673 |
$kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/; |
| 674 |
$debug and print STDERR "kohaversion : $kohaversion\n"; |
| 675 |
if ( $version < $kohaversion ) { |
| 676 |
my $warning = "Database update needed, redirecting to %s. Database is $version and Koha is $kohaversion"; |
| 677 |
if ( $type ne 'opac' ) { |
| 678 |
warn sprintf( $warning, 'Installer' ); |
| 679 |
print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); |
| 680 |
} else { |
| 681 |
warn sprintf( "OPAC: " . $warning, 'maintenance' ); |
| 682 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 683 |
} |
700 |
} |
| 684 |
safe_exit; |
701 |
}; |
| 685 |
} |
|
|
| 686 |
} |
702 |
} |
| 687 |
|
703 |
|
| 688 |
sub _session_log { |
704 |
sub _session_log { |
|
Lines 702-708
sub _timeout_syspref {
Link Here
|
| 702 |
return $timeout; |
718 |
return $timeout; |
| 703 |
} |
719 |
} |
| 704 |
|
720 |
|
|
|
721 |
=head checkauth |
| 722 |
@DEPRECATED See Bug 7174 |
| 723 |
|
| 724 |
Compatibility layer for old Koha authentication system. |
| 725 |
Tries to authenticate using Koha::Auth, but if no authentication mechanism is |
| 726 |
identified, falls back to the deprecated legacy behaviour. |
| 727 |
=cut |
| 728 |
|
| 705 |
sub checkauth { |
729 |
sub checkauth { |
|
|
730 |
my @params = @_; #Clone params so we don't accidentally change them if we fallback to checkauth_legacy() |
| 731 |
my $query = shift; |
| 732 |
my $authnotrequired = shift; |
| 733 |
my $flagsrequired = shift; |
| 734 |
my $type = shift; |
| 735 |
my $persona = shift; |
| 736 |
|
| 737 |
my $borrower; |
| 738 |
try { |
| 739 |
if (not($authnotrequired) && not($persona)) { |
| 740 |
$borrower = Koha::Auth::authenticate($query, $flagsrequired, {authnotrequired => $authnotrequired}); |
| 741 |
} |
| 742 |
} catch { |
| 743 |
if (blessed($_)) { |
| 744 |
if ($_->isa('Koha::Exception::VersionMismatch')) { |
| 745 |
|
| 746 |
my $warning = $_->error()." Redirecting to %s."; |
| 747 |
if ( $type ne 'opac' ) { |
| 748 |
warn sprintf( $warning, 'Installer' ); |
| 749 |
print $query->redirect("/cgi-bin/koha/installer/install.pl?step=1&op=updatestructure"); |
| 750 |
} else { |
| 751 |
warn sprintf( "OPAC: " . $warning, 'maintenance' ); |
| 752 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 753 |
} |
| 754 |
safe_exit; |
| 755 |
|
| 756 |
} |
| 757 |
elsif ($_->isa('Koha::Exception::BadSystemPreference')) { |
| 758 |
|
| 759 |
if ( $type ne 'opac' ) { |
| 760 |
warn $_->error()." Redirecting to installer."; |
| 761 |
print $query->redirect("/cgi-bin/koha/installer/install.pl"); |
| 762 |
} else { |
| 763 |
warn $_->error()." Redirecting to maintenance."; |
| 764 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 765 |
} |
| 766 |
safe_exit; |
| 767 |
|
| 768 |
} |
| 769 |
elsif ($_->isa('Koha::Exception::LoginFailed')) { |
| 770 |
#TODO:: Return proper legacy values to get_template_and_user() when login fails. |
| 771 |
} |
| 772 |
elsif ($_->isa('Koha::Exception::ServiceTemporarilyUnavailable')) { |
| 773 |
warn $_->error(); |
| 774 |
print $query->redirect("/cgi-bin/koha/maintenance.pl"); |
| 775 |
safe_exit; |
| 776 |
} |
| 777 |
else { |
| 778 |
warn "Unknown exception class ".ref($_)."\n"; |
| 779 |
die $_; #Unhandled exception case |
| 780 |
} |
| 781 |
} |
| 782 |
else { |
| 783 |
die $_; #Not a Koha::Exception-object |
| 784 |
} |
| 785 |
}; |
| 786 |
|
| 787 |
return checkauth_legacy(@params); |
| 788 |
} |
| 789 |
|
| 790 |
=head checkauth_legacy |
| 791 |
@DEPRECATED See Bug 7174 |
| 792 |
|
| 793 |
We are calling this because the given authentication mechanism is not yet supported |
| 794 |
in Koha::Auth. |
| 795 |
|
| 796 |
See checkauth-documentation floating somewhere in this file for info about the |
| 797 |
legacy authentication. |
| 798 |
=cut |
| 799 |
|
| 800 |
sub checkauth_legacy { |
| 706 |
my $query = shift; |
801 |
my $query = shift; |
| 707 |
$debug and warn "Checking Auth"; |
802 |
$debug and warn "Checking Auth"; |
| 708 |
|
803 |
|
|
Lines 1682-1693
sub get_session {
Link Here
|
| 1682 |
return $session; |
1777 |
return $session; |
| 1683 |
} |
1778 |
} |
| 1684 |
|
1779 |
|
|
|
1780 |
#@DEPRECATED See Bug 7174 |
| 1685 |
sub checkpw { |
1781 |
sub checkpw { |
| 1686 |
my ( $dbh, $userid, $password, $query, $type ) = @_; |
1782 |
my ( $dbh, $userid, $password, $query, $type ) = @_; |
| 1687 |
$type = 'opac' unless $type; |
1783 |
$type = 'opac' unless $type; |
| 1688 |
if ($ldap) { |
1784 |
if ($ldap) { |
| 1689 |
$debug and print STDERR "## checkpw - checking LDAP\n"; |
1785 |
$debug and print STDERR "## checkpw - checking LDAP\n"; |
| 1690 |
my ( $retval, $retcard, $retuserid ) = checkpw_ldap(@_); # EXTERNAL AUTH |
1786 |
my ( $retval, $retcard, $retuserid ) = checkpw_ldap($userid, $password); # EXTERNAL AUTH |
| 1691 |
return 0 if $retval == -1; # Incorrect password for LDAP login attempt |
1787 |
return 0 if $retval == -1; # Incorrect password for LDAP login attempt |
| 1692 |
($retval) and return ( $retval, $retcard, $retuserid ); |
1788 |
($retval) and return ( $retval, $retcard, $retuserid ); |
| 1693 |
} |
1789 |
} |
|
Lines 1726-1731
sub checkpw {
Link Here
|
| 1726 |
return checkpw_internal(@_) |
1822 |
return checkpw_internal(@_) |
| 1727 |
} |
1823 |
} |
| 1728 |
|
1824 |
|
|
|
1825 |
#@DEPRECATED See Bug 7174 |
| 1729 |
sub checkpw_internal { |
1826 |
sub checkpw_internal { |
| 1730 |
my ( $dbh, $userid, $password ) = @_; |
1827 |
my ( $dbh, $userid, $password ) = @_; |
| 1731 |
|
1828 |
|
|
Lines 1778-1783
sub checkpw_internal {
Link Here
|
| 1778 |
return 1, $cardnumber, $userid; |
1875 |
return 1, $cardnumber, $userid; |
| 1779 |
} |
1876 |
} |
| 1780 |
} |
1877 |
} |
|
|
1878 |
|
| 1879 |
#@DEPRECATED see Bug 7174. I think the demo-user should be represented with permissions instead of a hard-coded non-borrower anomaly. |
| 1781 |
if ( $userid && $userid eq 'demo' |
1880 |
if ( $userid && $userid eq 'demo' |
| 1782 |
&& "$password" eq 'demo' |
1881 |
&& "$password" eq 'demo' |
| 1783 |
&& C4::Context->config('demo') ) |
1882 |
&& C4::Context->config('demo') ) |
|
Lines 1790-1795
sub checkpw_internal {
Link Here
|
| 1790 |
return 0; |
1889 |
return 0; |
| 1791 |
} |
1890 |
} |
| 1792 |
|
1891 |
|
|
|
1892 |
#@DEPRECATED See Bug 7174 |
| 1793 |
sub checkpw_hash { |
1893 |
sub checkpw_hash { |
| 1794 |
my ( $password, $stored_hash ) = @_; |
1894 |
my ( $password, $stored_hash ) = @_; |
| 1795 |
|
1895 |
|
|
Lines 1800-1805
sub checkpw_hash {
Link Here
|
| 1800 |
if ( substr( $stored_hash, 0, 2 ) eq '$2' ) { |
1900 |
if ( substr( $stored_hash, 0, 2 ) eq '$2' ) { |
| 1801 |
$hash = hash_password( $password, $stored_hash ); |
1901 |
$hash = hash_password( $password, $stored_hash ); |
| 1802 |
} else { |
1902 |
} else { |
|
|
1903 |
#@DEPRECATED Digest::MD5, don't use it or you will get hurt. |
| 1803 |
$hash = md5_base64($password); |
1904 |
$hash = md5_base64($password); |
| 1804 |
} |
1905 |
} |
| 1805 |
return $hash eq $stored_hash; |
1906 |
return $hash eq $stored_hash; |