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 -N -r1.87 -r1.88 --- openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 8 Nov 2010 23:09:10 -0000 1.87 +++ openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 27 Oct 2014 16:39:01 -0000 1.88 @@ -64,7 +64,7 @@ # 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 {[expr {[string length $return_url] > 2083}]} { + 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] @@ -260,7 +260,7 @@ bad_password - auth_error - failed_to_connect { - if { ![exists_and_not_null result(auth_message)] } { + if { ![info exists result(auth_message)] || $result(auth_message) eq "" } { array set default_auth_message { no_account {Unknown username} bad_password {Bad password} @@ -289,7 +289,7 @@ } } closed { - if { ![exists_and_not_null result(account_message)] } { + if { ![info exists result(account_message)] || $result(account_message) eq "" } { set result(account_message) [_ acs-subsite.Account_not_avail_now] } } @@ -333,7 +333,7 @@ } } closed { - if { ![exists_and_not_null result(account_message)] } { + if { ![info exists result(account_message)] || $result(account_message) eq "" } { set result(account_message) [_ acs-subsite.Account_not_avail_now] } } @@ -350,8 +350,8 @@ set result(account_status) closed } - if { [exists_and_not_null remote_account_message] } { - if { [exists_and_not_null result(account_message)] } { + if { $remote_account_message ne "" } { + if { [info exists result(account_message)] && $result(account_message) ne "" } { # Concatenate local and remote account messages 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 { @@ -360,7 +360,7 @@ } # Issue login cookie if login was successful - if { $result(auth_status) eq "ok" && !$no_cookie_p && [exists_and_not_null result(user_id)] } { + 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 \ @@ -565,7 +565,7 @@ data_error - reg_error - failed_to_connect { - if { ![exists_and_not_null creation_info(creation_message)] } { + if { $creation_info(creation_message) eq "" } { set creation_info(creation_message) $default_creation_message($creation_info(creation_status)) } if { ![info exists creation_info(element_messages)] } { @@ -587,7 +587,7 @@ set creation_info(account_message) {} } closed { - if { ![exists_and_not_null creation_info(account_message)] } { + if { $creation_info(account_message) eq "" } { set creation_info(account_message) [_ acs-subsite.Account_not_avail_now] } } @@ -601,8 +601,7 @@ } on_error { set creation_info(creation_status) failed_to_connect set creation_info(creation_message) $errmsg - global errorInfo - ns_log Error "auth::create_user: Error invoking account registration driver for authority_id = $authority_id: $errorInfo" + ns_log Error "auth::create_user: Error invoking account registration driver for authority_id = $authority_id: $::errorInfo" } if { $creation_info(creation_status) ne "ok" } { @@ -620,8 +619,8 @@ set creation_info(account_status) closed } - if { [exists_and_not_null local_account_message] } { - if { [exists_and_not_null creation_info(account_message)] } { + if { ([info exists local_account_message] && $local_account_message ne "") } { + if { ([info exists creation_info(account_message)] && $creation_info(account_message) ne "") } { # Concatenate local and remote account messages set creation_info(account_message) "

[auth::authority::get_element -authority_id $authority_id -element pretty_name]: $creation_info(account_message)

[ad_system_name]: $local_account_message

