|
Lines 36-41
use Koha::AuthUtils qw(get_script_name hash_password);
Link Here
|
| 36 |
use Koha::Library::Groups; |
36 |
use Koha::Library::Groups; |
| 37 |
use Koha::Libraries; |
37 |
use Koha::Libraries; |
| 38 |
use Koha::Patrons; |
38 |
use Koha::Patrons; |
|
|
39 |
use Koha::Permissions; |
| 39 |
use POSIX qw/strftime/; |
40 |
use POSIX qw/strftime/; |
| 40 |
use List::MoreUtils qw/ any /; |
41 |
use List::MoreUtils qw/ any /; |
| 41 |
use Encode qw( encode is_utf8); |
42 |
use Encode qw( encode is_utf8); |
|
Lines 57-63
BEGIN {
Link Here
|
| 57 |
@EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash |
58 |
@EXPORT_OK = qw(&check_api_auth &get_session &check_cookie_auth &checkpw &checkpw_internal &checkpw_hash |
| 58 |
&get_all_subpermissions &get_user_subpermissions |
59 |
&get_all_subpermissions &get_user_subpermissions |
| 59 |
); |
60 |
); |
| 60 |
%EXPORT_TAGS = ( EditPermissions => [qw(get_all_subpermissions get_user_subpermissions)] ); |
|
|
| 61 |
$ldap = C4::Context->config('useldapserver') || 0; |
61 |
$ldap = C4::Context->config('useldapserver') || 0; |
| 62 |
$cas = C4::Context->preference('casAuthentication'); |
62 |
$cas = C4::Context->preference('casAuthentication'); |
| 63 |
$shib = C4::Context->config('useshibboleth') || 0; |
63 |
$shib = C4::Context->config('useshibboleth') || 0; |
|
Lines 1065-1071
sub checkauth {
Link Here
|
| 1065 |
|
1065 |
|
| 1066 |
if ( $return == 1 ) { |
1066 |
if ( $return == 1 ) { |
| 1067 |
my $select = " |
1067 |
my $select = " |
| 1068 |
SELECT borrowernumber, firstname, surname, flags, borrowers.branchcode, |
1068 |
SELECT borrowernumber, firstname, surname, borrowers.branchcode, |
| 1069 |
branches.branchname as branchname, |
1069 |
branches.branchname as branchname, |
| 1070 |
branches.branchprinter as branchprinter, |
1070 |
branches.branchprinter as branchprinter, |
| 1071 |
email |
1071 |
email |
|
Lines 1088-1097
sub checkauth {
Link Here
|
| 1088 |
} |
1088 |
} |
| 1089 |
} |
1089 |
} |
| 1090 |
if ( $sth->rows ) { |
1090 |
if ( $sth->rows ) { |
| 1091 |
( $borrowernumber, $firstname, $surname, $userflags, |
1091 |
( $borrowernumber, $firstname, $surname, |
| 1092 |
$branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow; |
1092 |
$branchcode, $branchname, $branchprinter, $emailaddress ) = $sth->fetchrow; |
| 1093 |
$debug and print STDERR "AUTH_3 results: " . |
1093 |
$debug and print STDERR "AUTH_3 results: " . |
| 1094 |
"$cardnumber,$borrowernumber,$userid,$firstname,$surname,$userflags,$branchcode,$emailaddress\n"; |
1094 |
"$cardnumber,$borrowernumber,$userid,$firstname,$surname,$branchcode,$emailaddress\n"; |
| 1095 |
} else { |
1095 |
} else { |
| 1096 |
print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n"; |
1096 |
print STDERR "AUTH_3: no results for userid='$userid', cardnumber='$cardnumber'.\n"; |
| 1097 |
} |
1097 |
} |
|
Lines 1143-1149
sub checkauth {
Link Here
|
| 1143 |
$session->param( 'surname', $surname ); |
1143 |
$session->param( 'surname', $surname ); |
| 1144 |
$session->param( 'branch', $branchcode ); |
1144 |
$session->param( 'branch', $branchcode ); |
| 1145 |
$session->param( 'branchname', $branchname ); |
1145 |
$session->param( 'branchname', $branchname ); |
| 1146 |
$session->param( 'flags', $userflags ); |
|
|
| 1147 |
$session->param( 'emailaddress', $emailaddress ); |
1146 |
$session->param( 'emailaddress', $emailaddress ); |
| 1148 |
$session->param( 'ip', $session->remote_addr() ); |
1147 |
$session->param( 'ip', $session->remote_addr() ); |
| 1149 |
$session->param( 'lasttime', time() ); |
1148 |
$session->param( 'lasttime', time() ); |
|
Lines 1848-1882
sub checkpw_internal {
Link Here
|
| 1848 |
|
1847 |
|
| 1849 |
my $sth = |
1848 |
my $sth = |
| 1850 |
$dbh->prepare( |
1849 |
$dbh->prepare( |
| 1851 |
"select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?" |
1850 |
"select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname from borrowers join branches on borrowers.branchcode=branches.branchcode where userid=?" |
| 1852 |
); |
1851 |
); |
| 1853 |
$sth->execute($userid); |
1852 |
$sth->execute($userid); |
| 1854 |
if ( $sth->rows ) { |
1853 |
if ( $sth->rows ) { |
| 1855 |
my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname, |
1854 |
my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname, |
| 1856 |
$surname, $branchcode, $branchname, $flags ) |
1855 |
$surname, $branchcode, $branchname ) |
| 1857 |
= $sth->fetchrow; |
1856 |
= $sth->fetchrow; |
| 1858 |
|
1857 |
|
| 1859 |
if ( checkpw_hash( $password, $stored_hash ) ) { |
1858 |
if ( checkpw_hash( $password, $stored_hash ) ) { |
| 1860 |
|
1859 |
|
| 1861 |
C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber, |
1860 |
C4::Context->set_userenv( "$borrowernumber", $userid, $cardnumber, |
| 1862 |
$firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv; |
1861 |
$firstname, $surname, $branchcode, $branchname ) unless $no_set_userenv; |
| 1863 |
return 1, $cardnumber, $userid; |
1862 |
return 1, $cardnumber, $userid; |
| 1864 |
} |
1863 |
} |
| 1865 |
} |
1864 |
} |
| 1866 |
$sth = |
1865 |
$sth = |
| 1867 |
$dbh->prepare( |
1866 |
$dbh->prepare( |
| 1868 |
"select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname,flags from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?" |
1867 |
"select password,cardnumber,borrowernumber,userid,firstname,surname,borrowers.branchcode,branches.branchname from borrowers join branches on borrowers.branchcode=branches.branchcode where cardnumber=?" |
| 1869 |
); |
1868 |
); |
| 1870 |
$sth->execute($userid); |
1869 |
$sth->execute($userid); |
| 1871 |
if ( $sth->rows ) { |
1870 |
if ( $sth->rows ) { |
| 1872 |
my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname, |
1871 |
my ( $stored_hash, $cardnumber, $borrowernumber, $userid, $firstname, |
| 1873 |
$surname, $branchcode, $branchname, $flags ) |
1872 |
$surname, $branchcode, $branchname ) |
| 1874 |
= $sth->fetchrow; |
1873 |
= $sth->fetchrow; |
| 1875 |
|
1874 |
|
| 1876 |
if ( checkpw_hash( $password, $stored_hash ) ) { |
1875 |
if ( checkpw_hash( $password, $stored_hash ) ) { |
| 1877 |
|
1876 |
|
| 1878 |
C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber, |
1877 |
C4::Context->set_userenv( $borrowernumber, $userid, $cardnumber, |
| 1879 |
$firstname, $surname, $branchcode, $branchname, $flags ) unless $no_set_userenv; |
1878 |
$firstname, $surname, $branchcode, $branchname ) unless $no_set_userenv; |
| 1880 |
return 1, $cardnumber, $userid; |
1879 |
return 1, $cardnumber, $userid; |
| 1881 |
} |
1880 |
} |
| 1882 |
} |
1881 |
} |
|
Lines 1900-1946
sub checkpw_hash {
Link Here
|
| 1900 |
|
1899 |
|
| 1901 |
=head2 getuserflags |
1900 |
=head2 getuserflags |
| 1902 |
|
1901 |
|
| 1903 |
my $authflags = getuserflags($flags, $userid, [$dbh]); |
1902 |
my $authflags = getuserflags($userid); |
| 1904 |
|
1903 |
|
| 1905 |
Translates integer flags into permissions strings hash. |
1904 |
Translates integer flags into permissions strings hash. |
| 1906 |
|
1905 |
|
| 1907 |
C<$flags> is the integer userflags value ( borrowers.userflags ) |
|
|
| 1908 |
C<$userid> is the members.userid, used for building subpermissions |
1906 |
C<$userid> is the members.userid, used for building subpermissions |
| 1909 |
C<$authflags> is a hashref of permissions |
|
|
| 1910 |
|
1907 |
|
| 1911 |
=cut |
1908 |
=cut |
| 1912 |
|
1909 |
|
| 1913 |
sub getuserflags { |
1910 |
sub getuserflags { |
| 1914 |
my $flags = shift; |
1911 |
my $params = shift; |
| 1915 |
my $userid = shift; |
1912 |
|
| 1916 |
my $dbh = @_ ? shift : C4::Context->dbh; |
1913 |
my $userid = $params->{userid}; |
|
|
1914 |
my $force_subpermissions = $params->{force_subpermissions}; |
| 1915 |
|
| 1916 |
my $patron = Koha::Patrons->find( { userid => $userid } ); |
| 1917 |
return unless $patron; |
| 1918 |
|
| 1917 |
my $userflags; |
1919 |
my $userflags; |
| 1918 |
{ |
1920 |
my @permissions = Koha::Permissions->search( { parent => undef } ); |
| 1919 |
# I don't want to do this, but if someone logs in as the database |
1921 |
foreach my $p (@permissions) { |
| 1920 |
# user, it would be preferable not to spam them to death with |
1922 |
my $patron_has = $p->patron_has( $patron->id ); |
| 1921 |
# numeric warnings. So, we make $flags numeric. |
|
|
| 1922 |
no warnings 'numeric'; |
| 1923 |
$flags += 0; |
| 1924 |
} |
| 1925 |
my $sth = $dbh->prepare("SELECT bit, flag, defaulton FROM userflags"); |
| 1926 |
$sth->execute; |
| 1927 |
|
1923 |
|
| 1928 |
while ( my ( $bit, $flag, $defaulton ) = $sth->fetchrow ) { |
1924 |
if ( $patron_has && !$force_subpermissions ) { |
| 1929 |
if ( ( $flags & ( 2**$bit ) ) || $defaulton ) { |
1925 |
$userflags->{ $p->code() } = $p->patron_has( $patron->id ); |
| 1930 |
$userflags->{$flag} = 1; |
|
|
| 1931 |
} |
1926 |
} |
| 1932 |
else { |
1927 |
else { |
| 1933 |
$userflags->{$flag} = 0; |
1928 |
my @subpermissions = $p->subpermissions; |
|
|
1929 |
foreach my $sp ( $p->subpermissions ) { |
| 1930 |
$userflags->{ $p->code } = $sp->patron_has( $patron->id ); |
| 1931 |
} |
| 1934 |
} |
1932 |
} |
| 1935 |
} |
1933 |
} |
| 1936 |
|
1934 |
|
| 1937 |
# get subpermissions and merge with top-level permissions |
|
|
| 1938 |
my $user_subperms = get_user_subpermissions($userid); |
| 1939 |
foreach my $module ( keys %$user_subperms ) { |
| 1940 |
next if $userflags->{$module} == 1; # user already has permission for everything in this module |
| 1941 |
$userflags->{$module} = $user_subperms->{$module}; |
| 1942 |
} |
| 1943 |
|
| 1944 |
return $userflags; |
1935 |
return $userflags; |
| 1945 |
} |
1936 |
} |
| 1946 |
|
1937 |
|
|
Lines 1972-1991
necessary to check borrowers.flags.
Link Here
|
| 1972 |
sub get_user_subpermissions { |
1963 |
sub get_user_subpermissions { |
| 1973 |
my $userid = shift; |
1964 |
my $userid = shift; |
| 1974 |
|
1965 |
|
| 1975 |
my $dbh = C4::Context->dbh; |
1966 |
return getuserflags( { userid => $userid, force_subpermissions => 1 } ); |
| 1976 |
my $sth = $dbh->prepare( "SELECT flag, user_permissions.code |
|
|
| 1977 |
FROM user_permissions |
| 1978 |
JOIN permissions USING (module_bit, code) |
| 1979 |
JOIN userflags ON (module_bit = bit) |
| 1980 |
JOIN borrowers USING (borrowernumber) |
| 1981 |
WHERE userid = ?" ); |
| 1982 |
$sth->execute($userid); |
| 1983 |
|
| 1984 |
my $user_perms = {}; |
| 1985 |
while ( my $perm = $sth->fetchrow_hashref ) { |
| 1986 |
$user_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1; |
| 1987 |
} |
| 1988 |
return $user_perms; |
| 1989 |
} |
1967 |
} |
| 1990 |
|
1968 |
|
| 1991 |
=head2 get_all_subpermissions |
1969 |
=head2 get_all_subpermissions |
|
Lines 1993-2017
sub get_user_subpermissions {
Link Here
|
| 1993 |
my $perm_hashref = get_all_subpermissions(); |
1971 |
my $perm_hashref = get_all_subpermissions(); |
| 1994 |
|
1972 |
|
| 1995 |
Returns a hashref of hashrefs defining all specific |
1973 |
Returns a hashref of hashrefs defining all specific |
| 1996 |
permissions currently defined. The return value |
1974 |
permissions currently defined. The return value has |
| 1997 |
has the same structure as that of C<get_user_subpermissions>, |
1975 |
the same basic structure as that of C<get_user_subpermissions> |
| 1998 |
except that the innermost hash value is the description |
|
|
| 1999 |
of the subpermission. |
| 2000 |
|
1976 |
|
| 2001 |
=cut |
1977 |
=cut |
| 2002 |
|
1978 |
|
| 2003 |
sub get_all_subpermissions { |
1979 |
sub get_all_subpermissions { |
| 2004 |
my $dbh = C4::Context->dbh; |
1980 |
my $permissions; |
| 2005 |
my $sth = $dbh->prepare( "SELECT flag, code |
1981 |
|
| 2006 |
FROM permissions |
1982 |
my @permissions = Koha::Permissions->search({ parent => undef }); |
| 2007 |
JOIN userflags ON (module_bit = bit)" ); |
1983 |
foreach my $p ( @permissions ) { |
| 2008 |
$sth->execute(); |
1984 |
foreach my $sp ( $p->subpermissions ) { |
| 2009 |
|
1985 |
$permissions->{ $p->code }->{ $sp->code } = 1; |
| 2010 |
my $all_perms = {}; |
1986 |
} |
| 2011 |
while ( my $perm = $sth->fetchrow_hashref ) { |
|
|
| 2012 |
$all_perms->{ $perm->{'flag'} }->{ $perm->{'code'} } = 1; |
| 2013 |
} |
1987 |
} |
| 2014 |
return $all_perms; |
1988 |
|
|
|
1989 |
return $permissions; |
| 2015 |
} |
1990 |
} |
| 2016 |
|
1991 |
|
| 2017 |
=head2 haspermission |
1992 |
=head2 haspermission |
|
Lines 2027-2036
Returns member's flags or 0 if a permission is not met.
Link Here
|
| 2027 |
|
2002 |
|
| 2028 |
sub haspermission { |
2003 |
sub haspermission { |
| 2029 |
my ( $userid, $flagsrequired ) = @_; |
2004 |
my ( $userid, $flagsrequired ) = @_; |
| 2030 |
my $sth = C4::Context->dbh->prepare("SELECT flags FROM borrowers WHERE userid=?"); |
2005 |
|
| 2031 |
$sth->execute($userid); |
2006 |
my $flags = getuserflags( { userid => $userid } ); |
| 2032 |
my $row = $sth->fetchrow(); |
|
|
| 2033 |
my $flags = getuserflags( $row, $userid ); |
| 2034 |
if ( $userid eq C4::Context->config('user') ) { |
2007 |
if ( $userid eq C4::Context->config('user') ) { |
| 2035 |
|
2008 |
|
| 2036 |
# Super User Account from /etc/koha.conf |
2009 |
# Super User Account from /etc/koha.conf |