Index: openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 26 Aug 2003 10:13:38 -0000 1.3 +++ openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 27 Aug 2003 11:50:48 -0000 1.4 @@ -463,7 +463,7 @@ ##### ad_proc -private auth::registration::Register { - {-authority_id:required} + {-authority_id ""} {-username:required} {-password:required} {-first_names ""} @@ -504,7 +504,7 @@ } ad_proc -private auth::registration::GetElements { - {-authority_id:required} + {-authority_id ""} } { @author Peter Marklund @@ -522,3 +522,533 @@ -operation GetElements \ -call_args [list [list]]] } + + +##### +# +# auth::password public procs +# +##### + +ad_proc -public auth::password::get_change_url { + {-user_id:required} +} { + Returns the URL to redirect to for changing passwords. If the + user's authority has a "change_pwd_url" set, it'll return that, + otherwise it'll return a link to /user/password-update under the + nearest subsite. + + @param user_id The ID of the user whose password you want to change. + + @return A URL that can be linked to for changing password. +} { + db_1row select_vars { + select aa.change_pwd_url, + u.username + from auth_authorities aa, + users u + where aa.authority_id = u.authority_id + and u.user_id = :user_id + } + + # Interpolate any username variable in URL + regsub -all "{username}" $change_pwd_url $username change_pwd_url + + # Default to the OpenACS change password URL + if { [empty_string_p $change_pwd_url] } { + set change_pwd_url "[subsite::get_element -element url]user/password-update?[export_vars { user_id }]" + } + + return $change_pwd_url +} + +ad_proc -public auth::password::can_change_p { + {-user_id:required} +} { + Returns whether the given user change password. + This depends on the user's authority and the configuration of that authority. + + @param user_id The ID of the user whose password you want to change. + + @return 1 if the user can change password, 0 otherwise. +} { + # TODO: Should we use acs_user::get here? Can we cache that proc? + set authority_id [db_string authority_id_from_user_id { + select authority_id + from users + where user_id = :user_id + }] + + return [auth::password::CanChangePassword -authority_id $authority_id] +} + +ad_proc -public auth::password::change { + {-user_id:required} + {-old_password:required} + {-new_password:required} +} { + Change the user's password. + + @param user_id The ID of the user whose password you want to change. + + @param old_password The current password of that user. This is required for security purposes. + + @param new_password The desired new password of the user. + + @return An array list with the following entries: + + +} { + # TODO: Should we use acs_user::get here? Can we cache that proc? + db_1row user_info { + select authority_id, + username + from users + where user_id = :user_id + } + + return [auth::password::ChangePassword \ + -authority_id $authority_id \ + -username $username \ + -old_password $old_password \ + -new_password $new_password] +} + +ad_proc -public auth::password::forgotten { + {-authority_id:required} + {-username:required} +} { + Handles forgotten passwords. + + @param authority_id The ID of the authority that the user is trying to log into. + + @param username The username that the user's trying to log in with. + + @return Array list with the following entries: + + +} { + + set forgotten_url [auth::password::get_forgotten_url \ + -authority_id $authority_id \ + -username $username] + + if { ![empty_string_p $forgotten_url] } { + ad_returnredirect $forgotten_url + ad_script_abort + } + + set can_retrieve_p [auth::password::can_retrieve_p -authority_id $authority_id] + set can_reset_p [auth::password::can_reset_p -authority_id $authority_id] + if { $can_retrieve_p } { + # Retrive password + array set result [auth::password::retrieve \ + -authority_id $authority_id \ + -username $username] + + # Error handling needed here? + # TODO + + } elseif { $can_reset_p } { + # Reset password + array set result [auth::password::reset \ + -authority_id $authority_id \ + -username $username] + + # Error handling needed here? + # TODO + + } else { + # Can't reset or retrieve - we give up + set result(password_status) not_supported + set result(password_message) [_ acs-subsite.sorry_forgotten_pwd] + } + + if { [exists_and_not_null result(password)] } { + # We have retrieved or reset a forgotten password that we should email to the user + if { [catch {auth::password::email_password \ + -username $username \ + -password $result(password)} errmsg] } { + + # We could not inform the user of his email - we failed + set result(password_status) "fail" + set result(password_message) [auth::password::get_email_error_msg $errmsg] + + } else { + # Successfully informed user of email + set result(password_status) ok + set result(password_message) [_ acs-subsite.Check_Your_Inbox] + } + } + + return [array get result] +} + +ad_proc -public auth::password::get_forgotten_url { + {-authority_id ""} + {-username ""} + {-remote_only:boolean} +} { + Returns the URL to redirect to for forgotten passwords. + + @param authority_id The ID of the authority that the user is trying to log into. + @param username The username that the user's trying to log in with. + @param remote_only If provided, only return any remote URL (not on this server). + + @return A URL that can be linked to when the user has forgotten his/her password, + or the empty string if none can be found. +} { + set have_user_id_p [expr ![empty_string_p $authority_id] && ![empty_string_p username]] + + if { $have_user_id_p } { + # We have the user id + + set forgotten_pwd_url [db_string select_forgotten_pwd_url { + select forgotten_pwd_url + from auth_authorities + where authority_id = :authority_id + }] + regsub -all "{username}" $forgotten_pwd_url $username forgotten_pwd_url + + + if { [empty_string_p $forgotten_pwd_url] } { + if { ! $remote_only_p } { + # If we can retrive or reset passwords we can use the local url + # In remote mode we fail + set can_retrieve_p [auth::password::can_retrieve_p -authority_id $authority_id] + set can_reset_p [auth::password::can_reset_p -authority_id $authority_id] + if { $can_retrieve_p || $can_reset_p } { + set forgotten_pwd_url "[subsite::get_element -element url]register/forgotten-password?[export_vars { authority_id username }]" + } + } + } + } else { + # We don't have the user id + + if { $remote_only_p } { + # Remote recovery requires username and authority so we fail + set forgotten_pwd_url "" + } else { + set forgotten_pwd_url "[subsite::get_element -element url]register/forgotten-password" + } + } + + return $forgotten_pwd_url +} + +ad_proc -public auth::password::can_retrieve_p { + {-authority_id:required} +} { + Returns whether the given authority can retrive forgotten passwords. + + @param authority_id The ID of the authority that the user is trying to log into. + + @return 1 if the authority allows retrieving passwords, 0 otherwise. +} { + return [auth::password::CanRetrievePassword -authority_id $authority_id] +} + +ad_proc -public auth::password::retrieve { + {-authority_id:required} + {-username:required} +} { + Retrieve the user's password. + + @param authority_id The ID of the authority that the user is trying to log into. + + @param username The username that the user's trying to log in with. + + @return An array list with the following entries: + + +} { + return [auth::password::RetrievePassword \ + -authority_id $authority_id \ + -username $username] +} + +ad_proc -public auth::password::can_reset_p { + {-authority_id:required} +} { + Returns whether the given authority can reset forgotten passwords. + + @param authority_id The ID of the authority that the user is trying to log into. + + @return 1 if the authority allows resetting passwords, 0 otherwise. +} { + return [auth::password::CanResetPassword \ + -authority_id $authority_id] +} + +ad_proc -public auth::password::reset { + {-authority_id:required} + {-username:required} +} { + Reset the user's password, which means setting it to a new + randomly generated password and inform the user of that new + password. + + @param user_id The ID of the user whose password you want to reset. + + @return An array list with the following entries: + + +} { + array set result [auth::password::ResetPassword \ + -authority_id $authority_id \ + -username $username] + + if { [catch {auth::password::email_password \ + -username $username \ + -authority_id $authority_id \ + -password $result(password)} errmsg] } { + + set result(password_status) "reset_error" + set result(password_message) [auth::password::get_email_error_msg $errmsg] + } + + return [array get result] +} + +##### +# +# auth::password private procs +# +##### + +ad_proc -private auth::password::email_password { + {-username:required} + {-authority_id ""} + {-password:required} +} { + Send an email to ther user with given username and authority with the new password. + + @return Does not return anything. Any errors caused by ns_sendmail are propagated + + @author Peter Marklund +} { + + set system_owner [ad_system_owner] + set system_name [ad_system_name] + set reset_password_url "[ad_url]/user/password-update?[export_vars {user_id {password_old $password}}]" + + set subject "[_ acs-subsite.lt_Your_forgotten_passwo]" + set body "[_ acs-subsite.Your_password]: $password" + + # TODO: use acs_user::get here? + set user_email [db_string email_from_user_id { + select email + from parties + where party_id = (select user_id + from users + where username = :username + ) + }] + + # Send email + ns_sendmail $email $system_owner $subject $body +} + +ad_proc -private auth::password::get_email_error_msg { errmsg } { + Reusable message used when email sending fails. + + @author Peter Marklund +} { + return "[_ acs-subsite.Error_sending_mail] +
+ 
+    $errmsg
+
+
+" +} + +ad_proc -private auth::password::CanChangePassword { + {-authority_id ""} +} { + Can users change password for a given authority. + + @param authority_id The ID of the authority that we are inquiring about. Defaults to local + + @author Peter Marklund +} { + if { [empty_string_p $authority_id] } { + set authority_id [auth::authority::local] + } + + # TODO: + # Implement parameters + + return [acs_sc::invoke \ + -contract "auth_password" \ + -impl [auth::authority::get_element -authority_id $authority_id -element "auth_impl_name"] \ + -operation CanChangePassword \ + -call_args [list [list]]] +} + +ad_proc -private auth::password::CanRetrievePassword { + {-authority_id ""} +} { + Can users retrieve password for a given authority. + + @param authority_id The ID of the authority that we are inquiring about. Defaults to local + + @author Peter Marklund +} { + if { [empty_string_p $authority_id] } { + set authority_id [auth::authority::local] + } + + # TODO: + # Implement parameters + + return [acs_sc::invoke \ + -contract "auth_password" \ + -impl [auth::authority::get_element -authority_id $authority_id -element "auth_impl_name"] \ + -operation CanRetrievePassword \ + -call_args [list [list]]] +} + +ad_proc -private auth::password::CanResetPassword { + {-authority_id ""} +} { + Can users reset password for a given authority. + + @param authority_id The ID of the authority that we are inquiring about. Defaults to local + + @author Peter Marklund +} { + if { [empty_string_p $authority_id] } { + set authority_id [auth::authority::local] + } + + # TODO: + # Implement parameters + + return [acs_sc::invoke \ + -contract "auth_password" \ + -impl [auth::authority::get_element -authority_id $authority_id -element "auth_impl_name"] \ + -operation CanResetPassword \ + -call_args [list [list]]] +} + +ad_proc -private auth::password::ChangePassword { + {-username:required} + {-old_password:required} + {-new_password:required} + {-authority_id ""} +} { + Change the password of a user. + + @param username + @param old_password + @param new_password + @param authority_id The ID of the authority the user belongs to. Defaults to local + + @author Peter Marklund +} { + if { [empty_string_p $authority_id] } { + set authority_id [auth::authority::local] + } + + # TODO: + # Implement parameters + + return [acs_sc::invoke \ + -contract "auth_password" \ + -impl [auth::authority::get_element -authority_id $authority_id -element "auth_impl_name"] \ + -operation ChangePassword \ + -call_args [list $username \ + $old_password \ + $new_password \ + [list]]] +} + +ad_proc -private auth::password::RetrievePassword { + {-username:required} + {-authority_id ""} +} { + Retrieve the password of a user. + + @param username + @param authority_id The ID of the authority the user belongs to. Defaults to local + + @author Peter Marklund +} { + if { [empty_string_p $authority_id] } { + set authority_id [auth::authority::local] + } + + # TODO: + # Implement parameters + + return [acs_sc::invoke \ + -contract "auth_password" \ + -impl [auth::authority::get_element -authority_id $authority_id -element "auth_impl_name"] \ + -operation RetrievePassword \ + -call_args [list $username \ + [list]]] +} + +ad_proc -private auth::password::ResetPassword { + {-username:required} + {-authority_id ""} +} { + Reset the password of a user. + + @param username + @param authority_id The ID of the authority the user belongs to. Defaults to local + + @author Peter Marklund +} { + if { [empty_string_p $authority_id] } { + set authority_id [auth::authority::local] + } + + # TODO: + # Implement parameters + + return [acs_sc::invoke \ + -contract "auth_password" \ + -impl [auth::authority::get_element -authority_id $authority_id -element "auth_impl_name"] \ + -operation ResetPassword \ + -call_args [list $username \ + [list]]] +} 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 -r1.4 -r1.5 --- openacs-4/packages/acs-authentication/tcl/local-procs.tcl 26 Aug 2003 10:13:38 -0000 1.4 +++ openacs-4/packages/acs-authentication/tcl/local-procs.tcl 27 Aug 2003 11:50:48 -0000 1.5 @@ -181,23 +181,29 @@ } -ad_proc -private auth::local::password::CanChangePassword {} { +ad_proc -private auth::local::password::CanChangePassword { + {parameters ""} +} { Implements the CanChangePassword operation of the auth_password service contract for the local account implementation. } { # Yeah, we can change your password return 1 } -ad_proc -private auth::local::password::CanRetrievePassword {} { +ad_proc -private auth::local::password::CanRetrievePassword { + {parameters ""} +} { Implements the CanRetrievePassword operation of the auth_password service contract for the local account implementation. } { # Nope, passwords are stored hashed, so we can't retrieve it for you return 0 } -ad_proc -private auth::local::password::CanResetPassword {} { +ad_proc -private auth::local::password::CanResetPassword { + {parameters ""} +} { Implements the CanResetPassword operation of the auth_password service contract for the local account implementation. } { @@ -249,6 +255,7 @@ service contract for the local account implementation. } { set result(password_status) "not_supported" + set result(password_message) [_ acs-susbite.cannot_retrieve_password] return [array get result] } @@ -260,7 +267,7 @@ service contract for the local account implementation. } { array set result { - password_status {} + password_status ok password_message {} } @@ -436,7 +443,7 @@ "[_ acs-subsite.lt_Welcome_to_system_nam]" \ "[_ acs-subsite.lt_To_confirm_your_regis]" } { - ns_returnerror "500" "$errmsg" + #ns_returnerror "500" "$errmsg" ns_log Warning "Error sending email verification email to $email. Error: $errmsg" } Index: openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/test/Attic/acs-authentication-procs-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs-oracle.xql 27 Aug 2003 11:50:48 -0000 1.1 @@ -0,0 +1,28 @@ + + + + oracle8.1.6 + + + + select q.user_id from + (select user_id + from users + where acs_permission.permission_p(:context_root_id, user_id, 'admin') = 't') q where rownum = 1 + + + + + + select q.* from + (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') q where rownum = 1 + + + + Index: openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/test/Attic/acs-authentication-procs-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs-postgresql.xql 27 Aug 2003 11:50:48 -0000 1.1 @@ -0,0 +1,29 @@ + + + + postgresql7.1 + + + + select user_id + from users + where acs_permission__permission_p(:context_root_id, user_id, 'admin') = 't' + limit 1 + + + + + + + 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' + limit 1 + + + + 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.3 -r1.4 --- openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 26 Aug 2003 10:13:38 -0000 1.3 +++ openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 27 Aug 2003 11:50:48 -0000 1.4 @@ -12,21 +12,21 @@ @author Peter Marklund } { + # Initialize variables + set user_id [ad_conn user_id] + db_1row get_admin_info { + select email + from cc_users + where user_id = :user_id + } + # We need to use a known password and the existing one cannot + # be retrieved + set password "test_password" + aa_run_with_teardown \ + -rollback \ -test_code { - # Initialize variables - set user_id [ad_conn user_id] - db_1row get_admin_info { - select email, - password as original_password, - member_state as original_member_state - from cc_users - where user_id = :user_id - } - # We need to use a known password and the existing one cannot - # be retrieved - set password "test_password" ad_change_password $user_id $password # Successful authentication @@ -95,21 +95,12 @@ -username $email \ -password $password] - aa_equals "auth_status for successful authentication" $auth_info(auth_status) "ok" + aa_equals "auth_status for successful authentication" $auth_info(auth_status) "ok" aa_equals "account_status for successful authentication" $auth_info(account_status) "closed" } # Error handling - - } -teardown_code { - - # Reset password and member state - db_dml update_password { - update users - set password = :original_password - where user_id = :user_id - } - acs_user::change_state -user_id $user_id -state $original_member_state + # TODO or too hard? } } @@ -118,8 +109,11 @@ @author Peter Marklund } { - db_transaction { + aa_run_with_teardown \ + -rollback \ + -test_code { + # Successful creation array set user_info [auth::create_user \ -username "auth_create_user1@test_user.com" \ @@ -128,10 +122,11 @@ -password "changeme" \ -secret_question "no_question" \ -secret_answer "no_answer"] - set successful_result(user_id) $user_info(user_id) - set successful_result(creation_status) $user_info(creation_status) - set successful_result(creation_message) $user_info(creation_message) + aa_true "returns integer user_id ([array get user_info])" [regexp {[1-9][0-9]*} $user_info(user_id)] + aa_equals "creation_status for successful creation" $user_info(creation_status) "ok" + aa_true "creation_message for successful creation" [empty_string_p $user_info(creation_message)] + # Missing first_names array set user_info [auth::create_user \ -username "auth_create_user2@test_user.com" \ @@ -141,23 +136,9 @@ -secret_question "no_question" \ -secret_answer "no_answer"] - set first_names_result(creation_status) $user_info(creation_status) - - error "rollback tests" + aa_equals "creation_status for missing first names" $user_info(creation_status) "fail" - } on_error { - if { ![string equal $errmsg "rollback tests"] } { - global errorInfo - - error "Tests threw error $errmsg \n\n $errorInfo" - } - } - - aa_true "returns integer user_id ([array get user_info])" [regexp {[1-9][0-9]*} $successful_result(user_id)] - aa_equals "creation_status for successful creation" $successful_result(creation_status) "ok" - aa_true "creation_message for successful creation" [empty_string_p $successful_result(creation_message)] - - aa_equals "creation_status for missing first names" $first_names_result(creation_status) "fail" + } } aa_register_case auth_confirm_email { @@ -200,62 +181,37 @@ aa_true "Form elements are not empty: $form_elements" [expr ![empty_string_p $form_elements]] } +########### +# +# Password API +# +########### + aa_register_case auth_password_get_change_url { Test the auth::password::get_change_url proc. @author Simon Carstensen } { - # Test whether auth::password::get_change_url returns and empty string when "change_pwd_url" is not se - - db_0or1row get_user_id { - select o.creation_user, - change_pwd_url as expected_result - from acs_objects o, - auth_authorities a - where a.authority_id = o.object_id - and a.change_pwd_url != null - limit 1 - } -default ""] - - aa_equals "Check that auth::password::get_change_url returns correct redirect URL when change_pwd_url is not null" \ - [auth::password::get_change_url -user_id $user_id ] \ - $expected_result - # Test whether auth::password::get_change_url returns the correct URL to redirect when "change_pwd_url" is set. - set user_id [db_string get_user_id { - select o.creation_user - from acs_objects o, - auth_authorities a - where a.authority_id = o.object_id - and a.change_pwd_url = null - limit 1 - } -default ""] + auth::test::get_password_vars -array_name test_vars - set expected_result "" - - aa_equals "Check that auth::password::get_change_url returns empty string when change_pwd_url is null. " \ - [auth::password::get_change_url -user_id $user_id] \ - $expected_result + if { [info exists test_vars(user_id)] } { + set change_pwd_url [auth::password::get_change_url -user_id $test_vars(user_id)] + aa_true "Check that auth::password::get_change_url returns correct redirect URL when change_pwd_url is not null" \ + [regexp {password-update} $change_pwd_url] + } } aa_register_case auth_password_can_change_p { Test the auth::password::can_change_p proc. @author Simon Carstensen } { + auth::test::get_password_vars -array_name test_vars - set user_id [db_string get_user_id { - select o.creation_user - from acs_objects o, - auth_authorities a - where a.authority_id = o.object_id - and a.short_name = 'local' - limit 1 - } -default ""] - aa_equals "Should return 1 when CanChangePassword is true for the local driver " \ - [auth::password::can_change_url -user_id $user_id] \ + [auth::password::can_change_p -user_id $test_vars(user_id)] \ "1" } @@ -264,68 +220,134 @@ @author Simon Carstensen } { - # create user we'll use for testing - set user_id [ad_user_new "test@user.com" "Test" "User" "changeme" "no_question" "no_answer"] + aa_run_with_teardown \ + -rollback \ + -test_code { + # create user we'll use for testing + set user_id [ad_user_new "test2@user.com" "Test" "User" "changeme" "no_question" "no_answer"] - # password_status "ok" - set old_password "changeme" - set new_password "changedyou" - array set auth_info [auth::password::change -user_id $user_id -old_password $old_password -new_password $new_password] - aa_equals "Should return 'ok'" \ - $auth_info(password_status) \ - "ok" + # password_status "ok" + set old_password "changeme" + set new_password "changedyou" + array set auth_info [auth::password::change -user_id $user_id -old_password $old_password -new_password $new_password] + aa_equals "Should return 'ok'" \ + $auth_info(password_status) \ + "ok" - # check that the new password is actually set correctly - set password_correct_p [ad_check_password $user_id $new_password] - aa_equals "check that the new password is actually set correctly" \ - $password_correct_p \ - "1" - - # Teardown user - - # password should not be changed if password is an empty string -# set old_password "changedyou" -# set new_password "" -# array set auth_info [auth::password::change -user_id $user_id -old_password $old_password -new_password $new_password] -# aa_equals "Should return 'ok'" \ -# $auth_info(password_status) \ -# "ok" - + # check that the new password is actually set correctly + set password_correct_p [ad_check_password $user_id $new_password] + aa_equals "check that the new password is actually set correctly" \ + $password_correct_p \ + "1" + } } aa_register_case auth_password_forgotten { Test the auth::password::forgotten proc. @author Simon Carstensen } { - # Test password_status on local driver for ok + auth::test::get_password_vars -array_name test_vars + + # Stub get_forgotten_url to avoid the redirect + aa_stub auth::password::get_forgotten_url { + return "" + } + + # We don't want email to go out + aa_stub auth::password::email_password { + return + } + + array set password_result [auth::password::forgotten \ + -authority_id $test_vars(authority_id) \ + -username $test_vars(username)] + + aa_equals "status ok" $password_result(password_status) "ok" + aa_true "non-empty message" [expr ![empty_string_p $password_result(password_message)]] } aa_register_case auth_password_get_forgotten_url { Test the auth::password::get_forgotten_url proc. @author Simon Carstensen } { - # Call auth::password::get_forgotten_url with the -remote_only switch and test whether it returns an empty string when username and authority is not specified, if not that it returns the authority's forgotten_pwd_url if non-empty (with [ns_urlencode username] correctly interpolated into the URL), else that it returns empty string. - # Call auth::password::get_forgotten_url without the -remote_only switch and test that it returns authority's forgotten_pwd_url if non-empty, that if authority's pwd mgr returns 1 for either CanRetrieve or CanReset it returns /register/forgotten-password?[export_vars { authority_id username }] + auth::test::get_password_vars -array_name test_vars + + # With user info + set url [auth::password::get_forgotten_url -authority_id $test_vars(authority_id) -username $test_vars(username)] + aa_true "there is a local forgotten-password page with user info" [regexp {forgotten-password} $url] + + set url [auth::password::get_forgotten_url -authority_id $test_vars(authority_id) -username $test_vars(username) -remote_only] + aa_equals "cannot get remote url with missing forgotten_pwd_url" $url "" + + # Without user info + set url [auth::password::get_forgotten_url -authority_id "" -username "" -remote_only] + aa_equals "cannot get remote url without user info" $url "" + + set url [auth::password::get_forgotten_url -authority_id "" -username ""] + aa_true "there is a local forgotten-password page without user info" [regexp {forgotten-password} $url] } aa_register_case auth_password_retrieve { Test the auth::password::retrieve proc. @author Simon Carstensen } { - # Test password_status for ok - # Test whether password is correct + 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 "cannot retrieve pwd from local auth" $result(password_status) "not_supported" + aa_true "must have message on failure" [expr ![empty_string_p $result(password_message)]] } aa_register_case auth_password_reset { Test the auth::password::reset proc. @author Simon Carstensen } { - # Test password_status for ok - # Test whether password actually changed + # We don't want email to go out + aa_stub auth::password::email_password { + return + } + + aa_run_with_teardown \ + -rollback \ + -test_code { + array set test_user { + username "test_username" + password "test_password" + first_names "test_first_names" + last_name "test_last_name" + } + + array set create_result [auth::create_user \ + -username $test_user(username) \ + -password $test_user(password) \ + -first_names $test_user(first_names) \ + -last_name $test_user(last_name)] + aa_equals "status should be ok for creating user" $create_result(creation_status) "ok" + + + array set reset_result [auth::password::reset \ + -authority_id [auth::authority::local] \ + -username $test_user(username)] + aa_equals "status should be ok for reseting password" $reset_result(password_status) "ok" + + array set auth_result [auth::authentication::Authenticate \ + -username $test_user(username) \ + -authority_id [auth::authority::local] \ + -password $reset_result(password)] + aa_equals "can authenticate with new password" $auth_result(auth_status) "ok" + + array set auth_result [auth::authentication::Authenticate \ + -username $test_user(username) \ + -authority_id [auth::authority::local] \ + -password $test_user(password)] + aa_false "cannot authenticate with old password" [string equal $auth_result(auth_status) "ok"] + } } ##### @@ -343,3 +365,13 @@ return [db_string select_user_id {}] } + +ad_proc -private auth::test::get_password_vars { + {-array_name:required} +} { + Get test vars for test case. +} { + upvar $array_name test_vars + + db_1row select_vars {} -column_array test_vars +}