Index: openacs-4/packages/acs-authentication/sql/oracle/batch-job-tables-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/sql/oracle/batch-job-tables-create.sql,v diff -u -r1.5 -r1.6 --- openacs-4/packages/acs-authentication/sql/oracle/batch-job-tables-create.sql 10 Sep 2003 12:37:02 -0000 1.5 +++ openacs-4/packages/acs-authentication/sql/oracle/batch-job-tables-create.sql 16 Sep 2003 13:07:42 -0000 1.6 @@ -13,9 +13,7 @@ not null, snapshot_p char(1) constraint auth_batch_jobs_snapshot_ck - check (snapshot_p in ('t', 'f')) - constraint auth_batch_jobs_snapshot_nn - not null, + check (snapshot_p in ('t', 'f')), authority_id integer constraint auth_batch_jobs_auth_fk references auth_authorities(authority_id) Index: openacs-4/packages/acs-authentication/sql/postgresql/batch-job-tables-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/sql/postgresql/batch-job-tables-create.sql,v diff -u -r1.4 -r1.5 --- openacs-4/packages/acs-authentication/sql/postgresql/batch-job-tables-create.sql 10 Sep 2003 09:09:47 -0000 1.4 +++ openacs-4/packages/acs-authentication/sql/postgresql/batch-job-tables-create.sql 16 Sep 2003 13:07:42 -0000 1.5 @@ -10,9 +10,7 @@ interactive_p boolean constraint auth_batch_jobs_interactive_nn not null, - snapshot_p boolean - constraint auth_batch_jobs_snapshot_nn - not null, + snapshot_p boolean, authority_id integer constraint auth_batch_jobs_auth_fk references auth_authorities(authority_id) Index: openacs-4/packages/acs-authentication/tcl/apm-callback-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/apm-callback-procs.tcl,v diff -u -r1.7 -r1.8 --- openacs-4/packages/acs-authentication/tcl/apm-callback-procs.tcl 12 Sep 2003 13:00:31 -0000 1.7 +++ openacs-4/packages/acs-authentication/tcl/apm-callback-procs.tcl 16 Sep 2003 13:07:42 -0000 1.8 @@ -320,14 +320,14 @@ Create service contract for account registration. } { set spec { - name "GetDocument" + name "auth_sync_retrieve" description "Retrieve a document, e.g. using HTTP, SMP, FTP, SOAP, etc." operations { GetDocument { description { Retrieves the document. Returns doc_status of 'ok', 'get_error', or 'failed_to_connect'. If not 'ok', then it should set doc_message to explain the problem. If 'ok', it must set - document to the document retrieved. + document to the document retrieved, and set snapshot_p to t if it has retrieved a snapshot document. } input { parameters:string,multiple @@ -336,6 +336,7 @@ doc_status:string doc_message:string document:string + snapshot_p:string } } GetParameters { 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.32 -r1.33 --- openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 12 Sep 2003 14:31:15 -0000 1.32 +++ openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 16 Sep 2003 13:07:42 -0000 1.33 @@ -40,9 +40,39 @@ ad_script_abort } +ad_proc -public auth::get_login_focus {} { + Get the relevant focus for the login box. +} { + if { [auth::UseEmailForLoginP] } { + return "login.email" + } else { + return "login.username" + } +} + +ad_proc -public auth::UseEmailForLoginP {} { + Do we use email address for login? code wrapped in a catch, so the + proc will not break regardless of what the parameter value is. +} { + if { [catch { + if { [template::util::is_true [parameter::get -parameter UseEmailForLoginP -package_id [ad_acs_kernel_id]]] } { + set p 1 + } else { + set p 0 + } + } errmsg] } { + global errorInfo + ns_log Error "Parameter acs-kernel.UseEmailForLoginP not a boolean:\n$errorInfo" + return 1 + } else { + return $p + } +} + ad_proc -public auth::authenticate { {-authority_id ""} - {-username:required} + {-username ""} + {-email ""} {-password:required} {-persistent:boolean} {-no_cookie:boolean} @@ -51,10 +81,11 @@ and return authentication and account status codes. @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 persistent Set this if you want a permanent login cookie - @param no_cookie Set this if you don't want to issue a login cookie + @param username Authority specific username of the user. + @param email User's email address. You must supply either username or email. + @param passowrd The password as the user entered it. + @param persistent Set this if you want a permanent login cookie + @param no_cookie Set this if you don't want to issue a login cookie @return Array list with the following entries: @@ -75,149 +106,166 @@ } { - # Default to local authority - if { [empty_string_p $authority_id] } { - set authority_id [auth::authority::local] + if { [empty_string_p $username] } { + if { [empty_string_p $email] } { + set result(auth_status) "auth_error" + if { [auth::UseEmailForLoginP] } { + set result(auth_message) "Email required" + } else { + set result(auth_message) "Username required" + } + return [array get result] + } + set user_id [cc_lookup_email_user $email] + if { [empty_string_p $user_id] } { + set result(auth_status) "no_account" + set result(auth_message) "Unknown email" + return [array get result] + } + acs_user::get -user_id $user_id -array user + set authority_id $user(authority_id) + set username $user(username) + } else { + # Default to local authority + if { [empty_string_p $authority_id] } { + set authority_id [auth::authority::local] + } } + + ns_log Notice "LARS: authority_id = $authority_id, username = $username" - # 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. - with_catch errmsg { - array set auth_info [auth::authentication::Authenticate \ + array set result [auth::authentication::Authenticate \ -username $username \ -authority_id $authority_id \ -password $password] # We do this so that if there aren't even the auth_status and account_status that need be # in the array, that gets caught below - if { [string equal $auth_info(auth_status) "ok"] } { - set dummy $auth_info(account_status) + if { [string equal $result(auth_status) "ok"] } { + set dummy $result(account_status) } } { - set auth_info(auth_status) failed_to_connect - set auth_info(auth_message) $errmsg + set result(auth_status) failed_to_connect + set result(auth_message) $errmsg global errorInfo ns_log Error "Error invoking authentication driver for authority_id = $authority_id: $errorInfo" } # Returns: - # auth_info(auth_status) - # auth_info(auth_message) - # auth_info(account_status) - # auth_info(account_message) + # result(auth_status) + # result(auth_message) + # result(account_status) + # result(account_message) - # Verify auth_info/auth_message return codes - switch $auth_info(auth_status) { + # Verify result/auth_message return codes + switch $result(auth_status) { ok { # Continue below } no_account - bad_password - auth_error - failed_to_connect { - if { ![exists_and_not_null auth_info(auth_message)] } { + if { ![exists_and_not_null result(auth_message)] } { array set default_auth_message { no_account {Unknown username} bad_password {Bad password} auth_error {Invalid username/password} failed_to_connect {Error communicating with authentication server} } - set auth_info(auth_message) $default_auth_message($auth_info(auth_status)) + set result(auth_message) $default_auth_message($result(auth_status)) } - return [array get auth_info] + return [array get result] } default { - ns_log Error "Illegal auth_status code '$auth_info(auth_status)' returned from authentication driver for authority_id $authority_id ([auth::authority::get_element -authority_id $authority_id -element pretty_name])" + ns_log Error "Illegal auth_status code '$result(auth_status)' returned from authentication driver for authority_id $authority_id ([auth::authority::get_element -authority_id $authority_id -element pretty_name])" - set auth_info(auth_status) "failed_to_connect" - set auth_info(auth_message) "Internal error during authentication" - return [array get auth_info] + set result(auth_status) "failed_to_connect" + set result(auth_message) "Internal error during authentication" + return [array get result] } } # Verify remote account_info/account_message return codes - switch $auth_info(account_status) { + switch $result(account_status) { ok { # Continue below - if { ![info exists auth_info(account_message)] } { - set auth_info(account_message) {} + if { ![info exists result(account_message)] } { + set result(account_message) {} } } closed { - if { ![exists_and_not_null auth_info(account_message)] } { - set auth_info(account_message) "This account is not available at this time" + if { ![exists_and_not_null result(account_message)] } { + set result(account_message) "This account is not available at this time" } } default { - ns_log Error "Illegal account_status code '$auth_info(account_status)' returned from authentication driver for authority_id $authority_id ([auth::authority::get_element -authority_id $authority_id -element pretty_name])" + ns_log Error "Illegal account_status code '$result(account_status)' returned from authentication driver for authority_id $authority_id ([auth::authority::get_element -authority_id $authority_id -element pretty_name])" - set auth_info(account_status) "closed" - set auth_info(account_message) "Internal error during authentication" + set result(account_status) "closed" + set result(account_message) "Internal error during authentication" } } # Save the remote account information for later - set remote_account_status $auth_info(account_status) - set remote_account_message $auth_info(account_message) + set remote_account_status $result(account_status) + set remote_account_message $result(account_message) # Clear out remote account_status and account_message - array unset auth_info account_status - array unset auth_info account_message + array unset result account_status + array unset result account_message # Map to row in local users table - array set auth_info [auth::get_local_account \ + array set result [auth::get_local_account \ -username $username \ -authority_id $authority_id] # Returns: - # auth_info(account_status) - # auth_info(account_message) - # auth_info(user_id) + # result(account_status) + # result(account_message) + # result(user_id) # Verify local account_info/account_message return codes - switch $auth_info(account_status) { + switch $result(account_status) { ok { # Continue below - if { ![info exists auth_info(account_message)] } { - set auth_info(account_message) {} + if { ![info exists result(account_message)] } { + set result(account_message) {} } } closed { - if { ![exists_and_not_null auth_info(account_message)] } { - set auth_info(account_message) "This account is not available at this time" + if { ![exists_and_not_null result(account_message)] } { + set result(account_message) "This account is not available at this time" } } default { - ns_log Error "Illegal account_status code '$auth_info(account_status)' returned from auth::get_local_account for authority_id $authority_id ([auth::authority::get_element -authority_id $authority_id -element pretty_name])" + ns_log Error "Illegal account_status code '$result(account_status)' returned from auth::get_local_account for authority_id $authority_id ([auth::authority::get_element -authority_id $authority_id -element pretty_name])" - set auth_info(account_status) "closed" - set auth_info(account_message) "Internal error during authentication" + set result(account_status) "closed" + set result(account_message) "Internal error during authentication" } } # If the remote account was closed, the whole account is closed, regardless of local account status if { [string equal $remote_account_status "closed"] } { - set auth_info(account_status) closed + set result(account_status) closed } if { [exists_and_not_null remote_account_message] } { - if { [exists_and_not_null auth_info(account_message)] } { + if { [exists_and_not_null result(account_message)] } { # Concatenate local and remote account messages - set auth_info(account_message) "

[auth::authority::get_element -authority_id $authority_id -element pretty_name]: $remote_account_message

[ad_system_name]: $auth_info(account_message)

" + set result(account_message) "

[auth::authority::get_element -authority_id $authority_id -element pretty_name]: $remote_account_message

[ad_system_name]: $result(account_message)

" } else { - set auth_info(account_message) $remote_account_message + set result(account_message) $remote_account_message } } # Issue login cookie if login was successful - if { [string equal $auth_info(auth_status) "ok"] && [string equal $auth_info(account_status) "ok"] && !$no_cookie_p } { - auth::issue_login -user_id $auth_info(user_id) -persistent=$persistent_p + if { [string equal $result(auth_status) "ok"] && [string equal $result(account_status) "ok"] && !$no_cookie_p } { + auth::issue_login -user_id $result(user_id) -persistent=$persistent_p } - return [array get auth_info] + return [array get result] } ad_proc -private auth::issue_login { @@ -306,36 +354,10 @@ # This holds element error messages array set element_messages [list] - ##### - # - # Check for missing required fields - # - ##### - - # We do this first, so that double-click protection works correctly - - set missing_elements_p 0 - array set reg_elms [auth::get_registration_elements] - foreach elm $reg_elms(required) { - if { [empty_string_p [set $elm]] } { - set element_messages($elm) "Required" - set missing_elements_p 1 - } + # Initialize username to email + if { [auth::UseEmailForLoginP] && [empty_string_p $username] } { + set username $email } - if { $verify_password_confirm_p } { - if { ![empty_string_p "$password$password_confirm"] && ![string equal $password $password_confirm] } { - set element_messages(password) "Passwords don't match" - set missing_elements_p 1 - } - } - if { $missing_elements_p } { - return [list \ - creation_status data_error \ - creation_message "Missing required fields" \ - element_messages [array get element_messages] \ - ] - } - ##### @@ -536,10 +558,16 @@ return [array get element_info] } -ad_proc -public auth::get_all_registration_elements {} { +ad_proc -public auth::get_all_registration_elements { + {-include_password_confirm:boolean} +} { Get the list of possible registration elements. } { - return { username password first_names last_name screen_name email url secret_question secret_answer } + if { $include_password_confirm_p } { + return { email username first_names last_name password password_confirm screen_name url secret_question secret_answer } + } else { + return { email username first_names last_name password screen_name url secret_question secret_answer } + } } ad_proc -public auth::get_registration_form_elements { @@ -586,7 +614,7 @@ password_confirm [_ acs-subsite.lt_Password_Confirmation] \ secret_question [_ acs-subsite.Question] \ secret_answer [_ acs-subsite.Answer]] - + array set html { username {size 30} email {size 30} @@ -619,7 +647,7 @@ } set form_elements [list] - foreach element [concat [auth::get_all_registration_elements] password_confirm] { + foreach element [auth::get_all_registration_elements -include_password_confirm] { if { [info exists required_p($element)] } { set form_element [list] @@ -696,12 +724,6 @@ } } - # PHASE II: This needs to be controlled by a parameter - if { [empty_string_p $username] } { - # What if email doesn't exist? - set username $user_info(email) - } - # Validate data set user_info(username) $username set user_info(authority_id) $authority_id @@ -978,7 +1000,7 @@ set element_messages(username) "No user with username '$user(username)' found for authority [auth::authority::get_element -authority_id $user(authority_id) -element pretty_name]" } } - + # TODO: When doing RBM's parameter, make sure that we still require both first_names and last_names, or none of them if { [exists_and_not_null user(first_names)] && [string first "<" $user(first_names)] != -1 } { set element_messages(first_names) [_ acs-subsite.lt_You_cant_have_a_lt_in] Index: openacs-4/packages/acs-authentication/tcl/authority-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/authority-procs.tcl,v diff -u -r1.15 -r1.16 --- openacs-4/packages/acs-authentication/tcl/authority-procs.tcl 12 Sep 2003 14:31:15 -0000 1.15 +++ openacs-4/packages/acs-authentication/tcl/authority-procs.tcl 16 Sep 2003 13:07:42 -0000 1.16 @@ -60,8 +60,6 @@
  • process_doc_impl_id Id of the batch sync ProcessDocument service contract implementation -
  • snapshot_p Whether batch jobs are snapshots or not -
  • batch_sync_enabled_p Is batch sync enabled for the authority? @@ -133,7 +131,7 @@ set authority_id [db_exec_plsql create_authority {}] # Set the arguments not taken by the new function with an update statement - foreach column {get_doc_impl_id process_doc_impl_id snapshot_p batch_sync_enabled_p help_contact_text_format} { + foreach column {get_doc_impl_id process_doc_impl_id batch_sync_enabled_p help_contact_text_format} { set edit_columns($column) [set $column] } @@ -278,7 +276,6 @@ ad_proc -public auth::authority::batch_sync { -authority_id:required - -snapshot:boolean } { Execute batch synchronization for this authority now. @@ -289,8 +286,7 @@ @return job_id } { set job_id [auth::sync::job::start \ - -authority_id $authority_id \ - -snapshot=$snapshot_p] + -authority_id $authority_id] get -authority_id $authority_id -array authority @@ -308,6 +304,7 @@ doc_status failed_to_connect doc_message {} document {} + snapshot_p f } with_catch errmsg { array set doc_result [auth::sync::GetDocument -authority_id $authority_id] @@ -318,11 +315,14 @@ set doc_result(doc_message) $errmsg } + set snapshot_p [template::util::is_true $doc_result(snapshot_p)] + auth::sync::job::end_get_document \ -job_id $job_id \ -doc_status $doc_result(doc_status) \ -doc_message $doc_result(doc_message) \ - -document $doc_result(document) + -document $doc_result(document) \ + -snapshot=$snapshot_p if { [string equal $doc_result(doc_status) "ok"] && ![empty_string_p $doc_result(document)] } { with_catch errmsg { @@ -409,7 +409,6 @@ register_url "" get_doc_impl_id "" process_doc_impl_id "" - snapshot_p "f" batch_sync_enabled_p "f" } } Index: openacs-4/packages/acs-authentication/tcl/driver-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/driver-procs.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/acs-authentication/tcl/driver-procs.tcl 3 Sep 2003 19:45:32 -0000 1.3 +++ openacs-4/packages/acs-authentication/tcl/driver-procs.tcl 16 Sep 2003 13:07:42 -0000 1.4 @@ -41,15 +41,27 @@ @author Simon Carstensen (simon@collaboraid.biz) @creation-date 2003-08-27 } { - set params [list] + array set param [list] + db_foreach select_values { select key, value from auth_driver_params where impl_id = :impl_id and authority_id = :authority_id } { - lappend params $key $value + set param($key) $value } + + # We need to ensure that the driver gets all the parameters it is asking for, and nothing but the ones it is asking for + set params [list] + foreach { name desc } [get_parameters -impl_id $impl_id] { + if { [info exists param($name)] } { + lappend params $name $param($name) + } else { + lappend params $name {} + } + } + return $params } 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.13 -r1.14 --- openacs-4/packages/acs-authentication/tcl/local-procs.tcl 12 Sep 2003 13:00:31 -0000 1.13 +++ openacs-4/packages/acs-authentication/tcl/local-procs.tcl 16 Sep 2003 13:07:42 -0000 1.14 @@ -81,7 +81,7 @@ contract_name "auth_authentication" owner "acs-authentication" name "local" - pretty_name "Local Authentication" + pretty_name "Local" aliases { Authenticate auth::local::authentication::Authenticate GetParameters auth::local::authentication::GetParameters @@ -113,7 +113,6 @@ set authority_id [auth::authority::local] - set user_id [acs_user::get_by_username -username $username] if { [empty_string_p $user_id] } { set result(auth_status) "no_account" @@ -162,7 +161,7 @@ contract_name "auth_password" owner "acs-authentication" name "local" - pretty_name "Local Password" + pretty_name "Local" aliases { CanChangePassword auth::local::password::CanChangePassword ChangePassword auth::local::password::ChangePassword @@ -246,6 +245,31 @@ set result(password_status) "ok" + if { [parameter::get -parameter EmailAccountOwnerOnPasswordChangeP -package_id [ad_acs_kernel_id] -default 1] } { + acs_user::get -username $username -array user + + set system_name [ad_system_name] + set pvt_home_name [ad_pvt_home_name] + set password_update_link_text [_ acs-subsite.Change_my_Password] + + if { [auth::UseEmailForLoginP] } { + set account_id_label [_ acs-subsite.Email] + set account_id $user(email) + } else { + set account_id_label [_ acs-subsite.Username] + set account_id $user(username) + } + + set subject [_ acs-subsite.Password_changed_subject] + set body [_ acs-subsite.Password_changed_body] + + ns_sendmail \ + $user(email) \ + [ad_outgoing_sender] \ + $subject \ + $body + } + return [array get result] } @@ -321,7 +345,7 @@ contract_name "auth_registration" owner "acs-authentication" name "local" - pretty_name "Local Registration" + pretty_name "Local" aliases { GetElements auth::local::registration::GetElements Register auth::local::registration::Register @@ -343,7 +367,12 @@ Implements the GetElements operation of the auth_register service contract for the local account implementation. } { - set result(required) { username email first_names last_name } + set result(required) {} + if { ![auth::UseEmailForLoginP] } { + set result(required) username + } + + set result(required) [concat $result(required) { email first_names last_name }] set result(optional) { screen_name url } if { ![parameter::get -parameter RegistrationProvidesRandomPasswordP -default 0] } { @@ -394,8 +423,9 @@ # Set user's password set user_id [acs_user::get_by_username -username $username] + ns_log Notice "LARS: Setting user_id $user_id's password to $password -- username = $username" ad_change_password $user_id $password - + # Used in messages below set system_name [ad_system_name] set system_url [ad_url] Index: openacs-4/packages/acs-authentication/tcl/password-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/password-procs.tcl,v diff -u -r1.3 -r1.4 --- openacs-4/packages/acs-authentication/tcl/password-procs.tcl 4 Sep 2003 16:36:17 -0000 1.3 +++ openacs-4/packages/acs-authentication/tcl/password-procs.tcl 16 Sep 2003 13:07:42 -0000 1.4 @@ -108,9 +108,9 @@ set dummy $result(password_status) } { set result(password_status) failed_to_connect - set result(password_message) "Error invoking the password management driver." + set result(password_message) $errmsg global errorInfo - ns_log Error "Error invoking password management driver for authority_id = $authority_id: $errorInfo" + ns_log Error "Error invoking password management driver for authority_id = $user(authority_id):\n$errorInfo" } # Check the result code and provide canned responses @@ -131,23 +131,26 @@ } default { set result(password_status) "failed_to_connect" - set result(password_message) "Illegal error code returned from password management driver" + set result(password_message) "Illegal code returned from password management driver" + ns_log Error "Error invoking password management driver for authority_id = $user(authority_id): Illegal return code from driver: $result(password_status)" } } - + return [array get result] } ad_proc -public auth::password::recover_password { - {-authority_id:required} - {-username:required} + {-authority_id ""} + {-username ""} + {-email ""} } { Handles forgotten passwords. Attempts to retrieve a password; if not possibe, attempts to reset a password. If it succeeds, it emails the user. For all outcomes, it returns a message to be displayed. @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 username The username that the user's trying to log in with. + @param email Email can be supplied instead of authority_id and username. @return Array list with the following entries: @@ -156,6 +159,32 @@
  • password_message: Human-readable message to be relayed to the user. May contain HTML. } { + if { [empty_string_p $username] } { + if { [empty_string_p $email] } { + set result(password_status) "failed_to_connect" + if { [auth::UseEmailForLoginP] } { + set result(password_message) "Email required" + } else { + set result(password_message) "Username required" + } + return [array get result] + } + set user_id [cc_lookup_email_user $email] + if { [empty_string_p $user_id] } { + set result(password_status) "failed_to_connect" + set result(password_message) "Unknown email" + return [array get result] + } + acs_user::get -user_id $user_id -array user + set authority_id $user(authority_id) + set username $user(username) + } else { + # Default to local authority + if { [empty_string_p $authority_id] } { + set authority_id [auth::authority::local] + } + } + set forgotten_url [auth::password::get_forgotten_url \ -remote_only \ -authority_id $authority_id \ @@ -207,6 +236,7 @@ ad_proc -public auth::password::get_forgotten_url { {-authority_id ""} {-username ""} + {-email ""} {-remote_only:boolean} } { Returns the URL to redirect to for forgotten passwords. @@ -219,34 +249,41 @@ or the empty string if none can be found. } { if { ![empty_string_p $username] } { - # We have the username + set local_url [export_vars -no_empty -base "[subsite::get_element -element url]register/recover-password" { authority_id username }] + } else { + set local_url [export_vars -no_empty -base "[subsite::get_element -element url]register/recover-password" { email }] + } + set forgotten_pwd_url {} + if { ![empty_string_p $username] } { if { [empty_string_p $authority_id] } { set authority_id [auth::authority::local] } + } else { + set user_id [cc_lookup_email_user $email] + if { ![empty_string_p $user_id] } { + acs_user::get -user_id $user_id -array user + set authority_id $user(authority_id) + set username $user(username) + } + } + if { ![empty_string_p $username] } { + # We have the username or email + + set forgotten_pwd_url [auth::authority::get_element -authority_id $authority_id -element forgotten_pwd_url] if { ![empty_string_p $forgotten_pwd_url] } { regsub -all "{username}" $forgotten_pwd_url $username forgotten_pwd_url - } else { - 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 [export_vars -base "[subsite::get_element -element url]register/recover-password" { authority_id username }] - } + } elseif { !$remote_only_p } { + if { [auth::password::can_retrieve_p -authority_id $authority_id] || [auth::password::can_reset_p -authority_id $authority_id] } { + set forgotten_pwd_url $local_url } } } else { # We don't have the username - - if { $remote_only_p } { - # Remote recovery can only be determined if we know the authority so we return the empty string - set forgotten_pwd_url {} - } else { + if { !$remote_only_p } { set forgotten_pwd_url "[subsite::get_element -element url]register/recover-password" } } @@ -444,14 +481,29 @@ @author Peter Marklund } { - set system_owner [ad_system_owner] - set system_name [ad_system_name] - set user_id [acs_user::get_by_username -authority_id $authority_id -username $username] acs_user::get -user_id $user_id -array user set reset_password_url [export_vars -base "[ad_url]/user/password-update" {user_id {old_password $password}}] - + set system_owner [ad_system_owner] + set system_name [ad_system_name] + if { [auth::UseEmailForLoginP] } { + set account_id_label [_ acs-subsite.Email] + set account_id $user(email) + } else { + set account_id_label [_ acs-subsite.Username] + set account_id $user(username) + } + # Hm, all this crummy code, just to justify the colons in the email body + set password_label [_ acs-subsite.Password] + if { [string length $password_label] > [string length $account_id_label] } { + set length [string length $password_label] + } else { + set length [string length $account_id_label] + } + set account_id_label [string range "$account_id_label[string repeat " " $length]" 0 [expr $length-1]] + set password_label [string range "$password_label[string repeat " " $length]" 0 [expr $length-1]] + set subject [_ acs-subsite.lt_Your_forgotten_passwo] set body [_ acs-subsite.Forgotten_password_body] Index: openacs-4/packages/acs-authentication/tcl/sync-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/sync-procs-oracle.xql,v diff -u -r1.7 -r1.8 --- openacs-4/packages/acs-authentication/tcl/sync-procs-oracle.xql 10 Sep 2003 14:26:06 -0000 1.7 +++ openacs-4/packages/acs-authentication/tcl/sync-procs-oracle.xql 16 Sep 2003 13:07:42 -0000 1.8 @@ -45,7 +45,8 @@ set doc_end_time = sysdate, doc_status = :doc_status, doc_message = :doc_message, - document = empty_clob() + document = empty_clob(), + snapshot_p = :snapshot_p where job_id = :job_id returning document into :1 Index: openacs-4/packages/acs-authentication/tcl/sync-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/sync-procs-postgresql.xql,v diff -u -r1.6 -r1.7 --- openacs-4/packages/acs-authentication/tcl/sync-procs-postgresql.xql 10 Sep 2003 14:26:06 -0000 1.6 +++ openacs-4/packages/acs-authentication/tcl/sync-procs-postgresql.xql 16 Sep 2003 13:07:42 -0000 1.7 @@ -46,7 +46,8 @@ set doc_end_time = current_timestamp, doc_status = :doc_status, doc_message = :doc_message, - document = :document + document = :document, + snapshot_p = :snapshot_p where job_id = :job_id Index: openacs-4/packages/acs-authentication/tcl/sync-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/sync-procs.tcl,v diff -u -r1.12 -r1.13 --- openacs-4/packages/acs-authentication/tcl/sync-procs.tcl 12 Sep 2003 13:00:32 -0000 1.12 +++ openacs-4/packages/acs-authentication/tcl/sync-procs.tcl 16 Sep 2003 13:07:42 -0000 1.13 @@ -112,7 +112,6 @@ {-job_id ""} {-authority_id:required} {-interactive:boolean} - {-snapshot:boolean} {-creation_user ""} } { Record the beginning of a job. @@ -121,8 +120,6 @@ @param interactive Set this if this is an interactive job, i.e. it's initiated by a user. - @param snapshot Set this if this is a snapshot job, as opposed to an incremental ('event driven') job. - @return job_id An ID for the new batch job. Used when calling other procs in this API. @author Lars Pind (lars@collaboraid.biz) @@ -137,13 +134,12 @@ } set interactive_p [db_boolean $interactive_p] - set snapshot_p [db_boolean $snapshot_p] db_dml job_insert { insert into auth_batch_jobs - (job_id, interactive_p, snapshot_p, creation_user, authority_id) + (job_id, interactive_p, creation_user, authority_id) values - (:job_id, :interactive_p, :snapshot_p, :creation_user, :authority_id) + (:job_id, :interactive_p, :creation_user, :authority_id) } } @@ -216,11 +212,16 @@ {-doc_status:required} {-doc_message ""} {-document ""} + {-snapshot:boolean} } { Record the that we've finished getting the document, and record the status. @param job_id The ID of the batch job you're ending. + + @param snapshot Set this if this is a snapshot job, as opposed to an incremental ('event driven') job. } { + set snapshot_p [db_boolean $snapshot_p] + db_dml update_doc_end {} -clobs [list $document] } @@ -466,7 +467,7 @@ ad_proc -private auth::sync::GetDocument { {-authority_id:required} } { - Wrapper for the GetDocument operation of the GetDocument service contract. + Wrapper for the GetDocument operation of the auth_sync_retrieve service contract. } { set impl_id [auth::authority::get_element -authority_id $authority_id -element "get_doc_impl_id"] @@ -482,7 +483,7 @@ return [acs_sc::invoke \ -error \ - -contract "GetDocument" \ + -contract "auth_sync_retrieve" \ -impl_id $impl_id \ -operation GetDocument \ -call_args [list $parameters]] @@ -509,6 +510,7 @@ return [acs_sc::invoke \ -error \ + -contract "auth_sync_process" \ -impl_id $impl_id \ -operation ProcessDocument \ -call_args [list $job_id $document $parameters]] @@ -528,9 +530,10 @@ Register this implementation } { set spec { - contract_name "GetDocument" + contract_name "auth_sync_retrieve" owner "acs-authentication" name "HTTPGet" + pretty_name "HTTP GET" aliases { GetDocument auth::sync::get_doc::http::GetDocument GetParameters auth::sync::get_doc::http::GetParameters @@ -544,14 +547,15 @@ ad_proc -private auth::sync::get_doc::http::unregister_impl {} { Unregister this implementation } { - acs_sc::impl::delete -contract_name "GetDocument" -impl_name "HTTPGet" + acs_sc::impl::delete -contract_name "auth_sync_retrieve" -impl_name "HTTPGet" } ad_proc -private auth::sync::get_doc::http::GetParameters {} { Parameters for HTTP GetDocument implementation. } { return { - url {The URL from which to retrieve the document} + IncrementalURL {The URL from which to retrieve document for incremental update. Will retrieve this most of the time.} + SnapshotURL {The URL from which to retrieve document for snapshot update. If specified, will get this once per month.} } } @@ -564,41 +568,35 @@ doc_status failed_to_conntect doc_message {} document {} + snapshot_p f } + + ns_log Notice "LARS: parameters = $parameters" array set param $parameters - set result(document) [util_httpget $param(url)] + if { ![empty_string_p $param(SnapshotURL)] && [string equal [clock format [clock seconds] -format "%d"] "01"] } { + # On the first day of the month, we get a snapshot + set url $param(SnapshotURL) + set result(snapshot_p) "t" + } else { + # All the other days of the month, we get the incremental + set url $param(IncrementalURL) + } + if { [empty_string_p $url] } { + error "No URL to get" + } + + set result(document) [util_httpget $url] + set result(doc_status) "ok" return [array get result] } -##### -# -# auth::sync::entry namespace -# -##### -ad_proc -public auth::sync::entry::get { - {-entry_id:required} - {-array:required} -} { - Get information about a batch entry in an array. - @param entry_id The ID of the batch entry you're ending. - - @param array Name of an array into which you want the information. - - @author Peter Marklund -} { - upvar 1 $array row - - db_1row select_entry {} -column_array row -} - - ##### # # auth::sync::process_doc::ims namespace @@ -611,10 +609,11 @@ set spec { contract_name "auth_sync_process" owner "acs-authentication" - name "IMS Enterprise 1.1" + name "IMS_Enterprise_v_1p1" + pretty_name "IMS Enterprise 1.1" aliases { ProcessDocument auth::sync::process_doc::ims::ProcessDocument - GetParameters auth::sync::proecss_doc::ims::GetParameters + GetParameters auth::sync::process_doc::ims::GetParameters } } 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.25 -r1.26 --- openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 12 Sep 2003 13:00:32 -0000 1.25 +++ openacs-4/packages/acs-authentication/tcl/test/acs-authentication-procs.tcl 16 Sep 2003 13:07:43 -0000 1.26 @@ -87,7 +87,7 @@ -username "" \ -password $password] - aa_equals "auth_status for blank username authentication" $auth_info(auth_status) "no_account" + aa_equals "auth_status for blank username authentication" $auth_info(auth_status) "auth_error" aa_true "auth_message for blank username authentication" ![empty_string_p $auth_info(auth_message)] # Authority bogus @@ -483,7 +483,6 @@ register_url "" get_doc_impl_id "" process_doc_impl_id "" - snapshot_p "f" batch_sync_enabled_p "f" } set columns(short_name) [ad_generate_random_string] @@ -612,7 +611,135 @@ } } +aa_register_case auth_use_email_for_login_p { + Test auth::UseEmailForLoginP +} { + aa_stub auth::get_register_authority { + return [auth::authority::local] + } + aa_run_with_teardown \ + -rollback \ + -test_code { + # Test various values to see that it doesn't break + + parameter::set_value -parameter UseEmailForLoginP -package_id [ad_acs_kernel_id] -value 0 + aa_false "Param UseEmailForLoginP 0 -> false" [auth::UseEmailForLoginP] + + parameter::set_value -parameter UseEmailForLoginP -package_id [ad_acs_kernel_id] -value {} + aa_false "Param UseEmailForLoginP {} -> false" [auth::UseEmailForLoginP] + + array set elms [auth::get_registration_elements] + aa_false "Registration elements do contain username" [expr [lsearch [concat $elms(required) $elms(optional)] "username"] == -1] + + parameter::set_value -parameter UseEmailForLoginP -package_id [ad_acs_kernel_id] -value {foo} + aa_true "Param UseEmailForLoginP foo -> true" [auth::UseEmailForLoginP] + + # Test login/registration + + parameter::set_value -parameter UseEmailForLoginP -package_id [ad_acs_kernel_id] -value 1 + aa_true "Param UseEmailForLoginP 1 -> true" [auth::UseEmailForLoginP] + + # GetElements + array set elms [auth::get_registration_elements] + aa_true "Registration elements do NOT contain username" [expr [lsearch [concat $elms(required) $elms(optional)] "username"] == -1] + + # Create a user with no username + set email [string tolower "[ad_generate_random_string]@foobar.com"] + set password [ad_generate_random_string] + + array set result [auth::create_user \ + -email $email \ + -password $password \ + -first_names [ad_generate_random_string] \ + -last_name [ad_generate_random_string] \ + -secret_question [ad_generate_random_string] \ + -secret_answer [ad_generate_random_string] \ + -screen_name [ad_generate_random_string]] + + aa_equals "Registration OK" $result(creation_status) "ok" + + # Authenticate as that user + array unset result + array set result [auth::authenticate \ + -email $email \ + -password $password \ + -no_cookie] + + aa_equals "Authentication OK" $result(auth_status) "ok" + + } +} + +aa_register_case auth_email_on_password_change { + Test acs-kernel.EmailAccountOwnerOnPasswordChangeP parameter +} { + aa_stub ns_sendmail { + global ns_sendmail_to + set ns_sendmail_to $to + } + + aa_run_with_teardown \ + -rollback \ + -test_code { + parameter::set_value -parameter EmailAccountOwnerOnPasswordChangeP -package_id [ad_acs_kernel_id] -value 1 + + global ns_sendmail_to + set ns_sendmail_to {} + + # Create a dummy local user + set username [ad_generate_random_string] + set email [string tolower "[ad_generate_random_string]@foobar.com"] + set password [ad_generate_random_string] + + array set result [auth::create_user \ + -username $username \ + -email $email \ + -password $password \ + -first_names [ad_generate_random_string] \ + -last_name [ad_generate_random_string] \ + -secret_question [ad_generate_random_string] \ + -secret_answer [ad_generate_random_string] \ + -screen_name [ad_generate_random_string]] + + aa_equals "Create user OK" $result(creation_status) "ok" + + set user_id $result(user_id) + + aa_log "auth_id = [db_string sel { select authority_id from users where user_id = :user_id }]" + + + # Change password + array unset result + set new_password [ad_generate_random_string] + array set result [auth::password::change \ + -user_id $user_id \ + -old_password $password \ + -new_password $new_password] + aa_equals "Password change OK" $result(password_status) "ok" + + # Check that we get email + aa_equals "Email sent to user" $ns_sendmail_to $email + set ns_sendmail_to {} + + # Set parameter to false + parameter::set_value -parameter EmailAccountOwnerOnPasswordChangeP -package_id [ad_acs_kernel_id] -value 0 + + # Change password + array unset result + set new_new_password [ad_generate_random_string] + array set result [auth::password::change \ + -user_id $user_id \ + -old_password $new_password \ + -new_password $new_new_password] + aa_equals "Password change OK" $result(password_status) "ok" + + # Check that we do not get an email + aa_equals "Email NOT sent to user" $ns_sendmail_to {} + } +} + + ##### # # Helper procs Index: openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl,v diff -u -r1.9 -r1.10 --- openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl 12 Sep 2003 13:00:32 -0000 1.9 +++ openacs-4/packages/acs-authentication/tcl/test/sync-test-procs.tcl 16 Sep 2003 13:07:43 -0000 1.10 @@ -506,11 +506,12 @@ aa_stub acs_sc::invoke { acs_sc::invoke__arg_parser - if { [string equal $contract GetDocument] && [string equal $operation GetDocument] } { + if { [string equal $contract "auth_sync_retrieve"] && [string equal $operation "GetDocument"] } { array set result { doc_status ok doc_message {} document {} + snapshot_p f } # Example document grabbed pulled from @@ -629,11 +630,10 @@ register_impl_id {} register_url {} help_contact_text {} - snapshot_p f batch_sync_enabled_p f } set new_auth(get_doc_impl_id) 1 - set new_auth(process_doc_impl_id) [acs_sc::impl::get_id -owner "acs-authentication" -name "IMS Enterprise 1.1"] + set new_auth(process_doc_impl_id) [acs_sc::impl::get_id -owner "acs-authentication" -name "IMS_Enterprise_v_1p1"] set new_auth(get_doc_impl_id) [acs_sc::impl::get_id -owner "acs-authentication" -name "HTTPGet"] @@ -690,7 +690,7 @@ aa_stub acs_sc::invoke { acs_sc::invoke__arg_parser - if { [string equal $contract GetDocument] && [string equal $operation GetDocument] } { + if { [string equal $contract "auth_sync_retrieve"] && [string equal $operation "GetDocument"] } { array set result { doc_status ok doc_message {} @@ -742,11 +742,10 @@ register_impl_id {} register_url {} help_contact_text {} - snapshot_p f batch_sync_enabled_p f } set new_auth(get_doc_impl_id) 1 - set new_auth(process_doc_impl_id) [acs_sc::impl::get_id -owner "acs-authentication" -name "IMS Enterprise 1.1"] + set new_auth(process_doc_impl_id) [acs_sc::impl::get_id -owner "acs-authentication" -name "IMS_Enterprise_v_1p1"] set new_auth(get_doc_impl_id) [acs_sc::impl::get_id -owner "acs-authentication" -name "HTTPGet"] @@ -929,10 +928,10 @@ } { array set result [acs_sc::invoke \ -error \ - -contract "GetDocument" \ + -contract "auth_sync_retrieve" \ -impl "HTTPGet" \ -operation "GetDocument" \ - -call_args [list [list url "[ad_url]/SYSTEM/dbtest.tcl"]]] + -call_args [list [list snapshot_url {} incremental_url "[ad_url]/SYSTEM/dbtest.tcl"]]] aa_equals "result.doc_status is ok" $result(doc_status) "ok"