Index: openacs-4/packages/acs-admin/acs-admin.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/acs-admin.info,v diff -u -N -r1.58.2.11 -r1.58.2.12 --- openacs-4/packages/acs-admin/acs-admin.info 1 Nov 2022 16:06:51 -0000 1.58.2.11 +++ openacs-4/packages/acs-admin/acs-admin.info 8 Feb 2023 18:35:05 -0000 1.58.2.12 @@ -9,7 +9,7 @@ f t - + Don Baccus An interface for Site-wide administration of an OpenACS Installation. 2021-09-15 @@ -20,9 +20,9 @@ GPL 3 - + - + Index: openacs-4/packages/acs-admin/www/cluster.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/Attic/cluster.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-admin/www/cluster.adp 8 Feb 2023 18:35:05 -0000 1.1.2.1 @@ -0,0 +1,16 @@ + +@page_title;literal@ +@context;literal@ + +

@page_title@

+ + +

Server Cluster is not enabled

+ + + Current node: @current_node@
+

+ + + + Index: openacs-4/packages/acs-admin/www/cluster.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/Attic/cluster.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/acs-admin/www/cluster.tcl 8 Feb 2023 18:35:05 -0000 1.1.2.1 @@ -0,0 +1,151 @@ +ad_page_contract { + @author Gustaf Neumann + + @creation-date Feb 8, 2023 +} { + {drop_node:nohtml,notnull ""} + {flush_node:nohtml,notnull ""} +} + +set page_title "Cluster Management" +set context [list $page_title] + +set server_cluster_enabled_p [server_cluster_enabled_p] +set dynamic_cluster_nodes [lsort [parameter::get -package_id $::acs::kernel_id -parameter DynamicClusterPeers]] + + +if {$drop_node ne ""} { + # + # Drop the provided node from DynamicClusterPeers + # + set p [lsearch $dynamic_cluster_nodes $drop_node] + if {$p != -1} { + set cluster_nodes [lreplace $dynamic_cluster_nodes $p $p] + parameter::set_value \ + -package_id $::acs::kernel_id \ + -parameter DynamicClusterPeers \ + -value $cluster_nodes + } else { + ns_log warning "cluster: provided node '$drop_node' is not in the" \ + "dynamic cluster configuration: $dynamic_cluster_nodes" + } + set done 1 +} elseif {$flush_node ne ""} { + # + # The following command might send the request to the current + # server. + # + acs::cluster send $flush_node acs::cache_flush_all + set done 1 +} +if {[info exists done]} { + ad_returnredirect ./cluster + ad_script_abort +} + + +if {$server_cluster_enabled_p} { + set nsstats_location $::acs::rootdir/packages/acs-subsite/www/admin/nsstats.tcl + set nsstats_available_p [file readable $nsstats_location] + + set current_node [acs::cluster cget -currentServerLocation] + set all_cluster_hosts [server_cluster_all_hosts] + set active_peer_nodes [lsort [nsv_get cluster cluster_peer_nodes]] + + set elements_list { + node_name { + label "Node" + orderby node_name + display_template { + @cluster_nodes.node_name@ (current) + @cluster_nodes.node_name@ + + } + html {style {white-space:nowrap;}} + } + canonical_p { + label "Canonical" + html {align center} + } + dynamic_p { + label "Dynamic" + html {align center} + } + peer_p { + label "Peer" + html {align center} + } + last_contact { + label "Last Contact" + orderby last_contact + display_template {@cluster_nodes.pretty_last_contact@} + html {align right style {white-space:nowrap;}} + } + last_request { + label "Last Request" + orderby last_request + display_template {@cluster_nodes.pretty_last_request@} + html {align right style {white-space:nowrap;}} + } + actions { + label "Actions" + html {style {white-space:nowrap;}} + display_template { +   + +   + +   + + + + + } + } + } + + multirow create cluster_nodes node_name current_p \ + canonical_p dynamic_p peer_p \ + last_contact pretty_last_contact \ + last_request pretty_last_request \ + nsstats_available_p + + template::list::create -name cluster_nodes \ + -multirow cluster_nodes \ + -key node_name \ + -no_data "No Cluster Nodes are known." \ + -elements $elements_list + + foreach node $all_cluster_hosts { + foreach var {last_contact last_request} { + set value [set $var [acs::cluster $var $node]] + set pretty_$var $value + if {$value ne ""} { + set seconds [expr {$value/1000}] + if {[nsf::is object ::xowiki::utility]} { + set pretty_$var [::xowiki::utility pretty_age -timestamp $seconds] + } else { + set pretty_$var "[expr {[clock seconds]-$seconds}]s ago" + } + } + } + + multirow append cluster_nodes $node \ + [expr {$node eq $current_node}] \ + [acs::cluster is_canonical_server $node] \ + [expr {$node in $dynamic_cluster_nodes}] \ + [expr {$node in $active_peer_nodes}] \ + $last_contact $pretty_last_contact \ + $last_request $pretty_last_request \ + $nsstats_available_p + } +} + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/acs-admin/www/subsites.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-admin/www/subsites.tcl,v diff -u -N -r1.5.2.5 -r1.5.2.6 --- openacs-4/packages/acs-admin/www/subsites.tcl 28 Nov 2022 10:24:13 -0000 1.5.2.5 +++ openacs-4/packages/acs-admin/www/subsites.tcl 8 Feb 2023 18:35:05 -0000 1.5.2.6 @@ -78,7 +78,7 @@ display_template { -   +     } 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 -N -r1.95.2.57 -r1.95.2.58 --- openacs-4/packages/acs-tcl/acs-tcl.info 7 Feb 2023 17:50:31 -0000 1.95.2.57 +++ openacs-4/packages/acs-tcl/acs-tcl.info 8 Feb 2023 18:35:04 -0000 1.95.2.58 @@ -9,7 +9,7 @@ f t - + OpenACS

The Kernel Tcl API library. 2021-09-15 @@ -18,7 +18,7 @@ GPL version 2 3 - + Index: openacs-4/packages/acs-tcl/tcl/cluster-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/Attic/cluster-procs.tcl,v diff -u -N -r1.1.2.5 -r1.1.2.6 --- openacs-4/packages/acs-tcl/tcl/cluster-procs.tcl 7 Feb 2023 17:50:32 -0000 1.1.2.5 +++ openacs-4/packages/acs-tcl/tcl/cluster-procs.tcl 8 Feb 2023 18:35:05 -0000 1.1.2.6 @@ -66,12 +66,9 @@ #::nsf::method::property nx::Class method debug on nx::Class create Cluster { - :property {proto http} - :property host - :property {port 80} :property {url /acs-cluster-do} + :property {currentServerLocation ""} - # set cls [nx::Class create ::acs::ClusterMethodMixin { # :method "object method" args { # ns_log notice "[self] define object method $args" @@ -362,23 +359,22 @@ :public method last_contact {location} { # - # Return the number of seconds since the last contact with - # the denoted server. If there is no data available, + # Return the millseconds since the last contact + # with the denoted server. If there is no data available, # the return values is empty. # if {[nsv_get cluster $location-last-contact clicksms]} { - return [expr {([clock clicks -milliseconds] - $clicksms)/1000.0}] + return $clicksms } } :public method last_request {location} { # - # Return the number of seconds since the last request from - # the denoted server. If there is no data available, - # the return values is empty. + # Return the millseconds since the last request from the + # denoted server. If there is no data available, the + # return values is empty. # - ns_log notice "check last-request <$location-last-request>" if {[nsv_get cluster $location-last-request clicksms]} { - return [expr {([clock clicks -milliseconds] - $clicksms)/1000.0}] + return $clicksms } } @@ -446,7 +442,7 @@ return 0 } - :method is_canonical_server {location} { + :public method is_canonical_server {location} { # # Check, if provided location belongs to the the canonical # server specs. The canonical server might listen on @@ -617,7 +613,7 @@ # sync. Therefore, we have lost confidence in our # caches and clear these. # - :log "send_join_request returned $body, flushing all my caches" + :log "send_join_request returned [dict get $r body], flushing all my caches" acs::cache_flush_all } } @@ -637,14 +633,15 @@ set success 0 } else { # - # We know, we are running on the canonical server, an we - # know that the request is trustworthy. + # We know, we are running on the canonical server, an + # we know that the request is trustworthy. # ns_log notice "Cluster join_request $peerLocation accepted from $peerLocation" set dynamicClusterNodes [parameter::get -package_id $::acs::kernel_id -parameter DynamicClusterPeers] set dynamicClusterNodes [lsort -unique [concat $dynamicClusterNodes $peerLocation]] # - # The parameter::set_value operation is broadcasted to all cluster nodes. + # The parameter::set_value operation causes a + # clusterwide cache-flush for the parameters # parameter::set_value -package_id $::acs::kernel_id -parameter DynamicClusterPeers -value $dynamicClusterNodes ns_log notice "Cluster join_request leads to DynamicClusterPeers $dynamicClusterNodes" @@ -879,6 +876,12 @@ # "acs::clusterwide", which is used quite early during boot. # acs::Cluster create ::acs::cluster + # + # Refetch setup on reload operations of this file. + # + if {[ns_ictl epoch] > 0 && [server_cluster_enabled_p]} { + ::acs::cluster setup + } }