Index: openacs-4/packages/acs-tcl/tcl/server-cluster-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/server-cluster-procs.tcl,v
diff -u -N -r1.10.2.6 -r1.10.2.7
--- openacs-4/packages/acs-tcl/tcl/server-cluster-procs.tcl	14 Jun 2022 17:59:36 -0000	1.10.2.6
+++ openacs-4/packages/acs-tcl/tcl/server-cluster-procs.tcl	7 Feb 2023 17:50:32 -0000	1.10.2.7
@@ -6,7 +6,11 @@
     @creation-date 7 Mar 2000
 }
 
-ad_proc server_cluster_enabled_p {} { Returns true if clustering is enabled. } {
+ad_proc server_cluster_enabled_p {} {
+
+    Returns true if clustering is enabled.
+
+} {
     return [parameter::get \
                 -package_id $::acs::kernel_id \
                 -parameter ClusterEnabledP \
@@ -15,114 +19,40 @@
 
 ad_proc server_cluster_all_hosts {} {
 
-    Returns a list of all hosts, possibly including this host, in the
-    server cluster.
+    Returns a list of all hosts in the server cluster, possibly
+    including the current host.
 
 } {
     if { ![server_cluster_enabled_p] } {
         return {}
     }
-    return [parameter::get -package_id $::acs::kernel_id -parameter ClusterPeerIP]
-}
+    #
+    # For now, include the CanonicalServer as well in the all_hosts
+    # list, since the eases the configuration. Later, we might want to
+    # have a canonical server, which is not a worker node, so it would
+    # not need to receive all the cache-flush operations.
+    #
+    set nodes [lsort -unique [concat \
+                                  [parameter::get -package_id $::acs::kernel_id -parameter CanonicalServer] \
+                                  [parameter::get -package_id $::acs::kernel_id -parameter ClusterPeerIP] \
+                                  [parameter::get -package_id $::acs::kernel_id -parameter DynamicClusterPeers] ]]
 
-ad_proc server_cluster_peer_hosts {} {
-
-    Returns a list of all hosts, excluding this host, in the server cluster.
-
-} {
-    return [lmap cluster_server [::acs::Cluster info instances] {
-        util::join_location \
-            -hostname [$cluster_server cget -host] \
-            -port [$cluster_server cget -port]
-    }]
+    #ns_log notice "server_cluster_all_hosts returns <$nodes>"
+    return $nodes
 }
 
-ad_proc server_cluster_authorized_p { ip } {
-
-    Can a request coming from $ip be a valid cluster request, i.e.,
-    matches some value in ClusterAuthorizedIP or is 127.0.0.1?
-
-} {
-    if { ![server_cluster_enabled_p] } {
-        return 0
-    }
-
-    if { $ip == "127.0.0.1" } {
-        return 1
-    }
-
-    foreach glob [parameter::get -package_id $::acs::kernel_id -parameter ClusterAuthorizedIP] {
-        if { [string match $glob $ip] } {
-            return 1
-        }
-    }
-    return 0
-}
-
-ad_proc -private server_cluster_my_config {} {
-} {
-    set driver_section [ns_driversection -driver nssock]
-    set my_ips   [ns_config $driver_section address]
-    set my_ports [ns_config -int $driver_section port]
-    return [list host $my_ips port $my_ports]
-}
-
-ad_proc -private server_cluster_get_config {location} {
-    Return a dict parsed from the host and port spec.
-    If no port is specified, it defaults to 80.
-    If no scheme is specified, it defaults to "http".
-    In case the hostname is provided as an DNS name, it is resolved.
-
-    @param location location (e.g., https://localhost:8443) or just host with optional port
-    @return dict containing proto, host, and port
-} {
-    set d {port 80 proto http}
-    if {[regexp  {^([^:]+)://} $location . proto]} {
-        if {$proto eq "https"} {
-            set d {port 443 proto https}
-        }
-        set d [dict merge $d [ns_parseurl $location]]
-        dict unset d tail
-        dict unset d path
-    } else {
-        set d [dict merge $d [ns_parsehostport $location]]
-    }
-    dict set d host [ns_addrbyhost [dict get $d host]]
-    return $d
-}
-
-
 ad_proc -private ad_canonical_server_p {} {
 
     Returns true if this is the primary (called historically
     "canonical") server, false otherwise.
 
-    Since the server can listen to multiple IP addresses and on
-    multiple ports, all of these have to be checked.
+    This function is e.g. used to determine, whether scheduled
+    procedures are run on the current node.
+
+    @return boolean value
 } {
-    set canonical_server [parameter::get -package_id $::acs::kernel_id -parameter CanonicalServer]
-    if { $canonical_server eq "" } {
-        ns_log Error "Your configuration is not correct for server clustering." \
-            "Please ensure that you have the CanonicalServer parameter set correctly."
-        return 1
-    }
 
-    set myConfig [server_cluster_my_config]
-    set canonicalConfig [server_cluster_get_config $canonical_server]
-    #
-    # Both, myConfig and canonicalConfig can contain multiple IP
-    # addressen and ports.
-    #
-    foreach my_ip [dict get $myConfig host] {
-        foreach my_port [dict get $myConfig port] {
-            dict with canonicalConfig {
-                if {$my_ip in $host && $my_port in $port} {
-                    return 1
-                }
-            }
-        }
-    }
-    return 0
+    return [::acs::cluster current_server_is_canonical_server]
 }
 
 # Local variables: