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.2 -r1.3
--- openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl	25 Aug 2003 13:44:59 -0000	1.2
+++ openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl	26 Aug 2003 10:13:38 -0000	1.3
@@ -125,8 +125,7 @@
     ad_user_login -forever=$persistent_p $user_id
 }
 
-ad_proc -public auth::register_user {
-    {-authority_id ""}
+ad_proc -public auth::create_user {
     {-username:required}
     {-password:required}
     {-first_names ""}
@@ -135,55 +134,184 @@
     {-url ""}
     {-secret_question ""}
     {-secret_answer ""}
+    {-email_verified_p "t"} 
+    {-member_state "approved"}
 } {
+    Create a user, and return creation status and account status.
+    
+    @param email_verified_p Whether the local account considers the email to be verified or not.
+    @param member_state     Whether the local account has been approved.
 
-    @param authority_id The id of the authority to create the user in. Defaults to
-                        the authority with lowest sort_order that has register_p set to true.
+    @return Array list containing the following entries:
+
+    <ul>
+      <li> creation_status:  ok, data_error, reg_error, failed_to_connect. Says whether user creation succeeded.
+      <li> creation_message: Information about the problem, to be relayed to the user. May contain HTML.
+      <li> element_messages: list of (element_name, message, element_name, message, ...) of 
+                             errors on the individual elements (username, password, first_names, ...), 
+                             to be relayed on to the user. If creation_status is not ok, then either 
+                             creation_message or element_messages is guaranteed to be non-empty. Cannot contain HTML.
+      <li> account_status:   ok, closed. Only set if creation_status was ok, this says whether the newly created account 
+                             is ready for use or not. For example, we may require approval, in which case the account 
+                             would be created but closed.
+      <li> account_message:  A human-readable explanation of why the account was closed. May include HTML, and thus shouldn't
+                             be quoted. Guaranteed to be non-empty if account_status is not ok.
+    </ul>
 } {
-    set authorities_list [list]
+     # Implementation note:
+     # just call auth::local::registration::Register for now
+
+     # If we ever create remote users, make sure we concatenate any account messages and local account messages
+     # into one combined message.
+     # Same for account_status (only ok if both are ok)
+
+     set authority_id [auth::authority::local]
+
+     auth::registration::Register \
+         -authority_id $authority_id \
+         -username $username \
+         -password $password \
+         -first_names $first_names \
+         -last_name $last_name \
+         -email $email \
+         -url $url \
+         -secret_question $secret_question \
+         -secret_answer $secret_answer
+}
+
+ad_proc -public auth::get_registration_elements {
+    {-authority_id ""}
+} {
+    Get the list of required/optional elements for user registration.
     
-    # Always register the user locally
-    lappend authorities_list [auth::authority::local]
+    @return Array-list with two entries, both being a subset of 
+            (username, password, first_names, last_name, email, url, secret_question, secret_answer).
+            
+    <ul>
+      <li> required: a list of required elements
+      <li> optional: a list of optional elements
+    </ul>
+            
+} {
+    if { [empty_string_p $authority_id] } {
+        set authority_id [auth::authority::local]
+    }
 
-    # Default authority_id if none was provided
+    return [auth::registration::GetElements -authority_id $authority_id]
+}
+
+ad_proc -public auth::get_registration_form_elements {
+    {-authority_id ""}
+} {
+    Returns a list of elements to be included in the -form chunk of an ad_form form.
+    All possible elements will always be present, but those that shouldn't be displayed 
+    will be hidden and have a hard-coded empty string value.
+} {
     if { [empty_string_p $authority_id] } {
-        # Pick the first authority that can create users
-        set authority_id [db_string first_registering_authority {
-            select authority_id
-            from auth_authorities
-            where register_p = 't'
-            and sort_order = (select max(sort_order)
-                              from auth_authorities
-                              where register_p = 't'
-                             )
-        } -default ""]
+        set authority_id [auth::authority::local]
+    }
 
-        if { [empty_string_p $authority_id] } {
-            error "No authority_id provided and could not find an authority that can create users"
-        }    
+    array set data_types {
+        username text
+        email text
+        first_names text
+        last_name text
+        url text
+        password text
+        secret_question text
+        secret_answer text
+    }
 
-        lappend authorities_list $authority_id
-    }    
+    array set widgets {
+        username text 
+        email test
+        first_names text
+        last_name text
+        url text
+        password text 
+        secret_question text
+        secret_answer text
+    }
+    
+    array set labels [list \
+        username [_ acs-subsite.Username] \
+        email [_ acs-subsite.Your_email_address] \
+        first_names [_ acs-subsite.First_names] \
+        last_name [_ acs-subsite.Last_name] \
+        url [_ acs-subsite.lt_Personal_Home_Page_UR] \
+        password [_ acs-subsite.Your_password] \
+        secret_question [_ acs-subsite.Question] \
+        secret_answer [_ acs-subsite.Answer] \
+    ]
 
-    # Register the user both with the local authority and the external one
-    db_transaction {
-        foreach authority_id $authorities_list {
-            auth::registration::Register \
-                -authority_id $authority_id \
-                -username $user_name \
-                -password $password \
-                -first_names $first_names \
-                -last_name $last_name \
-                -email $email \
-                -url $url \
-                -secret_question $secret_question \
-                -secret_answer $secret_answer
+    array set html {
+        username {size 30}
+        email {size 30}
+        first_names {size 20}
+        last_name {size 25}
+        url {size 50 value "http://"}
+        password {size 20}
+        secret_question {size 30}
+        secret_answer {size 30}
+    }
+    
+    array set element_info [auth::get_registration_elements -authority_id $authority_id]
+
+    set form_elements [list]
+    foreach element [concat $element_info(required) $element_info(optional)] {
+        set form_element [list]
+
+        # The header with name, datatype, and widget
+        set form_element_header "${element}:$data_types($element)($widgets($element))"
+        set optional_p [expr [lsearch -exact $element_info(optional) $element] != -1]
+        if { $optional_p } {
+            append form_element_header ",optional"
         }
+        lappend form_element $form_element_header
+
+        # The label
+        lappend form_element [list label $labels($element)]
+
+        # HTML
+        lappend form_element [list html $html($element)]
+
+        # The form element is finished - add it to the list
+        lappend form_elements $form_element
     }
+
+    return $form_elements
 }
 
+ad_proc -public auth::create_local_account {
+    {-user_id ""}
+    {-authority_id ""}
+    {-username:required}
+    {-first_names:required}
+    {-last_name:required}
+    {-email:required}
+    {-url ""}
+    {-member_state "approved"}
+    {-email_verified_p "t"}
+} {
+    Create the local account for a user.
+} {
 
+    # TODO: implement
+}
 
+ad_proc -public auth::confirm_email {
+    {-user_id:required}
+} {
+    Update an OpenACS record with the fact that the email address on
+    record was verified.
+} {
+    db_dml set_email_verified {
+        update users 
+        set email_verified_p = 't'
+        where user_id = :user_id
+    }
+}
+
 #####
 #
 # auth namespace private procs
@@ -277,8 +405,6 @@
    return [array get auth_info]    
 }
 
-
-
 #####
 #
 # auth::authentication
@@ -376,3 +502,23 @@
                                  $secret_question \
                                  $secret_answer]]
 }
