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.89.2.12 -r1.89.2.13
--- openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 24 Apr 2017 10:46:51 -0000 1.89.2.12
+++ openacs-4/packages/acs-authentication/tcl/authentication-procs.tcl 31 May 2017 11:48:36 -0000 1.89.2.13
@@ -168,6 +168,7 @@
{-no_cookie:boolean}
{-first_names ""}
{-last_name ""}
+ {-host_node_id ""}
} {
Try to authenticate and login the user forever by validating the username/password combination,
and return authentication and account status codes.
@@ -176,9 +177,10 @@
@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 password 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 host_node_id Optional parameter used to determine the cookie domain from the host_node_map
@return Array list with the following entries:
@@ -352,32 +354,55 @@
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)
"
+ set local_account_message [auth::authority::get_element \
+ -authority_id $authority_id \
+ -element pretty_name]
+ set result(account_message) [subst {
+ $local_account_message: $remote_account_message
+ [ad_system_name]: $result(account_message)
+ }]
} else {
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 "" } {
+ if { $result(auth_status) eq "ok"
+ && !$no_cookie_p
+ && [info exists result(user_id)] && $result(user_id) ne ""
+ } {
+ if {$host_node_id ne ""} {
+ set cookie_domain [db_string get_mapped_host {
+ select host from host_node_map where node_id = :host_node_id
+ } -default ""]
+ if {$cookie_domain eq ""} {
+ ns_log warning "auth::authenticate: host_node_id $host_node_id was provided but is apparently not mapped"
+ }
+ } else {
+ set cookie_domain ""
+ }
+ ns_log notice "auth::authenticate recieves host_node_id $host_node_id domain <$cookie_domain>"
auth::issue_login \
-user_id $result(user_id) \
-persistent=$persistent_p \
- -account_status $result(account_status)
+ -account_status $result(account_status) \
+ -cookie_domain $cookie_domain
}
return [array get result]
}
ad_proc -private auth::issue_login {
{-user_id:required}
- {-persistent:boolean}
{-account_status "ok"}
+ {-cookie_domain ""}
+ {-persistent:boolean}
} {
Issue the login cookie.
} {
ad_user_login \
-account_status $account_status \
+ -cookie_domain $cookie_domain \
-forever=$persistent_p \
$user_id
}
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 -N -r1.19.2.5 -r1.19.2.6
--- openacs-4/packages/acs-authentication/tcl/password-procs.tcl 21 Apr 2017 15:35:24 -0000 1.19.2.5
+++ openacs-4/packages/acs-authentication/tcl/password-procs.tcl 31 May 2017 11:48:36 -0000 1.19.2.6
@@ -122,7 +122,7 @@
# Refresh the current user's cookies, so he doesn't get logged out,
# if this user was logged in before changing password
if { [ad_conn isconnected] && $user_id == $connection_user_id } {
- ad_user_login -account_status [ad_conn account_status] $user_id
+ auth::issue_login -account_status [ad_conn account_status] -user_id $user_id
}
}
no_account - not_supported - old_password_bad - new_password_bad - change_error - failed_to_connect {
Index: openacs-4/packages/acs-subsite/lib/login.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/lib/login.tcl,v
diff -u -N -r1.36.2.6 -r1.36.2.7
--- openacs-4/packages/acs-subsite/lib/login.tcl 31 May 2017 09:48:45 -0000 1.36.2.6
+++ openacs-4/packages/acs-subsite/lib/login.tcl 31 May 2017 11:48:36 -0000 1.36.2.7
@@ -75,12 +75,7 @@
set subsite_url [subsite::get_element -element url]
set system_name [ad_system_name]
-if { $return_url ne "" } {
- if { [util::external_url_p $return_url] } {
- ad_returnredirect -message "only urls without a host name are permitted" "."
- ad_script_abort
- }
-} else {
+if { $return_url eq "" } {
set return_url [ad_pvt_home]
}
@@ -94,7 +89,7 @@
-username $username \
-email $email]
-set register_url [export_vars -no_empty -base "[subsite::get_url]register/user-new" { return_url host_node_id }]
+set register_url [export_vars -no_empty -base "[subsite::get_url]register/user-new" { return_url }]
if { $authority_id eq [auth::get_register_authority] || [auth::UseEmailForLoginP] } {
set register_url [export_vars -no_empty -base $register_url { username email}]
}
@@ -108,14 +103,15 @@
-action "[subsite::get_url]register/" -form {
{return_url:text(hidden)}
{time:text(hidden)}
+ {host_node_id:text(hidden)}
{token_id:integer(hidden)}
{hash:text(hidden)}
} -validate {
{ token_id {$token_id < 2**31} "invalid token id"}
}
set username_widget text
-if { [parameter::get -parameter UsePasswordWidgetForUsername -package_id [ad_acs_kernel_id]] } {
+if { [parameter::get -parameter UsePasswordWidgetForUsername -package_id $::acs::kernel_id] } {
set username_widget password
}
@@ -192,15 +188,19 @@
set token [sec_get_token $token_id]
set computed_hash [ns_sha1 "$time$token_id$token"]
- set expiration_time [parameter::get -parameter LoginPageExpirationTime -package_id [ad_acs_kernel_id] -default 600]
+ set expiration_time [parameter::get \
+ -parameter LoginPageExpirationTime \
+ -package_id $::acs::kernel_id \
+ -default 600]
if { $expiration_time < 30 } {
# If expiration_time is less than 30 seconds, it's practically impossible to login
# and you will have completely hosed login on your entire site
set expiration_time 30
}
- if { $hash ne $computed_hash ||
- $time < [ns_time] - $expiration_time } {
+ if { $hash ne $computed_hash
+ || $time < [ns_time] - $expiration_time
+ } {
ad_returnredirect -message [_ acs-subsite.Login_has_expired] -- [export_vars -base [ad_conn url] { return_url }]
ad_script_abort
}
@@ -222,6 +222,7 @@
-last_name $last_name \
-username [string trim $username] \
-password $password \
+ -host_node_id $host_node_id \
-persistent=[expr {$allow_persistent_login_p && [template::util::is_true $persistent_p]}]]
# Handle authentication problems
Index: openacs-4/packages/acs-subsite/www/register/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/register/index.adp,v
diff -u -N -r1.22.2.1 -r1.22.2.2
--- openacs-4/packages/acs-subsite/www/register/index.adp 22 Sep 2015 12:36:38 -0000 1.22.2.1
+++ openacs-4/packages/acs-subsite/www/register/index.adp 31 May 2017 11:48:36 -0000 1.22.2.2
@@ -2,5 +2,11 @@
#acs-subsite.Log_In#
{#acs-subsite.Log_In#}
-
+
Index: openacs-4/packages/acs-subsite/www/register/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/register/index.tcl,v
diff -u -N -r1.14.2.5 -r1.14.2.6
--- openacs-4/packages/acs-subsite/www/register/index.tcl 27 May 2016 22:26:49 -0000 1.14.2.5
+++ openacs-4/packages/acs-subsite/www/register/index.tcl 31 May 2017 11:48:36 -0000 1.14.2.6
@@ -6,6 +6,7 @@
{username ""}
{email ""}
{return_url:localurl ""}
+ {host_node_id:naturalnum ""}
} -validate {
valid_email -requires email {
if {![regexp {^[\w.@+/=$%!*~-]+$} $email]} {
@@ -21,6 +22,7 @@
set login_template "/packages/acs-subsite/lib/login"
}
+ns_log notice "register/index.tcl: login_template <$login_template> host_node_id <$host_node_id>"
# Local variables:
# mode: tcl
Index: openacs-4/packages/acs-tcl/tcl/security-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/security-procs.tcl,v
diff -u -N -r1.78.2.59 -r1.78.2.60
--- openacs-4/packages/acs-tcl/tcl/security-procs.tcl 30 May 2017 21:05:14 -0000 1.78.2.59
+++ openacs-4/packages/acs-tcl/tcl/security-procs.tcl 31 May 2017 11:48:36 -0000 1.78.2.60
@@ -155,7 +155,7 @@
}
}
- ns_log $::security::log(login_cookie) "Security: Insecure session OK: session_id = $session_id, untrusted_user_id = $untrusted_user_id, auth_level = $auth_level, user_id = $user_id"
+ ns_log $::security::log(login_cookie) "Security: Insecure session OK: session_id $session_id, untrusted_user_id $untrusted_user_id, auth_level $auth_level, user_id $user_id"
# We're okay, insofar as the insecure session, check if it's also secure
if { $auth_level eq "ok" && [security::secure_conn_p] } {
@@ -267,6 +267,7 @@
ad_proc -public ad_user_login {
{-account_status "ok"}
+ {-cookie_domain ""}
-forever:boolean
user_id
} {
@@ -286,14 +287,16 @@
set auth_level "ok"
set secure_p [security::secure_conn_p]
- set domain [parameter::get -parameter CookieDomain -package_id [ad_acs_kernel_id]]
+ if {$cookie_domain eq ""} {
+ set cookie_domain [parameter::get -parameter CookieDomain -package_id $::acs::kernel_id]
+ }
# If you're logged in over a secure connection, you're secure
if { $secure_p } {
ad_set_signed_cookie \
-max_age $max_age \
-secure t \
- -domain $domain \
+ -domain $cookie_domain \
ad_user_login_secure \
"$user_id,[ns_time],[sec_get_user_auth_token $user_id],[ns_time],$forever_p"
@@ -308,13 +311,13 @@
ns_log Debug "ad_user_login: Setting new ad_user_login cookie with max_age $max_age"
ad_set_signed_cookie \
-max_age $max_age \
- -domain $domain \
+ -domain $cookie_domain \
-secure f \
ad_user_login \
"$user_id,[ns_time],[sec_get_user_auth_token $user_id],$forever_p"
# deal with the current session
- sec_setup_session $user_id $auth_level $account_status
+ sec_setup_session -cookie_domain $cookie_domain $user_id $auth_level $account_status
}
ad_proc -public sec_get_user_auth_token {
@@ -352,24 +355,28 @@
}
-ad_proc -public ad_user_logout {} {
+ad_proc -public ad_user_logout {
+ {-cookie_domain ""}
+} {
Logs the user out.
} {
- set domain [parameter::get -parameter CookieDomain -package_id [ad_acs_kernel_id]]
+ if {$cookie_domain eq ""} {
+ set cookie_domain [parameter::get -parameter CookieDomain -package_id $::acs::kernel_id]
+ }
#
# Use the same "secure" setting for unsetting the cookie as it was
# used for setting the cookie. The implementation is not 100%
# correct, for cases, when the parameter value for
# "SecureSessionCookie" was altered during a session, but this
# should be a seldom border case.
#
- ad_unset_cookie -domain $domain -secure [expr {[parameter::get \
+ ad_unset_cookie -domain $cookie_domain -secure [expr {[parameter::get \
-parameter SecureSessionCookie \
-package_id [ad_acs_kernel_id] \
-default 0] ? "t" : "f"}] ad_session_id
- ad_unset_cookie -domain $domain -secure f ad_user_login
- ad_unset_cookie -domain $domain -secure t ad_secure_token
- ad_unset_cookie -domain $domain -secure t ad_user_login_secure
+ ad_unset_cookie -domain $cookie_domain -secure f ad_user_login
+ ad_unset_cookie -domain $cookie_domain -secure t ad_secure_token
+ ad_unset_cookie -domain $cookie_domain -secure t ad_user_login_secure
}
ad_proc -public ad_check_password {
@@ -413,7 +420,8 @@
db_release_unused_handles
}
-ad_proc -private sec_setup_session {
+ad_proc -private sec_setup_session {
+ {-cookie_domain ""}
new_user_id
auth_level
account_status
@@ -491,7 +499,7 @@
ns_log debug "OACS= about to generate session id cookie"
- sec_generate_session_id_cookie
+ sec_generate_session_id_cookie -cookie_domain $cookie_domain
ns_log debug "OACS= done generating session id cookie"
@@ -513,10 +521,15 @@
db_release_unused_handles
}
-ad_proc -private sec_generate_session_id_cookie {} {
+ad_proc -private sec_generate_session_id_cookie {
+ {-cookie_domain ""}
+} {
Sets the ad_session_id cookie based on global variables.
} {
set user_id [ad_conn untrusted_user_id]
+ #
+ # Maybe we need the session_id of the cookie-domain
+ #
set session_id [ad_conn session_id]
set auth_level [ad_conn auth_level]
set account_status [ad_conn account_status]
@@ -532,10 +545,14 @@
ns_log Debug "Security: [ns_time] sec_generate_session_id_cookie setting session_id=$session_id, user_id=$user_id, login_level=$login_level"
- set domain [parameter::get -parameter CookieDomain -package_id [ad_acs_kernel_id]]
+ if {$cookie_domain eq ""} {
+ set cookie_domain [parameter::get -parameter CookieDomain -package_id $::acs::kernel_id]
+ }
- # we fetch the last value element of ad_user_login cookie (or ad_user_login_secure) that indicates
- # if user wanted to be remembered when loggin in
+ # Fetch the last value element of ad_user_login cookie (or
+ # ad_user_login_secure) that indicates if user wanted to be
+ # remembered when loggin in.
+
set discard t
set max_age [sec_session_timeout]
catch {
@@ -550,7 +567,10 @@
-parameter SecureSessionCookie \
-package_id [ad_acs_kernel_id] \
-default 0] ? "t" : "f"}] \
- -discard $discard -replace t -max_age $max_age -domain $domain \
+ -discard $discard \
+ -replace t \
+ -max_age $max_age \
+ -domain $cookie_domain \
ad_session_id "$session_id,$user_id,$login_level,[ns_time]"
}
@@ -691,11 +711,6 @@
-default 0]
set require_qualified_return_url $UseHostnameDomainforReg
set host_node_id [ad_get_node_id_from_host_node_map $current_host]
-
- # we need
- # UseHostnameDomainforReg
- # host_node_id
- # config_hostname
if { $host_node_id > 0 } {
#
@@ -768,7 +783,10 @@
set url [security::replace_host_in_url -hostname $config_hostname $url]
}
}
- return [list url $url require_qualified_return_url $require_qualified_return_url]
+ return [list \
+ url $url \
+ require_qualified_return_url $require_qualified_return_url \
+ host_node_id $host_node_id]
}
@@ -790,14 +808,15 @@
} {
set subsite_info [security::get_register_subsite]
- set url [dict get $subsite_info url]
- set require_qualified_return_url [dict get $subsite_info require_qualified_return_url]
+ foreach var {url require_qualified_return_url host_node_id} {
+ set $var [dict get $subsite_info $var]
+ }
append url "register/"
#
# Don't add a return_url if you're already under /register,
- # because that will frequently interfere with normal login
+ # because that will frequently interfere with the normal login
# procedure.
#
if { [ad_conn isconnected] && $return_p && ![string match "register/*" [ad_conn extra_url]] } {
@@ -811,7 +830,7 @@
set return_url [ad_return_url -qualified]
}
}
- set url [export_vars -base $url -no_empty {authority_id username return_url}]
+ set url [export_vars -base $url -no_empty {authority_id username return_url host_node_id}]
ns_log $::security::log(login_url) "ad_get_login_url: final login_url <$url>"
Index: openacs-4/packages/acs-tcl/tcl/tcltrace-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/tcltrace-init.tcl,v
diff -u -N -r1.1.2.4 -r1.1.2.5
--- openacs-4/packages/acs-tcl/tcl/tcltrace-init.tcl 21 Apr 2017 14:22:46 -0000 1.1.2.4
+++ openacs-4/packages/acs-tcl/tcl/tcltrace-init.tcl 31 May 2017 11:48:36 -0000 1.1.2.5
@@ -24,7 +24,12 @@
#
# Optionally add more traces here
#
-#append trace "\ntrace add execution ::nsv_get enter {::tcltrace::before}"
+set traced_cmds {}
+#set traced_cmds {::nsv_get}
+#set traced_cmds {::ns_setcookie ::ns_getcookie ::ns_deletecookie}
+foreach cmd $traced_cmds {
+ append trace "\ntrace add execution $cmd enter {::tcltrace::before}"
+}
if {$trace ne ""} {
ns_ictl trace create $trace
Index: openacs-4/packages/acs-tcl/tcl/tcltrace-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/tcltrace-procs.tcl,v
diff -u -N -r1.2.2.3 -r1.2.2.4
--- openacs-4/packages/acs-tcl/tcl/tcltrace-procs.tcl 11 Apr 2016 14:27:31 -0000 1.2.2.3
+++ openacs-4/packages/acs-tcl/tcl/tcltrace-procs.tcl 31 May 2017 11:48:36 -0000 1.2.2.4
@@ -76,7 +76,7 @@
ad_proc -private before { cmd op } {
Simple trace proc for arbitraty commands. simply reports traces to error.log.
} {
- ns_log notice $cmd
+ ns_log notice "trace: $cmd"
}
}