Index: openacs-4/packages/acs-subsite/acs-subsite.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/acs-subsite.info,v
diff -u -r1.117.2.21 -r1.117.2.22
--- openacs-4/packages/acs-subsite/acs-subsite.info 31 Aug 2016 18:57:41 -0000 1.117.2.21
+++ openacs-4/packages/acs-subsite/acs-subsite.info 2 Sep 2016 17:33:19 -0000 1.117.2.22
@@ -9,7 +9,7 @@
t
t
-
+
OpenACS
Subsite
2015-10-04
@@ -18,11 +18,11 @@
GPL
3
-
+
-
+
Index: openacs-4/packages/acs-subsite/www/admin/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/index.adp,v
diff -u -r1.29.2.3 -r1.29.2.4
--- openacs-4/packages/acs-subsite/www/admin/index.adp 14 Sep 2015 10:35:45 -0000 1.29.2.3
+++ openacs-4/packages/acs-subsite/www/admin/index.adp 2 Sep 2016 17:33:19 -0000 1.29.2.4
@@ -30,7 +30,7 @@
#acs-subsite.lt_For_Site-Wide_Adminis#
Index: openacs-4/packages/acs-subsite/www/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-subsite/www/admin/index.tcl,v
diff -u -r1.19.6.2 -r1.19.6.3
--- openacs-4/packages/acs-subsite/www/admin/index.tcl 10 Sep 2015 08:21:37 -0000 1.19.6.2
+++ openacs-4/packages/acs-subsite/www/admin/index.tcl 2 Sep 2016 17:33:19 -0000 1.19.6.3
@@ -23,6 +23,7 @@
array set acs_admin_node [site_node::get -url $acs_admin_url]
set acs_admin_name $acs_admin_node(instance_name)
set sw_admin_p [permission::permission_p -party_id [ad_conn user_id] -object_id $acs_admin_node(object_id) -privilege admin]
+set full_acs_admin_url [util::configured_location]$acs_admin_url
set convert_subsite_p [expr { [llength [apm::get_package_descendent_options [ad_conn package_key]]] > 0 }]
Index: openacs-4/packages/acs-tcl/acs-tcl.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/acs-tcl.info,v
diff -u -r1.70.2.17 -r1.70.2.18
--- openacs-4/packages/acs-tcl/acs-tcl.info 5 Jul 2016 16:35:22 -0000 1.70.2.17
+++ openacs-4/packages/acs-tcl/acs-tcl.info 2 Sep 2016 17:33:19 -0000 1.70.2.18
@@ -9,7 +9,7 @@
f
t
-
+
OpenACS
The Kernel Tcl API library.
2016-05-15
@@ -18,7 +18,7 @@
GPL version 2
3
-
+
Index: openacs-4/packages/acs-tcl/tcl/defs-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/defs-procs.tcl,v
diff -u -r1.66.2.1 -r1.66.2.2
--- openacs-4/packages/acs-tcl/tcl/defs-procs.tcl 10 Sep 2015 08:21:56 -0000 1.66.2.1
+++ openacs-4/packages/acs-tcl/tcl/defs-procs.tcl 2 Sep 2016 17:33:19 -0000 1.66.2.2
@@ -123,6 +123,8 @@
ad_proc -public ad_url {} {
This will be called by email alerts. Do not use ad_conn location
@return the system url as defined in the kernel parameter SystemURL.
+ @see util::configured_location
+ @see util_current_location
} {
return [parameter::get -package_id [ad_acs_kernel_id] -parameter SystemURL]
}
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 -r1.78.2.20 -r1.78.2.21
--- openacs-4/packages/acs-tcl/tcl/security-procs.tcl 30 Aug 2016 11:01:40 -0000 1.78.2.20
+++ openacs-4/packages/acs-tcl/tcl/security-procs.tcl 2 Sep 2016 17:33:19 -0000 1.78.2.21
@@ -626,9 +626,12 @@
-parameter UseHostnameDomainforReg \
-default 0]
if { $UseHostnameDomainforReg } {
-
- # Get config.tcl's hostname
- set config_hostname [ns_config [ns_driversection] hostname]
+ #
+ # Get the configured hostname from the NaviServer/AOLserver
+ # config file (config.tcl) either from nssock or from the
+ # https driver.
+ #
+ set config_hostname [dict get [util_driver_info] hostname]
set current_location [util_current_location]
util::split_location $current_location currentProto currentHost currentPort
@@ -745,7 +748,7 @@
where host = :hostname
}
set subsiteUrl [site_node::get_url -node_id ${host_node_id} -notrailing]
- set rUrl [util::join_location -proto $returnProto -hostname ${config_hostname} -port $returnPort]
+ set rUrl [util::join_location -proto $returnProto -hostname $config_hostname -port $returnPort]
append rUrl $subsiteUrl $restUrl
set return_url_decoded $rUrl
# no need to iterate over all entries of host-node map
Index: openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl,v
diff -u -r1.140.2.46 -r1.140.2.47
--- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 30 Aug 2016 10:39:32 -0000 1.140.2.46
+++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl 2 Sep 2016 17:33:19 -0000 1.140.2.47
@@ -2516,15 +2516,14 @@
}
ad_proc -public util_driver_info {
- {-array:required}
+ {-array}
{-driver ""}
} {
Returns the protocol and port for the specified driver.
@param driver the driver to query (defaults to [ad_conn driver])
@param array the array to populate with proto and port
} {
- upvar $array result
if {$driver eq ""} {
set driver [ad_conn driver]
@@ -2535,27 +2534,29 @@
switch -glob -- $driver {
nsudp* -
nssock* {
- set result(proto) http
- set result(port) [ns_config -int $section Port]
+ set d [list proto http port [ns_config -int $section Port]]
}
nsunix {
- set result(proto) http
- set result(port) {}
+ set d [list proto http port ""]
}
nsssl* - nsssle {
- set result(port) [ns_config -int $section Port]
- set result(proto) https
+ set d [list proto https port [ns_config -int $section Port]]
}
nsopenssl {
- set result(port) [ns_config -int $section ServerPort]
- set result(proto) https
+ set d [list proto https port [ns_config -int $section ServerPort]]
}
default {
ns_log Error "Unknown driver: [ad_conn driver]. Only know nssock, nsunix, nsssl, nsssle, nsopenssl"
- set result(port) [ns_config -int $section Port]
- set result(proto) http
+ set d [list proto http port [ns_config -int $section Port]]
}
}
+ lappend d hostname [ns_config $section hostname]
+
+ if {[info exists array]} {
+ upvar $array result
+ array set result {*}$d
+ }
+ return $d
}
ad_proc util::split_location {location protoVar hostnameVar portVar} {
@@ -2614,13 +2615,43 @@
return $result
}
+ad_proc -public util::configured_location {} {
+
+ Return the configured location as configured for the current
+ network driver. While [util_current_location] honors the virtual
+ host information of the host header field,
+ util::configured_location returns the main configured location
+ (probably the main subsite). This also differs from [ad_url],
+ which returns always the same value from the kernel parameter,
+ since it returns either the https or http result.
+
+ @return the configured location in the form "proto://hostname?:port?"
+
+ @see ad_url
+ @see util_current_location
+} {
+ set driver_info [util_driver_info]
+ return [util::join_location \
+ -proto [dict get $driver_info proto] \
+ -hostname [dict get $driver_info hostname] \
+ -port [dict get $driver_info port]]
+}
+
ad_proc -public util_current_location {} {
- Like ad_conn location - Returns the location string of the current
- request in the form protocol://hostname[:port] but it looks at the
- "Host:" header, that is, takes into account the host name the client
- used although it may be different from the host name from the server
- configuration file. If the Host header is missing or empty
- util_current_location falls back to ad_conn location.
+
+ Like [ad_conn location] - Returns the location string of the
+ current request in the form protocol://hostname?:port? but it
+ looks at the "Host:" header field, that is, takes into account the
+ host name the client used although it may be different from the
+ host name from the server configuration file. If the Host header
+ is missing or empty util_current_location falls back to ad_conn
+ location.
+
+ @return the configured location in the form "protocol://hostname?:port?"
+
+ @see util::configured_location
+ @see ad_url
+ @see ad_conn
} {
#