Index: openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl,v diff -u -r1.7.2.7 -r1.7.2.8 --- openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl 26 Mar 2024 09:10:06 -0000 1.7.2.7 +++ openacs-4/packages/acs-tcl/tcl/test/test-permissions-procs.tcl 27 Mar 2024 11:46:40 -0000 1.7.2.8 @@ -169,10 +169,13 @@ site_node::instantiate_and_mount application_group::group_id_from_package_id group::add_member - } ad_proc_permission_inheritance_and_groups { + group::get_rel_segment + } test_inheritance_and_custom_permissions { - Test "advanced" permission use cases: inheritance via - permission context and group permissions. + Test "advanced" permission use cases: + - inheritance via permission context + - permissions as membed of a group + - custom user-defined permissions @author Antonio Pisano @@ -184,6 +187,8 @@ set user_$i [dict get [acs::test::user::create] user_id] } + set admin_user [dict get [acs::test::user::create -admin] user_id] + aa_run_with_teardown -rollback -test_code { # # To test permissions on some object, we create 2 @@ -278,7 +283,7 @@ # Now verify permissions in various inheritance settings # - aa_section "Inheritance ON" + aa_section "Standard permission - Inheritance ON" for {set i 1} {$i <= 2} {incr i} { set user_id [set user_$i] @@ -294,6 +299,8 @@ [permission::permission_p -party_id $user_4 -object_id $test_subsite_2 -privilege "admin"] aa_true "Group 1 has admin privilege on subsite 2" \ [permission::permission_p -party_id $test_group_1 -object_id $test_subsite_2 -privilege "admin"] + aa_true "SWA has admin privilege on subsite 2" \ + [permission::permission_p -party_id $admin_user -object_id $test_subsite_2 -privilege "admin"] set parties_with_permissions [list] foreach entry [permission::get_parties_with_permission \ @@ -302,7 +309,7 @@ lassign $entry party_name party_id lappend parties_with_permissions $party_id } - foreach party_id [list $test_group_1 $user_1 $user_2 $user_4] { + foreach party_id [list $test_group_1 $user_1 $user_2 $user_4 $admin_user] { aa_true "'$party_id' belongs to the parties with admin privileges '$parties_with_permissions'" \ {$party_id in $parties_with_permissions} } @@ -311,7 +318,7 @@ {$party_id ni $parties_with_permissions} } - aa_section "Inheritance OFF" + aa_section "Standard permission - Inheritance OFF" permission::toggle_inherit -object_id $test_subsite_2 @@ -328,7 +335,9 @@ aa_true "User 4 has admin privilege on subsite 2" \ [permission::permission_p -party_id $user_4 -object_id $test_subsite_2 -privilege "admin"] aa_false "Group 1 has NO admin privilege on subsite 2" \ - [permission::permission_p -party_id $test_group_1 -object_id $test_subsite_2 -privilege "admin"] + [permission::permission_p -party_id $test_group_1 -object_id $test_subsite_2 -privilege "admin"] + aa_true "SWA has admin privilege on subsite 2" \ + [permission::permission_p -party_id $admin_user -object_id $test_subsite_2 -privilege "admin"] set parties_with_permissions [list] foreach entry [permission::get_parties_with_permission \ @@ -337,7 +346,7 @@ lassign $entry party_name party_id lappend parties_with_permissions $party_id } - foreach party_id [list $user_4] { + foreach party_id [list $user_4 $admin_user] { aa_true "'$party_id' belongs to the parties with admin privileges '$parties_with_permissions'" \ {$party_id in $parties_with_permissions} } @@ -347,9 +356,210 @@ } - } -teardown_code { - for {set i 1} {$i <= 4} {incr i} { + aa_section "Create a custom user-defined permission" + + set privilege __test_permission + aa_log "Creating a custom permission" + ::acs::dc call acs_privilege create_privilege -privilege $privilege + + aa_log "Grant '$privilege' for users of group 1 in the first subsite." + permission::grant -party_id $test_group_1 -object_id $test_subsite_1 -privilege $privilege + + aa_log "Grant '$privilege' for user_4 in the second subsite." + permission::grant -party_id $user_4 -object_id $test_subsite_2 -privilege $privilege + + + aa_section "Custom non-child permission - Inheritance ON" + + permission::set_inherit -object_id $test_subsite_2 + + for {set i 1} {$i <= 2} {incr i} { set user_id [set user_$i] + aa_true "User '$user_id' from group 1, is has '$privilege' of subsite 2" \ + [permission::permission_p -party_id $user_id -object_id $test_subsite_2 -privilege $privilege] + } + for {set i 3} {$i <= 4} {incr i} { + set user_id [set user_$i] + aa_false "User '$user_id' from group 2, has NOT '$privilege' of subsite 1" \ + [permission::permission_p -party_id $user_id -object_id $test_subsite_1 -privilege $privilege] + } + aa_true "User 4 has $privilege privilege on subsite 2" \ + [permission::permission_p -party_id $user_4 -object_id $test_subsite_2 -privilege $privilege] + aa_true "Group 1 has $privilege privilege on subsite 2" \ + [permission::permission_p -party_id $test_group_1 -object_id $test_subsite_2 -privilege $privilege] + # + # An SWA does not have a custom non-child permission when + # this is inherited, because it is not a member of any + # party having it. + # + # The only parties with this permission are those we have + # set explicitly. + # + aa_false "SWA has NOT $privilege privilege on subsite 2" \ + [permission::permission_p -party_id $admin_user -object_id $test_subsite_2 -privilege $privilege] + + set parties_with_permissions [list] + foreach entry [permission::get_parties_with_permission \ + -object_id $test_subsite_2 \ + -privilege $privilege] { + lassign $entry party_name party_id + lappend parties_with_permissions $party_id + } + foreach party_id [list $test_group_1 $user_1 $user_2 $user_4] { + aa_true "'$party_id' belongs to the parties with $privilege privileges '$parties_with_permissions'" \ + {$party_id in $parties_with_permissions} + } + foreach party_id [list $test_group_2 $user_3 $admin_user] { + aa_true "'$party_id' does NOT belong to the parties with $privilege privileges '$parties_with_permissions'" \ + {$party_id ni $parties_with_permissions} + } + + + aa_section "Custom non-child permission - Inheritance OFF" + + permission::set_not_inherit -object_id $test_subsite_2 + + for {set i 1} {$i <= 2} {incr i} { + set user_id [set user_$i] + aa_false "User '$user_id' from group 1, is NOT an admin of subsite 2" \ + [permission::permission_p -party_id $user_id -object_id $test_subsite_2 -privilege "admin"] + } + for {set i 3} {$i <= 4} {incr i} { + set user_id [set user_$i] + aa_false "User '$user_id' from group 2, is NOT an admin of subsite 1" \ + [permission::permission_p -party_id $user_id -object_id $test_subsite_1 -privilege "admin"] + } + aa_true "User 4 has admin privilege on subsite 2" \ + [permission::permission_p -party_id $user_4 -object_id $test_subsite_2 -privilege "admin"] + aa_false "Group 1 has NO admin privilege on subsite 2" \ + [permission::permission_p -party_id $test_group_1 -object_id $test_subsite_2 -privilege "admin"] + # + # Maybe counterintuitively, an SWA will have permission + # here when inheritance is off, because in this case the + # object's context will be forced to the root context, + # where the SWA has admin privilege. + # + aa_true "SWA has admin privilege on subsite 2" \ + [permission::permission_p -party_id $admin_user -object_id $test_subsite_2 -privilege "admin"] + + set parties_with_permissions [list] + foreach entry [permission::get_parties_with_permission \ + -object_id $test_subsite_2 \ + -privilege admin] { + lassign $entry party_name party_id + lappend parties_with_permissions $party_id + } + foreach party_id [list $user_4 $admin_user] { + aa_true "'$party_id' belongs to the parties with admin privileges '$parties_with_permissions'" \ + {$party_id in $parties_with_permissions} + } + foreach party_id [list $test_group_1 $test_group_2 $user_1 $user_2 $user_3] { + aa_true "'$party_id' does NOT belong to the parties with admin privileges '$parties_with_permissions'" \ + {$party_id ni $parties_with_permissions} + } + + aa_section "Custom permission child of a standard permission - Inheritance ON" + + aa_log "Making the privilege a child of the read privilege" + ::acs::dc call acs_privilege add_child \ + -privilege read -child_privilege $privilege + + permission::set_inherit -object_id $test_subsite_2 + + # + # As the new privilege is a child of the read privilege, + # members of Group 2 will also have this permission. + # + for {set i 1} {$i <= 2} {incr i} { + set user_id [set user_$i] + aa_true "User '$user_id' from group 1, is has '$privilege' on subsite 2" \ + [permission::permission_p -party_id $user_id -object_id $test_subsite_2 -privilege $privilege] + } + for {set i 3} {$i <= 4} {incr i} { + set user_id [set user_$i] + aa_true "User '$user_id' from group 2, is has '$privilege' on subsite 2" \ + [permission::permission_p -party_id $user_id -object_id $test_subsite_2 -privilege $privilege] + } + aa_true "Group 1 has $privilege privilege on subsite 2" \ + [permission::permission_p -party_id $test_group_1 -object_id $test_subsite_2 -privilege $privilege] + aa_true "SWA has $privilege privilege on subsite 2" \ + [permission::permission_p -party_id $admin_user -object_id $test_subsite_2 -privilege $privilege] + # + # Group 2 itself won't have permission, as default read + # for members is obtained through the relationship + # segment. + # + aa_false "Group 2 has NOT $privilege privilege on subsite 2" \ + [permission::permission_p -party_id $test_group_2 -object_id $test_subsite_2 -privilege $privilege] + set test_group_2_members [group::get_rel_segment -group_id $test_group_2 -type membership_rel] + aa_true "Group 2 membership rel has $privilege privilege on subsite 2" \ + [permission::permission_p -party_id $test_group_2_members -object_id $test_subsite_2 -privilege $privilege] + + set parties_with_permissions [list] + foreach entry [permission::get_parties_with_permission \ + -object_id $test_subsite_2 \ + -privilege $privilege] { + lassign $entry party_name party_id + lappend parties_with_permissions $party_id + } + foreach party_id [list $test_group_1 $test_group_2_members $user_1 $user_2 $user_3 $user_4] { + aa_true "'$party_id' belongs to the parties with $privilege privileges '$parties_with_permissions'" \ + {$party_id in $parties_with_permissions} + } + foreach party_id [list $test_group_2] { + aa_true "'$party_id' does NOT belong to the parties with admin privileges '$parties_with_permissions'" \ + {$party_id ni $parties_with_permissions} + } + + + aa_section "Custom permission child of a standard permission - Inheritance OFF" + + permission::set_not_inherit -object_id $test_subsite_2 + + # + # Group 1 does not inherit this permission now. + # + for {set i 1} {$i <= 2} {incr i} { + set user_id [set user_$i] + aa_false "User '$user_id' from group 1, is has NOT '$privilege' on subsite 2" \ + [permission::permission_p -party_id $user_id -object_id $test_subsite_2 -privilege $privilege] + } + # + # Group 2 still has it by means of the privilege being a child of read + # + for {set i 3} {$i <= 4} {incr i} { + set user_id [set user_$i] + aa_true "User '$user_id' from group 2, is has '$privilege' on subsite 2" \ + [permission::permission_p -party_id $user_id -object_id $test_subsite_2 -privilege $privilege] + } + aa_false "Group 1 has NOT $privilege privilege on subsite 2" \ + [permission::permission_p -party_id $test_group_1 -object_id $test_subsite_2 -privilege $privilege] + aa_true "SWA has $privilege privilege on subsite 2" \ + [permission::permission_p -party_id $admin_user -object_id $test_subsite_2 -privilege $privilege] + aa_false "Group 2 has NOT $privilege privilege on subsite 2" \ + [permission::permission_p -party_id $test_group_2 -object_id $test_subsite_2 -privilege $privilege] + set test_group_2_members [group::get_rel_segment -group_id $test_group_2 -type membership_rel] + aa_true "Group 2 membership rel has $privilege privilege on subsite 2" \ + [permission::permission_p -party_id $test_group_2_members -object_id $test_subsite_2 -privilege $privilege] + + set parties_with_permissions [list] + foreach entry [permission::get_parties_with_permission \ + -object_id $test_subsite_2 \ + -privilege $privilege] { + lassign $entry party_name party_id + lappend parties_with_permissions $party_id + } + foreach party_id [list $test_group_2_members $user_3 $user_4] { + aa_true "'$party_id' belongs to the parties with $privilege privileges '$parties_with_permissions'" \ + {$party_id in $parties_with_permissions} + } + foreach party_id [list $test_group_1 $test_group_2 $user_1 $user_2] { + aa_true "'$party_id' does NOT belong to the parties with admin privileges '$parties_with_permissions'" \ + {$party_id ni $parties_with_permissions} + } + + } -teardown_code { + foreach user_id [list $user_1 $user_2 $user_3 $user_4 $admin_user] { acs::test::user::delete \ -user_id $user_id \ -delete_created_acs_objects