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 |