user-new.tcl

ADP include for adding new users Expects parameters:

Location:
/packages/acs-subsite/lib/user-new.tcl
File Contents

ad_include_contract {
    ADP include for adding new users

    Expects parameters:

    @param self_register_p Is the form for users who self register (1) or
                           for administrators who create oher users (0)?

    @param next_url        Any url to redirect to after the form has been
                           submitted.  The variables user_id,
                           password, and account_messages will be
                           added to the URL. Optional.

    @param email           Prepopulate the register form with given email.
                           Optional.

    @param return_url      URL to redirect to after creation, will not get any
                           query vars added

    @param rel_group_id    The name of a group which you want to relate this
                           user to after creating the user.  Will add
                           an element to the form where the user can
                           pick a relation among the permissible
                           rel-types for the group. Can be empty.

} {
    {self_register_p:boolean 1}
    {next_url ""}
    {email ""}
    {return_url ""}
    {rel_group_id:integer ""}
}

::util::block_request -condition {[ns_conn pool] eq "bots"} -target bots
#
# Check if user can self register
auth::self_registration

# Redirect to HTTPS if so configured
if { [security::RestrictLoginToSSLP] } {
    security::require_secure_conn
}

# Log user out if currently logged in, if specified in the includeable chunk's parameters,
# e.g. not when creating accounts for other users
if { $self_register_p } {
    ad_user_logout
}

# Redirect to the registration assessment if there is one, if not, continue with the regular
# registration form.

set implName [parameter::get -parameter "RegistrationImplName" -package_id [subsite::main_site_id]]

set callback_url [callback -catch -impl "$implName" user::registration]

if { $callback_url ne "" } {
    ad_returnredirect [export_vars -base $callback_url { return_url }]
    ad_script_abort
}


# Pre-generate user_id for double-click protection
set user_id [db_nextval acs_object_id_seq]
ns_log notice "===== 1 acs-subsite/lib/user-new user_id=$user_id" 

ad_form -name register -export {next_url user_id return_url} -form [auth::get_registration_form_elements]

#
# Standard validator
#
set validate {
    {email
        {[party::get_by_email -email $email] eq ""}
        "[_ acs-subsite.Email_already_exists]"
    }
}
ns_log notice "===== 2 acs-subsite/lib/user-new user_id=$user_id email ok $email" 

#
# Handling of additional groups
#
if { $rel_group_id ne "" } {
    ad_form -extend -name register -form {
        {rel_group_id:integer(hidden),optional}
    }

    if { [permission::permission_p -object_id $rel_group_id -privilege "admin"] } {
        ad_form -extend -name register -form {
            {rel_type:text(select)
                {label "Role"}
                {options {[group::get_rel_types_options -group_id $rel_group_id]}}
            }
        }
    } else {
        ad_form -extend -name register -form {
            {rel_type:text(hidden)
                {value "membership_rel"}
            }
        }
    }
}

#
# Register the validators after all form-fields were added (in case
# conditional fields were added needing validators).
#
ad_form -extend -name register -validate $validate

