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 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} ) {
(-)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 1073-1079 sub userenv { Link Here
1073
1073
1074
  C4::Context->set_userenv($usernum, $userid, $usercnum,
1074
  C4::Context->set_userenv($usernum, $userid, $usercnum,
1075
                           $userfirstname, $usersurname,
1075
                           $userfirstname, $usersurname,
1076
                           $userbranch, $branchname, $userflags,
1076
                           $userbranch, $branchname, $superlibrarian,
1077
                           $emailaddress, $branchprinter, $persona);
1077
                           $emailaddress, $branchprinter, $persona);
1078
1078
1079
Establish a hash of user environment variables.
1079
Establish a hash of user environment variables.
Lines 1085-1091 set_userenv is called in Auth.pm Link Here
1085
#'
1085
#'
1086
sub set_userenv {
1086
sub set_userenv {
1087
    shift @_;
1087
    shift @_;
1088
    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter, $persona, $shibboleth)=
1088
    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $superlibrarian, $emailaddress, $branchprinter, $persona, $shibboleth)=
1089
    map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here
1089
    map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here
1090
    @_;
1090
    @_;
1091
    my $var=$context->{"activeuser"} || '';
1091
    my $var=$context->{"activeuser"} || '';
Lines 1098-1104 sub set_userenv { Link Here
1098
        #possibly a law problem
1098
        #possibly a law problem
1099
        "branch"     => $userbranch,
1099
        "branch"     => $userbranch,
1100
        "branchname" => $branchname,
1100
        "branchname" => $branchname,
1101
        "flags"      => $userflags,
1101
        "flags"      => $superlibrarian, #@DEPRECATED, use Koha::Borrower->isSuperlibrarian() instead of flags
1102
        "emailaddress"     => $emailaddress,
1102
        "emailaddress"     => $emailaddress,
1103
        "branchprinter"    => $branchprinter,
1103
        "branchprinter"    => $branchprinter,
1104
        "persona"    => $persona,
1104
        "persona"    => $persona,
Lines 1213-1218 sub tz { Link Here
1213
1213
1214
1214
1215
=head2 IsSuperLibrarian
1215
=head2 IsSuperLibrarian
1216
@DEPRECATED, use Koha::Borrower->isSuperlibrarian()
1216
1217
1217
    C4::Context->IsSuperLibrarian();
1218
    C4::Context->IsSuperLibrarian();
1218
1219
Lines 1229-1235 sub IsSuperLibrarian { Link Here
1229
        return 1;
1230
        return 1;
1230
    }
1231
    }
1231
1232
1232
    return ($userenv->{flags}//0) % 2;
1233
    return ($userenv->{flags}//0) % 2; #If flags == 1, this is true.
1233
}
1234
}
1234
1235
1235
=head2 interface
1236
=head2 interface
(-)a/Koha/Auth.pm (+227 lines)
Line 0 Link Here
1
package Koha::Auth;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
#Define common packages
21
use Modern::Perl;
22
use Scalar::Util qw(blessed);
23
use Try::Tiny;
24
25
#Define Koha packages
26
use Koha::Auth::RequestNormalizer;
27
use Koha::Auth::Route::Password;
28
use Koha::Auth::Route::Cookie;
29
use Koha::Auth::Route::RESTV1;
30
31
#Define Exceptions
32
use Koha::Exception::BadParameter;
33
use Koha::Exception::Logout;
34
use Koha::Exception::UnknownProgramState;
35
36
use C4::Branch;
37
38
#Define the headers, POST-parameters and cookies extracted from the various web-frameworks'
39
# request-objects and passed to the authentication system as normalized values.
40
our @authenticationHeaders = ('X-Koha-Date', 'Authorization');
41
our @authenticationPOSTparams = ('password', 'userid', 'PT', 'branch', 'logout.x', 'koha_login_context');
42
our @authenticationCookies = ('CGISESSID'); #Really we should have only one of these.
43
44
=head authenticate
45
46
@PARAM3 HASHRef of authentication directives. Supported values:
47
            'inOPAC' => 1,    #Authentication context is in OPAC
48
            'inREST' => 'v1', #Authentication context is in REST API V1
49
            'inSC'   => 1,    #Authentication context is in the staff client
50
            'authnotrequired' => 1, #Disregard all Koha::Exception::LoginFailed||NoPermission-exceptions,
51
                                    #and authenticate as an anonymous user if normal authentication
52
                                    #fails.
53
@THROWS Koha::Exception::VersionMismatch
54
        Koha::Exception::BadSystemPreference
55
        Koha::Exception::BadParameter
56
        Koha::Exception::ServiceTemporarilyUnavailable
57
        Koha::Exception::LoginFailed
58
        Koha::Exception::NoPermission
59
        Koha::Exception::Logout, catch this and redirect the request to the logout page.
60
=cut
61
62
sub authenticate {
63
    my ($controller, $permissions, $authParams) = @_;
64
    my $rae = _authenticate_validateAndNormalizeParameters(@_); #Get the normalized request authentication elements
65
66
    my $borrower; #Each authentication route returns a Koha::Borrower-object on success. We use this to generate the Context()
67
68
    ##Select the Authentication route.
69
    ##Routes are introduced in priority order, and if one matches, the other routes are ignored.
70
    try {
71
        #0. Logout
72
        if ($rae->{postParams}->{'logout.x'}) {
73
            clearUserEnvironment($rae, $authParams);
74
            Koha::Exception::Logout->throw(error => "User logged out. Please redirect me!");
75
        }
76
        #1. Check for password authentication, including LDAP.
77
        elsif ($rae->{postParams}->{koha_login_context} && $rae->{postParams}->{userid} && $rae->{postParams}->{password}) {
78
            $borrower = Koha::Auth::Route::Password::challenge($rae, $permissions, $authParams);
79
        }
80
        #2. Check for REST's signature-based authentication.
81
        #elsif ($rae->{headers}->{'Authorization'} && $rae->{headers}->{'Authorization'} =~ /Koha/) {
82
        elsif ($rae->{headers}->{'Authorization'}) {
83
            $borrower = Koha::Auth::Route::RESTV1::challenge($rae, $permissions, $authParams);
84
        }
85
        #3. Check for the cookie. If cookies go stale, they block all subsequent authentication methods, so keep it down on this list.
86
        elsif ($rae->{cookies}->{CGISESSID}) {
87
            $borrower = Koha::Auth::Route::Cookie::challenge($rae, $permissions, $authParams);
88
        }
89
        else { #HTTP CAS ticket or shibboleth or Persona not implemented
90
            #We don't know how to authenticate, or there is no authentication attempt.
91
            Koha::Exception::LoginFailed->throw(error => "Koha doesn't understand your authentication protocol.");
92
        }
93
    } catch {
94
        if (blessed($_)) {
95
            if ($_->isa('Koha::Exception::LoginFailed') || $_->isa('Koha::Exception::NoPermission')) {
96
                if ($authParams->{authnotrequired}) { #We failed to login, but we can continue anonymously.
97
                    $borrower = Koha::Borrower->new();
98
                }
99
                else {
100
                    $_->rethrow(); #Anonymous login not allowed this time
101
                }
102
            }
103
            else {
104
                die $_; #Propagate other errors to the calling Controller to redirect as it wants.
105
            }
106
        }
107
        else {
108
            die $_; #Not a Koha::Exception-object
109
        }
110
    };
111
112
    my $session = setUserEnvironment($controller, $rae, $borrower, $authParams);
113
    my $cookie = Koha::Auth::RequestNormalizer::getSessionCookie($controller, $session);
114
115
    return ($borrower, $cookie);
116
}
117
118
=head _authenticate_validateAndNormalizeParameters
119
120
@PARAM1 CGI- or Mojolicious::Controller-object, this is used to identify which web framework to use.
121
@PARAM2 HASHRef or undef, Permissions HASH telling which Koha permissions the user must have, to access the resource.
122
@PARAM3 HASHRef or undef, Special authentication parameters, see authenticate()
123
@THROWS Koha::Exception::BadParameter, if validating parameters fails.
124
=cut
125
126
sub _authenticate_validateAndNormalizeParameters {
127
    my ($controller, $permissions, $authParams) = @_;
128
129
    #Validate $controller.
130
    my $requestAuthElements;
131
    if (blessed($controller) && $controller->isa('CGI')) {
132
        $requestAuthElements = Koha::Auth::RequestNormalizer::normalizeCGI($controller, \@authenticationHeaders, \@authenticationPOSTparams, \@authenticationCookies);
133
    }
134
    elsif (blessed($controller) && $controller->isa('Mojolicious::Controller')) {
135
        $requestAuthElements = Koha::Auth::RequestNormalizer::normalizeMojolicious($controller, \@authenticationHeaders, \@authenticationPOSTparams, \@authenticationCookies);
136
    }
137
    else {
138
        Koha::Exception::BadParameter->throw(error => "Koha::Auth::authenticate():> The first parameter MUST be either a 'CGI'-object or a 'Mojolicious::Controller'-object");
139
    }
140
    #Validate $permissions
141
    unless (not($permissions) || (ref $permissions eq 'HASH')) {
142
        Koha::Exception::BadParameter->throw(error => "Koha::Auth::authenticate():> The second parameter MUST be 'undef' or a HASHRef of Koha permissions. See C4::Auth::haspermission().");
143
    }
144
    #Validate $authParams
145
    unless (not($authParams) || (ref $authParams eq 'HASH')) {
146
        Koha::Exception::BadParameter->throw(error => "Koha::Auth::authenticate():> The third parameter MUST be 'undef' or a HASHRef.");
147
    }
148
149
    return $requestAuthElements;
150
}
151
152
=head setUserEnvironment
153
Set the C4::Context::user_env() and CGI::Session.
154
155
Any idea why there is both the CGI::Session and C4::Context::usernenv??
156
=cut
157
158
sub setUserEnvironment {
159
    my ($controller, $rae, $borrower, $authParams) = @_;
160
161
    my $session = C4::Auth::get_session( $rae->{cookies}->{CGISESSID} || '' );
162
    C4::Context->_new_userenv( $session->id );
163
164
    _determineUserBranch($rae, $borrower, $authParams, $session);
165
166
    #Then start setting remaining session parameters
167
    $session->param( 'number',       $borrower->borrowernumber );
168
    $session->param( 'id',           $borrower->userid );
169
    $session->param( 'cardnumber',   $borrower->cardnumber );
170
    $session->param( 'firstname',    $borrower->firstname );
171
    $session->param( 'surname',      $borrower->surname );
172
    $session->param( 'emailaddress', $borrower->email );
173
    $session->param( 'ip',           $session->remote_addr() );
174
    $session->param( 'lasttime',     time() );
175
176
    #Finally configure the userenv.
177
    C4::Context->set_userenv(
178
        $session->param('number'),       $session->param('id'),
179
        $session->param('cardnumber'),   $session->param('firstname'),
180
        $session->param('surname'),      $session->param('branch'),
181
        $session->param('branchname'),   undef,
182
        $session->param('emailaddress'), $session->param('branchprinter'),
183
        $session->param('persona'),      $session->param('shibboleth')
184
    );
185
186
    return $session;
187
}
188
189
sub _determineUserBranch {
190
    my ($rae, $borrower, $authParams, $session) = @_;
191
192
    my ($branchcode, $branchname);
193
    if ($rae->{postParams}->{branch}) {
194
        #We are instructed to change the active branch
195
        $branchcode = $rae->{postParams}->{branch};
196
    }
197
    elsif ($session->param('branch') && $session->param('branch') ne 'NO_LIBRARY_SET') {
198
        ##Branch is already set
199
        $branchcode = $session->param('branch');
200
    }
201
    elsif ($borrower->branchcode) {
202
        #Default to the borrower's branch
203
        $branchcode = $borrower->branchcode;
204
    }
205
    else {
206
        #No borrower branch? This must be the superuser.
207
        $branchcode = 'NO_LIBRARY_SET';
208
        $branchname = 'NO_LIBRARY_SET';
209
    }
210
    $session->param( 'branch',     $branchcode );
211
    $session->param( 'branchname', ($branchname || C4::Branch::GetBranchName($branchcode) || 'NO_LIBRARY_SET'));
212
}
213
214
=head clearUserEnvironment
215
216
Removes all active authentications
217
=cut
218
219
sub clearUserEnvironment {
220
    my ($rae, $authParams) = @_;
221
222
    my $session = C4::Auth::get_session( $rae->{cookies}->{CGISESSID} );
223
    $session->delete();
224
    $session->flush;
225
    #Do we need to unset this if it has never been set? C4::Context::_unset_userenv( $rae->{cookies}->{CGISESSID} );
226
}
227
1;
(-)a/Koha/Auth/Challenge.pm (+74 lines)
Line 0 Link Here
1
package Koha::Auth::Challenge;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
=head1 NAME Koha::Auth::Challenge
23
24
=head2 SYNOPSIS
25
26
This is a authentication challenge parent class.
27
All Challenge-objects must implement the challenge()-method.
28
29
=head SUBLASSING
30
31
package Koha::Auth::Challenge::YetAnotherChallenge;
32
33
use base qw('Koha::Auth::Challenge');
34
35
sub challenge {
36
    #Implement the parent method to make this subclass interoperable.
37
}
38
39
=head2 USAGE
40
41
    use Scalar::Util qw(blessed);
42
    try {
43
        ...
44
        Koha::Auth::Challenge::Version::challenge();
45
        Koha::Auth::Challenge::OPACMaintenance::challenge();
46
        Koha::Auth::Challenge::YetAnotherChallenge::challenge();
47
        ...
48
    } catch {
49
        if (blessed($_)) {
50
            if ($_->isa('Koha::Exception::VersionMismatch')) {
51
                ##handle exception
52
            }
53
            elsif ($_->isa('Koha::Exception::AnotherKindOfException')) {
54
                ...
55
            }
56
            ...
57
            else {
58
                warn "Unknown exception class ".ref($_)."\n";
59
                die $_; #Unhandled exception case
60
            }
61
        }
62
        else {
63
            die $_; #Not a Koha::Exception-object
64
        }
65
    };
66
67
=cut
68
69
sub challenge {
70
    #@OVERLOAD this "interface"
71
    warn caller()." doesn't implement challenge()\n";
72
}
73
74
1;
(-)a/Koha/Auth/Challenge/Cookie.pm (+78 lines)
Line 0 Link Here
1
package Koha::Auth::Challenge::Cookie;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use C4::Context;
23
use C4::Auth;
24
use Koha::AuthUtils;
25
use Koha::Borrowers;
26
27
use Koha::Exception::LoginFailed;
28
29
use base qw(Koha::Auth::Challenge);
30
31
=head challenge
32
STATIC
33
34
    Koha::Auth::Challenge::Cookie::challenge($cookieValue);
35
36
Checks if the given authentication cookie value matches a session, and checks if
37
the session is still active.
38
@PARAM1 String, hashed session key identifying a session in koha.sessions
39
@RETURNS Koha::Borrower matching the verified and active session
40
@THROWS Koha::Exception::LoginFailed, if no session is found,
41
                                      if the session has expired,
42
                                      if the session IP address changes,
43
                                      if no borrower was found for the session
44
=cut
45
46
sub challenge {
47
    my ($cookie) = @_;
48
49
    my $session = C4::Auth::get_session($cookie);
50
    Koha::Exception::LoginFailed->throw(error => "No session matching the given session identifier '$session'.") unless $session;
51
52
    # See if the given session is timed out
53
    if ( ($session->param('lasttime') || 0) < (time()- C4::Auth::_timeout_syspref()) ) {
54
        $session->delete();
55
        $session->flush;
56
        C4::Context::_unset_userenv($cookie);
57
        Koha::Exception::LoginFailed->throw(error => "Session expired, please login again.");
58
    }
59
    # Check if we still access using the same IP than when the session was initialized.
60
    elsif ( C4::Context->preference('SessionRestrictionByIP') && $session->param('ip') ne $ENV{'REMOTE_ADDR'} ) {
61
        $session->delete();
62
        $session->flush;
63
        C4::Context::_unset_userenv($cookie);
64
        Koha::Exception::LoginFailed->throw(error => "Session's client address changed, please login again.");
65
    }
66
67
    #Get the Borrower-object
68
    my $userid   = $session->param('id');
69
    my $borrower = Koha::AuthUtils::checkKohaSuperuserFromUserid($userid);
70
    $borrower = Koha::Borrowers->find({userid => $userid}) if not($borrower) && $userid;
71
    Koha::Exception::LoginFailed->throw(error => "Cookie authentication succeeded, but no borrower found with userid '".($userid || '')."'.")
72
            unless $borrower;
73
74
    $session->param( 'lasttime', time() );
75
    return $borrower;
76
}
77
78
1;
(-)a/Koha/Auth/Challenge/IndependentBranchesAutolocation.pm (+52 lines)
Line 0 Link Here
1
package Koha::Auth::Challenge::IndependentBranchesAutolocation;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use C4::Context;
23
use C4::Branch;
24
25
use Koha::Exception::LoginFailed;
26
27
use base qw(Koha::Auth::Challenge);
28
29
=head challenge
30
31
If sysprefs 'IndependentBranches' and 'Autolocation' are active, checks if the user
32
is in the correct network region to login.
33
@PARAM1 String, branchcode of the branch the current user is authenticating in to.
34
@THROWS Koha::Exception::LoginFailed, if the user is in the wrong network segment.
35
=cut
36
37
sub challenge {
38
    my ($currentBranchcode) = @_;
39
40
    if ( $currentBranchcode && C4::Context->boolean_preference('IndependentBranches') && C4::Context->boolean_preference('Autolocation') ) {
41
        my $ip = $ENV{'REMOTE_ADDR'};
42
43
        my $branches = C4::Branch::GetBranches();
44
        # we have to check they are coming from the right ip range
45
        my $domain = $branches->{$currentBranchcode}->{'branchip'};
46
        if ( $ip !~ /^$domain/ ) {
47
            Koha::Exception::LoginFailed->throw(error => "Branch '$currentBranchcode' is inaccessible from this network.");
48
        }
49
    }
50
}
51
52
1;
(-)a/Koha/Auth/Challenge/OPACMaintenance.pm (+44 lines)
Line 0 Link Here
1
package Koha::Auth::Challenge::OPACMaintenance;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use C4::Context;
23
24
use base qw(Koha::Auth::Challenge);
25
26
use Koha::Exception::ServiceTemporarilyUnavailable;
27
28
=head challenge
29
STATIC
30
31
    Koha::Auth::Challenge::OPACMaintenance::challenge();
32
33
Checks if OPAC is under maintenance.
34
35
@THROWS Koha::Exception::ServiceTemporarilyUnavailable
36
=cut
37
38
sub challenge {
39
    if ( C4::Context->preference('OpacMaintenance') ) {
40
        Koha::Exception::ServiceTemporarilyUnavailable->throw(error => 'OPAC is under maintenance');
41
    }
42
}
43
44
1;
(-)a/Koha/Auth/Challenge/Password.pm (+127 lines)
Line 0 Link Here
1
package Koha::Auth::Challenge::Password;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use Koha::Borrowers;
23
use Koha::AuthUtils;
24
25
use base qw(Koha::Auth::Challenge);
26
27
use Koha::Exception::LoginFailed;
28
29
our @usernameAliasColumns = ('userid', 'cardnumber'); #Possible columns to treat as the username when authenticating. Must be UNIQUE in DB.
30
31
=head NAME Koha::Auth::Challenge::Password
32
33
=head SYNOPSIS
34
35
This module implements the more specific behaviour of the password authentication component.
36
37
=cut
38
39
=head challenge
40
STATIC
41
42
    Koha::Auth::Challenge::Password::challenge();
43
44
@RETURN Koha::Borrower-object if check succeedes, otherwise throws exceptions.
45
@THROWS Koha::Exception::LoginFailed from Koha::AuthUtils password checks.
46
=cut
47
48
sub challenge {
49
    my ($userid, $password) = @_;
50
51
    my $borrower;
52
    if (C4::Context->config('useldapserver')) {
53
        $borrower = Koha::Auth::Challenge::Password::checkLDAPPassword($userid, $password);
54
        return $borrower if $borrower;
55
    }
56
    if (C4::Context->preference('casAuthentication')) {
57
        warn("Koha::Auth doesn't support CAS-authentication yet. Please refactor the CAS client implementation to work with Koha::Auth. It cant be too hard :)");
58
    }
59
    if (C4::Context->config('useshibboleth')) {
60
        warn("Koha::Auth doesn't support Shibboleth-authentication yet. Please refactor the Shibboleth client implementation to work with Koha::Auth. It cant be too hard :)");
61
    }
62
63
    return Koha::Auth::Challenge::Password::checkKohaPassword($userid, $password);
64
}
65
66
=head checkKohaPassword
67
68
    my $borrower = Koha::Auth::Challenge::Password::checkKohaPassword($userid, $password);
69
70
Checks if the given username and password match anybody in the Koha DB
71
@PARAM1 String, user identifier, either the koha.borrowers.userid, or koha.borrowers.cardnumber
72
@PARAM2 String, clear text password from the authenticating user
73
@RETURN Koha::Borrower, if login succeeded.
74
                Sets Koha::Borrower->isSuperuser() if the user is a superuser.
75
@THROWS Koha::Exception::LoginFailed, if no matching password was found for all username aliases in Koha.
76
=cut
77
78
sub checkKohaPassword {
79
    my ($userid, $password) = @_;
80
    my $borrower; #Find the borrower to return
81
82
    $borrower = Koha::AuthUtils::checkKohaSuperuser($userid, $password);
83
    return $borrower if $borrower;
84
85
    my $usernameFound = 0; #Report to the user if userid/barcode was found, even if the login failed.
86
    #Check for each username alias if we can confirm a login with that.
87
    for my $unameAlias (@usernameAliasColumns) {
88
        my $borrower = Koha::Borrowers->find({$unameAlias => $userid});
89
        if ( $borrower ) {
90
            $usernameFound = 1;
91
            return $borrower if ( Koha::AuthUtils::checkHash( $password, $borrower->password ) );
92
        }
93
    }
94
95
    Koha::Exception::LoginFailed->throw(error => "Password authentication failed for the given ".( ($usernameFound) ? "password" : "username and password").".");
96
}
97
98
=head checkLDAPPassword
99
100
Checks if the given username and password match anybody in the LDAP service
101
@PARAM1 String, user identifier
102
@PARAM2 String, clear text password from the authenticating user
103
@RETURN Koha::Borrower, or
104
            undef if we couldn't reliably contact the LDAP server so we should
105
            fallback to local Koha Password authentication.
106
@THROWS Koha::Exception::LoginFailed, if LDAP login failed
107
=cut
108
109
sub checkLDAPPassword {
110
    my ($userid, $password) = @_;
111
112
    #Lazy load dependencies because somebody might never need them.
113
    require C4::Auth_with_ldap;
114
115
    my ($retval, $cardnumber, $local_userid) = C4::Auth_with_ldap::checkpw_ldap($userid, $password);    # EXTERNAL AUTH
116
    if ($retval == -1) {
117
        Koha::Exception::LoginFailed->throw(error => "LDAP authentication failed for the given username and password");
118
    }
119
120
    if ($retval) {
121
        my $borrower = Koha::Borrowers->find({userid => $local_userid});
122
        return $borrower;
123
    }
124
    return undef;
125
}
126
127
1;
(-)a/Koha/Auth/Challenge/Permission.pm (+42 lines)
Line 0 Link Here
1
package Koha::Auth::Challenge::Permission;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use Koha::Auth::PermissionManager;
23
24
use base qw(Koha::Auth::Challenge);
25
26
=head challenge
27
STATIC
28
29
    Koha::Auth::Challenge::Permission::challenge($borrower, $permissionsRequired);
30
31
@THROWS Koha::Exception::NoPermission with the missing permission if permissions
32
                are inadequate
33
=cut
34
35
sub challenge {
36
    my ($borrower, $permissionsRequired) = @_;
37
38
    my $permissionManager = Koha::Auth::PermissionManager->new();
39
    $permissionManager->hasPermissions($borrower, $permissionsRequired);
40
}
41
42
1;
(-)a/Koha/Auth/Challenge/RESTV1.pm (+169 lines)
Line 0 Link Here
1
package Koha::Auth::Challenge::RESTV1;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
use DateTime::Format::HTTP;
22
use DateTime;
23
24
use Koha::Borrowers;
25
26
use base qw(Koha::Auth::Challenge);
27
28
use Koha::Exception::LoginFailed;
29
use Koha::Exception::BadParameter;
30
31
=head challenge
32
33
    my $borrower = Koha::Auth::Challenge::RESTV1::challenge();
34
35
For authentication to succeed, the client have to send 2 HTTP
36
headers:
37
 - X-Koha-Date: the standard HTTP Date header complying to RFC 1123, simply wrapped to X-Koha-Date,
38
                since the w3-specification forbids setting the Date-header from javascript.
39
 - Authorization: the standard HTTP Authorization header, see below for how it is constructed.
40
41
=head2 HTTP Request example
42
43
GET /api/v1/borrowers/12 HTTP/1.1
44
Host: api.yourkohadomain.fi
45
X-Koha-Date: Mon, 26 Mar 2007 19:37:58 +0000
46
Authorization: Koha admin69:frJIUN8DYpKDtOLCwo//yllqDzg=
47
48
=head2 Constructing the Authorization header
49
50
-You brand the authorization header with "Koha"
51
-Then you give the userid/cardnumber of the user authenticating.
52
-Then the hashed signature.
53
54
The signature is a HMAC-SHA256-HEX hash of several elements of the request,
55
separated by spaces:
56
 - HTTP method (uppercase)
57
 - userid/cardnumber
58
 - X-Koha-Date-header
59
Signed with the Borrowers API key
60
61
The server then tries to rebuild the signature with each of the user's API keys.
62
If one matches the received signature, then authentication is almost OK.
63
64
To avoid requests to be replayed, the last request's X-Koha-Date-header is stored
65
in database and the authentication succeeds only if the stored Date
66
is lesser than the X-Koha-Date-header.
67
68
=head2 Constructing the signature example
69
70
Signature = HMAC-SHA256-HEX("HTTPS" + " " +
71
                            "/api/v1/borrowers/12?howdoyoudo=voodoo" + " " +
72
                            "admin69" + " " +
73
                            "760818212" + " " +
74
                            "frJIUN8DYpKDtOLCwo//yllqDzg="
75
                           );
76
77
=head
78
79
@PARAM1 HASHRef of Header name => values
80
@PARAM2 String, upper case request method name, eg. HTTP or HTTPS
81
@PARAM3 String the request uri
82
@RETURNS Koha::Borrower if authentication succeeded.
83
@THROWS Koha::Exception::LoginFailed, if API key signature verification failed
84
@THROWS Koha::Exception::BadParameter
85
@THROWS Koha::Exception::UnknownObject, if we cannot find a Borrower with the given input.
86
=cut
87
88
sub challenge {
89
    my ($headers, $method, $uri) = @_;
90
91
    my $req_dt;
92
    eval {
93
        $req_dt = DateTime::Format::HTTP->parse_datetime( $headers->{'X-Koha-Date'} ); #Returns DateTime
94
    };
95
    my $authorizationHeader = $headers->{'Authorization'};
96
    my ($req_username, $req_signature);
97
    if ($authorizationHeader =~ /^Koha (\S+?):(\w+)$/) {
98
        $req_username = $1;
99
        $req_signature = $2;
100
    }
101
    else {
102
        Koha::Exception::BadParameter->throw(error => "Authorization HTTP-header is not well formed. It needs to be of format 'Authorization: Koha userid:signature'");
103
    }
104
    unless ($req_dt) {
105
        Koha::Exception::BadParameter->throw(error => "X-Koha-Date HTTP-header is not well formed. It needs to be of RFC 1123 -date format, eg. 'X-Koha-Date: Wed, 09 Feb 1994 22:23:32 +0200'");
106
    }
107
108
    my $borrower = Koha::Borrowers->cast($req_username);
109
110
    my @apikeys = Koha::ApiKeys->search({
111
        borrowernumber => $borrower->borrowernumber,
112
        active => 1,
113
    });
114
    Koha::Exception::LoginFailed->throw(error => "User has no API keys. Please add one using the Staff interface or OPAC.") unless @apikeys;
115
116
    my $matchingApiKey;
117
    foreach my $apikey (@apikeys) {
118
        my $signature = makeSignature($method, $req_username, $headers->{'X-Koha-Date'}, $apikey);
119
120
        if ($signature eq $req_signature) {
121
            $matchingApiKey = $apikey;
122
            last();
123
        }
124
    }
125
126
    unless ($matchingApiKey) {
127
        Koha::Exception::LoginFailed->throw(error => "API key authentication failed");
128
    }
129
130
    unless ($matchingApiKey->last_request_time < $req_dt->epoch()) {
131
        Koha::Exception::BadParameter->throw(error => "X-Koha-Date HTTP-header is stale, expected later date than '".DateTime::Format::HTTP->format_datetime($req_dt)."'");
132
    }
133
134
    $matchingApiKey->set({last_request_time => $req_dt->epoch()});
135
    $matchingApiKey->store();
136
137
    return $borrower;
138
}
139
140
sub makeSignature {
141
    my ($method, $userid, $headerXKohaDate, $apiKey) = @_;
142
143
    my $message = join(' ', uc($method), $userid, $headerXKohaDate);
144
    return Digest::SHA::hmac_sha256_hex($message, $apiKey->api_key);
145
}
146
147
=head prepareAuthenticationHeaders
148
@PARAM1 Koha::Borrower, to authenticate
149
@PARAM2 DateTime, OPTIONAL, the timestamp of the HTTP request
150
@PARAM3 HTTP verb, 'get', 'post', 'patch', 'put', ...
151
@RETURNS HASHRef of authentication HTTP header names and their values. {
152
            "X-Koha-Date" => "Mon, 26 Mar 2007 19:37:58 +0000",
153
            "Authorization" => "Koha admin69:frJIUN8DYpKDtOLCwo//yllqDzg=",
154
        }
155
=cut
156
157
sub prepareAuthenticationHeaders {
158
    my ($borrower, $dateTime, $method) = @_;
159
    $borrower = Koha::Borrowers->cast($borrower);
160
161
    my $headerXKohaDate = DateTime::Format::HTTP->format_datetime(
162
                                                ($dateTime || DateTime->now( time_zone => C4::Context->tz() ))
163
                          );
164
    my $headerAuthorization = "Koha ".$borrower->userid.":".makeSignature('get', $borrower->userid, $headerXKohaDate, $borrower->getApiKey('active'));
165
    return {'X-Koha-Date' => $headerXKohaDate,
166
            'Authorization' => $headerAuthorization};
167
}
168
169
1;
(-)a/Koha/Auth/Challenge/Version.pm (+56 lines)
Line 0 Link Here
1
package Koha::Auth::Challenge::Version;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use C4::Context;
23
use Koha;
24
25
use base qw(Koha::Auth::Challenge);
26
27
use Koha::Exception::VersionMismatch;
28
use Koha::Exception::BadSystemPreference;
29
30
=head challenge
31
STATIC
32
33
    Koha::Auth::Challenge::Version::challenge();
34
35
Checks if the DB version is valid.
36
37
@THROWS Koha::Exception::VersionMismatch, if versions do not match
38
@THROWS Koha::Exception::BadSystemPreference, if "Version"-syspref is not set.
39
                        This probably means that Koha has not been installed yet.
40
=cut
41
42
sub challenge {
43
    my $versionSyspref = C4::Context->preference('Version');
44
    unless ( $versionSyspref ) {
45
        Koha::Exception::BadSystemPreference->throw(error => "No Koha 'Version'-system preference defined. Koha needs to be installed.");
46
    }
47
48
    my $kohaversion = Koha::version();
49
    # remove the 3 last . to have a Perl number
50
    $kohaversion =~ s/(.*\..*)\.(.*)\.(.*)/$1$2$3/;
51
    if ( $versionSyspref < $kohaversion ) {
52
        Koha::Exception::VersionMismatch->throw(error => "Database update needed. Database is 'v$versionSyspref' and Koha is 'v$kohaversion'");
53
    }
54
}
55
56
1;
(-)a/Koha/Auth/RequestNormalizer.pm (+157 lines)
Line 0 Link Here
1
package Koha::Auth::RequestNormalizer;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use Scalar::Util qw(blessed);
23
24
25
=head normalizeCGI
26
27
Takes a CGI-object and finds the authentication markers from it.
28
@PARAM1 CGI-object.
29
@PARAM2 ARRAYRef, authentication headers that should be extracted for authentication
30
@PARAM3 ARRAYRef, authentication POST parameters that should be extracted for authentication
31
@PARAM4 ARRAYRef, authentication cookies that should be extracted for authentication
32
@RETURNS List of : HASHRef of headers required for authentication, or undef
33
                   HASHRef of POST parameters required for authentication, or undef
34
                   HASHRef of the authenticaton cookie name => value, or undef
35
=cut
36
37
sub normalizeCGI {
38
    my ($controller, $authenticationHeaders, $authenticationPOSTparams, $authenticationCookies) = @_;
39
40
    my ($headers, $postParams, $cookies) = ({}, {}, {});
41
    foreach my $authHeader (@$authenticationHeaders) {
42
        if (my $val = $controller->http($authHeader)) {
43
            $headers->{$authHeader} = $val;
44
        }
45
    }
46
    foreach my $authParam (@$authenticationPOSTparams) {
47
        if (my $val = $controller->param($authParam)) {
48
            $postParams->{$authParam} = $val;
49
        }
50
    }
51
    foreach my $authCookie (@$authenticationCookies) {
52
        if (my $val = $controller->cookie($authCookie)) {
53
            $cookies->{$authCookie} = $val;
54
        }
55
    }
56
    my $method = $1 if ($ENV{SERVER_PROTOCOL} =~ /^(.+?)\//);
57
    my $requestAuthElements = { #Collect the authentication elements here.
58
        headers => $headers,
59
        postParams => $postParams,
60
        cookies => $cookies,
61
        method => $method,
62
        url => $ENV{REQUEST_URI},
63
    };
64
    return $requestAuthElements;
65
}
66
67
=head normalizeMojolicious
68
69
Takes a Mojolicious::Controller-object and finds the authentication markers from it.
70
@PARAM1 Mojolicious::Controller-object.
71
@PARAM2-4 See normalizeCGI()
72
@RETURNS HASHRef of the request's authentication elements marked for extraction, eg:
73
        {
74
            headers => { X-Koha-Signature => '32rFrFw3iojsev34AS',
75
                         X-Koha-Username => 'pavlov'},
76
            POSTparams => { password => '1234',
77
                            userid => 'pavlov'},
78
            cookies => { CGISESSID => '233FADFEV3as1asS' },
79
            method => 'https',
80
            url => '/borrower/12/holds'
81
        }
82
=cut
83
84
sub normalizeMojolicious {
85
    my ($controller, $authenticationHeaders, $authenticationPOSTparams, $authenticationCookies) = @_;
86
87
    my $request = $controller->req();
88
    my ($headers, $postParams, $cookies) = ({}, {}, {});
89
    my $headersHash = $request->headers()->to_hash();
90
    foreach my $authHeader (@$authenticationHeaders) {
91
        if (my $val = $headersHash->{$authHeader}) {
92
            $headers->{$authHeader} = $val;
93
        }
94
    }
95
    foreach my $authParam (@$authenticationPOSTparams) {
96
        if (my $val = $request->param($authParam)) {
97
            $postParams->{$authParam} = $val;
98
        }
99
    }
100
101
    my $requestCookies = $request->cookies;
102
    if (scalar(@$requestCookies)) {
103
        foreach my $authCookieName (@$authenticationCookies) {
104
            foreach my $requestCookie (@$requestCookies) {
105
                if ($authCookieName eq $requestCookie->name) {
106
                    $cookies->{$authCookieName} = $requestCookie->value;
107
                }
108
            }
109
        }
110
    }
111
112
    my $requestAuthElements = { #Collect the authentication elements here.
113
        headers => $headers,
114
        postParams => $postParams,
115
        cookies => $cookies,
116
        method => $controller->req->method,
117
        url => '/' . $controller->req->url->path_query,
118
    };
119
    return $requestAuthElements;
120
}
121
122
=head getSessionCookie
123
124
@PARAM1 CGI- or Mojolicious::Controller-object, this is used to identify which web framework to use.
125
@PARAM2 CGI::Session.
126
@RETURNS a Mojolicious cookie or a CGI::Cookie.
127
=cut
128
129
sub getSessionCookie {
130
    my ($controller, $session) = @_;
131
132
    my $cookie = {
133
            name     => 'CGISESSID',
134
            value    => $session->id,
135
    };
136
    my $cookieOk;
137
138
    if (blessed($controller) && $controller->isa('CGI')) {
139
        $cookie->{HttpOnly} = 1;
140
        $cookieOk = $controller->cookie( $cookie );
141
    }
142
    elsif (blessed($controller) && $controller->isa('Mojolicious::Controller')) {
143
        $controller->res->cookies($cookie);
144
        foreach my $c (@{$controller->res->cookies}) {
145
            if ($c->name eq 'CGISESSID') {
146
                $cookieOk = $c;
147
                last;
148
            }
149
        }
150
    }
151
    unless ($cookieOk) {
152
        Koha::Exception::UnknownProgramState->throw(error => __PACKAGE__."::getSessionCookie():> Unable to get a proper cookie?");
153
    }
154
    return $cookieOk;
155
}
156
157
1;
(-)a/Koha/Auth/Route.pm (+75 lines)
Line 0 Link Here
1
package Koha::Auth::Route;
2
3
use Modern::Perl;
4
5
# Copyright 2015 Vaara-kirjastot
6
#
7
# This file is part of Koha.
8
#
9
# Koha is free software; you can redistribute it and/or modify it
10
# under the terms of the GNU General Public License as published by
11
# the Free Software Foundation; either version 3 of the License, or
12
# (at your option) any later version.
13
#
14
# Koha is distributed in the hope that it will be useful, but
15
# WITHOUT ANY WARRANTY; without even the implied warranty of
16
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17
# GNU General Public License for more details.
18
#
19
# You should have received a copy of the GNU General Public License
20
# along with Koha; if not, see <http://www.gnu.org/licenses>.
21
22
=head
23
24
=NAME Koha::Auth::Route
25
26
=SYNOPSIS
27
28
This is an interface definition for Koha::Auth::Route::* -subclasses.
29
This documentation explains how to subclass different routes.
30
31
=USAGE
32
33
    if ($userid && $password) {
34
        $borrower = Koha::Auth::Route::<RouteName>::challenge($requestAuthElements, $permissionsRequired, $routeParams);
35
    }
36
37
=head INPUT
38
39
Each Route gets three parameters:
40
    $requestAuthElements, HASHRef of HASHRefs:
41
        headers =>      HASHRef of HTTP Headers matching the @authenticationHeaders-package
42
                        variable in Koha::Auth,
43
                        Eg. { 'X-Koha-Signature' => "23in4ow2gas2opcnpa", ... }
44
        postParams =>   HASHRef of HTTP POST parameters matching the
45
                        @authenticationPOSTparams-package variable in Koha::Auth,
46
                        Eg. { password => '1234', 'userid' => 'admin'}
47
        cookies =>      HASHRef of HTTP Cookies matching the
48
                        @authenticationPOSTparams-package variable in Koha::Auth,
49
                        EG. { CGISESSID => '9821rj1kn3tr9ff2of2ln1' }
50
    $permissionsRequired:
51
                        HASHRef of Koha permissions.
52
                        See Koha::Auth::PermissionManager for example.
53
    $routeParams:       HASHRef of special Route-related data
54
                        {inOPAC => 1, authnotrequired => 0, ...}
55
56
=head OUTPUT
57
58
Each route must return a Koha::Borrower-object representing the authenticated user.
59
Even if the login succeeds with a superuser or similar virtual user, like
60
anonymous login, a mock Borrower-object must be returned.
61
If the login fails, each route must throw Koha::Exceptions to notify the cause
62
of the failure.
63
64
=head ROUTE STRUCTURE
65
66
Each route consists of Koha::Auth::Challenge::*-objects to test for various
67
authentication challenges.
68
69
See. Koha::Auth::Challenge for more information.
70
71
=cut
72
73
sub challenge {}; #@OVERLOAD this "interface"
74
75
1;
(-)a/Koha/Auth/Route/Cookie.pm (+44 lines)
Line 0 Link Here
1
package Koha::Auth::Route::Cookie;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use Koha::Auth::Challenge::OPACMaintenance;
23
use Koha::Auth::Challenge::Version;
24
use Koha::Auth::Challenge::Cookie;
25
use Koha::Auth::Challenge::Permission;
26
27
use base qw(Koha::Auth::Route);
28
29
=head challenge
30
See Koha::Auth::Route, for usage documentation.
31
@THROWS Koha::Exceptions from authentication components.
32
=cut
33
34
sub challenge {
35
    my ($rae, $permissionsRequired, $routeParams) = @_;
36
37
    Koha::Auth::Challenge::OPACMaintenance::challenge() if $routeParams->{inOPAC};
38
    Koha::Auth::Challenge::Version::challenge();
39
    my $borrower = Koha::Auth::Challenge::Cookie::challenge($rae->{cookies}->{CGISESSID});
40
    Koha::Auth::Challenge::Permission::challenge($borrower, $permissionsRequired) if $permissionsRequired;
41
    return $borrower;
42
}
43
44
1;
(-)a/Koha/Auth/Route/Password.pm (+46 lines)
Line 0 Link Here
1
package Koha::Auth::Route::Password;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use Koha::Auth::Challenge::OPACMaintenance;
23
use Koha::Auth::Challenge::Version;
24
use Koha::Auth::Challenge::IndependentBranchesAutolocation;
25
use Koha::Auth::Challenge::Password;
26
use Koha::Auth::Challenge::Permission;
27
28
use base qw(Koha::Auth::Route);
29
30
=head challenge
31
See Koha::Auth::Route, for usage documentation.
32
@THROWS Koha::Exceptions from authentication components.
33
=cut
34
35
sub challenge {
36
    my ($rae, $permissionsRequired, $routeParams) = @_;
37
38
    Koha::Auth::Challenge::OPACMaintenance::challenge() if $routeParams->{inOPAC};
39
    Koha::Auth::Challenge::Version::challenge();
40
    Koha::Auth::Challenge::IndependentBranchesAutolocation::challenge($routeParams->{branch});
41
    my $borrower = Koha::Auth::Challenge::Password::challenge($rae->{postParams}->{userid}, $rae->{postParams}->{password});
42
    Koha::Auth::Challenge::Permission::challenge($borrower, $permissionsRequired) if $permissionsRequired;
43
    return $borrower;
44
}
45
46
1;
(-)a/Koha/Auth/Route/RESTV1.pm (+43 lines)
Line 0 Link Here
1
package Koha::Auth::Route::RESTV1;
2
3
# Copyright 2015 Vaara-kirjastot
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Modern::Perl;
21
22
use Koha::Auth::Challenge::Version;
23
use Koha::Auth::Challenge::RESTV1;
24
use Koha::Auth::Challenge::Permission;
25
26
use base qw(Koha::Auth::Route);
27
28
=head challenge
29
See Koha::Auth::Route, for usage documentation.
30
@THROWS Koha::Exceptions from authentication components.
31
=cut
32
33
sub challenge {
34
    my ($rae, $permissionsRequired, $routeParams) = @_;
35
36
    #Koha::Auth::Challenge::RESTMaintenance::challenge() if $routeParams->{inREST}; #NOT IMPLEMENTED YET
37
    Koha::Auth::Challenge::Version::challenge();
38
    my $borrower = Koha::Auth::Challenge::RESTV1::challenge($rae->{headers}, $rae->{method}, $rae->{url});
39
    Koha::Auth::Challenge::Permission::challenge($borrower, $permissionsRequired) if $permissionsRequired;
40
    return $borrower;
41
}
42
43
1;
(-)a/Koha/AuthUtils.pm (-1 / +64 lines)
Lines 24-29 use Fcntl qw/O_RDONLY/; # O_RDONLY is used in generate_salt Link Here
24
24
25
use Koha::Borrower;
25
use Koha::Borrower;
26
26
27
use Koha::Exception::LoginFailed;
28
27
use base 'Exporter';
29
use base 'Exporter';
28
30
29
our $VERSION = '1.01';
31
our $VERSION = '1.01';
Lines 136-141 sub generate_salt { Link Here
136
    return $string;
138
    return $string;
137
}
139
}
138
140
141
=head checkHash
142
143
    my $passwordOk = Koha::AuthUtils::checkHash($password1, $password2)
144
145
Checks if a clear-text String/password matches the given hash when
146
MD5 or Bcrypt hashing algorith is applied to it.
147
148
Bcrypt is applied if @PARAM2 starts with '$2'
149
MD5 otherwise
150
151
@PARAM1 String, clear text passsword or any other String
152
@PARAM2 String, hashed text password or any other String.
153
@RETURN Boolean, 1 if given parameters match
154
               , 0 if not
155
=cut
156
157
sub checkHash {
158
    my ( $password, $stored_hash ) = @_;
159
160
    $password = Encode::encode( 'UTF-8', $password )
161
            if Encode::is_utf8($password);
162
163
    return if $stored_hash eq '!';
164
165
    my $hash;
166
    if ( substr( $stored_hash, 0, 2 ) eq '$2' ) {
167
        $hash = hash_password( $password, $stored_hash );
168
    } else {
169
        #@DEPRECATED Digest::MD5, don't use it or you will get hurt.
170
        require Digest::MD5;
171
        $hash = Digest::MD5::md5_base64($password);
172
    }
173
    return $hash eq $stored_hash;
174
}
175
176
=head checkKohaSuperuser
177
178
    my $borrower = Koha::AuthUtils::checkKohaSuperuser($userid, $password);
179
180
Check if the userid and password match the ones in the $KOHA_CONF
181
@PARAM1 String, user identifier, either the koha.borrowers.userid, or koha.borrowers.cardnumber
182
@PARAM2 String, clear text password from the authenticating user
183
@RETURNS Koha::Borrower branded as superuser with ->isSuperuser()
184
         or undef if user logging in is not a superuser.
185
@THROWS Koha::Exception::LoginFailed if user identifier matches, but password doesn't
186
=cut
187
188
sub checkKohaSuperuser {
189
    my ($userid, $password) = @_;
190
191
    if ( $userid && $userid eq C4::Context->config('user') ) {
192
        if ( $password && $password eq C4::Context->config('pass') ) {
193
            return _createTemporarySuperuser();
194
        }
195
        else {
196
            Koha::Exception::LoginFailed->throw(error => "Password authentication failed");
197
        }
198
    }
199
}
200
139
=head checkKohaSuperuserFromUserid
201
=head checkKohaSuperuserFromUserid
140
See checkKohaSuperuser(), with only the "user identifier"-@PARAM.
202
See checkKohaSuperuser(), with only the "user identifier"-@PARAM.
141
@THROWS nothing.
203
@THROWS nothing.
Lines 153-165 sub checkKohaSuperuserFromUserid { Link Here
153
215
154
Create a temporary superuser which should be instantiated only to the environment
216
Create a temporary superuser which should be instantiated only to the environment
155
and then discarded. So do not ->store() it!
217
and then discarded. So do not ->store() it!
156
@RETURN Koha::Borrower
218
@RETURN Koha::Borrower, stamped as superuser.
157
=cut
219
=cut
158
220
159
sub _createTemporarySuperuser {
221
sub _createTemporarySuperuser {
160
    my $borrower = Koha::Borrower->new();
222
    my $borrower = Koha::Borrower->new();
161
223
162
    my $superuserName = C4::Context->config('user');
224
    my $superuserName = C4::Context->config('user');
225
    $borrower->isSuperuser(1);
163
    $borrower->set({borrowernumber => 0,
226
    $borrower->set({borrowernumber => 0,
164
                       userid     => $superuserName,
227
                       userid     => $superuserName,
165
                       cardnumber => $superuserName,
228
                       cardnumber => $superuserName,
(-)a/Koha/Borrower.pm (+26 lines)
Lines 43-48 sub type { Link Here
43
    return 'Borrower';
43
    return 'Borrower';
44
}
44
}
45
45
46
=head isSuperuser
47
48
    $borrower->isSuperuser(1); #Set this borrower to be a superuser
49
    if ($borrower->isSuperuser()) {
50
        #All your base are belong to us
51
    }
52
53
Should be used from the authentication modules to mark this $borrower-object to
54
have unlimited access to all Koha-features.
55
This $borrower-object is the Koha DB user.
56
@PARAM1 Integer, 1 means this borrower is the super/DB user.
57
                "0" disables the previously set superuserness.
58
=cut
59
60
sub isSuperuser {
61
    my ($self, $Iam) = @_;
62
63
    if (defined $Iam && $Iam == 1) {
64
        $self->{superuser} = 1;
65
    }
66
    elsif (defined $Iam && $Iam eq "0") { #Dealing with zero is special in Perl
67
        $self->{superuser} = undef;
68
    }
69
    return (exists($self->{superuser}) && $self->{superuser}) ? 1 : undef;
70
}
71
46
=head1 AUTHOR
72
=head1 AUTHOR
47
73
48
Kyle M Hall <kyle@bywatersolutions.com>
74
Kyle M Hall <kyle@bywatersolutions.com>
(-)a/Koha/Schema/Result/BorrowerPermission.pm (+149 lines)
Line 0 Link Here
1
use utf8;
2
package Koha::Schema::Result::BorrowerPermission;
3
4
# Created by DBIx::Class::Schema::Loader
5
# DO NOT MODIFY THE FIRST PART OF THIS FILE
6
7
=head1 NAME
8
9
Koha::Schema::Result::BorrowerPermission
10
11
=cut
12
13
use strict;
14
use warnings;
15
16
use base 'DBIx::Class::Core';
17
18
=head1 TABLE: C<borrower_permissions>
19
20
=cut
21
22
__PACKAGE__->table("borrower_permissions");
23
24
=head1 ACCESSORS
25
26
=head2 borrower_permission_id
27
28
  data_type: 'integer'
29
  is_auto_increment: 1
30
  is_nullable: 0
31
32
=head2 borrowernumber
33
34
  data_type: 'integer'
35
  is_foreign_key: 1
36
  is_nullable: 0
37
38
=head2 permission_module_id
39
40
  data_type: 'integer'
41
  is_foreign_key: 1
42
  is_nullable: 0
43
44
=head2 permission_id
45
46
  data_type: 'integer'
47
  is_foreign_key: 1
48
  is_nullable: 0
49
50
=cut
51
52
__PACKAGE__->add_columns(
53
  "borrower_permission_id",
54
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
55
  "borrowernumber",
56
  { data_type => "integer", is_foreign_key => 1, is_nullable => 0 },
57
  "permission_module_id",
58
  { data_type => "integer", is_foreign_key => 1, is_nullable => 0 },
59
  "permission_id",
60
  { data_type => "integer", is_foreign_key => 1, is_nullable => 0 },
61
);
62
63
=head1 PRIMARY KEY
64
65
=over 4
66
67
=item * L</borrower_permission_id>
68
69
=back
70
71
=cut
72
73
__PACKAGE__->set_primary_key("borrower_permission_id");
74
75
=head1 UNIQUE CONSTRAINTS
76
77
=head2 C<borrowernumber>
78
79
=over 4
80
81
=item * L</borrowernumber>
82
83
=item * L</permission_module_id>
84
85
=item * L</permission_id>
86
87
=back
88
89
=cut
90
91
__PACKAGE__->add_unique_constraint(
92
  "borrowernumber",
93
  ["borrowernumber", "permission_module_id", "permission_id"],
94
);
95
96
=head1 RELATIONS
97
98
=head2 borrowernumber
99
100
Type: belongs_to
101
102
Related object: L<Koha::Schema::Result::Borrower>
103
104
=cut
105
106
__PACKAGE__->belongs_to(
107
  "borrowernumber",
108
  "Koha::Schema::Result::Borrower",
109
  { borrowernumber => "borrowernumber" },
110
  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
111
);
112
113
=head2 permission
114
115
Type: belongs_to
116
117
Related object: L<Koha::Schema::Result::Permission>
118
119
=cut
120
121
__PACKAGE__->belongs_to(
122
  "permission",
123
  "Koha::Schema::Result::Permission",
124
  { permission_id => "permission_id" },
125
  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
126
);
127
128
=head2 permission_module
129
130
Type: belongs_to
131
132
Related object: L<Koha::Schema::Result::PermissionModule>
133
134
=cut
135
136
__PACKAGE__->belongs_to(
137
  "permission_module",
138
  "Koha::Schema::Result::PermissionModule",
139
  { permission_module_id => "permission_module_id" },
140
  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
141
);
142
143
144
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2015-07-17 12:21:37
145
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:WaapKkhLT6DkqDZGVFvbQg
146
147
148
# You can replace this text with custom code or comments, and it will be preserved on regeneration
149
1;
(-)a/Koha/Schema/Result/PermissionModule.pm (+119 lines)
Line 0 Link Here
1
use utf8;
2
package Koha::Schema::Result::PermissionModule;
3
4
# Created by DBIx::Class::Schema::Loader
5
# DO NOT MODIFY THE FIRST PART OF THIS FILE
6
7
=head1 NAME
8
9
Koha::Schema::Result::PermissionModule
10
11
=cut
12
13
use strict;
14
use warnings;
15
16
use base 'DBIx::Class::Core';
17
18
=head1 TABLE: C<permission_modules>
19
20
=cut
21
22
__PACKAGE__->table("permission_modules");
23
24
=head1 ACCESSORS
25
26
=head2 permission_module_id
27
28
  data_type: 'integer'
29
  is_auto_increment: 1
30
  is_nullable: 0
31
32
=head2 module
33
34
  data_type: 'varchar'
35
  is_nullable: 0
36
  size: 32
37
38
=head2 description
39
40
  data_type: 'varchar'
41
  is_nullable: 1
42
  size: 255
43
44
=cut
45
46
__PACKAGE__->add_columns(
47
  "permission_module_id",
48
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
49
  "module",
50
  { data_type => "varchar", is_nullable => 0, size => 32 },
51
  "description",
52
  { data_type => "varchar", is_nullable => 1, size => 255 },
53
);
54
55
=head1 PRIMARY KEY
56
57
=over 4
58
59
=item * L</permission_module_id>
60
61
=back
62
63
=cut
64
65
__PACKAGE__->set_primary_key("permission_module_id");
66
67
=head1 UNIQUE CONSTRAINTS
68
69
=head2 C<module>
70
71
=over 4
72
73
=item * L</module>
74
75
=back
76
77
=cut
78
79
__PACKAGE__->add_unique_constraint("module", ["module"]);
80
81
=head1 RELATIONS
82
83
=head2 borrower_permissions
84
85
Type: has_many
86
87
Related object: L<Koha::Schema::Result::BorrowerPermission>
88
89
=cut
90
91
__PACKAGE__->has_many(
92
  "borrower_permissions",
93
  "Koha::Schema::Result::BorrowerPermission",
94
  { "foreign.permission_module_id" => "self.permission_module_id" },
95
  { cascade_copy => 0, cascade_delete => 0 },
96
);
97
98
=head2 permissions
99
100
Type: has_many
101
102
Related object: L<Koha::Schema::Result::Permission>
103
104
=cut
105
106
__PACKAGE__->has_many(
107
  "permissions",
108
  "Koha::Schema::Result::Permission",
109
  { "foreign.module" => "self.module" },
110
  { cascade_copy => 0, cascade_delete => 0 },
111
);
112
113
114
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2015-07-17 12:21:37
115
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:qc8JEcG/PXIlFu44MB+ouQ
116
117
118
# You can replace this text with custom code or comments, and it will be preserved on regeneration
119
1;
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/auth.tt (-1 / +3 lines)
Lines 43-49 Link Here
43
<form action="[% url %]" method="post" name="loginform" id="loginform">
43
<form action="[% url %]" method="post" name="loginform" id="loginform">
44
    <input type="hidden" name="koha_login_context" value="intranet" />
44
    <input type="hidden" name="koha_login_context" value="intranet" />
45
[% FOREACH INPUT IN INPUTS %]
45
[% FOREACH INPUT IN INPUTS %]
46
    <input type="hidden" name="[% INPUT.name |html %]" value="[% INPUT.value |html %]" />
46
	[% UNLESS INPUT.name == 'logout.x' #No reason to send the logout-signal again %]
47
        <input type="hidden" name="[% INPUT.name |html %]" value="[% INPUT.value |html %]" />
48
	[% END %]
47
[% END %]
49
[% END %]
48
<p><label for="userid">Username:</label>
50
<p><label for="userid">Username:</label>
49
<input type="text" name="userid" id="userid" class="input focus" value="[% userid %]" size="20" tabindex="1" />
51
<input type="text" name="userid" id="userid" class="input focus" value="[% userid %]" size="20" tabindex="1" />
(-)a/koha-tmpl/opac-tmpl/bootstrap/en/modules/opac-auth.tt (-1 / +3 lines)
Lines 142-148 Link Here
142
                                <input type="hidden" name="koha_login_context" value="opac" />
142
                                <input type="hidden" name="koha_login_context" value="opac" />
143
                                <fieldset class="brief">
143
                                <fieldset class="brief">
144
                                    [% FOREACH INPUT IN INPUTS %]
144
                                    [% FOREACH INPUT IN INPUTS %]
145
                                        <input type="hidden" name="[% INPUT.name |html %]" value="[% INPUT.value |html %]" />
145
                                        [% UNLESS INPUT.name == 'logout.x' #No reason to send the logout-signal again %]
146
                                            <input type="hidden" name="[% INPUT.name |html %]" value="[% INPUT.value |html %]" />
147
                                        [% END %]
146
                                    [% END %]
148
                                    [% END %]
147
                                    <label for="userid">Login</label>
149
                                    <label for="userid">Login</label>
148
                                    <input type="text"  size="25" id="userid"  name="userid" />
150
                                    <input type="text"  size="25" id="userid"  name="userid" />
(-)a/opac/opac-search-history.pl (-1 lines)
Lines 41-47 my ($template, $loggedinuser, $cookie) = get_template_and_user( Link Here
41
        query => $cgi,
41
        query => $cgi,
42
        type => "opac",
42
        type => "opac",
43
        authnotrequired => 1,
43
        authnotrequired => 1,
44
        flagsrequired => {borrowers => 1},
45
        debug => 1,
44
        debug => 1,
46
    }
45
    }
47
);
46
);
(-)a/opac/opac-user.pl (-1 / +1 lines)
Lines 349-355 foreach my $res (@reserves) { Link Here
349
$template->param( WAITING => \@waiting );
349
$template->param( WAITING => \@waiting );
350
350
351
# current alert subscriptions
351
# current alert subscriptions
352
my $alerts = getalert($borrowernumber) if $borrowernumber;
352
my $alerts = getalert($borrowernumber) if $borrowernumber; #Superuser has no borrowernumber
353
foreach ( @$alerts ) {
353
foreach ( @$alerts ) {
354
    $_->{ $_->{type} } = 1;
354
    $_->{ $_->{type} } = 1;
355
    $_->{relatedto} = findrelatedto( $_->{type}, $_->{externalid} );
355
    $_->{relatedto} = findrelatedto( $_->{type}, $_->{externalid} );
(-)a/t/db_dependent/Auth_with_ldap.t (-9 / +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)");
(-)a/t/db_dependent/Koha/Borrower.t (-1 / +55 lines)
Line 0 Link Here
0
- 
1
#!/usr/bin/perl
2
3
# Copyright 2015 Open Source Freedom Fighters
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use Test::More; #Please don't set the test count here. It is nothing but trouble when rebasing against master and is of dubious help.
21
22
use Koha::Borrower;
23
24
25
26
testIsSuperuser();
27
28
29
30
31
32
################################################################################
33
#### Define test subroutines here ##############################################
34
################################################################################
35
36
=head testIsSuperuser
37
@UNIT_TEST
38
Tests Koha::Borrower->isSuperuser()
39
=cut
40
41
sub testIsSuperuser {
42
    my $borrower = Koha::Borrower->new();
43
    ok((not(defined($borrower->isSuperuser()))), "isSuperuser(): By default user is not defined as superuser.");
44
    ok(($borrower->isSuperuser(1) == 1), "isSuperuser(): Setting user as superuser returns 1.");
45
    ok(($borrower->isSuperuser() == 1), "isSuperuser(): Getting superuser status from a superuser returns 1.");
46
    ok((not(defined($borrower->isSuperuser(0)))), "isSuperuser(): Removing superuser status from a superuser OK and returns undef");
47
    ok((not(defined($borrower->isSuperuser()))), "isSuperuser(): Ex-superuser superuser status is undef");
48
}
49
50
51
52
53
#######################
54
done_testing(); #YAY!!
55
#######################

Return to bug 7174