View | Details | Raw Unified | Return to bug 7174
Collapse All | Expand All

(-)a/C4/Auth.pm (-81 / +200 lines)
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} ) {
(-)a/C4/Auth_with_ldap.pm (-1 / +10 lines)
Lines 103-110 sub search_method { Link Here
103
    return $search;
103
    return $search;
104
}
104
}
105
105
106
=head checkpw_ldap
107
108
@RETURNS Integer, -1 if login failed
109
                , 0 if connection to the LDAP server couldn't be reliably established.
110
		 or List of (-1|1|0, $cardnumber, $local_userid);
111
		 where $cardnumber is koha.borrowers.cardnumber
112
		       $local_userid is the koha.borrowers.userid
113
=cut
114
106
sub checkpw_ldap {
115
sub checkpw_ldap {
107
    my ($dbh, $userid, $password) = @_;
116
    my ($userid, $password) = @_;
108
    my @hosts = split(',', $prefhost);
117
    my @hosts = split(',', $prefhost);
109
    my $db = Net::LDAP->new(\@hosts);
118
    my $db = Net::LDAP->new(\@hosts);
110
    unless ( $db ) {
119
    unless ( $db ) {
(-)a/C4/Context.pm (-4 / +5 lines)
Lines 1055-1061 sub userenv { Link Here
1055
1055
1056
  C4::Context->set_userenv($usernum, $userid, $usercnum,
1056
  C4::Context->set_userenv($usernum, $userid, $usercnum,
1057
                           $userfirstname, $usersurname,
1057
                           $userfirstname, $usersurname,
1058
                           $userbranch, $branchname, $userflags,
1058
                           $userbranch, $branchname, $superlibrarian,
1059
                           $emailaddress, $branchprinter, $persona);
1059
                           $emailaddress, $branchprinter, $persona);
1060
1060
1061
Establish a hash of user environment variables.
1061
Establish a hash of user environment variables.
Lines 1067-1073 set_userenv is called in Auth.pm Link Here
1067
#'
1067
#'
1068
sub set_userenv {
1068
sub set_userenv {
1069
    shift @_;
1069
    shift @_;
1070
    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter, $persona, $shibboleth)=
1070
    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $superlibrarian, $emailaddress, $branchprinter, $persona, $shibboleth)=
1071
    map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here
1071
    map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here
1072
    @_;
1072
    @_;
1073
    my $var=$context->{"activeuser"} || '';
1073
    my $var=$context->{"activeuser"} || '';
Lines 1080-1086 sub set_userenv { Link Here
1080
        #possibly a law problem
1080
        #possibly a law problem
1081
        "branch"     => $userbranch,
1081
        "branch"     => $userbranch,
1082
        "branchname" => $branchname,
1082
        "branchname" => $branchname,
1083
        "flags"      => $userflags,
1083
        "flags"      => $superlibrarian, #@DEPRECATED, use Koha::Borrower->isSuperlibrarian() instead of flags
1084
        "emailaddress"     => $emailaddress,
1084
        "emailaddress"     => $emailaddress,
1085
        "branchprinter"    => $branchprinter,
1085
        "branchprinter"    => $branchprinter,
1086
        "persona"    => $persona,
1086
        "persona"    => $persona,
Lines 1195-1200 sub tz { Link Here
1195
1195
1196
1196
1197
=head2 IsSuperLibrarian
1197
=head2 IsSuperLibrarian
1198
@DEPRECATED, use Koha::Borrower->isSuperlibrarian()
1198
1199
1199
    C4::Context->IsSuperLibrarian();
1200
    C4::Context->IsSuperLibrarian();
1200
1201
Lines 1211-1217 sub IsSuperLibrarian { Link Here
1211
        return 1;
1212
        return 1;
1212
    }
1213
    }
1213
1214
1214
    return ($userenv->{flags}//0) % 2;
1215
    return ($userenv->{flags}//0) % 2; #If flags == 1, this is true.
1215
}
1216
}
1216
1217
1217
=head2 interface
1218
=head2 interface
(-)a/t/db_dependent/Auth_with_ldap.t (-10 / +9 lines)
Lines 74-80 subtest "checkpw_ldap tests" => sub { Link Here
74
74
75
    ## Connection fail tests
75
    ## Connection fail tests
76
    $desired_connection_result = 'error';
76
    $desired_connection_result = 'error';
77
    warning_is { $ret = C4::Auth_with_ldap::checkpw_ldap( $dbh, 'hola', password => 'hey' ) }
77
    warning_is { $ret = C4::Auth_with_ldap::checkpw_ldap( 'hola', password => 'hey' ) }
78
        "LDAP connexion failed",
78
        "LDAP connexion failed",
79
        "checkpw_ldap prints correct warning if LDAP conexion fails";
79
        "checkpw_ldap prints correct warning if LDAP conexion fails";
80
    is( $ret, 0, "checkpw_ldap returns 0 if LDAP conexion fails");
80
    is( $ret, 0, "checkpw_ldap returns 0 if LDAP conexion fails");
Lines 96-102 subtest "checkpw_ldap tests" => sub { Link Here
96
96
97
97
98
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
98
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
99
                               $dbh, 'hola', password => 'hey' ) }
99
                               'hola', password => 'hey' ) }
100
                    qr/Anonymous LDAP bind failed: LDAP error #1: error_name/,
100
                    qr/Anonymous LDAP bind failed: LDAP error #1: error_name/,
101
                    "checkpw_ldap prints correct warning if LDAP anonymous bind fails";
101
                    "checkpw_ldap prints correct warning if LDAP anonymous bind fails";
102
        is( $ret, 0, "checkpw_ldap returns 0 if LDAP anonymous bind fails");
102
        is( $ret, 0, "checkpw_ldap returns 0 if LDAP anonymous bind fails");
Lines 108-121 subtest "checkpw_ldap tests" => sub { Link Here
108
        $desired_count_result  = 0; # user auth problem
108
        $desired_count_result  = 0; # user auth problem
109
        $non_anonymous_bind_result = 'success';
109
        $non_anonymous_bind_result = 'success';
110
        reload_ldap_module();
110
        reload_ldap_module();
111
        is ( C4::Auth_with_ldap::checkpw_ldap( $dbh, 'hola', password => 'hey' ),
111
        is ( C4::Auth_with_ldap::checkpw_ldap( 'hola', password => 'hey' ),
112
            0, "checkpw_ldap returns 0 if user lookup returns 0");
112
            0, "checkpw_ldap returns 0 if user lookup returns 0");
113
113
114
        $non_anonymous_bind_result = 'error';
114
        $non_anonymous_bind_result = 'error';
115
        reload_ldap_module();
115
        reload_ldap_module();
116
116
117
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
117
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
118
                               $dbh, 'hola', password => 'hey' ) }
118
                               'hola', password => 'hey' ) }
119
                    qr/LDAP bind failed as kohauser hola: LDAP error #1: error_name/,
119
                    qr/LDAP bind failed as kohauser hola: LDAP error #1: error_name/,
120
                    "checkpw_ldap prints correct warning if LDAP bind fails";
120
                    "checkpw_ldap prints correct warning if LDAP bind fails";
121
        is ( $ret, -1, "checkpw_ldap returns -1 LDAP bind fails for user (Bug 8148)");
121
        is ( $ret, -1, "checkpw_ldap returns -1 LDAP bind fails for user (Bug 8148)");
Lines 130-136 subtest "checkpw_ldap tests" => sub { Link Here
130
        reload_ldap_module();
130
        reload_ldap_module();
131
131
132
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
132
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
133
                               $dbh, 'hola', password => 'hey' ) }
