_acs-tcl__ad_proc_permission_grant_and_revoke (private)
_acs-tcl__ad_proc_permission_grant_and_revoke
Defined in packages/acs-tcl/tcl/test/test-permissions-procs.tcl
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
Source code: set _aa_export {} set body_count 1 foreach testcase_body {{ aa_run_with_teardown -rollback -test_code { # We get a user_id as party_id. set user_id [db_nextval acs_object_id_seq] # Create the user set user_info [acs::test::user::create -user_id $user_id] # Create and mount new subsite to test the permissions on this # instance. set site_name [ad_generate_random_string] set new_package_id [site_node::instantiate_and_mount -node_name $site_name -package_key acs-subsite] # Grant privileges of admin,read,write and create, after check # this ones, after revoke this ones. # Grant admin privilege permission::grant -party_id $user_id -object_id $new_package_id -privilege "admin" # Verifying the admin privilege on the user aa_true "testing admin privilege" [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin"] # Revoking admin privilege permission::revoke -party_id $user_id -object_id $new_package_id -privilege "admin" aa_false "testing if admin privilege was revoked" [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "admin"] # Grant read privilege permission::grant -party_id $user_id -object_id $new_package_id -privilege "read" # Verifying the read privilege on the user aa_true "testing read permissions" [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "read"] # Revoking read privilege permission::revoke -party_id $user_id -object_id $new_package_id -privilege "read" # We tested with a query because we have problems with inherit aa_false "testing if read privilege was revoked" [db_string test_read { select 1 from acs_permissions where object_id = :new_package_id and grantee_id = :user_id } -default 0] # Grant write privilege permission::grant -party_id $user_id -object_id $new_package_id -privilege "write" # Verifying the write privilege on the user aa_true "testing write permissions" [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write"] # Revoking write privilege permission::revoke -party_id $user_id -object_id $new_package_id -privilege "write" aa_false "testing if write permissions was revoked" [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "write"] # Grant create privilege permission::grant -party_id $user_id -object_id $new_package_id -privilege "create" # Verifying the create privilege on the user aa_true "testing create permissions" [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create"] # Revoking create privilege permission::revoke -party_id $user_id -object_id $new_package_id -privilege "create" aa_false "testing if create privileges was revoked" [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "create"] # Grant delete privilege permission::grant -party_id $user_id -object_id $new_package_id -privilege "delete" # Verifying the delete privilege on the user aa_true "testing delete permissions" [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete"] # Revoking delete privilege permission::revoke -party_id $user_id -object_id $new_package_id -privilege "delete" aa_false "testing if delete permissions was revoked" [permission::permission_p -party_id $user_id -object_id $new_package_id -privilege "delete"] } }} { aa_log "Running testcase body $body_count" set ::__aa_test_indent [info level] set catch_val [catch $testcase_body msg] if {$catch_val != 0 && $catch_val != 2} { aa_log_result "fail" "ad_proc_permission_grant_and_revoke (body $body_count): Error during execution: $msg, stack trace: \n$::errorInfo" } incr body_count }XQL Not present: Generic, PostgreSQL, Oracle