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.89.2.8 -r1.89.2.9
--- openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 7 Mar 2017 19:53:19 -0000 1.89.2.8
+++ openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 7 Mar 2017 19:56:34 -0000 1.89.2.9
@@ -22,14 +22,14 @@
{-level ok}
{-account_status ok}
} {
- If the current session is not authenticated, redirect to the
+ If the current session is not authenticated, redirect to the
login page, and aborts the current page script.
Otherwise, returns the user_id of the user logged in.
- Use this in a page script to ensure that only registered and authenticated
+ 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 a returnredirect and abort the current page.
+ @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,8 +38,8 @@
-account_status $account_status]
if { $user_id != 0 } {
- # user is in fact logged in, return user_id
- return $user_id
+ # user is in fact logged in, return user_id
+ return $user_id
}
set message {}
@@ -50,24 +50,24 @@
set return_url [ad_get_login_url -return]
# Long URLs (slightly above 4000 bytes) can kill aolserver-4.0.10, causing
- # a restart. They lead to empty Bowser-windows with aolserver 4.5 (but no
- # crash so far). May browsers have length limitations for URLs. E.g.
+ # a restart. They lead to empty Bowser-windows with aolserver 4.5 (but no
+ # crash so far). May browsers have length limitations for URLs. E.g.
# 2083 is the documented maximal length of MSIE.
#
- # Long URLs will be generated e.g. when
+ # Long URLs will be generated e.g. when
# a) a user edits a form with text entries
# b) before submitting the form logs out of OpenACS from a different browser window
- # c) submits the form.
- # When submitting needs authentication, OpenACS generates the redirect to
+ # c) submits the form.
+ # When submitting needs authentication, OpenACS generates the redirect to
# /register with the form-data coded into the URL to continue there.....
# set user_agent [string tolower [ns_set get [ns_conn headers] User-Agent]]
# ns_log notice "URL have url, len=[string length $return_url] $user_agent"
if {[string length $return_url] > 2083} {
- set message "Your login expired and the computed URL for automated continuation is too long. "
- append message "If you were editing a from, please use the back button after logging in and resubmit the form."
- set return_url [ad_get_login_url]
+ set message "Your login expired and the computed URL for automated continuation is too long. "
+ append message "If you were editing a from, please use the back button after logging in and resubmit the form."
+ set return_url [ad_get_login_url]
}
# The -return switch causes the URL to return to the current page
@@ -82,7 +82,7 @@
but if the user is logged in, then we require that the authentication is not expired.
@return user_id of user, if the user is logged in and auth_status is not expired, or 0 if the user is not logged in.
- If user's auth_status is expired, this proc will issue a returnredirect and abort the current page.
+ If user's auth_status is expired, this proc will issue a returnredirect and abort the current page.
@see ad_script_abort
} {
@@ -96,23 +96,23 @@
}
ad_proc -public auth::self_registration {} {
- Check AllowSelfRegister parameter and set user message if
+ Check AllowSelfRegister parameter and set user message if
self registration not allowed.
-} {
+} {
if { [string is false [parameter::get_from_package_key \
- -package_key acs-authentication \
- -parameter AllowSelfRegister]] } {
- util_user_message -message "Self registration is not allowed"
- auth::require_login
+ -package_key acs-authentication \
+ -parameter AllowSelfRegister]] } {
+ util_user_message -message "Self registration is not allowed"
+ auth::require_login
}
}
ad_proc -public auth::get_user_id {
{-level ok}
{-account_status ok}
} {
- Get the current user_id with at least the level of security specified.
- If no user is logged in, or the user is not logged in at a sufficiently
+ Get the current user_id with at least the level of security specified.
+ If no user is logged in, or the user is not logged in at a sufficiently
high security level, return 0.
@return user_id of user, if the user is logged in, 0 otherwise.
@@ -130,14 +130,14 @@
if { $account_status eq "ok" && [ad_conn account_status] ne "ok" } {
return 0
}
-
+
array set levelv {
none 0
expired 1
ok 2
secure 3
}
-
+
# If HTTPS isn't available, we can't require secure authentication
if { ![security::https_available_p] } {
set levelv(secure) 2
@@ -152,7 +152,7 @@
}
ad_proc -public auth::UseEmailForLoginP {} {
- Do we use email address for login? code wrapped in a catch, so the
+ 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.
} {
return [parameter::get -boolean -parameter UseEmailForLoginP -package_id [ad_acs_kernel_id] -default 1]
@@ -169,35 +169,35 @@
{-first_names ""}
{-last_name ""}
} {
- Try to authenticate and login the user forever by validating the username/password combination,
- and return authentication and account status codes.
-
+ Try to authenticate and login the user forever by validating the username/password combination,
+ and return authentication and account status codes.
+
@param return_url If specified, this can be included in account status messages.
@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 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:
-
+
- - 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.
+
- 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_url: A URL to redirect the user to. Could e.g. ask the user to update his password.
-
- account_message: Human-readable message about account status. Guaranteed to be set if auth_status is not ok
- and account_url is empty.
- 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.
+
- account_status: Account status from authentication server.
+ ok, closed.
+
- account_url: A URL to redirect the user to. Could e.g. ask the user to update his password.
+
- account_message: Human-readable message about account status. Guaranteed to be set if auth_status is not ok
+ and account_url is empty.
+ 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.
+
- user_id: Set to local user_id if auth_status is ok.
} {
@@ -226,12 +226,12 @@
set authority_id [auth::authority::local]
}
}
-
+
with_catch errmsg {
array set result [auth::authentication::Authenticate \
- -username $username \
- -authority_id $authority_id \
- -password $password]
+ -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
@@ -245,14 +245,14 @@
}
# Returns:
- # result(auth_status)
- # result(auth_message)
- # result(account_status)
- # result(account_message)
+ # result(auth_status)
+ # result(auth_message)
+ # result(account_status)
+ # result(account_message)
# Verify result/auth_message return codes
switch $result(auth_status) {
- ok {
+ ok {
# Continue below
}
no_account -
@@ -281,7 +281,7 @@
# Verify remote account_info/account_message return codes
switch $result(account_status) {
- ok {
+ ok {
# Continue below
if { ![info exists result(account_message)] } {
set result(account_message) {}
@@ -308,24 +308,24 @@
array unset result account_status
array unset result account_message
set result(account_url) {}
-
+
# Map to row in local users table
array set result [auth::get_local_account \
-return_url $return_url \
-username $username \
-authority_id $authority_id \
- -email $email \
+ -email $email \
-first_names $first_names \
- -last_name $last_name]
- # Returns:
+ -last_name $last_name]
+ # Returns:
# result(account_status)
- # result(account_message)
- # result(account_url)
+ # result(account_message)
+ # result(account_url)
# result(user_id)
# Verify local account_info/account_message return codes
switch $result(account_status) {
- ok {
+ ok {
# Continue below
if { ![info exists result(account_message)] } {
set result(account_message) {}
@@ -343,7 +343,7 @@
set result(account_message) [_ acs-subsite.Auth_internal_error]
}
}
-
+
# If the remote account was closed, the whole account is closed, regardless of local account status
if {$remote_account_status eq "closed"} {
set result(account_status) closed
@@ -357,15 +357,15 @@
set result(account_message) $remote_account_message
}
}
-
+
# Issue login cookie if login was successful
if { $result(auth_status) eq "ok" && !$no_cookie_p && [info exists result(user_id)] && $result(user_id) ne "" } {
auth::issue_login \
-user_id $result(user_id) \
-persistent=$persistent_p \
-account_status $result(account_status)
}
-
+
return [array get result]
}
@@ -396,7 +396,7 @@
# Check that the authority has a register implementation
auth::authority::get -authority_id $authority_id -array authority
-
+
if { $authority(register_impl_id) eq "" } {
ns_log Error "auth::get_register_authority: parameter value for RegisterAuthority is an authority without registration driver, defaulting to local authority"
set authority_id [auth::authority::local]
@@ -406,15 +406,15 @@
ns_log Error "auth::get_register_authority: parameter RegisterAuthority has the invalid value $parameter_value. Defaulting to local authority"
set authority_id [auth::authority::local]
}
-
+
return $authority_id
}
ad_proc -public auth::create_user {
{-verify_password_confirm:boolean}
{-user_id ""}
{-username ""}
- {-email:required}
+ {-email:required}
{-first_names ""}
{-last_name ""}
{-screen_name ""}
@@ -423,34 +423,34 @@
{-url ""}
{-secret_question ""}
{-secret_answer ""}
- {-email_verified_p ""}
+ {-email_verified_p ""}
{-nologin:boolean}
} {
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 verify_password_confirm
- Set this flag if you want the proc to verify that password and password_confirm match for you.
-
+ Set this flag if you want the proc to verify that password and password_confirm match for you.
+
@return Array list containing the following entries:
- - creation_status: ok, data_error, reg_error, failed_to_connect. Says whether user creation succeeded.
-
- creation_message: Information about the problem, to be relayed to the user. If creation_status is not ok, then either
- creation_message or element_messages is guaranteed to be non-empty, and both are
- guaranteed to be in the array list. May contain HTML.
-
- element_messages: list of (element_name, message, element_name, message, ...) of
- errors on the individual registration elements.
- 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, and both are
- guaranteed to be in the array list. Cannot contain HTML.
-
- 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.
-
- 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.
-
- user_id: The user_id of the created user. Only when creation_status is ok.
+
- creation_status: ok, data_error, reg_error, failed_to_connect. Says whether user creation succeeded.
+
- creation_message: Information about the problem, to be relayed to the user. If creation_status is not ok, then either
+ creation_message or element_messages is guaranteed to be non-empty, and both are
+ guaranteed to be in the array list. May contain HTML.
+
- element_messages: list of (element_name, message, element_name, message, ...) of
+ errors on the individual registration elements.
+ 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, and both are
+ guaranteed to be in the array list. Cannot contain HTML.
+
- 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.
+
- 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.
+
- user_id: The user_id of the created user. Only when creation_status is ok.
@see auth::get_all_registration_elements
@@ -485,7 +485,7 @@
}
}
- # email_verified_p
+ # email_verified_p
set user_info(email_verified_p) $email_verified_p
db_transaction {
@@ -495,12 +495,12 @@
-username $username \
-array user_info]
- # Returns:
+ # Returns:
# creation_info(creation_status)
- # creation_info(creation_message)
- # creation_info(element_messages)
+ # creation_info(creation_message)
+ # creation_info(element_messages)
# creation_info(account_status)
- # creation_info(account_message)
+ # creation_info(account_message)
# creation_info(user_id)
# We don't do any fancy error checking here, because create_local_account is not a service contract
@@ -518,10 +518,10 @@
# Clear out remote creation_info array for reuse
array set creation_info {
creation_status {}
- creation_message {}
- element_messages {}
+ creation_message {}
+ element_messages {}
account_status {}
- account_message {}
+ account_message {}
}
@@ -542,13 +542,13 @@
-url $url \
-secret_question $secret_question \
-secret_answer $secret_answer]
-
+
# Returns:
- # creation_info(creation_status)
- # creation_info(creation_message)
- # creation_info(element_messages)
- # creation_info(account_status)
- # creation_info(account_message)
+ # creation_info(creation_status)
+ # creation_info(creation_message)
+ # creation_info(element_messages)
+ # creation_info(account_status)
+ # creation_info(account_message)
# Verify creation_info/creation_message return codes
array set default_creation_message {
@@ -558,7 +558,7 @@
}
switch $creation_info(creation_status) {
- ok {
+ ok {
# Continue below
}
data_error -
@@ -581,7 +581,7 @@
# Verify remote account_info/account_message return codes
switch $creation_info(account_status) {
- ok {
+ ok {
# Continue below
set creation_info(account_message) {}
}
@@ -601,18 +601,18 @@
set creation_info(creation_status) failed_to_connect
set creation_info(creation_message) $errmsg
ns_log Error "auth::create_user: Error invoking account registration driver for authority_id = $authority_id: $::errorInfo"
- }
+ }
- if { $creation_info(creation_status) ne "ok" } {
+ if { $creation_info(creation_status) ne "ok" } {
return [array get creation_info]
}
#####
- #
+ #
# Clean up, concat account messages, issue login cookie
#
#####
-
+
# If the local account was closed, the whole account is closed, regardless of remote account status
if {$local_account_status eq "closed"} {
set creation_info(account_status) closed
@@ -626,32 +626,32 @@
set creation_info(account_message) $local_account_message
}
}
-
+
# Unless nologin was specified, issue login cookie if login was successful
if { !$nologin_p && $creation_info(creation_status) eq "ok" && $creation_info(account_status) eq "ok" && [ad_conn user_id] == 0 } {
auth::issue_login -user_id $creation_info(user_id)
}
-
+
return [array get creation_info]
}
ad_proc -public auth::get_registration_elements {
} {
Get the list of required/optional elements for user registration.
-
+
@return Array-list with two entries
-
+
- - required: a list of required elements
-
- optional: a list of optional elements
+
- required: a list of required elements
+
- optional: a list of optional elements
-
+
@see auth::get_all_registration_elements
} {
set authority_id [auth::get_register_authority]
array set element_info [auth::registration::GetElements -authority_id $authority_id]
-
+
if { ![info exists element_info(required)] } {
set element_info(required) {}
}
@@ -661,7 +661,7 @@
set local_required_elms { first_names last_name email }
set local_optional_elms {}
-
+
switch [acs_user::ScreenName] {
require {
lappend local_required_elms "screen_name"
@@ -677,7 +677,7 @@
if { [lsearch $element_info(required) $elm] == -1 } {
lappend element_info(required) $elm
}
-
+
# Remove from optional
set index [lsearch $element_info(optional) $elm]
if { $index != -1 } {
@@ -710,7 +710,7 @@
ad_proc -public auth::get_registration_form_elements {
} {
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
+ 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.
} {
array set data_types {
@@ -727,7 +727,7 @@
}
array set widgets {
- username text
+ username text
email text
first_names text
last_name text
@@ -750,7 +750,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}
@@ -772,7 +772,7 @@
if {"password" in $element_info(optional)} {
lappend element_info(optional) password_confirm
}
-
+
# required_p will have 1 if required, 0 if optional, and unset if not in the form
array set required_p [list]
foreach element $element_info(required) {
@@ -824,20 +824,20 @@
@return Array list containing the following entries:
- - creation_status: ok, data_error, reg_error, failed_to_connect. Says whether user creation succeeded.
-
- creation_message: Information about the problem, to be relayed to the user. If creation_status is not ok, then either
- creation_message or element_messages is guaranteed to be non-empty, and both are
- guaranteed to be in the array list. May contain HTML.
-
- element_messages: list of (element_name, message, element_name, message, ...) of
- errors on the individual registration elements.
- 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, and both are
- guaranteed to be in the array list. Cannot contain HTML.
-
- 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.
-
- 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.
+
- creation_status: ok, data_error, reg_error, failed_to_connect. Says whether user creation succeeded.
+
- creation_message: Information about the problem, to be relayed to the user. If creation_status is not ok, then either
+ creation_message or element_messages is guaranteed to be non-empty, and both are
+ guaranteed to be in the array list. May contain HTML.
+
- element_messages: list of (element_name, message, element_name, message, ...) of
+ errors on the individual registration elements.
+ 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, and both are
+ guaranteed to be in the array list. Cannot contain HTML.
+
- 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.
+
- 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.
All entries are guaranteed to always be set, but may be empty.
@@ -859,7 +859,7 @@
set user_info($elm) {}
}
}
-
+
# Validate data
auth::validate_account_info \
-authority_id $authority_id \
@@ -893,7 +893,7 @@
set user_info(email_verified_p) "t"
}
}
-
+
# Default a local account username
if { $user_info(authority_id) == [auth::authority::local] \
&& [auth::UseEmailForLoginP] \
@@ -911,8 +911,8 @@
# If so, add -2 or -3 or ... to make it unique
if { $existing_user_id ne "" } {
set match "${username}-%"
- set existing_usernames [db_list select_existing_usernames {
- select username
+ set existing_usernames [db_list select_existing_usernames {
+ select username
from users
where authority_id = :authority_id
and username like :match
@@ -957,7 +957,7 @@
}
} {
set error_p 1
- }
+ }
if { $error_p || $user_id == 0 } {
set result(creation_status) "failed_to_connect"
@@ -972,7 +972,7 @@
set username [acs_user::get_element -user_id $user_id -element username]
}
set result(username) $username
-
+
# Creation succeeded
set result(creation_status) "ok"
@@ -996,20 +996,20 @@
email
first_names
last_name
- password
+ password
password_question
password_answer
- {url ""}
- {email_verified_p "t"}
- {member_state "approved"}
- {user_id ""}
- {username ""}
+ {url ""}
+ {email_verified_p "t"}
+ {member_state "approved"}
+ {user_id ""}
+ {username ""}
{authority_id ""}
{screen_name ""}
} {
Creates a new user in the system. The user_id can be specified as an argument to enable double click protection.
If this procedure succeeds, returns the new user_id. Otherwise, returns 0.
-
+
@see auth::create_user
@see auth::create_local_account
} {
@@ -1031,13 +1031,13 @@
set creation_user ""
set peeraddr ""
-
+
# This may fail, either because there's no connection, or because
# we're in the bootstrap-installer, at which point [ad_conn user_id] is undefined.
catch {
set creation_user [ad_conn user_id]
set peeraddr [ad_conn peeraddr]
- }
+ }
set salt [sec_random_token]
set hashed_password [ns_sha1 "$password$salt"]
@@ -1048,7 +1048,7 @@
set user_id [db_exec_plsql user_insert {}]
# set password_question, password_answer
- db_dml update_question_answer {}
+ db_dml update_question_answer {}
if {[catch {
# Call the extension
@@ -1063,10 +1063,10 @@
ns_log Error "Problem creating a new user: $::errorInfo"
set error_p 1
}
-
+
if { $error_p } {
return 0
- }
+ }
# success.
return $user_id
}
@@ -1085,15 +1085,15 @@
@return Array list containing the following entries:
- - update_status: ok, data_error, update_error, failed_to_connect. Says whether user update succeeded.
-
- update_message: Information about the problem, to be relayed to the user. If update_status is not ok, then either
- update_message or element_messages is guaranteed to be non-empty, and both are
- guaranteed to be in the array list. May contain HTML.
-
- element_messages: list of (element_name, message, element_name, message, ...) of
- errors on the individual registration elements.
- to be relayed on to the user. If update_status is not ok, then either
- udpate_message or element_messages is guaranteed to be non-empty, and both are
- guaranteed to be in the array list. Cannot contain HTML.
+
- update_status: ok, data_error, update_error, failed_to_connect. Says whether user update succeeded.
+
- update_message: Information about the problem, to be relayed to the user. If update_status is not ok, then either
+ update_message or element_messages is guaranteed to be non-empty, and both are
+ guaranteed to be in the array list. May contain HTML.
+
- element_messages: list of (element_name, message, element_name, message, ...) of
+ errors on the individual registration elements.
+ to be relayed on to the user. If update_status is not ok, then either
+ udpate_message or element_messages is guaranteed to be non-empty, and both are
+ guaranteed to be in the array list. Cannot contain HTML.
All entries are guaranteed to always be set, but may be empty.
@@ -1147,7 +1147,7 @@
-person_id $user_id \
-bio $user_info(bio)
}
-
+
# Update parties: email, url
if { [info exists user_info(email)] } {
party::update \
@@ -1159,14 +1159,14 @@
-party_id $user_id \
-url $user_info(url)
}
-
+
# Update users: email_verified_p
if { [info exists user_info(email_verified_p)] } {
acs_user::update \
-user_id $user_id \
- -email_verified_p $user_info(email_verified_p)
+ -email_verified_p $user_info(email_verified_p)
}
-
+
# Update users: screen_name
if { [info exists user_info(screen_name)] } {
acs_user::update \
@@ -1190,7 +1190,7 @@
}
} {
set error_p 1
- }
+ }
if { $error_p } {
set result(update_status) "failed_to_connect"
@@ -1215,9 +1215,9 @@
@return Array list containing the following entries:
- - delete_status: ok, delete_error, failed_to_connect. Says whether user deletion succeeded.
-
- delete_message: Information about the problem, to be relayed to the user. If delete_status is not ok, then
- delete_message is guaranteed to be non-empty. May contain HTML.
+
- delete_status: ok, delete_error, failed_to_connect. Says whether user deletion succeeded.
+
- delete_message: Information about the problem, to be relayed to the user. If delete_status is not ok, then
+ delete_message is guaranteed to be non-empty. May contain HTML.
All entries are guaranteed to always be set, but may be empty.
@@ -1231,13 +1231,13 @@
set user_id [acs_user::get_by_username \
-authority_id $authority_id \
-username $username]
-
+
if { $user_id eq "" } {
set result(delete_status) "delete_error"
set result(delete_message) [_ acs-subsite.No_user_with_this_username]
return [array get result]
}
-
+
# Mark the account banned
acs_user::ban -user_id $user_id
@@ -1259,7 +1259,7 @@
}
ad_proc -private auth::verify_account_status {} {
- Verify the account status of the current user,
+ Verify the account status of the current user,
and set [ad_conn account_status] appropriately.
} {
# Just recheck the authentication cookie, and it'll do the verification for us
@@ -1283,18 +1283,18 @@
{-first_names ""}
{-last_name ""}
} {
- Get the user_id of the local account for the given
+ Get the user_id of the local account for the given
username and domain combination.
@param username The username to find
@param authority_id The ID of the authority to ask to verify the user. Leave blank for local authority.
} {
array set auth_info [list]
-
+
# Will return:
# auth_info(account_status)
- # auth_info(account_message)
+ # auth_info(account_message)
# auth_info(user_id)
if { $authority_id eq "" } {
@@ -1317,64 +1317,64 @@
if {$info_result(info_status) eq "ok"} {
array set user $info_result(user_info)
-
- if {$email ne ""
- && (![info exists user(email)] || $user(email) eq "")
- } {
- set user(email) $email
- }
- if {$first_names ne ""
- && (![info exists user(first_names)] || $user(first_names) eq "")
- } {
- set user(first_names) $first_names
- }
- if {$last_name ne ""
- && (![info exists user(last_name)] || $user(last_name) eq "")
- } {
- set user(last_name) $last_name
- }
+
+ if {$email ne ""
+ && (![info exists user(email)] || $user(email) eq "")
+ } {
+ set user(email) $email
+ }
+ if {$first_names ne ""
+ && (![info exists user(first_names)] || $user(first_names) eq "")
+ } {
+ set user(first_names) $first_names
+ }
+ if {$last_name ne ""
+ && (![info exists user(last_name)] || $user(last_name) eq "")
+ } {
+ set user(last_name) $last_name
+ }
array set creation_info [auth::create_local_account \
- -authority_id $authority_id \
- -username $username \
- -array user]
+ -authority_id $authority_id \
+ -username $username \
+ -array user]
- if {$creation_info(creation_status) eq "ok"} {
- acs_user::get -authority_id $authority_id -username $username -array user
- } else {
- set auth_info(account_status) "closed"
- # Used to get help contact info
- auth::authority::get -authority_id $authority_id -array authority
- set system_name [ad_system_name]
- set auth_info(account_message) "You have successfully authenticated, but we were unable to create an account for you on $system_name. "
- set auth_info(element_messages) $creation_info(element_messages)
- append auth_info(account_message) "The error was: $creation_info(element_messages). Please contact the system administrator."
-
- if { $authority(help_contact_text) ne "" } {
- append auth_info(account_message) "Help Information
"
- append auth_info(account_message) [ad_html_text_convert \
- -from $authority(help_contact_text_format) \
- -to "text/html" -- $authority(help_contact_text)]
- }
- return [array get auth_info]
- }
+ if {$creation_info(creation_status) eq "ok"} {
+ acs_user::get -authority_id $authority_id -username $username -array user
+ } else {
+ set auth_info(account_status) "closed"
+ # Used to get help contact info
+ auth::authority::get -authority_id $authority_id -array authority
+ set system_name [ad_system_name]
+ set auth_info(account_message) "You have successfully authenticated, but we were unable to create an account for you on $system_name. "
+ set auth_info(element_messages) $creation_info(element_messages)
+ append auth_info(account_message) "The error was: $creation_info(element_messages). Please contact the system administrator."
+ if { $authority(help_contact_text) ne "" } {
+ append auth_info(account_message) "Help Information
"
+ append auth_info(account_message) [ad_html_text_convert \
+ -from $authority(help_contact_text_format) \
+ -to "text/html" -- $authority(help_contact_text)]
+ }
+ return [array get auth_info]
+ }
+
} else {
-
+
# Local user account doesn't exist
set auth_info(account_status) "closed"
-
+
# Used to get help contact info
auth::authority::get -authority_id $authority_id -array authority
set system_name [ad_system_name]
set auth_info(account_message) [_ acs-subsite.Success_but_no_account_yet]
-
+
if { $authority(help_contact_text) ne "" } {
append auth_info(account_message) [_ acs-subsite.Help_information]
append auth_info(account_message) [ad_html_text_convert \
-from $authority(help_contact_text_format) \
-to "text/html" -- $authority(help_contact_text)]
}
-
+
return [array get auth_info]
}
}
@@ -1391,7 +1391,7 @@
# Return user_id
set auth_info(user_id) $user(user_id)
- return [array get auth_info]
+ return [array get auth_info]
}
ad_proc -private auth::check_local_account_status {
@@ -1417,7 +1417,7 @@
set system_name [ad_system_name]
acs_user::get -user_id $user_id -array user
set authority_id $user(authority_id)
- set email $user(email)
+ set email $user(email)
switch $member_state {
approved {
@@ -1429,15 +1429,15 @@
if { $email_verified_p == "f" } {
if { !$no_dialogue_p } {
set result(account_message) "[_ acs-subsite.lt_Registration_informat]
[_ acs-subsite.lt_Please_read_and_follo]
"
-
+
with_catch errmsg {
auth::send_email_verification_email -user_id $user_id
} {
ns_log Error "auth::check_local_account_status: Error sending out email verification email to email $email:\n$::errorInfo"
set result(account_message) [_ acs-subsite.Error_sending_verification_mail]
}
}
-
+
} elseif { [acs_user::ScreenName] eq "require"
&& $screen_name eq ""
} {
@@ -1446,7 +1446,7 @@
-base "[subsite::get_element -element url]user/basic-info-update" {
message return_url {edit_p 1}
}]
-
+
} elseif { $PasswordExpirationDays > 0
&& ($password_age_days eq "" || $password_age_days > $PasswordExpirationDays)
} {
@@ -1456,10 +1456,10 @@
set result(account_status) "ok"
}
}
- banned {
+ banned {
set result(account_message) [_ acs-subsite.lt_Sorry_but_it_seems_th]
}
- deleted {
+ deleted {
set restore_url [export_vars -base "restore-user" { return_url }]
set result(account_message) [_ acs-subsite.Account_closed]
}
@@ -1472,7 +1472,7 @@
ns_log Error "auth::check_local_account_status: problem with registration state machine: user_id $user_id has member_state '$member_state'"
}
}
-
+
return [array get result]
}
@@ -1485,12 +1485,12 @@
catch {
acs_user::get -user_id $user_id -array user
array set check_result [auth::check_local_account_status \
- -user_id $user_id \
- -member_state $user(member_state) \
- -email_verified_p $user(email_verified_p) \
- -screen_name $user(screen_name) \
- -password_age_days $user(password_age_days)]
-
+ -user_id $user_id \
+ -member_state $user(member_state) \
+ -email_verified_p $user(email_verified_p) \
+ -screen_name $user(screen_name) \
+ -password_age_days $user(password_age_days)]
+
set result $check_result(account_status)
}
return $result
@@ -1499,7 +1499,7 @@
ad_proc -private auth::get_user_secret_token {
-user_id:required
} {
- Get a secret token for the user. Can be used for email verification purposes.
+ Get a secret token for the user. Can be used for email verification purposes.
} {
return [ns_sha1 "${user_id}[sec_get_token 1]"]
}
@@ -1514,7 +1514,7 @@
set token [auth::get_user_secret_token -user_id $user_id]
acs_user::get -user_id $user_id -array user
set confirmation_url [export_vars -base "[ad_url]/register/email-confirm" { token user_id }]
- set system_name [ad_system_name]
+ set system_name [ad_system_name]
acs_mail_lite::send -send_immediately \
-to_addr $user(email) \
@@ -1529,9 +1529,9 @@
{-username:required}
{-user_array:required}
{-message_array:required}
-} {
+} {
Validates user info and returns errors, if any.
-
+
@param update Set this flag if you're updating an existing record, meaning we shouldn't check for duplicates.
@param user_array Name of an array in the caller's namespace which contains the registration elements.
@@ -1545,26 +1545,26 @@
if { !$update_p } {
set required_elms [concat $required_elms { first_names last_name email }]
}
-
+
foreach elm $required_elms {
if { ![info exists user($elm)] || $user($elm) eq "" } {
set element_messages($elm) "Required"
}
}
if { [info exists user(email)] } {
- set user(email) [string trim $user(email)]
+ set user(email) [string trim $user(email)]
}
-
+
if { [info exists user(username)] } {
- set user(username) [string trim $user(username)]
+ set user(username) [string trim $user(username)]
}
-
+
if { $update_p } {
set user(user_id) [acs_user::get_by_username \
-authority_id $authority_id \
-username $username]
-
+
if { $user(user_id) eq "" } {
set this_authority [auth::authority::get_element -authority_id $authority_id -element pretty_name]
set element_messages(username) [_ acs-subsite.Username_not_found_for_authority]
@@ -1575,19 +1575,19 @@
}
# TODO: When doing RBM's parameter, make sure that we still require both first_names and last_names, or none of them
- if { ([info exists user(first_names)] && $user(first_names) ne "")
- && [string first "<" $user(first_names)] != -1
+ if { ([info exists user(first_names)] && $user(first_names) ne "")
+ && [string first "<" $user(first_names)] != -1
} {
set element_messages(first_names) [_ acs-subsite.lt_You_cant_have_a_lt_in]
}
- if { ([info exists user(last_name)] && $user(last_name) ne "")
- && [string first "<" $user(last_name)] != -1
+ if { ([info exists user(last_name)] && $user(last_name) ne "")
+ && [string first "<" $user(last_name)] != -1
} {
set element_messages(last_name) [_ acs-subsite.lt_You_cant_have_a_lt_in_1]
}
- if { [info exists user(email)] && $user(email) ne "" } {
+ if { [info exists user(email)] && $user(email) ne "" } {
if { ![util_email_valid_p $user(email)] } {
set element_messages(email) [_ acs-subsite.Not_valid_email_addr]
} else {
@@ -1613,23 +1613,23 @@
# We could do the same logic as below with 'stealing' the screen_name of an old, banned user.
}
}
-
+
if { [info exists user(email)] && $user(email) ne "" } {
# Check that email is unique
set email $user(email)
set email_party_id [party::get_by_email -email $user(email)]
if { $email_party_id ne "" && (!$update_p || $email_party_id != $user(user_id)) } {
- # We found a user with this email, and either we're not updating,
+ # We found a user with this email, and either we're not updating,
# or it's not the same user_id as the one we're updating
-
+
if { [acs_object_type $email_party_id] ne "user" } {
set element_messages(email) [_ acs-subsite.Have_group_mail]
} else {
acs_user::get \
-user_id $email_party_id \
-array email_user
-
+
switch $email_user(member_state) {
banned {
# A user with this email does exist, but he's banned, so we can 'steal' his email address
@@ -1638,26 +1638,26 @@
-party_id $email_party_id \
-email "dummy-email-$email_party_id"
}
- default {
+ default {
set element_messages(email) [_ acs-subsite.Have_user_mail]
}
- }
+ }
}
}
}
-
+
# They're trying to set the username
if { [info exists user(username)] && $user(username) ne "" } {
# Check that username is unique
set username_user_id [acs_user::get_by_username -authority_id $authority_id -username $user(username)]
- if { $username_user_id ne ""
- && (!$update_p || $username_user_id != $user(user_id)) } {
+ if { $username_user_id ne ""
+ && (!$update_p || $username_user_id != $user(user_id)) } {
# We already have a user with this username, and either
# we're not updating, or it's not the same user_id as the
# one we're updating
-
- set username_member_state [acs_user::get_element -user_id $username_user_id -element member_state]
+
+ set username_member_state [acs_user::get_element -user_id $username_user_id -element member_state]
switch $username_member_state {
banned {
# A user with this username does exist, but he's banned, so we can 'steal' his username
@@ -1666,7 +1666,7 @@
-user_id $username_user_id \
-username "dummy-username-$username_user_id"
}
- default {
+ default {
set element_messages(username) [_ acs-subsite.Have_user_name]
}
}
@@ -1689,18 +1689,18 @@
# admin rights on the magic object 'security_context_root').
#
set number_of_admins_left [db_string count_admins_left {
- select count(*)
- from acs_permissions p,
- party_approved_member_map m,
- acs_magic_objects amo,
- cc_users u
- where amo.name = 'security_context_root'
- and p.object_id = amo.object_id
- and p.grantee_id = m.party_id
- and u.user_id = m.member_id
- and u.member_state = 'approved'
- and u.authority_id <> :authority_id
- and acs_permission.permission_p(amo.object_id, u.user_id, 'admin')
+ select count(*)
+ from acs_permissions p,
+ party_approved_member_map m,
+ acs_magic_objects amo,
+ cc_users u
+ where amo.name = 'security_context_root'
+ and p.object_id = amo.object_id
+ and p.grantee_id = m.party_id
+ and u.user_id = m.member_id
+ and u.member_state = 'approved'
+ and u.authority_id <> :authority_id
+ and acs_permission.permission_p(amo.object_id, u.user_id, 'admin')
}]
return [ad_decode $number_of_admins_left "0" "0" "1"]
@@ -1719,9 +1719,9 @@
} {
Invoke the Authenticate service contract operation for the given authority.
- @param authority_id The ID of the authority to ask to verify the user.
+ @param authority_id The ID of the authority to ask to verify the user.
@param username Username of the user.
- @param passowrd The password as the user entered it.
+ @param passowrd The password as the user entered it.
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "auth_impl_id"]
@@ -1737,24 +1737,24 @@
# See http://openacs.org/bugtracker/openacs/bug?format=table&f%5fstate=8&bug%5fnumber=2200
# Basically, we want upgrades to work, so we have to check for
- # version number -jfr
+ # version number -jfr
set authentication_version [util_memoize [list apm_highest_version_name acs-authentication]]
set old_version_p [util_memoize [list apm_version_names_compare 5.1.3 $authentication_version]]
if {[string is true $old_version_p]} {
- return [acs_sc::invoke \
- -error \
- -impl_id $impl_id \
- -operation Authenticate \
- -call_args [list $username $password $parameters]]
+ return [acs_sc::invoke \
+ -error \
+ -impl_id $impl_id \
+ -operation Authenticate \
+ -call_args [list $username $password $parameters]]
} else {
- return [acs_sc::invoke \
- -error \
- -impl_id $impl_id \
- -operation Authenticate \
- -call_args [list $username $password $parameters $authority_id]]
+ return [acs_sc::invoke \
+ -error \
+ -impl_id $impl_id \
+ -operation Authenticate \
+ -call_args [list $username $password $parameters $authority_id]]
}
}
@@ -1778,7 +1778,7 @@
} {
Invoke the Register service contract operation for the given authority.
- @authority_id Id of the authority.
+ @authority_id Id of the authority.
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "register_impl_id"]
@@ -1797,16 +1797,16 @@
-impl_id $impl_id \
-operation Register \
-call_args [list $parameters \
- $username \
- $authority_id \
- $first_names \
- $last_name \
- $screen_name \
- $email \
- $url \
- $password \
- $secret_question \
- $secret_answer]]
+ $username \
+ $authority_id \
+ $first_names \
+ $last_name \
+ $screen_name \
+ $email \
+ $url \
+ $password \
+ $secret_question \
+ $secret_answer]]
}
ad_proc -private auth::registration::GetElements {
@@ -1847,15 +1847,13 @@
} {
Invoke the Register service contract operation for the given authority.
- @authority_id Id of the authority.
+ @authority_id Id of the authority.
} {
set impl_id [auth::authority::get_element -authority_id $authority_id -element "user_info_impl_id"]
if { $impl_id eq "" } {
# No implementation of authentication
- return {
- info_status no_account
- }
+ return { info_status no_account }
}
set parameters [auth::driver::get_parameter_values \