ad_form -extend -name register -on_request {
    # Populate elements from local variables

} -on_submit {

ns_log notice "NEW USER $email request from peer=[ns_conn peeraddr], ($first_names, $last_name, $password, $secret_question, $secret_answer, $url)\n[ns_set array [ns_conn headers]]"
#### temporary spam measure
 
set sender_addr [lindex [ns_set iget [ns_conn headers] x-forwarded-for] end]
set is_spam 0
set spamRE [parameter::get -parameter SpamUserNameRegexp -package_id [ad_acs_kernel_id] -default ""]
if {$spamRE ne ""} {set is_spam [regexp $spamRE "$first_names, $last_name"]}
if {!$is_spam && $sender_addr ne ""}  {ns_log notice "NEW USER forwarded=$sender_addr";set is_spam [string match "72.232*" $sender_addr]} 

if {$is_spam} {
  ns_log notice "NEW USER $email REJECTED"
  ad_return_warning "spammer alert" \
      "The request looks like a spam attack. please contact oct@openacs.org"
  ad_script_abort
}
    
    db_transaction {
ns_log notice "===== 4 "
ns_log notice [list auth::create_user \
                                     -user_id $user_id \
                                     -verify_password_confirm \
                                     -username $username \
                                     -email $email \
                                     -first_names $first_names \
                                     -last_name $last_name \
                                     -screen_name $screen_name \
                                     -password $password \
                                     -password_confirm $password_confirm \
                                     -url $url \
                                     -secret_question $secret_question \
                                     -secret_answer $secret_answer]
        array set creation_info [auth::create_user \
                                     -user_id $user_id \
                                     -verify_password_confirm \
                                     -username $username \
                                     -email $email \
                                     -first_names $first_names \
                                     -last_name $last_name \
                                     -screen_name $screen_name \
                                     -password $password \
                                     -password_confirm $password_confirm \
                                     -url $url \
                                     -secret_question $secret_question \
                                     -secret_answer $secret_answer]
ns_log notice "===== 3 acs-subsite/lib/user-new creation_info [array get creation_info]"

        if { $creation_info(creation_status) eq "ok" && $rel_group_id ne "" } {
            group::add_member \
                -group_id $rel_group_id \
                -user_id $user_id \
                -rel_type $rel_type
        }
    }

    # Handle registration problems

    switch -- $creation_info(creation_status) {
        ok {
            # Continue below
        }
        default {
            # Adding the error to the first element, but only if there are no element messages
            if { [llength $creation_info(element_messages)] == 0 } {
                array set reg_elms [auth::get_registration_elements]
                set first_elm [lindex [concat $reg_elms(required) $reg_elms(optional)] 0]
                form set_error register $first_elm $creation_info(creation_message)
            }

            # Element messages
            foreach { elm_name elm_error } $creation_info(element_messages) {
                form set_error register $elm_name $elm_error
            }
            break
        }
    }

    switch -- $creation_info(account_status) {
        ok {
            # Continue below
        }
        default {

            if {[parameter::get -parameter RegistrationRequiresEmailVerificationP -default 0] &&
                $creation_info(account_status) eq "closed"} {
                    ad_return_warning "Email Validation is required" $creation_info(account_message)
                    ad_script_abort
            }
            if {[parameter::get -parameter RegistrationRequiresApprovalP -default 0] &&
                $creation_info(account_status) eq "closed"} {
                    ad_return_warning "Account approval is required" $creation_info(account_message)
                    ad_script_abort
            }

            # Display the message on a separate page
            ad_returnredirect \
                -message $creation_info(account_message) \
                -html \
                "[subsite::get_element -element url]register/account-closed"
            ad_script_abort
        }
    }

} -after_submit {

    if { $next_url ne "" } {
        #
        # Add user_id and account_message to the URL, but do not pass
        # password via query parameter. We have to make sure that
        # $next_url tries to get the password from the client property
        # as well.
        #
        security::set_client_property_password $password
        if {$::acs::pass_password_as_query_variable} {
            ad_returnredirect [export_vars -base $next_url {
                user_id password {account_message $creation_info(account_message)}
            }]
        } else {
            ad_returnredirect [export_vars -base $next_url {
                user_id {account_message $creation_info(account_message)}
            }]
        }
        ad_script_abort
    }

ns_log notice "===== 4 acs-subsite/lib/user-new User is registered and logged in"

    # User is registered and logged in
    if { $return_url eq "" } {
        # Redirect to subsite home page.
        set return_url [subsite::get_element -element url]
    }

    # If the user is self registering, then try to set the preferred
    # locale (assuming the user has set it as an anonymous visitor
    # before registering).
    if { $self_register_p } {
        # We need to explicitly get the cookie and not use
        # lang::user::locale, as we are now a registered user,
        # but one without a valid locale setting.
        set locale [ad_get_cookie "ad_locale"]
        if { $locale ne "" } {
            lang::user::set_locale $locale
            ad_set_cookie -replace t -max_age 0 "ad_locale" ""
        }
    }

    # Handle account_message
    if { $creation_info(account_message) ne "" && $self_register_p } {
        # Only do this if user is self-registering
        # as opposed to creating an account for someone else
        ad_returnredirect [export_vars -base "[subsite::get_element -element url]register/account-message" {
            { message $creation_info(account_message) } return_url
        }]
        ad_script_abort
    } else {
        # No messages
        ad_returnredirect $return_url
        ad_script_abort
    }
}
ns_log notice "===== END acs-subsite/lib/user-new" 

# Local variables:
#    mode: tcl
#    tcl-indent-level: 4
#    indent-tabs-mode: nil
# End:
user-new.tcl

Related Files

File Contents