133
                               'hola', password => 'hey' ) }
134
                    qr/LDAP bind failed as kohauser hola: LDAP error #1: error_name/,
134
                    qr/LDAP bind failed as kohauser hola: LDAP error #1: error_name/,
135
                    "checkpw_ldap prints correct warning if LDAP bind fails";
135
                    "checkpw_ldap prints correct warning if LDAP bind fails";
136
        is ( $ret, 0, "checkpw_ldap returns 0 LDAP bind fails for user (Bug 12831)");
136
        is ( $ret, 0, "checkpw_ldap returns 0 LDAP bind fails for user (Bug 12831)");
Lines 150-156 subtest "checkpw_ldap tests" => sub { Link Here
150
        reload_ldap_module();
150
        reload_ldap_module();
151
151
152
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
152
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
153
                               $dbh, 'hola', password => 'hey' ) }
153
                               'hola', password => 'hey' ) }
154
                    qr/LDAP bind failed as ldapuser cn=Manager,dc=metavore,dc=com: LDAP error #1: error_name/,
154
                    qr/LDAP bind failed as ldapuser cn=Manager,dc=metavore,dc=com: LDAP error #1: error_name/,
155
                    "checkpw_ldap prints correct warning if LDAP bind fails";
155
                    "checkpw_ldap prints correct warning if LDAP bind fails";
