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.11
--- 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	3 Sep 2024 15:37:34 -0000	1.11
@@ -27,145 +27,172 @@
     ##########################################################################
 
     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 {timeout 5m}
+        :property {default_size 100KB}
 
-	: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.
+            #
+            set specifiedSize [::parameter::get_from_package_key \
+                                   -package_key ${:package_key} \
+                                   -parameter "${:parameter}Size" \
+                                   -default ${:default_size}]
+            if {[::nsf::is integer $specifiedSize]} {
+                set size $specifiedSize
+            } else {
+                set size [ns_baseunit -size $specifiedSize]
+            }
+            return $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 {[namespace which ns_cache_eval] ne ""} {
+            #
+            # NaviServer variant
+            #
+            :public method eval {{-partition_key} {-expires} {-timeout} {-per_request:switch} key command} {
+                #
+                # Evaluate the command unless it is cached.
+                #
+                # @param expires (passed straight through to NaviServer)
+                # @param partition_key Used for determining the cache
+                #        name in partitioned caches
+                # @param per_request when set, cache the result per
+                #        request. So far, no attempt is made to flush
+                #        the result inside the request.
+                #
+                if {![info exists partition_key]} {
                     set partition_key $key
                 }
-		if {[info exists expires]} {
-                    set expires_flag [list -expires $expires]
-                } else {
-                    set expires_flag {}
+                foreach optional_parameter {expires timeout} {
+                    if {[info exists $optional_parameter]} {
+                        set ${optional_parameter}_flag [list -$optional_parameter [set $optional_parameter]]
+                    } else {
+                        set ${optional_parameter}_flag ""
+                    }
                 }
+                set cache_name [:cache_name $partition_key]
+                try {
+                    if {$per_request} {
+                        acs::per_request_cache eval -key ::acs-${cache_name}($key) {
+                            :uplevel [list ns_cache_eval \
+                                          {*}$expires_flag {*}$timeout_flag -- \
+                                          $cache_name $key $command]
+                        }
+                    } else {
+                        :uplevel [list ns_cache_eval {*}$expires_flag {*}$timeout_flag -- \
+                                      $cache_name $key $command]
+                    }
 
-		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 an 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 [::acs::clusterwide 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 \
+                    -timeout ${:timeout} \
+                    {*}[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}  {-timeout} {-per_request:switch} key command} {
                 #
                 # ignore "-expires", since not supported by AOLserver
+                # ignore "-timeout", since not supported by AOLserver
+                # ignore "-per_request" optimization so far
                 #
-		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 $command]
+                } 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} {
             #
@@ -190,30 +217,30 @@
             # Flush all entries in a cache. Both, NaviServer and
             # AOLserver support "ns_cache_flush".
             #
-            ns_cache_flush [:cache_name $partition_key]
+            ::acs::clusterwide ns_cache_flush [:cache_name $partition_key]
             #ns_log notice "flush_all -> ns_cache_flush [:cache_name $partition_key]"
             #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 +253,88 @@
     ##########################################################################
 
     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".
+            # Flush all entries in all partitions of a cache. Both,
+            # NaviServer and AOLserver support "ns_cache_flush".
             #
             for {set i 0} {$i < ${:partitions}} {incr i} {
-		ns_cache_flush ${:name}-$i
+                ::acs::clusterwide 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]"
-	    }
+            }
         }
 
+        if {[namespace which ns_cache_eval] ne ""} {
+            #
+            # NaviServer variant
+            #
+            :method flush_pattern_in_all_partitions {pattern} {
+                #
+                # Flush matching entries in all partitions of a cache based on
+                # a pattern.
+                #
+                for {set i 0} {$i < ${:partitions}} {incr i} {
+                    ::acs::clusterwide ns_cache_flush -glob ${:name}-$i $pattern
+                    ns_log notice "flush_pattern_in_all_partitions: ns_cache_flush ${:name}-$i $pattern"
+                    #ns_log notice "... content of ${:name}-$i: [ns_cache_keys ${:name}-$i]"
+                }
+            }
+        } else {
+            #
+            # AOLserver variant
+            #
+            :method flush_pattern_in_all_partitions {pattern} {
+                for {set i 0} {$i < ${:partitions}} {incr i} {
+                    foreach name [ns_cache names ${:name}-$i $pattern] {
+                        :flush -partition_key $partition_key $name
+                    }
+                }
+            }
+        }
+
         :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,169 +350,351 @@
     ##########################################################################
 
     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
