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.1 -r1.2 --- openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 22 Aug 2003 10:55:00 -0000 1.1 +++ openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 25 Aug 2003 13:44:59 -0000 1.2 @@ -26,7 +26,8 @@ Use this in a page script to ensure that only registered and authenticated users can execute the page, for example for posting to a forum. - @return user_id of user, if the user is logged in. Otherwise will issue an ad_script_abort. + @return user_id of user, if the user is logged in. + Otherwise will issue a returnredirect and abort the current page. @see ad_script_abort } { @@ -38,15 +39,43 @@ {-username:required} {-password:required} } { - Try to authenticate login the user by validating the username/password combination, + Try to authenticate and login the user forever by validating the username/password combination, and return authentication and account status codes. - @param username Username of the user. - + @param authority_id The ID of the authority to ask to verify the user. Defaults to local authority. + @param username Authority specific username of the user. @param passowrd The password as the user entered it. - @param authority_id The ID of the authority to ask to verify the user. Leave blank for local authority. + @return Array list with the following entries: + + + } { + # Default to local authority + if { [empty_string_p $authority_id] } { + set authority_id [auth::authority::local] + } + + # Implementation note: + # Invoke the service contract + # Provide canned strings for auth_message and account_message if not returned by SC implementation. + # Concatenate remote account message and local account message into one logical understandable message. + # Same with account status: only ok if both are ok. + array set auth_info [auth::authentication::Authenticate \ -username $username \ -authority_id $authority_id \ @@ -204,7 +233,9 @@ # Initialize to 'closed', because most cases below mean the account is closed set auth_info(account_status) "closed" - + + # system_name is used in some of the I18N messages + set system_name [ad_system_name] switch $member_state { "approved" { if { $email_verified_p == "f" } { @@ -267,14 +298,34 @@ } { if { [empty_string_p $authority_id] } { set authority_id [auth::authority::local] + } { + # Check that the authority exists + set authority_exists_p [db_string authority_exists_p { + select count(*) + from auth_authorities + where authority_id = :authority_id + }] + + if { ! $authority_exists_p } { + set auth_info(auth_status) auth_error + set auth_info(auth_message) "Internal error - authority with id $authority_id does not exist" + + return [array get auth_info] + } } # TODO: # Implement parameters + set impl_id [auth::authority::get_element -authority_id $authority_id -element "auth_impl_name"] + if { [empty_string_p $impl_id] } { + # Invalid authority + return {} + } + return [acs_sc::invoke \ -contract "auth_authentication" \ - -impl [auth::authority::get_element -authority_id $authority_id -element "auth_impl_name"] \ + -impl $impl_id \ -operation Authenticate \ -call_args [list $username $password [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.2 -r1.3 --- openacs-4/packages/acs-authentication/tcl/local-procs.tcl 22 Aug 2003 15:10:54 -0000 1.2 +++ openacs-4/packages/acs-authentication/tcl/local-procs.tcl 25 Aug 2003 13:44:59 -0000 1.3 @@ -102,7 +102,7 @@ password {parameters {}} } { - Implements the GetParameters operation of the auth_authentication + Implements the Authenticate operation of the auth_authentication service contract for the local account implementation. } { array set auth_info [list] @@ -123,6 +123,7 @@ set auth_info(auth_status) "ok" } else { set auth_info(auth_status) "bad_password" + set auth_info(auth_message) "Invalid username or password" return [array get auth_info] } 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.1 -r1.2 --- openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 22 Aug 2003 10:55:00 -0000 1.1 +++ openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 25 Aug 2003 13:44:59 -0000 1.2 @@ -11,12 +11,246 @@ Test the auth::authenticate proc. @author Peter Marklund +} { + aa_run_with_teardown \ + -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 + array set auth_info \ + [auth::authenticate \ + -username $email \ + -password $password] + + aa_equals "auth_status for successful authentication" $auth_info(auth_status) "ok" + + # Failed authentications + # Incorrect password + array set auth_info \ + [auth::authenticate \ + -username $email \ + -password "blabla"] + + aa_equals "auth_status for bad password authentication" $auth_info(auth_status) "bad_password" + aa_true "auth_message for bad password authentication" ![empty_string_p $auth_info(auth_message)] + + # Blank password + array set auth_info \ + [auth::authenticate \ + -username $email \ + -password ""] + + aa_equals "auth_status for blank password authentication" $auth_info(auth_status) "bad_password" + aa_true "auth_message for blank password authentication" ![empty_string_p $auth_info(auth_message)] + + # Incorrect username + array set auth_info \ + [auth::authenticate \ + -username "blabla" \ + -password $password] + + aa_equals "auth_status for bad username authentication" $auth_info(auth_status) "no_account" + aa_true "auth_message for bad username authentication" ![empty_string_p $auth_info(auth_message)] + + # Blank username + array set auth_info \ + [auth::authenticate \ + -username "" \ + -password $password] + + aa_equals "auth_status for blank username authentication" $auth_info(auth_status) "no_account" + aa_true "auth_message for blank username authentication" ![empty_string_p $auth_info(auth_message)] + + # Authority bogus + array set auth_info \ + [auth::authenticate \ + -authority_id -123 \ + -username $email \ + -password $password] + + aa_equals "auth_status for bad authority_id authentication" $auth_info(auth_status) "auth_error" + aa_true "auth_message for bad authority_id authentication" ![empty_string_p $auth_info(auth_message)] + + # Closed account status + set closed_states {banned rejected "needs approval" deleted} + foreach closed_state $closed_states { + acs_user::change_state -user_id $user_id -state $closed_state + + # Successful authentication + array set auth_info \ + [auth::authenticate \ + -username $email \ + -password $password] + + 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 + } +} + +aa_register_case auth_password_get_change_url { + Test the auth::password::get_change_url proc. + + @author Simon Carstensen } { - # Successful authentication - # Failed authentications + # Test whether auth::password::get_change_url returns and empty string when "change_pwd_url" is not se - # Closed account status + 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 ""] + + 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 +} + +aa_register_case auth_password_can_change_p { + Test the auth::password::can_change_p proc. + + @author Simon Carstensen +} { - # Error handling + 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] \ + "1" } + +aa_register_case auth_password_change { + Test the auth::password::change proc. + + @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"] + + # 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" + +} + +aa_register_case auth_password_forgotten { + Test the auth::password::forgotten proc. + + @author Simon Carstensen +} { + # Test password_status on local driver for ok +} + +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 }] +} + +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 +} + +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 +} + +##### +# +# Helper procs +# +#### + +# ad_proc -private auth::test::get_admin_user_id {} { +# Return the user id of a site-wide-admin on the system +# } { +# set context_root_id [acs_lookup_magic_object security_context_root] + +# return [db_string select_user_id {}] +# }