Index: openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl,v
diff -u -r1.145 -r1.146
--- openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl	19 Sep 2018 00:55:36 -0000	1.145
+++ openacs-4/packages/acs-tcl/tcl/request-processor-procs.tcl	15 Oct 2018 07:51:40 -0000	1.146
@@ -1305,7 +1305,9 @@
     Returns the package_id of the kernel. (not cached)
 
 } {
-    return [db_string acs_kernel_id_get {} -default 0]
+    return [db_string acs_kernel_id_get {
+        select package_id from apm_packages where package_key = 'acs-kernel'
+    } -default 0]
 }
 
 ad_proc -public ad_acs_kernel_id {} {
@@ -1333,7 +1335,7 @@
     passed on to AOLserver's/NaviServer's <code>ns_conn</code> If the
     property is not a valid option for <code>ns_conn</code> either
     then it will throw an error.
-    
+
 <p>
     Valid options for ad_conn are:
     ajax_p,
@@ -1791,6 +1793,8 @@
     set $key [root_of_host_noncached $host]
 }
 
+
+
 ad_proc -private root_of_host_noncached {host} {
 
     Helper function for root_of_host, which performs the actual work.
@@ -1807,35 +1811,36 @@
         }
     }
 
-    #
-    # Other hostnames map to subsites.
-    #
-    set node_id [util_memoize [list rp_lookup_node_from_host $host]]
-
-    if {$node_id eq ""} {
-        set host [regsub "www\." $host ""]
+    if {[security::provided_host_valid $host]} {
+        #
+        # Other hostnames map to subsites.
+        #
         set node_id [util_memoize [list rp_lookup_node_from_host $host]]
-    }
 
-    if { $node_id ne "" } {
-        set url [site_node::get_url -node_id $node_id]
+        if {$node_id eq ""} {
+            set host_stripped [regsub "www\." $host ""]
+            if {$host_stripped ne $host} {
+                set node_id [util_memoize [list rp_lookup_node_from_host $host_stripped]]
+            }
+        }
 
-        return [string range $url 0 end-1]
-    } else {
-        # Hack to provide a useful default
-        return ""
+        if { $node_id ne "" } {
+            set url [site_node::get_url -node_id $node_id]
+            return [string range $url 0 end-1]
+        }
     }
+    # Hack to provide a useful default
+    return ""
 }
 
 ad_proc -private rp_lookup_node_from_host { host } {
+    Lookup host from host_node_map.
+    @return node_id on success or empty string
+} {
     if {$host ne ""} {
-        if {![regexp {^[\w.@+/=$%!*~\[\]-]+$} $host]} {
-            binary scan [encoding convertto utf-8 $host] H* hex
-            ad_log error "rp_lookup_node_from_host: host <$host> (hex $hex) contains invalid characters"
-            ad_return_complaint 1 "invalid request"
-            ad_script_abort
-        }
-        return [db_string node_id {} -default ""]
+        return [db_string node_id {
+            select node_id from host_node_map where host = :host
+        } -default ""]
     }
 }
 
@@ -1879,4 +1884,3 @@
 #    tcl-indent-level: 4
 #    indent-tabs-mode: nil
 # End:
-
Fisheye: Tag 1.6 refers to a dead (removed) revision in file `openacs-4/packages/acs-tcl/tcl/request-processor-procs.xql'.
Fisheye: No comparison available.  Pass `N' to diff?
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.109 -r1.110
--- openacs-4/packages/acs-tcl/tcl/security-procs.tcl	20 Sep 2018 20:10:31 -0000	1.109
+++ openacs-4/packages/acs-tcl/tcl/security-procs.tcl	15 Oct 2018 07:51:40 -0000	1.110
@@ -115,7 +115,7 @@
             #if {[nsv_array exists aa_test]} {
             #    ns_log notice "nsv_array logindata [nsv_get aa_test logindata logindata]"
             #    ns_log notice "ns_conn peeraddr [ns_conn peeraddr]"
-            #    ns_log notice "dict get $logindata peeraddr [dict get $logindata peeraddr]"                
+            #    ns_log notice "dict get $logindata peeraddr [dict get $logindata peeraddr]"
             #}
             if {[nsv_array exists aa_test]
                 && [nsv_get aa_test logindata logindata]
@@ -2115,6 +2115,28 @@
     return $locations
 }
 
+ad_proc -private security::provided_host_valid {host} {
+    Check, if the provided host contains just valid characters.
+    Spit warning message out only once per request.
+    @param host host from host header field.
+} {
+    #
+    # The global variable takes care of outputting error message only
+    # once per request.
+    #
+    set key ::__security_provided_host_validated($host)
+    if {![info exists $key]} {
+        set $key 1
+        if {$host ne ""} {
+            if {![regexp {^[\w.:@+/=$%!*~\[\]-]+$} $host]} {
+                binary scan [encoding convertto utf-8 $host] H* hex
+                ad_log warning "provided host <$host> (hex $hex) contains invalid characters"
+                set $key 0
+            }
+        }
+    }
+    return [set $key]
+}
 
 ad_proc -public security::validated_host_header {} {
     @return validated host header field or empty
@@ -2233,8 +2255,7 @@
     # Check against host node map. Here we need as well protection
     # against invalid utf-8 characters.
     #
-    if {![regexp {^[\w.:@+/=$%!*~\[\]-]+$} $host]} {
-        ns_log Warning "host header field contains invalid characters: $host"
+    if {![security::provided_host_valid $hostName]} {
         return ""
     }
     set result [db_list host_header_field_mapped {select 1 from host_node_map where host = :hostName}]