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:
+
+
+ - auth_status: Whether authentication succeeded.
+ ok, no_account, bad_password, auth_error, failed_to_connect
+
- auth_message: Human-readable message about what went wrong. Guaranteed to be set if auth_status is not ok.
+ Should be ignored if auth_status is ok. May contain HTML.
+
+
- account_status: Account status from authentication server.
+ ok, closed.
+
- account_message: Human-readable message about account status. Guaranteed to be set if auth_status is not ok.
+ If non-empty, must be relayed to the user regardless of account_status. May contain HTML.
+ This proc is responsible for concatenating any remote and/or local account messages into
+ one single message which can be displayed to the user.
+
+
- user_id: Set to local user_id if auth_status is ok.
+
+
} {
+ # 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 {}]
+# }