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 -N -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
+}