+        }
     }
-}
 
-
-namespace eval ::acs {
     ##########################################################################
     #
-    # Cluster Management
+    # Class for hash-key-partitioned caches
     #
-    # If a site is running a cluster of OpenACS systems, certain
-    # commands have to be executed on cluster nodes (e.g. flushing
-    # caches, etc). A cluster setup is currently not commonly used and
-    # requires probably some more work, but the code here provides a
-    # basic infrastructure. It is a good practice to flag commands to
-    # be executed on all cluster nodes in the code with
-    # ::acs::clusterwide.
+    # Key-partitioning is based on a modulo function using a special
+    # partition_key, which has to be numeric - at least for the time being.
+    #
     ##########################################################################
 
-    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
-    }
+    nx::Class create ::acs::HashKeyPartitionedCache -superclasses ::acs::KeyPartitionedCache {
+        :property {partitions:integer 2}
 
-    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}
+        :public method flush_pattern {{-partition_key:required} pattern} {
+            #
+            # flush just in all partitions
+            #
+            :flush_pattern_in_all_partitions $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]]
+        }
+
     }
+}
 
-    nx::Class create Cluster {
-	:property host
-	:property {port 80}
+namespace eval ::acs {
+    ##########################################################################
+    #
+    # ::acs::LockfreeCache: Per-thread and per-request Cache
+    #
+    # Lockfree cache are provided either as per-thread caches or
+    # per-request caches, sharing the property that accessing these
+    # values does not require locks.
+    #
+    # The per-thread caches use namespaced variables, which are not
+    # touched by the automatic cleanup routines of the server. So, the
+    # values cached in one requests can be used by some later request
+    # in the same thread. The entries are kept in per-thread caches as
+    # long as the thread lives, there is so far no automatic mechanism
+    # to flush these. So, per-thread caches are typically used for
+    # values fetched from the database, which do not change, unless
+    # the server is restarted.
+    #
+    # Per-request caches have very short-lived entries. Some values
+    # are needed multiple times per request, and/or they should show
+    # consistently the same value during the same request, no matter,
+    # if concurrently, a value is changed (e.g. permissions).
+    #
+    # Note: the usage of per-thread caches is only recommended for
+    # static values, which do no change during the life time of the
+    # server, since there is so far no automatic measure in place to
+    # the flush values in every thread.
+    #
+    ##########################################################################
+    nx::Class create ::acs::LockfreeCache {
+        :property {prefix}
 
-	set :allowed_host_patterns [list]
-	set :url /acs-cluster-do
-	array set :allowed_host { "127.0.0.1" 1 }
+        :public method get {
+            {-key:required}
+            var
+        } {
+            #
+            # Get entry with the provided key from this cache if it
+            # exists. In most cases, the "eval" method should be used.
+            #
+            # @param key cache key
+            # @return return boolean value indicating success.
+            #
+            if {[info exists ${:prefix}] && [dict exists [set ${:prefix}] $key]} {
+                :upvar $var value
+                set value [dict get [set ${:prefix}] $key]
+                return 1
+            }
+            return 0
+        }
 
-	#
-	# 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 ""
-	}
+        :public method eval {
+            {-key:required}
+            {-no_cache}
+            {-no_empty:switch false}
+            {-from_cache_indicator}
+            cmd
+        } {
+            #
+            # Use the "prefix" to determine whether the cache is
+            # per-thread or per-request.
+            #
+            # @param key key for caching, should start with package-key
+            #            and a dot to avoid name clashes
+            # @param cmd command to be executed.
+            # @param no_empty don't cache empty values. This flag is
+            #        deprecated, one should use the no_cache flag
+            #        instead.
+            # @param no_cache list of returned values that should not be cached
+            # @param from_cache_indicator variable name to indicate whether
+            #        the returned value was from cache or not
+            #
+            # @return return the last value set (don't use "return").
+            #
+            #set cache_key ${:prefix}$key
+            #ns_log notice "### exists $cache_key => [dict exists ${:prefix} $key]"
+            if {[info exists from_cache_indicator]} {
+                :upvar $from_cache_indicator from_cache
+            }
 
-	#
-	# handling the ns_filter methods
-	#
-	:public object method trace args {
-	    :log ""
-	    return filter_return
-	}
+            if {![info exists ${:prefix}] || ![dict exists [set ${:prefix}] $key]} {
+                #ns_log notice "### call cmd <$cmd>"
+                set from_cache 0
+                set value [:uplevel $cmd]
+                if {$no_empty} {
+                    ad_log warning "no_empty flag is deprecated and will be dropped in the future."
+                    lappend no_cache ""
+                }
+                if {[info exists no_cache] && $value in $no_cache} {
+                    #ns_log notice "### cache eval $key returns <$value> without caching"
+                    return $value
+                }
+                #if {$value eq "0"} {
+                #    ns_log notice "### cache eval $key returns <$value> with caching"
+                #}
+                dict set ${:prefix} $key $value
+                #ns_log notice "### [list dict set ${:prefix} $key $value]"
+            } else {
+                set from_cache 1
+                set value [dict get [set ${:prefix}] $key]
+            }
+            #ns_log notice "### will return [list dict get ${:prefix} $key]"
+            return $value
+        }
 
-	:public object method preauth args {
-	    :log ""
-	    :incoming_request
-	    return filter_return
-	}
+        #:public method flush {
+        #   {-pattern *}
+        #} {
+        #    #
+        #    # Flush a cache entry based on the pattern (which might be
+        #    # wild-card-free).
+        #    #
+        #    ::acs::clusterwide [self] flush_local -pattern $pattern
+        #}
 
-	:public object method postauth args {
-	    :log ""
-	    return filter_return
-	}
+        :public method flush {
+           {-pattern *}
+        } {
+            #
+            # Flush a cache entry based on the pattern (which might be
+            # wild-card-free). Currently, the clusterwide flushing is
+            # omitted.
+            #
+            # We have the per-request cache (clusterwide operations do
+            # not make sense for this) and per-thread caching. The
+            # per-thread caching application have to be aware that
+            # flushing is happening only in one thread, so clusterwide
+            # operations will only start to make sense, when the all
+            # threads of a server would be cleaned.
+            #
+            if {[info exists ${:prefix}]} {
+                if {$pattern eq "*"} {
+                    #ns_log notice "### dict flush ${:prefix} <$pattern>"
+                    unset -nocomplain ${:prefix}
+                } elseif {[string first "*" $pattern] != -1} {
+                    #
+                    # A real pattern with wild-card was provided.
+                    #
+                    set keys [dict keys [set ${:prefix}] $pattern]
+                    #ns_log notice "### dict flush ${:prefix} <$pattern> -> [llength $keys]"
+                    foreach key $keys {
+                        dict unset ${:prefix} $key
+                    }
+                } elseif [dict exists [set ${:prefix}] $pattern] {
+                    #
+                    # A "pattern" without a wildcard was provided
+                    #
+                    dict unset ${:prefix} $pattern
+                }
+            }
+        }
 
-	#
-	# 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
-	    }
-	}
+        #
+        # The per-request cache uses Tcl variables in the global
+        # namespace, such they are automatically reclaimed after the
+        # request. These use the prefix "::__acs_cache"
+        #
+        :create per_request_cache -prefix ::__acs_cache
 
