Index: openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl,v diff -u -r1.58 -r1.59 --- openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 3 Apr 2019 17:34:43 -0000 1.58 +++ openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 3 Sep 2024 15:37:30 -0000 1.59 @@ -19,7 +19,11 @@ } { set context_root_id [acs_magic_object security_context_root] - return [db_string select_user_id {}] + return [db_string select_user_id { + select min(user_id) + from users + where acs_permission.permission_p(:context_root_id, user_id, 'admin') + }] } ad_proc -private auth::test::get_password_vars { @@ -29,23 +33,39 @@ } { upvar $array_name test_vars - db_1row select_vars {} -column_array test_vars + db_1row select_vars { + select u.user_id, + aa.authority_id, + u.username + from users u, + auth_authorities aa + where u.authority_id = aa.authority_id + and aa.short_name = 'local' + fetch first 1 rows only + } -column_array test_vars } #### - aa_register_case \ -cats {api} \ -procs { + acs::test::user::create + acs_package_root_dir acs_user::change_state + acs_user::create_portrait acs_user::delete + acs_user::erase_portrait acs_user::get_by_username + acs_user::get_portrait_id + acs_user::get_user_info auth::authenticate auth::create_user - acs_user::get_portrait_id - acs_user::erase_portrait - acs_user::create_portrait + + util_text_to_url + package_instantiate_object + cr_filename_to_mime_type + package_exec_plsql } \ auth_authenticate { Test the auth::authenticate proc. @@ -129,6 +149,7 @@ array unset auth_info array set auth_info \ [auth::authenticate \ + -authority_id $authority_id \ -no_cookie \ -username "blabla" \ -password $password] @@ -150,12 +171,14 @@ # Authority bogus array unset auth_info - array set auth_info \ - [auth::authenticate \ - -no_cookie \ - -authority_id -123 \ - -username $username \ - -password $password] + aa_silence_log_entries -severities error { + array set auth_info \ + [auth::authenticate \ + -no_cookie \ + -authority_id -123 \ + -username $username \ + -password $password] + } aa_equals "auth_status for bad authority_id authentication" $auth_info(auth_status) "failed_to_connect" aa_true "auth_message for bad authority_id authentication" {$auth_info(auth_message) ne ""} @@ -196,7 +219,11 @@ acs_user::get_by_username ad_generate_random_string auth::create_user + acs::test::user::create + acs_user::get + util_text_to_url + package_instantiate_object } auth_create_user { Test the auth::create_user proc. } { @@ -210,14 +237,11 @@ -test_code { # Successful creation - array set user_info [auth::create_user \ - -username "auth_create_user1" \ - -email "auth_create_user1@test_user.com" \ - -first_names "Test" \ - -last_name "User" \ - -password "changeme" \ - -secret_question "no_question" \ - -secret_answer "no_answer"] + array set user_info [acs::test::user::create] + set user [acs_user::get -user_id $user_info(user_id)] + set username [dict get $user username] + set email [dict get $user email] + set authority_id [dict get $user authority_id] aa_true "returns creation_status" [info exists user_info(creation_status)] @@ -231,7 +255,7 @@ } aa_false "No creation_message for successful creation" \ - {[info exists user_info(creation_message)] && $user_info(creation_message) ne ""} + {[info exists user_info(creation_message)] && $user_info(creation_message) ne ""} aa_true "returns user_id" [info exists user_info(user_id)] if { [info exists user_info(user_id)] } { @@ -241,8 +265,9 @@ # Duplicate email and username array unset user_info array set user_info [auth::create_user \ - -username "auth_create_user1" \ - -email "auth_create_user1@test_user.com" \ + -username $username \ + -email $email \ + -authority_id $authority_id \ -first_names "Test3" \ -last_name "User" \ -password "changeme" \ @@ -256,18 +281,19 @@ array unset elm_msgs array set elm_msgs $user_info(element_messages) aa_true "element_message for username exists" \ - {[info exists elm_msgs(username)] && $elm_msgs(username) ne ""} + {[info exists elm_msgs(username)] && $elm_msgs(username) ne ""} aa_true "element_message for email exists" \ - {[info exists elm_msgs(email)] && $elm_msgs(email) ne ""} + {[info exists elm_msgs(email)] && $elm_msgs(email) ne ""} } - set user_id [acs_user::get_by_username -username auth_create_user1] + set user_id [acs_user::get_by_username -authority_id $authority_id -username $username] if { $user_id ne "" } { acs_user::delete -user_id $user_id } # Missing first_names, last_name, email array unset user_info array set user_info [auth::create_user \ + -authority_id $authority_id \ -username "auth_create_user2" \ -email "" \ -first_names "" \ @@ -284,7 +310,7 @@ array set elm_msgs $user_info(element_messages) if { [aa_true "element_message(email) exists" \ - {[info exists elm_msgs(email)] && $elm_msgs(email) ne ""} ]} { + {[info exists elm_msgs(email)] && $elm_msgs(email) ne ""} ]} { aa_log "element_message(email) = $elm_msgs(email)" } if { [aa_true "element_message(first_names) exists" [info exists elm_msgs(first_names)] ]} { @@ -294,14 +320,15 @@ aa_log "element_message(last_name) = $elm_msgs(last_name)" } } - set user_id [acs_user::get_by_username -username auth_create_user2] + set user_id [acs_user::get_by_username -authority_id $authority_id -username auth_create_user2] if { $user_id ne "" } { acs_user::delete -user_id $user_id } # Malformed email array unset user_info array set user_info [auth::create_user \ + -authority_id $authority_id \ -username [ad_generate_random_string] \ -email "not an email" \ -first_names "[ad_generate_random_string]<[ad_generate_random_string]" \ @@ -358,10 +385,12 @@ } aa_register_case \ - -cats {api smoke} \ + -cats {api smoke production_safe} \ -error_level {warning} \ -procs { auth::get_registration_elements + + util_text_to_url } \ auth_get_registration_elements { Test the auth::get_registration_elements proc @@ -375,7 +404,7 @@ } aa_register_case \ - -cats {api smoke} \ + -cats {api smoke production_safe} \ -error_level {warning} \ -procs { auth::get_registration_form_elements @@ -395,7 +424,7 @@ ########### aa_register_case \ - -cats {api smoke} \ + -cats {api smoke production_safe} \ -procs { auth::password::get_change_url auth::test::get_password_vars @@ -415,25 +444,36 @@ } aa_register_case \ - -cats {api smoke} \ + -cats {api smoke production_safe} \ -error_level {warning} \ -procs { auth::password::can_change_p auth::test::get_password_vars + auth::password::can_reset_p + auth::password::can_retrieve_p } \ - auth_password_can_change_p { - Test the auth::password::can_change_p proc. + auth_password_can_change_reset_retrieve_p { + Test auth::password::can_change_p, auth::password::can_reset_p + and auth::password::can_retrieve_p. } { auth::test::get_password_vars -array_name test_vars - aa_equals "Should return 1 when CanChangePassword is true for the local driver " \ + aa_equals "auth::password::can_change_p should return 1 when CanChangePassword is true for the local driver " \ [auth::password::can_change_p -user_id $test_vars(user_id)] \ "1" + aa_equals "auth::password::can_reset_p should return 1 for the local driver " \ + [auth::password::can_reset_p -authority_id $test_vars(authority_id)] \ + "1" + aa_equals "auth::password::can_retrieve_p return 1 for the local driver " \ + [auth::password::can_retrieve_p -authority_id $test_vars(authority_id)] \ + "1" } aa_register_case \ -cats {api} \ -procs { + aa_stub + acs::test::user::create acs_user::delete ad_acs_kernel_id ad_check_password @@ -442,6 +482,8 @@ auth::password::change parameter::get parameter::set_value + + util_text_to_url } \ auth_password_change { Test the auth::password::change proc. @@ -497,6 +539,10 @@ -procs { auth::password::recover_password auth::test::get_password_vars + aa_stub + + util_text_to_url + ad_sign } \ auth_password_recover { Test the auth::password::recover_password proc. @@ -516,20 +562,34 @@ aa_run_with_teardown \ -rollback \ -test_code { - array set password_result [auth::password::recover_password \ + aa_log [list auth::password::recover_password \ -authority_id $test_vars(authority_id) \ - -username $test_vars(username)] + -username $test_vars(username)] + aa_silence_log_entries -severities error { + # + # Handle case without errors, when mail is not configured. + # + array set password_result [auth::password::recover_password \ + -authority_id $test_vars(authority_id) \ + -username $test_vars(username)] + } + if {[::acs_mail_lite::configured_p]} { + aa_equals "status ok" $password_result(password_status) "ok" + } else { + aa_equals "SMTP host not configured" $password_result(password_status) "failed_to_connect" + } - aa_equals "status ok" $password_result(password_status) "ok" - aa_true "non-empty message" {$password_result(password_message) ne ""} + aa_true "nonempty message" {$password_result(password_message) ne ""} } } aa_register_case \ - -cats {api smoke} \ + -cats {api smoke production_safe} \ -procs { auth::password::get_forgotten_url auth::test::get_password_vars + + util_text_to_url } \ auth_password_get_forgotten_url { Test the auth::password::get_forgotten_url proc. @@ -552,32 +612,49 @@ } aa_register_case \ - -cats {api smoke} \ + -cats {api smoke production_safe} \ -procs { auth::password::retrieve auth::test::get_password_vars + + util_text_to_url } \ auth_password_retrieve { Test the auth::password::retrieve proc. } { auth::test::get_password_vars -array_name test_vars - array set result [auth::password::retrieve \ - -authority_id $test_vars(authority_id) \ - -username $test_vars(username)] - aa_equals "retrieve pwd from local auth" $result(password_status) "ok" + aa_silence_log_entries -severities error { + # + # Handle case without errors, when mail is not configured. + # + array set result [auth::password::retrieve \ + -authority_id $test_vars(authority_id) \ + -username $test_vars(username)] + } + if {[::acs_mail_lite::configured_p]} { + aa_equals "retrieve pwd from local auth" $result(password_status) "ok" + } else { + aa_equals "SMTP host not configured" $result(password_status) "failed_to_connect" + } + aa_true "must have message on failure" {$result(password_message) ne ""} } aa_register_case \ -cats {api} \ -procs { + aa_stub + acs::test::user::create acs_user::delete + acs_user::get acs_user::get_by_username - auth::authentication::Authenticate + auth::authentication::authenticate auth::authority::local auth::create_user auth::password::reset + + util_text_to_url } \ auth_password_reset { Test the auth::password::reset proc. @@ -608,14 +685,14 @@ aa_true "Result contains new password" [info exists reset_result(password)] if { [info exists reset_result(password)] } { - array set auth_result [auth::authentication::Authenticate \ + array set auth_result [auth::authentication::authenticate \ -username $test_user(username) \ -authority_id $test_user(authority_id) \ -password $reset_result(password)] aa_equals "can authenticate with new password" $auth_result(auth_status) "ok" array unset auth_result - array set auth_result [auth::authentication::Authenticate \ + array set auth_result [auth::authentication::authenticate \ -username $test_user(username) \ -authority_id $test_user(authority_id) \ -password $test_user(password)] @@ -636,80 +713,137 @@ # ########### -aa_register_case \ - -cats {api db} \ - -procs { - auth::password::retrieve - auth::test::get_password_vars - } \ - auth_authority_api { - Test the auth::authority::create, auth::authority::edit, and auth::authority::delete procs. +aa_register_case -cats { + api db +} -procs { + auth::authority::create + auth::authority::delete + auth::authority::edit + auth::authority::get + auth::authority::get_authority_options + auth::authority::get_id + auth::authority::get_short_names + db_list_of_lists +} auth_authority_api { + Test authorty creation, edition, deletion and some retrieval api. } { - aa_run_with_teardown \ - -rollback \ - -test_code { + aa_run_with_teardown -rollback -test_code { - # Add authority and test that it was added correctly. - array set columns { - pretty_name "Test authority" - help_contact_text "Blah blah" - enabled_p "t" - sort_order "1000" - auth_impl_id "" - pwd_impl_id "" - forgotten_pwd_url "" - change_pwd_url "" - register_impl_id "" - register_url "" - get_doc_impl_id "" - process_doc_impl_id "" - batch_sync_enabled_p "f" - } - set columns(short_name) [ad_generate_random_string] + # Add authority and test that it was added correctly. + array set columns { + pretty_name "Test authority" + help_contact_text "Blah blah" + enabled_p "t" + sort_order "1000" + auth_impl_id "" + pwd_impl_id "" + forgotten_pwd_url "" + change_pwd_url "" + register_impl_id "" + register_url "" + get_doc_impl_id "" + process_doc_impl_id "" + batch_sync_enabled_p "f" + } + set columns(short_name) [ad_generate_random_string] - set authority_id [auth::authority::create -array columns] + set authority_id [auth::authority::create -array columns] + set expected_authority_id [auth::authority::get_id -short_name $columns(short_name)] - set authority_added_p [db_string authority_added_p { - select count(*) from auth_authorities where authority_id = :authority_id - } -default "0"] + aa_equals "(auth::authority::get_id): Value returned is as expected" $expected_authority_id $authority_id - aa_true "was the authority added?" $authority_added_p + set proc_value [lsort [auth::authority::get_short_names]] + set db_value [lsort [db_list select_authority_short_names { + select short_name + from auth_authorities + }]] + aa_equals "(auth::authority::get_short_names): Value returned is as expected" $proc_value $db_value - aa_log "authority_id = '$authority_id'" + set proc_value [lsort [auth::authority::get_authority_options]] + set db_value [lsort [db_list_of_lists select_authorities { + select pretty_name, authority_id + from auth_authorities + where enabled_p = 't' + and auth_impl_id is not null + order by sort_order + }]] + aa_equals "(auth::authority::get_authority_options): Value returned is as expected" $proc_value $db_value - # Edit authority and test that it has actually changed. - array set columns { - pretty_name "Test authority2" - help_contact_text "Blah blah2" - enabled_p "f" - sort_order "1001" - forgotten_pwd_url "foobar.com" - change_pwd_url "foobar.com" - register_url "foobar.com" - } - set columns(short_name) [ad_generate_random_string] + set authority_added_p [db_string authority_added_p { + select count(*) from auth_authorities where authority_id = :authority_id + } -default "0"] - auth::authority::edit \ - -authority_id $authority_id \ - -array columns + aa_true "was the authority added?" $authority_added_p - auth::authority::get \ - -authority_id $authority_id \ - -array edit_result + aa_log "authority_id = '$authority_id'" - foreach column [array names columns] { - aa_equals "edited column $column" $edit_result($column) $columns($column) - } + # Edit authority and test that it has actually changed. + array set columns { + pretty_name "Test authority2" + help_contact_text "Blah blah2" + enabled_p "f" + sort_order "1001" + forgotten_pwd_url "foobar.com" + change_pwd_url "foobar.com" + register_url "foobar.com" + } + set columns(short_name) [ad_generate_random_string] - # Delete authority and test that it was actually added. - auth::authority::delete -authority_id $authority_id + auth::authority::edit \ + -authority_id $authority_id \ + -array columns - set authority_exists_p [db_string authority_added_p { - select count(*) from auth_authorities where authority_id = :authority_id - } -default "0"] + set proc_value [lsort [auth::authority::get_short_names]] + set db_value [lsort [db_list select_authority_short_names { + select short_name + from auth_authorities + }]] + aa_equals "(auth::authority::get_short_names): Value returned is as expected" $proc_value $db_value - aa_false "was the authority deleted?" $authority_exists_p + set proc_value [lsort [auth::authority::get_authority_options]] + set db_value [lsort [db_list_of_lists select_authorities { + select pretty_name, authority_id + from auth_authorities + where enabled_p = 't' + and auth_impl_id is not null + order by sort_order + }]] + aa_equals "(auth::authority::get_authority_options): Value returned is as expected" $proc_value $db_value + + auth::authority::get \ + -authority_id $authority_id \ + -array edit_result + + foreach column [array names columns] { + aa_equals "edited column $column" $edit_result($column) $columns($column) } + + # Delete authority and test that it was actually added. + auth::authority::delete -authority_id $authority_id + + set proc_value [lsort [auth::authority::get_short_names]] + set db_value [lsort [db_list select_authority_short_names { + select short_name + from auth_authorities + }]] + aa_equals "(auth::authority::get_short_names): Value returned is as expected" $proc_value $db_value + + set proc_value [lsort [auth::authority::get_authority_options]] + set db_value [lsort [db_list_of_lists select_authorities { + select pretty_name, authority_id + from auth_authorities + where enabled_p = 't' + and auth_impl_id is not null + order by sort_order + }]] + aa_equals "(auth::authority::get_authority_options): Value returned is as expected" $proc_value $db_value + + set authority_exists_p [db_string authority_added_p { + select count(*) from auth_authorities where authority_id = :authority_id + } -default "0"] + + aa_false "was the authority deleted?" $authority_exists_p + } } @@ -723,6 +857,8 @@ auth::driver::get_parameter_values auth::driver::get_parameters auth::driver::set_parameter_value + + util_text_to_url } \ auth_driver_get_parameter_values { Test the auth::driver::set_parameter_values proc. @@ -773,14 +909,20 @@ aa_register_case \ -cats {api} \ -procs { + aa_stub ad_acs_kernel_id ad_generate_random_string + ad_parameter_cache auth::UseEmailForLoginP auth::authenticate + auth::authority::get_id auth::authority::local auth::create_user auth::get_registration_elements parameter::set_value + + util_text_to_url + auth::create_local_account } \ auth_use_email_for_login_p { Test auth::UseEmailForLoginP @@ -822,15 +964,22 @@ set email [string tolower "[ad_generate_random_string]@foobar.com"] set password [ad_generate_random_string] - array set result [auth::create_user \ - -authority_id $authority_id \ - -email $email \ - -password $password \ - -first_names [ad_generate_random_string] \ - -last_name [ad_generate_random_string] \ - -secret_question [ad_generate_random_string] \ - -secret_answer [ad_generate_random_string] \ - -screen_name [ad_generate_random_string]] + ad_try { + array set result [auth::create_user \ + -authority_id $authority_id \ + -email $email \ + -password $password \ + -first_names [ad_generate_random_string] \ + -last_name [ad_generate_random_string] \ + -secret_question [ad_generate_random_string] \ + -secret_answer [ad_generate_random_string] \ + -screen_name [ad_generate_random_string]] + } on ok {r} { + aa_true "auth::create_user with no username succeeded" 1 + } on error {errorMsg} { + aa_false "auth::create_user with no username failed: '$errorMsg'" 1 + set result(creation_status) "NOT OK" + } aa_equals "Registration OK" $result(creation_status) "ok" @@ -844,19 +993,25 @@ aa_equals "Authentication OK" $result(auth_status) "ok" + } -teardown_code { + ad_parameter_cache -delete [ad_acs_kernel_id] UseEmailForLoginP } } aa_register_case \ -cats {api} \ -procs { + aa_stub + acs::test::user::create + acs_user::get_user_info ad_acs_kernel_id ad_generate_random_string ad_parameter_cache auth::create_user - acs_user::get_user_info auth::password::change parameter::set_value + + util_text_to_url } \ auth_email_on_password_change { Test acs-kernel.EmailAccountOwnerOnPasswordChangeP parameter @@ -919,6 +1074,92 @@ } } +aa_register_case \ + -cats {api} \ + -procs { + auth::authority::edit + auth::authority::get + auth::authority::get_element + auth::authority::get_id + } \ + auth_authority_edit { + Test authority edit +} { + aa_log "Retrieving test authority" + set authority_id [auth::authority::get_id -short_name "acs_testing"] + + set random_string [ad_generate_random_string] + set random_object [db_string get_object { + select max(object_id) from acs_objects + }] + set random_boolean [expr {int(rand() * 10) % 2}] + set random_int [expr {int(rand() * pow(10, 7))}] + + set valid_values [list \ + short_name $random_string \ + pretty_name $random_string \ + help_contact_text $random_string \ + help_contact_text_format "text/enhanced" \ + enabled_p $random_boolean \ + sort_order $random_int \ + auth_impl_id $random_object \ + pwd_impl_id $random_object \ + forgotten_pwd_url $random_string \ + change_pwd_url $random_string \ + register_impl_id $random_object \ + register_url $random_string \ + user_info_impl_id $random_object \ + get_doc_impl_id $random_object \ + process_doc_impl_id $random_object \ + batch_sync_enabled_p $random_boolean] + + set broken_values $valid_values + lappend broken_values [ad_generate_random_string] "" + + set illegal_values $valid_values + lappend illegal_values authority_id [db_string gen_id { + select coalesce(max(authority_id), 0) + 1 from auth_authorities + }] + + aa_run_with_teardown \ + -rollback \ + -test_code { + array set values $broken_values + aa_true "Trying to update non-existing columns returns an error" \ + [catch {auth::authority::edit -authority_id $authority_id -array values}] + array unset values + + array set values $illegal_values + aa_true "Trying to update illegal columns columns returns an error" \ + [catch {auth::authority::edit -authority_id $authority_id -array values}] + array unset values + + array set values $valid_values + aa_false "Update valid columns and values is fine" \ + [catch {auth::authority::edit -authority_id $authority_id -array values}] + array unset values + + auth::authority::get -authority_id $authority_id -array updated_values + foreach {key value} $valid_values { + # Check if value is what we set in the update. We need + # to normalize booleans. + aa_true "(get): Value '$key' was updated to '$value'" \ + {[info exists updated_values($key)] && ($updated_values($key) eq $value || + ([string is boolean -strict $updated_values($key)] && [string is boolean -strict $value] && + [string is true -strict $updated_values($key)] == [string is true -strict $value])) + } + set updated_value [auth::authority::get_element \ + -authority_id $authority_id \ + -element $key] + aa_true "(get_element): Value '$key' was updated to '$value'" \ + {$updated_value eq $value || + ([string is boolean -strict $updated_value] && [string is boolean -strict $value] && + [string is true -strict $updated_value] == [string is true -strict $value]) + } + } + } +} + # Local variables: # mode: tcl # tcl-indent-level: 4