156
        is ( $ret, 0, "checkpw_ldap returns 0 if bind fails");
156
        is ( $ret, 0, "checkpw_ldap returns 0 if bind fails");
Lines 162-168 subtest "checkpw_ldap tests" => sub { Link Here
162
        reload_ldap_module();
162
        reload_ldap_module();
163
163
164
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
164
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
165
                               $dbh, 'hola', password => 'hey' ) }
165
                               'hola', password => 'hey' ) }
166
                    qr/LDAP Auth rejected : invalid password for user 'hola'. LDAP error #1: error_name/,
166
                    qr/LDAP Auth rejected : invalid password for user 'hola'. LDAP error #1: error_name/,
167
                    "checkpw_ldap prints correct warning if LDAP bind fails";
167
                    "checkpw_ldap prints correct warning if LDAP bind fails";
168
        is ( $ret, -1, "checkpw_ldap returns -1 if bind fails (Bug 8148)");
168
        is ( $ret, -1, "checkpw_ldap returns -1 if bind fails (Bug 8148)");
Lines 175-181 subtest "checkpw_ldap tests" => sub { Link Here
175
        reload_ldap_module();
175
        reload_ldap_module();
176
176
177
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
177
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
178
                               $dbh, 'hola', password => 'hey' ) }
178
                               'hola', password => 'hey' ) }
179
                    qr/LDAP bind failed as ldapuser cn=Manager,dc=metavore,dc=com: LDAP error #1: error_name/,
179
                    qr/LDAP bind failed as ldapuser cn=Manager,dc=metavore,dc=com: LDAP error #1: error_name/,
180
                    "checkpw_ldap prints correct warning if LDAP bind fails";
180
                    "checkpw_ldap prints correct warning if LDAP bind fails";
181
        is ( $ret, 0, "checkpw_ldap returns 0 if bind fails");
181
        is ( $ret, 0, "checkpw_ldap returns 0 if bind fails");
Lines 187-193 subtest "checkpw_ldap tests" => sub { Link Here
187
        reload_ldap_module();
187
        reload_ldap_module();
188
188
189
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
189
        warning_like { $ret = C4::Auth_with_ldap::checkpw_ldap(
190
                               $dbh, 'hola', password => 'hey' ) }
190
                               'hola', password => 'hey' ) }
191
                    qr/LDAP Auth rejected : invalid password for user 'hola'. LDAP error #1: error_name/,
191
                    qr/LDAP Auth rejected : invalid password for user 'hola'. LDAP error #1: error_name/,
192
                    "checkpw_ldap prints correct warning if LDAP bind fails";
192
                    "checkpw_ldap prints correct warning if LDAP bind fails";
193
        is ( $ret, -1, "checkpw_ldap returns -1 if bind fails (Bug 8148)");
193
        is ( $ret, -1, "checkpw_ldap returns -1 if bind fails (Bug 8148)");
194
- 

Return to bug 7174