-	#
-	# 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"
-	}
+        #
+        # Define the "per_thread_cache"
+        #
+        if {[ns_config "ns/parameters" cachingmode "per-node"] eq "none"} {
+            #
+            # If caching mode is "none", let the "per_thread_cache" behave
+            # like the "per_request_cache".
+            #
+            :create per_thread_cache -prefix ::__acs_cache
+            ns_log notice "cachingmode [ns_config "ns/parameters" cachingmode singlenode]" \
+                "-> per_thread_cache behaves like per-request_cache"
 
-	#
-	# Handling outgoing requests
-	#
-	:public object method broadcast args {
-	    foreach server [:info instances] {
-		$server message {*}$args
-	    }
-	}
+        } else {
+            #
+            # The per-thread cache uses namespaced Tcl variables, identified
+            # by the prefix "::acs:cache"
+            #
+            :create per_thread_cache -prefix ::acs::cache
+        }
+    }
+    namespace eval ::acs::cache {}
+}
 
-	:public object method message args {
-	    :log "--cluster outgoing request to [:host]:[:port] // $args"
+namespace eval ::acs {
+    ad_proc -private try_cache {cache operation args} {
 
-	    utl::http::get -url http://[:host]:[:port]/[:url]?cmd=[ns_urlencode $args]
-	}
+        Function to support caching during bootstrap.  When the
+        provided cache exists, then use it for caching, otherwise
+        perform uncalled call. This function is made intentionally
+        private, since this should only be required during
+        bootstrapping. It does not make sense to wrap arbitrary caching
+        calls with this function.
+
+    } {
+        if {
+            [namespace which $cache] ne "" &&
+            [$cache info lookup methods $operation] ne ""
+        } {
+            return [uplevel 1 [list $cache $operation {*}$args]]
+        } else {
+            #
+            # Complain only, when
+            # a) not during initial install, and
+            # b) if this is not during startup of an installed version
+            #
+            set complain_p [expr {[ns_ictl epoch] > 0 && [nsv_names acs_installer] eq ""}]
+            if {$operation eq "eval"} {
+                nsf::parseargs {{-partition_key} {-expires} {-per_request:switch} key command} $args
+                if {$complain_p} {
+                    ns_log warning "no cache $cache: need direct call $key $args"
+                }
+                #ns_log warning "no cache $cache: need direct call $key [info exists partition_key] <$command>"
+                return [uplevel 1 $command]
+            }
+            if {$complain_p} {
+                ns_log warning "no cache $cache: call ignored"
+            }
+        }
     }
 }
 
+namespace eval ::acs {
+    #
+    # Experimental disk-cache, to test whether this can speed up long
+    # calls, producing potentially large output ..
+    #
+    # The interface should be probably streamlined with the other
+    # chaching infrastructure.
+    #
+    # Documentation follows.
 
+    if { [apm_first_time_loading_p] } {
+        nsv_set ad_disk_cache mutex [ns_mutex create disk_cache]
+    }
 
+    ad_proc -public disk_cache_flush {
+        -key:required
+        -id:required
+    } {
+        Flushes the filesystem cache.
+
+        @param key the key used to name the directory where the disk cache
+               is stored.
+        @param id the id used to name the file where the disk cache is
+               stored.
+
+        @see acs::disk_cache_eval
+    } {
+        set dir [ad_tmpdir]/oacs-cache/$key
+        foreach file [glob -nocomplain $dir/$id-*] {
+            file delete -- $file
+            ns_log notice "FLUSH file delete -- $file"
+        }
+    }
+
+    ad_proc -public disk_cache_eval {
+        -call:required
+        -key:required
+        -id:required
+    } {
+        Evaluate an expression. When the acs-tcl.DiskCache parameter is
+        set, cache the result on the disk. If a cache already exists,
+        return the cached value.
+
+        @param call a Tcl snippet executed in the caller scope.
+        @param key a key used to name the directory where the disk cache
+               will be stored.
+        @param id an id used to name the file where the disk cache will be
+              stored. The name will also depend on a hash of the
+              actual snippet.
+    } {
+        set cache [::parameter::get_from_package_key \
+                       -package_key acs-tcl \
+                       -parameter DiskCache \
+                       -default 1]
+        if {$cache} {
+            set hash [ns_sha1 $call]
+            set dir [ad_tmpdir]/oacs-cache/$key
+            set file_name $dir/$id-$hash
+            if {![ad_file isdirectory $dir]} {
+                file mkdir $dir
+            }
+            ns_mutex eval [nsv_get ad_disk_cache mutex] {
+                if {[ad_file readable $file_name]} {
+                    set result [template::util::read_file $file_name]
+                } else {
+                    set result [uplevel $call]
+                    template::util::write_file $file_name $result
+                }
+            }
+        } else {
+            set result [uplevel $call]
+        }
+        return $result
+    }
+}
+
+
 # Local variables:
 #    mode: tcl
 #    tcl-indent-level: 4