Index: openacs-4/packages/acs-api-browser/tcl/test/acs-api-browser-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-api-browser/tcl/test/acs-api-browser-procs.tcl,v diff -u -N -r1.4.2.25 -r1.4.2.26 --- openacs-4/packages/acs-api-browser/tcl/test/acs-api-browser-procs.tcl 19 Feb 2021 15:12:56 -0000 1.4.2.25 +++ openacs-4/packages/acs-api-browser/tcl/test/acs-api-browser-procs.tcl 22 Feb 2021 19:00:04 -0000 1.4.2.26 @@ -423,6 +423,15 @@ @creation-date 2020-02-18 } { + # Fetch service-contract procs to exclude them from the check + # when they are called from within the acs-service-contract + # package. + foreach alias [db_list get_sc_aliases { + select distinct impl_alias from acs_sc_impl_aliases + }] { + set sc_aliases($alias) 1 + } + foreach caller [lsort -dictionary [nsv_array names api_proc_doc]] { #set caller db_transaction set called_procs [api_called_proc_names -proc_name $caller] @@ -445,6 +454,12 @@ && $package_key ne "" && $caller_package_key ne $package_key } { + # It is fine for acs-service-contract to invoke + # contract implementations. + if {$caller_package_key eq "acs-service-contract" && + [info exists sc_aliases($called)]} { + continue + } if {[apidoc::get_doc_property $called protection public] eq "private" && ![string match AcsSc.* $caller] } { Index: openacs-4/packages/acs-authentication/tcl/local-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/local-procs.tcl,v diff -u -N -r1.47.2.2 -r1.47.2.3 --- openacs-4/packages/acs-authentication/tcl/local-procs.tcl 22 Feb 2021 14:35:59 -0000 1.47.2.2 +++ openacs-4/packages/acs-authentication/tcl/local-procs.tcl 22 Feb 2021 19:00:04 -0000 1.47.2.3 @@ -134,7 +134,7 @@ } -ad_proc -public auth::local::authentication::Authenticate { +ad_proc -private auth::local::authentication::Authenticate { username password {parameters {}} @@ -170,7 +170,7 @@ return [array get auth_info] } -ad_proc -public auth::local::authentication::GetParameters {} { +ad_proc -private auth::local::authentication::GetParameters {} { Implements the GetParameters operation of the auth_authentication service contract for the local account implementation. } { @@ -431,7 +431,7 @@ acs_sc::impl::delete -contract_name "auth_registration" -impl_name "local" } -ad_proc -public auth::local::registration::GetElements { +ad_proc -private auth::local::registration::GetElements { {parameters ""} } { Implements the GetElements operation of the auth_registration @@ -457,7 +457,7 @@ return [array get result] } -ad_proc -public auth::local::registration::Register { +ad_proc -private auth::local::registration::Register { parameters username authority_id @@ -571,7 +571,7 @@ return [array get result] } -ad_proc -public auth::local::registration::GetParameters {} { +ad_proc -private auth::local::registration::GetParameters {} { Implements the GetParameters operation of the auth_registration service contract for the local account implementation. } { Index: openacs-4/packages/acs-authentication/tcl/test-authority-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/Attic/test-authority-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-authentication/tcl/test-authority-procs.tcl 22 Feb 2021 19:00:04 -0000 1.1.2.1 @@ -0,0 +1,133 @@ +ad_library { + + Provide a simply authority named "acs_testing" for creating test + users during runs of the regression test. This is needed, when a + site/sub-site runs a registry which does e.g. a synchronized + registry, where no additional accounts can be created. + + @author Gustaf Neumann + @creation-date 2018-10-04 +} + +namespace eval acs::test::auth {} +namespace eval acs::test::auth::registration {} + +##### +# +# acs::test::auth +# +##### + +ad_proc -private acs::test::auth::install {} { + + Register the service contract implementations for the acs_testing + authority and update the authority accordingly. Do nothing, when + the registry exists already. + +} { + set authority_name acs_testing + + if {[auth::authority::get_id -short_name $authority_name] eq ""} { + ns_log notice "create authority $authority_name" + + set register_impl_id [acs_sc::impl::get_id \ + -owner acs-authentication \ + -name acs_testing \ + -contract auth_registration] + if {$register_impl_id eq ""} { + acs::test::auth::registration::register_impl + set register_impl_id [acs_sc::impl::get_id \ + -owner acs-authentication \ + -name acs_testing \ + -contract auth_registration] + ns_log notice "create authority $authority_name => register_impl_id $register_impl_id" + } + + set auth_impl_id [acs_sc::impl::get_id -owner acs-authentication -name local -contract auth_authentication] + set pwd_impl_id [acs_sc::impl::get_id -owner acs-authentication -name local -contract auth_password] + set user_info_impl_id [acs_sc::impl::get_id -owner acs-authentication -name local -contract auth_user_info] + + db_transaction { + array set row [list \ + short_name $authority_name \ + pretty_name "ACS Automated Testing" \ + auth_impl_id $auth_impl_id \ + pwd_impl_id $pwd_impl_id \ + register_impl_id $register_impl_id \ + user_info_impl_id $user_info_impl_id \ + ] + auth::authority::create -array row + } + } +} + +ad_proc -private acs::test::auth::registration::register_impl {} { + + Register the 'acs_testing' implementation of the + 'auth_registration' service contract. We just implement + "Register" new and reuse the implementations for "GetElements" and + "GetParameters" + + @return impl_id of the newly created implementation. +} { + ns_log notice "create registration::register_impl sc" + + set spec { + contract_name "auth_registration" + owner "acs-authentication" + name "acs_testing" + pretty_name "ACS Automated Testing" + aliases { + GetElements auth::local::registration::GetElements + Register acs::test::auth::registration::Register + GetParameters auth::local::registration::GetParameters + } + } + return [acs_sc::impl::new_from_spec -spec $spec] +} + + +ad_proc -private acs::test::auth::registration::Register { + parameters + username + authority_id + first_names + last_name + screen_name + email + url + password + secret_question + secret_answer +} { + + Implements the "Register" operation of the auth_registration + service contract for the acs testing authority. This is in essence + a simplified version of the "local" authority without the + notifications and confirmation options. + +} { + set result { + creation_status "ok" + creation_message {} + element_messages {} + account_status "ok" + account_message {} + generated_pwd_p 0 + } + dict set result password $password + + # + # Set user's password + # + set user_id [acs_user::get_by_username -authority_id $authority_id -username $username] + ad_change_password $user_id $password + + return $result +} + +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/acs-automated-testing/tcl/authority-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-automated-testing/tcl/authority-procs.tcl,v diff -u -N --- openacs-4/packages/acs-automated-testing/tcl/authority-procs.tcl 4 Oct 2018 09:59:41 -0000 1.1 +++ /dev/null 1 Jan 1970 00:00:00 -0000 @@ -1,133 +0,0 @@ -ad_library { - - Provide a simply authority named "acs_testing" for creating test - users during runs of the regression test. This is needed, when a - site/sub-site runs a registry which does e.g. a synchronized - registry, where no additional accounts can be created. - - @author Gustaf Neumann - @creation-date 2018-10-04 -} - -namespace eval acs::test::auth {} -namespace eval acs::test::auth::registration {} - -##### -# -# acs::test::auth -# -##### - -ad_proc -private acs::test::auth::install {} { - - Register the service contract implementations for the acs_testing - authority and update the authority accordingly. Do nothing, when - the registry exists already. - -} { - set authority_name acs_testing - - if {[auth::authority::get_id -short_name $authority_name] eq ""} { - ns_log notice "create authority $authority_name" - - set register_impl_id [acs_sc::impl::get_id \ - -owner acs-authentication \ - -name acs_testing \ - -contract auth_registration] - if {$register_impl_id eq ""} { - acs::test::auth::registration::register_impl - set register_impl_id [acs_sc::impl::get_id \ - -owner acs-authentication \ - -name acs_testing \ - -contract auth_registration] - ns_log notice "create authority $authority_name => register_impl_id $register_impl_id" - } - - set auth_impl_id [acs_sc::impl::get_id -owner acs-authentication -name local -contract auth_authentication] - set pwd_impl_id [acs_sc::impl::get_id -owner acs-authentication -name local -contract auth_password] - set user_info_impl_id [acs_sc::impl::get_id -owner acs-authentication -name local -contract auth_user_info] - - db_transaction { - array set row [list \ - short_name $authority_name \ - pretty_name "ACS Automated Testing" \ - auth_impl_id $auth_impl_id \ - pwd_impl_id $pwd_impl_id \ - register_impl_id $register_impl_id \ - user_info_impl_id $user_info_impl_id \ - ] - auth::authority::create -array row - } - } -} - -ad_proc -private acs::test::auth::registration::register_impl {} { - - Register the 'acs_testing' implementation of the - 'auth_registration' service contract. We just implement - "Register" new and reuse the implementations for "GetElements" and - "GetParameters" - - @return impl_id of the newly created implementation. -} { - ns_log notice "create registration::register_impl sc" - - set spec { - contract_name "auth_registration" - owner "acs-authentication" - name "acs_testing" - pretty_name "ACS Automated Testing" - aliases { - GetElements auth::local::registration::GetElements - Register acs::test::auth::registration::Register - GetParameters auth::local::registration::GetParameters - } - } - return [acs_sc::impl::new_from_spec -spec $spec] -} - - -ad_proc -private acs::test::auth::registration::Register { - parameters - username - authority_id - first_names - last_name - screen_name - email - url - password - secret_question - secret_answer -} { - - Implements the "Register" operation of the auth_registration - service contract for the acs testing authority. This is in essence - a simplified version of the "local" authority without the - notifications and confirmation options. - -} { - set result { - creation_status "ok" - creation_message {} - element_messages {} - account_status "ok" - account_message {} - generated_pwd_p 0 - } - dict set result password $password - - # - # Set user's password - # - set user_id [acs_user::get_by_username -authority_id $authority_id -username $username] - ad_change_password $user_id $password - - return $result -} - -# Local variables: -# mode: tcl -# tcl-indent-level: 4 -# indent-tabs-mode: nil -# End: