Index: openacs-4/packages/acs-tcl/tcl/00-icanuse-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/00-icanuse-procs.tcl,v
diff -u -r1.1.2.1 -r1.1.2.2
--- openacs-4/packages/acs-tcl/tcl/00-icanuse-procs.tcl	17 Jul 2019 08:34:09 -0000	1.1.2.1
+++ openacs-4/packages/acs-tcl/tcl/00-icanuse-procs.tcl	30 Mar 2020 19:30:39 -0000	1.1.2.2
@@ -75,6 +75,7 @@
 
 ::acs::register_icanuse "ns_asynclogfile" {[info commands ::ns_asynclogfile] ne ""}
 ::acs::register_icanuse "ns_writer" {[info commands ::ns_writer] ne ""}
+::acs::register_icanuse "ns_hash" {[info commands ::ns_hash] ne ""}
 
 # Local variables:
 #    mode: tcl
Index: openacs-4/packages/acs-tcl/tcl/acs-cache-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/acs-cache-procs.tcl,v
diff -u -r1.10 -r1.10.2.1
--- openacs-4/packages/acs-tcl/tcl/acs-cache-procs.tcl	11 Feb 2019 11:47:33 -0000	1.10
+++ openacs-4/packages/acs-tcl/tcl/acs-cache-procs.tcl	30 Mar 2020 19:30:39 -0000	1.10.2.1
@@ -27,145 +27,145 @@
     ##########################################################################
 
     nx::Class create ::acs::Cache {
-	#
-	# Provide a base class to generalize cache management to
-	# extend cache primitives like e.g. for cache partitioning.
-	#
-	:property name
-	:property parameter:required
+        #
+        # Provide a base class to generalize cache management to
+        # extend cache primitives like e.g. for cache partitioning.
+        #
+        :property name
+        :property parameter:required
         :property package_key:required
-	:property maxentry:integer
-	:property {default_size:integer 10000}
+        :property maxentry:integer
+        :property {default_size:integer 10000}
 
-	:method cache_name {key} {
-	    #
-	    # More or less dummy function, which can be refined.  The
-	    # base definition completely ignores "key".
-	    #
-	    return ${:name}
-	}
+        :method cache_name {key} {
+            #
+            # More or less dummy function, which can be refined.  The
+            # base definition completely ignores "key".
+            #
+            return ${:name}
+        }
 
-	:method get_size {} {
-	    #
-	    # Determine the cache size depending on configuration
-	    # variables.
-	    #
-	    return [::parameter::get_from_package_key \
-			-package_key ${:package_key} \
-			-parameter "${:parameter}Size" \
-			-default ${:default_size}]
-	}
+        :method get_size {} {
+            #
+            # Determine the cache size depending on configuration
+            # variables.
+            #
+            return [::parameter::get_from_package_key \
+                        -package_key ${:package_key} \
+                        -parameter "${:parameter}Size" \
+                        -default ${:default_size}]
+        }
 
-	:public method flush {{-partition_key} key} {
-	    if {![info exists partition_key]} {
+        :public method flush {{-partition_key} key} {
+            if {![info exists partition_key]} {
                 set partition_key $key
             }
-	    ::acs::clusterwide ns_cache flush [:cache_name $partition_key] $key
-	}
+            ::acs::clusterwide ns_cache flush [:cache_name $partition_key] $key
+        }
 
-	if {[info commands ns_cache_eval] ne ""} {
-	    #
-	    # NaviServer variant
-	    #
-	    :public method eval {{-partition_key} {-expires:integer} key command} {
-		#
-		# Evaluate the command unless it is cached.
-		#
-		if {![info exists partition_key]} {
+        if {[info commands ns_cache_eval] ne ""} {
+            #
+            # NaviServer variant
+            #
+            :public method eval {{-partition_key} {-expires:integer} key command} {
+                #
+                # Evaluate the command unless it is cached.
+                #
+                if {![info exists partition_key]} {
                     set partition_key $key
                 }
-		if {[info exists expires]} {
+                if {[info exists expires]} {
                     set expires_flag [list -expires $expires]
                 } else {
                     set expires_flag {}
                 }
 
-		try {
-		    :uplevel [list ns_cache_eval {*}$expires_flag -- \
+                try {
+                    :uplevel [list ns_cache_eval {*}$expires_flag -- \
                                   [:cache_name $partition_key] $key $command]
 
-		} on break {r} {
-		    #
-		    # When the command ends with "break", it means:
-		    # "don't cache". We return in this case always a
-		    # 0.
-		    #
-		    #ns_log notice "====================== [self] $key -> break -> <$r>"
-		    return 0
+                } on break {r} {
+                    #
+                    # When the command ends with "break", it means:
+                    # "don't cache". We return in this case always a
+                    # 0.
+                    #
+                    #ns_log notice "====================== [self] $key -> break -> <$r>"
+                    return 0
 
-		} on ok {r} {
-		    return $r
-		}
-	    }
+                } on ok {r} {
+                    return $r
+                }
+            }
 
-	    :public method set {-partition_key key value} {
-		#
-		# Set some value in the cache. This code uses
-		# ns_cache_eval to achieve this behavior, which is
-		# typically a AOLserver idiom and should be avoided.
-		#
-		if {![info exists partition_key]} {
+            :public method set {-partition_key key value} {
+                #
+                # Set some value in the cache. This code uses
+                # ns_cache_eval to achieve this behavior, which is
+                # typically a AOLserver idiom and should be avoided.
+                #
+                if {![info exists partition_key]} {
                     set partition_key $key
                 }
-		:uplevel [list ns_cache_eval -force -- [:cache_name $partition_key] $key [list set _ $value]]
-	    }
+                :uplevel [list ns_cache_eval -force -- [:cache_name $partition_key] $key [list set _ $value]]
+            }
 
-	    :public method flush_pattern {{-partition_key ""} pattern} {
-		#
-		# Flush in the cache a value based on a pattern
-		# operation. Use this function rarely, since on large
-		# caches (e.g. 100k entries or more) the glob
-		# operation will cause long locks, which should be
-		# avoided. The partitioned variants can help to reduce
-		# the lock times.
-		#
-		return [ns_cache_flush -glob [:cache_name $partition_key] $pattern]
-	    }
+            :public method flush_pattern {{-partition_key ""} pattern} {
+                #
+                # Flush in the cache a value based on a pattern
+                # operation. Use this function rarely, since on large
+                # caches (e.g. 100k entries or more) the glob
+                # operation will cause long locks, which should be
+                # avoided. The partitioned variants can help to reduce
+                # the lock times.
+                #
+                return [ns_cache_flush -glob [:cache_name $partition_key] $pattern]
+            }
 
-	    :method cache_create {name size} {
-		#
-		# Create a cache.
-		#
-		ns_cache_create \
-		    {*}[expr {[info exists :maxentry] ? "-maxentry ${:maxentry}" : ""}] \
-		    $name $size
-	    }
+            :method cache_create {name size} {
+                #
+                # Create a cache.
+                #
+                ns_cache_create \
+                    {*}[expr {[info exists :maxentry] ? "-maxentry ${:maxentry}" : ""}] \
+                    $name $size
+            }
 
-	} else {
-	    #
-	    # AOLserver variant
-	    #
-	    :public method eval {{-partition_key} {-expires:integer} key body} {
+        } else {
+            #
+            # AOLserver variant
+            #
+            :public method eval {{-partition_key} {-expires:integer} key body} {
                 #
                 # ignore "-expires", since not supported by AOLserver
                 #
-		if {![info exists partition_key]} {
+                if {![info exists partition_key]} {
                     set partition_key $key
                 }
-		try {
-		    :uplevel [list ns_cache eval [:cache_name $partition_key] $key $body]
-		} on break {r} {
-		    return 0
-		} on ok {r} {
-		    return $r
-		}
-	    }
-	    :public method set {-partition_key key value} {
-		if {![info exists partition_key]} {set partition_key $key}
-		:uplevel [list ns_cache set [:cache_name $partition_key] $key $value]
-	    }
-	    :public method flush_pattern {{-partition_key ""} pattern} {
-		foreach name [ns_cache names [:cache_name $partition_key] $pattern] {
-		    :flush -partition_key $partition_key $name
-		}
-	    }
-	    :public method flush_cache {{-partition_key ""}} {
-		ns_cache_flush [:cache_name $partition_key]
-	    }
-	    :method cache_create {name size} {
-		ns_cache create $name -size $size
-	    }
-	}
+                try {
+                    :uplevel [list ns_cache eval [:cache_name $partition_key] $key $body]
+                } on break {r} {
+                    return 0
+                } on ok {r} {
+                    return $r
+                }
+            }
+            :public method set {-partition_key key value} {
+                if {![info exists partition_key]} {set partition_key $key}
+                :uplevel [list ns_cache set [:cache_name $partition_key] $key $value]
+            }
+            :public method flush_pattern {{-partition_key ""} pattern} {
+                foreach name [ns_cache names [:cache_name $partition_key] $pattern] {
+                    :flush -partition_key $partition_key $name
+                }
+            }
+            :public method flush_cache {{-partition_key ""}} {
+                ns_cache_flush [:cache_name $partition_key]
+            }
+            :method cache_create {name size} {
+                ns_cache create $name -size $size
+            }
+        }
 
         :public method get {-partition_key key} {
             #
@@ -195,25 +195,25 @@
             #ns_log notice "... content of ${:name}: [ns_cache_keys ${:name}]"
         }
 
-	:public method flush_all {} {
+        :public method flush_all {} {
             #
             # Flush all contents of all (partitioned) caches. In the
             # case of a base ::acs::Cache, it is identical to
             # "flush_cash".
             #
-	    :flush_cache
-	}
+            :flush_cache
+        }
 
-	:public method init {} {
+        :public method init {} {
             #
             # If the name was not provided, use the object name as
             # default.
             #
             if {![info exists :name]} {
                 set :name [namespace tail [current]]
             }
-	    :cache_create ${:name} [:get_size]
-	}
+            :cache_create ${:name} [:get_size]
+        }
     }
 
     ##########################################################################
@@ -226,60 +226,60 @@
     ##########################################################################
 
     nx::Class create ::acs::PartitionedCache -superclasses ::acs::Cache {
-	:property {partitions:integer 1}
+        :property {partitions:integer 1}
 
-	:protected method cache_name {key:integer} {
+        :protected method cache_name {key:integer} {
             #
             # Return the cache_name always as the same Tcl_Obj (list
             # element) rather than concatenating always a fresh
             # Tcl_Obj dynamically the fly (type string). Caching the
             # cache structure in the dynamic Tcl_Obj can't not work.
             #
             return [lindex ${:partition_names} [expr {$key % ${:partitions}}]]
-	}
+        }
 
-	:public method init {} {
+        :public method init {} {
             #
             # If the name was not provided, use the object name as
             # default for the cache name.
             #
             if {![info exists :name]} {
                 set :name [namespace tail [current]]
             }
-	    set :partitions [::parameter::get_from_package_key \
-				-package_key ${:package_key} \
-				-parameter "${:parameter}Partitions" \
-				-default ${:partitions}]
-	    #
-	    # Create multiple separate caches depending on the
-	    # partitions. A PartitionedCache requires to have a
-	    # partitioning function that determines the nth partition
-	    # number from some partition_key.
-	    #
-	    set size [expr {[:get_size] / ${:partitions}}]
+            set :partitions [::parameter::get_from_package_key \
+                                -package_key ${:package_key} \
+                                -parameter "${:parameter}Partitions" \
+                                -default ${:partitions}]
+            #
+            # Create multiple separate caches depending on the
+            # partitions. A PartitionedCache requires to have a
+            # partitioning function that determines the nth partition
+            # number from some partition_key.
+            #
+            set size [expr {[:get_size] / ${:partitions}}]
             set :partition_names {}
-	    for {set i 0} {$i < ${:partitions}} {incr i} {
-                lappend :partition_names ${:name}-$i                
-		:cache_create ${:name}-$i $size
-	    }
-	}
+            for {set i 0} {$i < ${:partitions}} {incr i} {
+                lappend :partition_names ${:name}-$i
+                :cache_create ${:name}-$i $size
+            }
+        }
 
         :public method flush_all {{-partition_key ""}} {
             #
             # Flush all entries in all caches. Both, NaviServer and
             # AOLserver support "ns_cache_flush".
             #
             for {set i 0} {$i < ${:partitions}} {incr i} {
-		ns_cache_flush ${:name}-$i
+                ns_cache_flush ${:name}-$i
                 #ns_log notice "flush_all: ns_cache_flush ${:name}-$i"
                 #ns_log notice "... content of ${:name}-$i: [ns_cache_keys ${:name}-$i]"
-	    }
+            }
         }
 
         :public method show_all {} {
             for {set i 0} {$i < ${:partitions}} {incr i} {
                 ns_log notice "content of ${:name}-$i: [ns_cache_keys ${:name}-$i]"
-	    }
+            }
 
         }
 
@@ -295,23 +295,57 @@
     ##########################################################################
 
     nx::Class create ::acs::KeyPartitionedCache -superclasses ::acs::PartitionedCache {
-	:property {partitions:integer 1}
+        :property {partitions:integer 1}
 
-	:public method flush_pattern {{-partition_key:integer,required} pattern} {
-	    #
-	    # flush just in the determined partition
-	    #
-	    next
-	}
+        :public method flush_pattern {{-partition_key:integer,required} pattern} {
+            #
+            # flush just in the determined partition
+            #
+            next
+        }
 
-	:public method flush {{-partition_key:integer,required} key} {
-	    next
-	}
+        :public method flush {{-partition_key:integer,required} key} {
+            next
+        }
 
-	:public method set {{-partition_key:integer,required} key value} {
-	    next
-	}
+        :public method set {{-partition_key:integer,required} key value} {
+            next
+        }
     }
+
+    ##########################################################################
+    #
+    # Class for hash-key-partitioned caches
+    #
+    # Key-partitioning is based on a modulo function using a special
+    # partition_key, which has to be numeric - at least for the time being.
+    #
+    ##########################################################################
+
+    nx::Class create ::acs::HashKeyPartitionedCache -superclasses ::acs::KeyPartitionedCache {
+        :property {partitions:integer 2}
+
+        :public method flush_pattern {{-partition_key:required} pattern} {
+            #
+            # flush just in the determined partition
+            #
+            next [list -partition_key [ns_hash $partition_key] $pattern]
+        }
+
+        :public method flush {{-partition_key:required} key} {
+            next [list -partition_key [ns_hash $partition_key] $pattern]
+
+        }
+
+        :public method set {{-partition_key:required} key value} {
+            next [list -partition_key [ns_hash $partition_key] $pattern]
+        }
+
+        :protected method cache_name {key} {
+            next [list [ns_hash $key]]
+        }
+
+    }
 }
 
 
@@ -330,129 +364,129 @@
     ##########################################################################
 
     proc clusterwide args {
-	#
-	# First, execute the command on the local server.
-	#
-	eval $args
-	#
-	# Then, distribute the command to all servers in the cluster.
-	#
-	::acs::Cluster broadcast {*}$args
+        #
+        # First, execute the command on the local server.
+        #
+        eval $args
+        #
+        # Then, distribute the command to all servers in the cluster.
+        #
+        ::acs::Cluster broadcast {*}$args
     }
 
     proc cache_flush_all {cache pattern} {
-	# Provide means to perform a wildcard-based cache flushing on
-	# (cluster) machines.
-	foreach n [ns_cache names $cache $pattern] {ns_cache flush $cache $n}
+        # Provide means to perform a wildcard-based cache flushing on
+        # (cluster) machines.
+        foreach n [ns_cache names $cache $pattern] {ns_cache flush $cache $n}
     }
 
     nx::Class create Cluster {
-	:property host
-	:property {port 80}
+        :property host
+        :property {port 80}
 
-	set :allowed_host_patterns [list]
-	set :url /acs-cluster-do
-	array set :allowed_host { "127.0.0.1" 1 }
+        set :allowed_host_patterns [list]
+        set :url /acs-cluster-do
+        array set :allowed_host { "127.0.0.1" 1 }
 
-	#
-	# The allowed commands are of the form
-	#   - command names followed by
-	#   - optional "except patterns"
-	#
-	set :allowed_command {
-	    set ""
-	    unset ""
-	    nsv_set ""
-	    nsv_unset ""
-	    nsv_incr ""
-	    bgdelivery ""
-	    ns_cache "^ns_cache\s+eval"
-	    ns_cache_flush ""
-	    acs::cache_flush_all ""
-	}
+        #
+        # The allowed commands are of the form
+        #   - command names followed by
+        #   - optional "except patterns"
+        #
+        set :allowed_command {
+            set ""
+            unset ""
+            nsv_set ""
+            nsv_unset ""
+            nsv_incr ""
+            bgdelivery ""
+            ns_cache "^ns_cache\s+eval"
+            ns_cache_flush ""
+            acs::cache_flush_all ""
+        }
 
-	#
-	# handling the ns_filter methods
-	#
-	:public object method trace args {
-	    :log ""
-	    return filter_return
-	}
+        #
+        # handling the ns_filter methods
+        #
+        :public object method trace args {
+            :log ""
+            return filter_return
+        }
 
-	:public object method preauth args {
-	    :log ""
-	    :incoming_request
-	    return filter_return
-	}
+        :public object method preauth args {
+            :log ""
+            :incoming_request
+            return filter_return
+        }
 
-	:public object method postauth args {
-	    :log ""
-	    return filter_return
-	}
+        :public object method postauth args {
+            :log ""
+            return filter_return
+        }
 
-	#
-	# handle incoming request issues
-	#
-	:public object method  incoming_request {} {
-	    set cmd [ns_queryget cmd]
-	    set addr [lindex [ns_set iget [ns_conn headers] x-forwarded-for] end]
-	    if {$addr eq ""} {set addr [ns_conn peeraddr]}
-	    #ns_log notice "--cluster got cmd='$cmd' from $addr"
-	    ad_try {
-		set result [::acs::Cluster execute [ns_conn peeraddr] $cmd]
-	    } on error {errorMsg} {
-		ns_log notice "--cluster error: $errorMsg"
-		ns_return 417 text/plain $errorMsg
-	    } on ok {r} {
-		#ns_log notice "--cluster success $result"
-		ns_return 200 text/plain $result
-	    }
-	}
+        #
+        # handle incoming request issues
+        #
+        :public object method  incoming_request {} {
+            set cmd [ns_queryget cmd]
+            set addr [lindex [ns_set iget [ns_conn headers] x-forwarded-for] end]
+            if {$addr eq ""} {set addr [ns_conn peeraddr]}
+            #ns_log notice "--cluster got cmd='$cmd' from $addr"
+            ad_try {
+                set result [::acs::Cluster execute [ns_conn peeraddr] $cmd]
+            } on error {errorMsg} {
+                ns_log notice "--cluster error: $errorMsg"
+                ns_return 417 text/plain $errorMsg
+            } on ok {r} {
+                #ns_log notice "--cluster success $result"
+                ns_return 200 text/plain $result
+            }
+        }
 
-	#
-	# Handling outgoing requests
-	#
-	:public object method execute {host cmd} {
-	    if {![info exists :allowed_host($host)]} {
-		set ok 0
-		foreach g ${:allowed_host_patterns} {
-		    if {[string match $g $host]} {
-			set ok 1
-			break
-		    }
-		}
-		if {!$ok} {
-		    error "refuse to execute commands from $host (command: '$cmd')"
-		}
-	    }
-	    set cmd_name [lindex $cmd 0]
-	    set key allowed_command($cmd_name)
-	    #ns_log notice "--cluster $key exists ? [info exists :$key]"
-	    if {[info exists :$key]} {
-		set except_RE [set :$key]
-		#ns_log notice "--cluster [list regexp $except_RE $cmd] -> [regexp $except_RE $cmd]"
-		if {$except_RE eq "" || ![regexp $except_RE $cmd]} {
-		    ns_log notice "--cluster executes command '$cmd' from host $host"
-		    return [eval $cmd]
-		}
-	    }
-	    error "command '$cmd' from host $host not allowed"
-	}
+        #
+        # Handling outgoing requests
+        #
+        :public object method execute {host cmd} {
+            if {![info exists :allowed_host($host)]} {
+                set ok 0
+                foreach g ${:allowed_host_patterns} {
+                    if {[string match $g $host]} {
+                        set ok 1
+                        break
+                    }
+                }
+                if {!$ok} {
+                    error "refuse to execute commands from $host (command: '$cmd')"
+                }
+            }
+            set cmd_name [lindex $cmd 0]
+            set key allowed_command($cmd_name)
+            #ns_log notice "--cluster $key exists ? [info exists :$key]"
+            if {[info exists :$key]} {
+                set except_RE [set :$key]
+                #ns_log notice "--cluster [list regexp $except_RE $cmd] -> [regexp $except_RE $cmd]"
+                if {$except_RE eq "" || ![regexp $except_RE $cmd]} {
+                    ns_log notice "--cluster executes command '$cmd' from host $host"
+                    return [eval $cmd]
+                }
+            }
+            error "command '$cmd' from host $host not allowed"
+        }
 
-	#
-	# Handling outgoing requests
-	#
-	:public object method broadcast args {
-	    foreach server [:info instances] {
-		$server message {*}$args
-	    }
-	}
+        #
+        # Handling outgoing requests
+        #
+        :public object method broadcast args {
+            foreach server [:info instances] {
+                $server message {*}$args
+            }
+        }
 
-	:public object method message args {
-	    :log "--cluster outgoing request to [:host]:[:port] // $args"
+        :public object method message args {
+            :log "--cluster outgoing request to [:host]:[:port] // $args"
 
-	    utl::http::get -url http://[:host]:[:port]/[:url]?cmd=[ns_urlencode $args]
-	}
+            utl::http::get -url http://[:host]:[:port]/[:url]?cmd=[ns_urlencode $args]
+        }
     }
 }
 
Index: openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl,v
diff -u -r1.141.2.13 -r1.141.2.14
--- openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl	27 Feb 2020 21:48:39 -0000	1.141.2.13
+++ openacs-4/packages/acs-tcl/tcl/site-nodes-procs.tcl	30 Mar 2020 19:30:39 -0000	1.141.2.14
@@ -1331,12 +1331,23 @@
                 -package_key acs-tcl \
                 -parameter SiteNodesCache \
                 -default_size 2000000
+            #
+            # In case we have "ns_hash" defined, we can use the
+            # "HashKeyPartitionedCache". Otherwise fall back to the
+            # plain cache.
+            #
+            if {[::acs::icanuse "ns_hash"]} {
+                ::acs::HashKeyPartitionedCache create ::acs::site_nodes_id_cache \
+                    -package_key acs-tcl \
+                    -parameter SiteNodesIdCache \
+                    -default_size 100000
+            } else {
+                ::acs::Cache create ::acs::site_nodes_id_cache \
+                    -package_key acs-tcl \
+                    -parameter SiteNodesIdCache \
+                    -default_size 100000
+            }
 
-            ::acs::Cache create ::acs::site_nodes_id_cache \
-                -package_key acs-tcl \
-                -parameter SiteNodesIdCache \
-                -default_size 100000
-
             ::acs::KeyPartitionedCache create ::acs::site_nodes_children_cache \
                 -package_key acs-tcl \
                 -parameter SiteNodesChildenCache \
@@ -1452,15 +1463,15 @@
                 #
 
                 :flush_per_request_cache
-                
+
                 switch -glob -- $pattern {
                     id-*           {set cache site_nodes_id_cache}
                     get_children-* {set cache site_nodes_children_cache}
                     default        {set cache site_nodes_cache}
                 }
                 ::acs::$cache flush_pattern -partition_key $partition_key $pattern
             }
-            
+
             :public method flush_cache {-node_id:required,1..1 {-with_subtree:boolean true} {-url ""}} {
                 #
                 # Flush entries from site-node tree, including the current node,