+
+ad_proc -private auth::registration::GetElements {
+    {-authority_id:required}    
+} {
+
+    @author Peter Marklund
+} {
+    if { [empty_string_p $authority_id] } {
+        set authority_id [auth::authority::local]
+    }
+
+    # TODO:
+    # Implement parameters
+
+    return [acs_sc::invoke \
+                -contract "auth_registration" \
+                -impl [auth::authority::get_element -authority_id $authority_id -element "auth_impl_name"] \
+                -operation GetElements \
+                -call_args [list [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.3 -r1.4
--- openacs-4/packages/acs-authentication/tcl/local-procs.tcl	25 Aug 2003 13:44:59 -0000	1.3
+++ openacs-4/packages/acs-authentication/tcl/local-procs.tcl	26 Aug 2003 10:13:38 -0000	1.4
@@ -376,26 +376,29 @@
     }
 
     # TODO: email = username
+    if { [empty_string_p $email] } {
+        set email $username
+    }
     # TODO: Add catch
-
-    set user_id [ad_user_new \
+    if {[catch {set user_id [ad_user_new \
                      $email \
                      $first_names \
                      $last_name \
                      $password \
-                     $question \
-                     $answer \
+                     $secret_question \
+                     $secret_answer \
                      $url \
-                     $email_verified_p \
-                     $member_state \
+                     "t" \
+                     "approved" \
                      "" \
                      $username \
-                     $authority_id]
+                                 $authority_id]} errmsg] || ! $user_id } {
 
-    if { !$user_id } {
         set result(creation_status) "fail"
         set result(creation_message) "We experienced an error while trying to register an account for you."
         return [array get result]
+    } else {
+        set result(user_id) $user_id
     }
     
     # Creation succeeded
@@ -441,7 +444,7 @@
         set email_verified_p "t"
     }
 
-    # Send password/confirmail email to user
+    # Send password confirmation email to user
     if { [parameter::get -parameter RegistrationProvidesRandomPasswordP -default 0] || \
              [parameter::get -parameter EmailRegistrationConfirmationToUserP -default 0] } {
 	with_catch errmsg {
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.2 -r1.3
--- openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl	25 Aug 2003 13:44:59 -0000	1.2
+++ openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl	26 Aug 2003 10:13:38 -0000	1.3
@@ -113,6 +113,93 @@
         }
 }
 
+aa_register_case auth_create_user {
+    Test the auth::create_user proc.
+
+    @author Peter Marklund
+} {
+    db_transaction {
+
+        # Successful creation
+         array set user_info [auth::create_user \
+                                  -username "auth_create_user1@test_user.com" \
+                                  -first_names "Test" \
+                                  -last_name "User" \
+                                  -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)
+
+         # Missing first_names
+         array set user_info [auth::create_user \
+                                  -username "auth_create_user2@test_user.com" \
+                                  -first_names "" \
+                                  -last_name "User" \
+                                  -password "changeme" \
+                                  -secret_question "no_question" \
+                                  -secret_answer "no_answer"]
+
+         set first_names_result(creation_status) $user_info(creation_status)
+         
+         error "rollback tests"
+
+    } 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 {
+    Test the auth::confirm_email proc.
+
+    @author Peter Marklund
+} {
+    set user_id [ad_conn user_id]
+
+    auth::confirm_email -user_id $user_id
+
+    # Check that update was made in db
+    set email_verified_p [db_string select_email_verified_p {
+        select email_verified_p
+        from cc_users
+        where user_id = :user_id
+    }]
+
+    aa_equals "email should be verified" $email_verified_p "t"
+}
+
+aa_register_case auth_get_registration_elements {
+    Test the auth::get_registration_elements proc
+
+    @author Peter Marklund
+} {
+    array set element_array [auth::get_registration_elements]
+
+    aa_true "there is more than one required element: ($element_array(required))" [expr [llength $element_array(required)] > 0]
+    aa_true "there is more than one optional element: ($element_array(optional))" [expr [llength $element_array(optional)] > 0]
+}
+
+aa_register_case auth_get_registration_form_elements {
+    Test the auth::get_registration_form_elements proc
+
+    @auth Peter Marklund
+} {
+    set form_elements [auth::get_registration_form_elements]
+
+    aa_true "Form elements are not empty: $form_elements" [expr ![empty_string_p $form_elements]]
+}
+
 aa_register_case auth_password_get_change_url {
     Test the auth::password::get_change_url proc.
 
@@ -247,10 +334,12 @@
 #
 ####
 
-# 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]
+namespace eval auth::test {}
 
-#     return [db_string select_user_id {}]
-# }
+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 {}]
+}