" } else { @@ -768,10 +767,10 @@ array set element_info [auth::get_registration_elements] - if { [lsearch $element_info(required) password] != -1 } { + if {"password" in $element_info(required)} { lappend element_info(required) password_confirm } - if { [lsearch $element_info(optional) password] != -1 } { + if {"password" in $element_info(optional)} { lappend element_info(optional) password_confirm } @@ -870,7 +869,7 @@ -message_array element_messages # Handle validation errors - if { [llength [array names element_messages]] > 0 } { + if { [array size element_messages] > 0 } { return [list \ creation_status "data_error" \ creation_message {} \ @@ -888,7 +887,7 @@ set member_state "approved" } - if { ![exists_and_not_null user_info(email_verified_p)] } { + if { ![info exists user_info(email_verified_p)] || $user_info(email_verified_p) eq "" } { if { [parameter::get -parameter RegistrationRequiresEmailVerificationP -default 0] } { set user_info(email_verified_p) "f" } else { @@ -936,7 +935,7 @@ with_catch errmsg { # We create the user without a password # If it's a local account, that'll get set later - set user_id [ad_user_new \ + set user_id [auth::create_local_account_helper \ $user_info(email) \ $user_info(first_names) \ $user_info(last_name) \ @@ -964,8 +963,7 @@ if { $error_p || $user_id == 0 } { set result(creation_status) "failed_to_connect" set result(creation_message) [_ acs-subsite.Error_trying_to_register] - global errorInfo - ns_log Error "auth::create_local_account: Error creating local account.\n$errorInfo" + ns_log Error "auth::create_local_account: Error creating local account.\n$::errorInfo" return [array get result] } @@ -987,16 +985,96 @@ with_catch errmsg { auth::send_email_verification_email -user_id $user_id } { - global errorInfo - ns_log Error "auth::create_local_account: Error sending out email verification email to email $email:\n$errorInfo" + ns_log Error "auth::create_local_account: Error sending out email verification email to email $email:\n$::errorInfo" set auth_info(account_message) [_ acs_subsite.Error_sending_verification_mail] } } return [array get result] } +ad_proc -private auth::create_local_account_helper { + email + first_names + last_name + password + password_question + password_answer + {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 +} { + if { $user_id eq "" } { + set user_id [db_nextval acs_object_id_seq] + } + if { $password_question eq "" } { + set password_question [db_null] + } + + if { $password_answer eq "" } { + set password_answer [db_null] + } + + if { $url eq "" } { + set url [db_null] + } + + 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"] + + set error_p 0 + db_transaction { + + set user_id [db_exec_plsql user_insert {}] + + # set password_question, password_answer + db_dml update_question_answer {*SQL*} + + if {[catch { + # Call the extension + acs_user_extension::user_new -user_id $user_id + } errmsg]} { + # At this point, we don't want the user addition to fail + # if some extension is screwing things up + } + + } on_error { + # we got an error. log it and signal failure. + global errorInfo + ns_log Error "Problem creating a new user: $errorInfo" + set error_p 1 + } + + if { $error_p } { + return 0 + } + # success. + return $user_id +} + + + ad_proc -public auth::update_local_account { {-authority_id:required} {-username:required} @@ -1040,7 +1118,7 @@ -message_array element_messages # Handle validation errors - if { [llength [array names element_messages]] > 0 } { + if { [array size element_messages] > 0 } { return [list \ update_status "data_error" \ update_message {} \ @@ -1243,16 +1321,19 @@ array set user $info_result(user_info) - if {$email ne "" \ - && (![info exists user(email)] || $user(email) eq "")} { + 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 "")} { + 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 "")} { + 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 \ @@ -1346,7 +1427,7 @@ set PasswordExpirationDays [parameter::get -parameter PasswordExpirationDays -package_id [ad_acs_kernel_id] -default 0] - if { $email_verified_p eq "f" } { + 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]

" @@ -1358,7 +1439,7 @@ set result(account_message) [_ acs-subsite.Error_sending_verification_mail] } } - } elseif { [string equal [acs_user::ScreenName] "require"] && $screen_name eq "" } { + } elseif { [acs_user::ScreenName] eq "require" && $screen_name eq "" } { set message "Please enter a screen name now." set result(account_url) [export_vars -no_empty -base "[subsite::get_element -element url]user/basic-info-update" { message return_url {edit_p 1} }] } elseif { $PasswordExpirationDays > 0 && \ @@ -1461,7 +1542,7 @@ } foreach elm $required_elms { - if { ![exists_and_not_null user($elm)] } { + if { ![info exists user($elm)] || $user($elm) eq "" } { set element_messages($elm) "Required" } } @@ -1489,15 +1570,17 @@ } # 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 } { + 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 { [exists_and_not_null user(last_name)] && [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 { [exists_and_not_null user(email)] } { + 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 { @@ -1524,7 +1607,7 @@ } } - if { [exists_and_not_null user(email)] } { + 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)] @@ -1557,12 +1640,15 @@ } # They're trying to set the username - if { [exists_and_not_null user(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)) } { - # 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 + 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] switch $username_member_state {