- Publicity: Public Only All
cluster-procs.tcl
This file defines the following Objects and Classes: ::acs::Cluster
, ::acs::cluster
- Location:
- packages/acs-tcl/tcl/cluster-procs.tcl
Procedures in this file
- Class ::acs::Cluster (public)
- Object ::acs::cluster (public)
- acs::Cluster instproc broadcast (public)
- acs::Cluster instproc check_state (public)
- acs::Cluster instproc current_server_is_canonical_server (public)
- acs::Cluster instproc current_server_is_dynamic_cluster_peer (public)
- acs::Cluster instproc disconnect_request (public)
- acs::Cluster instproc dynamic_cluster_nodes (public)
- acs::Cluster instproc dynamic_cluster_reconfigure (public)
- acs::Cluster instproc incoming_request (public)
- acs::Cluster instproc is_canonical_server (public)
- acs::Cluster instproc join_request (public)
- acs::Cluster instproc last_contact (public)
- acs::Cluster instproc last_request (public)
- acs::Cluster instproc preauth (public)
- acs::Cluster instproc qualified_location (public)
- acs::Cluster instproc register_nodes (public)
- acs::Cluster instproc secret_configured (public)
- acs::Cluster instproc send (public)
- acs::Cluster instproc send_disconnect_request_to_canonical_server (public)
- acs::Cluster instproc send_join_request_to_canonical_server (public)
- acs::Cluster instproc setup (public)
- acs::Cluster instproc update_node_info (public)
Detailed information
Class ::acs::Cluster (public)
::nx::Class ::acs::ClusterClass for managing a cluster of OpenACS nodes
- Testcases:
- No testcase defined.
Object ::acs::cluster (public)
::acs::Cluster ::acs::clusterConfigured cluster object, keeping the state of the cluster configuration. The interaction with the cluster is performed over this object.
- See Also:
- Class ::acs:Cluster
- ::acs::cluster send_join_request_to_canonical_server
- ::acs::cluster join_request /peerLocation/
- ::acs::cluster setup
- ::acs::cluster preauth ?/arg .../?
- ::acs::cluster is_canonical_server /location/
- ::acs::cluster current_server_is_canonical_server
- ::acs::cluster send ?-delivery /value/? /location/ ?/arg .../?
- ::acs::cluster secret_configured
- ::acs::cluster last_request /location/
- ::acs::cluster incoming_request
- ::acs::cluster dynamic_cluster_nodes
- ::acs::cluster send_disconnect_request_to_canonical_server
- ::acs::cluster disconnect_request /peerLocation/
- ::acs::cluster update_node_info
- ::acs::cluster broadcast ?/arg .../?
- ::acs::cluster qualified_location /location/
- ::acs::cluster current_server_is_dynamic_cluster_peer
- ::acs::cluster register_nodes ?-startup?
- ::acs::cluster message ...
- ::acs::cluster check_state
- ::acs::cluster dynamic_cluster_reconfigure /operation/ /qualifiedLocation/
- ::acs::cluster last_contact /location/
- Testcases:
- No testcase defined.
acs::Cluster method broadcast (public)
<instance of acs::Cluster> broadcast args [ args... ]Send requests to all cluster peers.
- Parameters:
- args (required)
- Testcases:
- No testcase defined.
acs::Cluster method check_state (public)
<instance of acs::Cluster> check_stateCheck the livelyness of the dynamic cluster nodes. This method is intended to be run on the canonical server only, since it might update the DynamicClusterPeers via acs::clusterwide.
- Testcases:
- No testcase defined.
acs::Cluster method current_server_is_canonical_server (public)
<instance of acs::Cluster> current_server_is_canonical_serverCheck, if the current server is the canonical_server.
- Testcases:
- No testcase defined.
acs::Cluster method current_server_is_dynamic_cluster_peer (public)
<instance of acs::Cluster> current_server_is_dynamic_cluster_peerWe are a dynamic cluster peer, when we are not the canonical server neither isted in the static server locations.
- Testcases:
- No testcase defined.
acs::Cluster method disconnect_request (public)
<instance of acs::Cluster> disconnect_request peerLocationServer received a request to disconnect $peerLocation from dynamic cluster nodes.
- Parameters:
- peerLocation (required)
- Testcases:
- No testcase defined.
acs::Cluster method dynamic_cluster_nodes (public)
<instance of acs::Cluster> dynamic_cluster_nodesConvenience function returning the list of dynamic cluster nodes.
- Testcases:
- No testcase defined.
acs::Cluster method dynamic_cluster_reconfigure (public)
<instance of acs::Cluster> dynamic_cluster_reconfigure operation \
qualifiedLocationReconfigure the cluster via "join" or "disconnect" operation, when running on the canonical server. The result of the reconfiguration is a changed list of DynamicClusterPeers. The method returns a boolean value indicating success.
- Parameters:
- operation (required)
- qualifiedLocation (required)
- Testcases:
- No testcase defined.
acs::Cluster method incoming_request (public)
<instance of acs::Cluster> incoming_requestWe received an incoming request from a cluster peer.
- Testcases:
- No testcase defined.
acs::Cluster method is_canonical_server (public)
<instance of acs::Cluster> is_canonical_server locationCheck, if provided location belongs to the canonical server specs. The canonical server might listen on multiple protocols, IP addresses and ports.
- Parameters:
- location (required)
- Testcases:
- No testcase defined.
acs::Cluster method join_request (public)
<instance of acs::Cluster> join_request peerLocationServer received a request to join dynamic cluster nodes from $peerLocation. ns_log notice "Server received a join request" ns_log notice "... ns_conn host <[ns_conn host]> peer <[ns_conn peeraddr]>" ns_log notice "... ns_conn port <[ns_conn port]> peerport <[ns_conn peerport]>" ns_log notice "... peerLocation <$peerLocation> qualified [:qualified_location $peerLocation]" set headers [join [lmap {key value} [ns_set array [ns_conn headers]] {set _ "$key: $value\n... "}]] ns_log notice "... headers $headers"
- Parameters:
- peerLocation (required)
- Testcases:
- No testcase defined.
acs::Cluster method last_contact (public)
<instance of acs::Cluster> last_contact locationReturn the milliseconds since the last contact with the denoted server. If there is no data available, the return values is empty.
- Parameters:
- location (required)
- Testcases:
- No testcase defined.
acs::Cluster method last_request (public)
<instance of acs::Cluster> last_request locationReturn the milliseconds since the last request from the denoted server. If there is no data available, the return values is empty.
- Parameters:
- location (required)
- Testcases:
- No testcase defined.
acs::Cluster method preauth (public)
<instance of acs::Cluster> preauth args [ args... ]Process no more pre-authorization filters for this connection (avoid running of expensive filters). ns_log notice "PREAUTH returns filter_break"
- Parameters:
- args (required)
- Testcases:
- No testcase defined.
acs::Cluster method qualified_location (public)
<instance of acs::Cluster> qualified_location locationReturn a canonical representation of the provided location, where the DNS name is resolved and the protocol and port is always included. When there is no protocol provided, HTTP is assumed. Provide defaults, when no port is included in the passed-in location. Note, that there is no default provided for non-HTTP* locations, so these must contain the port.
- Parameters:
- location (required)
- Testcases:
- No testcase defined.
acs::Cluster method register_nodes (public)
<instance of acs::Cluster> register_nodes [ -startup ]Register the defined cluster nodes by creating/recreating cluster node objects.
- Switches:
- -startup (optional, defaults to
"false")- Testcases:
- No testcase defined.
acs::Cluster method secret_configured (public)
<instance of acs::Cluster> secret_configuredCheck, whether the secret for signing messages in the intra-cluster talk is configured. More checks for different secret definition methods might be added.
- Testcases:
- No testcase defined.
acs::Cluster method send (public)
<instance of acs::Cluster> send [ -delivery delivery ] location \
args [ args... ]Send a command by different means to the cluster node for intra-server talk. Valid delivery methods are - ns_http (for HTTP and HTTPS) - connchan (for HTTP and HTTPS) - udp (plain UDP only)
- Switches:
- -delivery (optional, defaults to
"ns_http")- Parameters:
- location (required)
- args (required)
- Testcases:
- No testcase defined.
acs::Cluster method send_disconnect_request_to_canonical_server (public)
<instance of acs::Cluster> send_disconnect_request_to_canonical_serverSend a disconnect request to the canonical server.
- Testcases:
- No testcase defined.
acs::Cluster method send_join_request_to_canonical_server (public)
<instance of acs::Cluster> send_join_request_to_canonical_serverSend a join request to the canonical server.
- Testcases:
- No testcase defined.
acs::Cluster method setup (public)
<instance of acs::Cluster> setupSetup object specific variables. Make sure to call this method, when the called procs are available. Make sure the container support is initialized
- Testcases:
- No testcase defined.
acs::Cluster method update_node_info (public)
<instance of acs::Cluster> update_node_infoUpdate cluster configuration when the when the configuration variables changed, or when nodes become available/unavailable after some time. Typically, this method is called via scheduled procedure every couple of seconds when clustering is enabled.
- Testcases:
- No testcase defined.
Content File Source
# Copyright (C) 2022-2023 Gustaf Neumann, neumann@wu-wien.ac.at # # Vienna University of Economics and Business # Institute of Information Systems and New Media # A-1020, Welthandelsplatz 1 # Vienna, Austria # # This is a BSD-Style license applicable for this file. # # Permission to use, copy, modify, distribute, and sell this # software and its documentation for any purpose is hereby granted # without fee, provided that the above copyright notice appears in # all copies and that both that copyright notice and this permission # notice appear in supporting documentation. We make no # representations about the suitability of this software for any # purpose. It is provided "as is" without express or implied # warranty. # namespace eval ::acs { ########################################################################## # # Cluster Management # # 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. ########################################################################## proc clusterwide args { # # First, execute the command on the local server. # set result [eval $args] # # Then, distribute the command to all servers in the cluster. # ::acs::cluster broadcast {*}$args return $result } proc cache_flush_pattern {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 } } proc cache_flush_all {} { # # Reset all caches and flush all of its contents. # foreach cache [ns_cache_names] { ns_cache flush $cache } } #::nsf::method::property nx::Object "object method" debug on #::nsf::method::property nx::Class method debug on nx::Class create Cluster { # # Class for managing a cluster of OpenACS nodes # :property {url /acs-cluster-do} :property {myLocation ""} # set cls [nx::Class create ::acs::ClusterMethodMixin { # :method "object method" args { # ns_log notice "[self] define object method $args" # next # } # :method method args { # ns_log notice "[self] define method $args" # next # } # }] # :object mixins add $cls :variable allowed_host { "127.0.0.1" 1 } # # The allowed commands are of the form # - command names followed by # - optional "except patterns" # :variable allowed_command { set "" unset "" nsv_set "" nsv_unset "" nsv_incr "" nsv_dict "" bgdelivery "" callback "" ns_cache "^ns_cache\s+eval" ns_cache_flush "" util_memoize_flush_regexp_local "" ns_urlspace "" acs::cache_flush_all "" acs::cache_flush_pattern "" lang::message::cache "" ad_parameter_cache_flush_dict "" ::acs::cluster "^::acs::cluster\s+join_request" ::acs::cluster "^::acs::cluster\s+disconnect_request" } # # Control verbosity # :method log {args} { if {[parameter::get \ -package_id $::acs::kernel_id \ -parameter ClusterEnableLoggingP \ -default t]} { ns_log notice "cluster: [join $args { }]" } } :public method setup {} { # # Setup object specific variables. Make sure to call this # method, when the called procs are available. # # Make sure the container support is initialized # ::acs::Container create ::acs::container # # Set the variables controlling the behavior # set :myLocations [:current_server_locations] set :myLocation [:preferred_location ${:myLocations}] set :canonicalServer [parameter::get -package_id $::acs::kernel_id -parameter CanonicalServer] set :canonicalServerLocation [:preferred_location [:qualified_location ${:canonicalServer}]] set :current_server_is_canonical_server [:current_server_is_canonical_server] set :staticServerLocations \ [lmap entry [parameter::get -package_id $::acs::kernel_id -parameter ClusterPeerIP] { :preferred_location [:qualified_location $entry] }] ns_log notice "[self]: cluster configured to" set :myLocations [:current_server_locations] set :myLocation [:preferred_location ${:myLocations}] ns_log notice "... myLocations ${:myLocations}" ns_log notice "... myLocation ${:myLocation}" ns_log notice "... canonicalServer ${:canonicalServer}" ns_log notice "... canonicalServerLocation ${:canonicalServerLocation}" ns_log notice "... current_server_is_canonical_server ${:current_server_is_canonical_server}" ns_log notice "... staticServerLocations '${:staticServerLocations}'" } :method init {} { nsv_set cluster . . next } # # Handling the ns_filter methods (as defined in cluster-init.tcl) # :public method preauth args { # # Process no more pre-authorization filters for this # connection (avoid running of expensive filters). # #ns_log notice "PREAUTH returns filter_break" return filter_break } # :public method postauth args { # #ns_log notice "POSTAUTH returns filter_break" # return filter_break # } # :public method trace args { # #:log "trace" # #ns_log notice "TRACE handles request" # #:incoming_request # #ns_log notice "TRACE returns filter_return" # return filter_return # } :method allowed_command {cmd} { # # Check, which command are allowed to be executed in the # cluster. # #ns_log notice "--cluster allowed [dict keys ${:allowed_command}]?" set cmd_name [lindex $cmd 0] #ns_log notice "--cluster can i execute $cmd_name? [dict exists ${:allowed_command} $cmd_name]" if {[dict exists ${:allowed_command} $cmd_name]} { set except_RE [dict get ${:allowed_command} $cmd_name] #ns_log notice "--cluster [list regexp $except_RE $cmd] -> [regexp $except_RE $cmd]" set allowed [expr {$except_RE eq "" || ![regexp $except_RE $cmd]}] } elseif {[nsf::is object $cmd_name] && ([$cmd_name ::nsf::methods::object::info::hastype acs::Cache] || [$cmd_name ::nsf::methods::object::info::hastype acs::LockfreeCache])} { # # Allow operations on cache objects (e.g. needed for) # ns_log notice "--cluster acs_cache operation: $cmd" set allowed 1 } else { set allowed 0 } return $allowed } # # Handle incoming requests # :public method incoming_request {} { # # We received an incoming request from a cluster peer. # catch {::throttle do incr ::count(cluster:received)} #ns_log notice "==== [self] incoming_request [ns_conn query]" ad_try { #ns_logctl severity Debug(connchan) on #ns_logctl severity Debug(request) on #ns_logctl severity Debug(ns:driver) on #ns_logctl severity Debug on set r [:message decode] set receive_timestamp [clock clicks -milliseconds] dict with r { # # We could check here the provided timepstamp and # honor only recent requests (protection against # replay attacks). However, the allowed requests # are non-destructive. # nsv_set cluster $peer-last-contact $receive_timestamp nsv_set cluster $peer-last-request $receive_timestamp nsv_incr cluster $peer-count ns_log notice "--cluster got cmd='$cmd' from $peer after [expr {$receive_timestamp - $timestamp}]ms" set result [:execute $r] } } 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 incoming requests from peeraddr # :method execute {messageDict} { #:log execute $messageDict dict with messageDict { if {$peer ni [nsv_get cluster cluster_peer_nodes]} { ns_log notice ":execute: {$peer ni [nsv_get cluster cluster_peer_nodes]} // cmd $cmd" set ok [dict exists ${:allowed_host} $peeraddr] if {!$ok} { set authorizedIP [parameter::get \ -package_id $::acs::kernel_id \ -parameter ClusterAuthorizedIP] set ok [expr {$peer in $authorizedIP}] if {!$ok} { foreach ip $authorizedIP { # # Check every single element, if it is # in CIDR notation or it contains a # wild card. # if {([string first / $ip] != -1 && [ns_ip match $ip $peer]) || ([string first * $ip] != -1 && [string match $ip $peer]) } { set ok 1 break } } } } } else { set ok 1 } if {!$ok} { ns_log notice "could refuse to execute commands from $peeraddr (command: '$cmd') allowed [dict keys ${:allowed_host}]" } if {[:allowed_command $cmd]} { ns_log notice "--cluster executes command '$cmd' from peeraddr $peeraddr port [ns_conn peerport]" return [{*}$cmd] } error "command '$cmd' from peeraddr $peeraddr not allowed" } } :public method broadcast args { # # Send requests to all cluster peers. # if {[ns_ictl epoch] > 0} { catch {::throttle do incr ::count(cluster:broadcast)} } # Small optimization for cachingmode "none": no need to # send cache flushing requests to nodes, when there is no # caching in place. # if {[ns_config "ns/parameters" cachingmode "per-node"] eq "none" && [lindex $args 0] in { acs::cache_flush_pattern acs::cache_flush_all ns_cache} } { # # If caching mode is none, it is expected that all # nodes have this parameter set. Therefore, there is no # need to communicate cache flushing commands. # return } if {[nsv_get cluster cluster_peer_nodes locations]} { # # During startup the throttle thread might not be started, # so omit these statistic values # if {[ns_ictl epoch] > 0} { foreach location $locations { catch {::throttle do incr ::count(cluster:sent)} set t0 [clock clicks -microseconds] :send $location {*}$args set ms [expr {([clock clicks -microseconds] - $t0)/1000}] catch {::throttle do incr ::agg_time(cluster:sent) $ms} } } else { foreach location $locations { :send $location {*}$args } } } } :public method dynamic_cluster_nodes {} { # # Convenience function returning the list of dynamic # cluster nodes. # return [parameter::get \ -package_id $::acs::kernel_id \ -parameter DynamicClusterPeers] } :public method check_state {} { # # Check the livelyness of the dynamic cluster nodes. This # method is intended to be run on the canonical server # only, since it might update the DynamicClusterPeers via # acs::clusterwide. # set autodeleteInterval [parameter::get \ -package_id $::acs::kernel_id \ -parameter ClusterAutodeleteInterval \ -default 2m] foreach node [:dynamic_cluster_nodes] { set last_contact [acs::cluster last_contact $node] if {$last_contact ne ""} { set seconds [expr {$last_contact/1000}] if {[clock seconds]-($last_contact/1000) > [ns_baseunit -time $autodeleteInterval]} { ns_log notice "[self] disconnect dynamic node $node due to ClusterAutodeleteInterval" :disconnect_request $node } } } } :public method update_node_info {} { # # Update cluster configuration when the when the # configuration variables changed, or when nodes become # available/unavailable after some time. # # Typically, this method is called via scheduled procedure # every couple of seconds when clustering is enabled. # set dynamic_peers [:dynamic_cluster_nodes] if {!${:current_server_is_canonical_server}} { # # The current node might be a static or a dynamic # peer. Do we have contact to the canonical_server? # if {![:reachable ${:canonicalServerLocation}]} { # # We lost contact to the canonical server. This is # for our server not a big problem, since all # other peer-to-peer updates will continue to # work. # # During downtime of the canonical server, # scheduled procedures (e.g. mail delivery) will # be interrupted, and no new servers can register. # ns_log warning "cluster node lost contact to " \ "canonical server: ${:canonicalServerLocation}" } # # Are we an dynamic peer and not listed in # dynamic cluster nodes? This might happen in # situations, where the canonical server was # restarted (or separated for a while). # if {[:current_server_is_dynamic_cluster_peer] && ${:myLocation} ni $dynamic_peers } { ns_log warning "cluster node is not listed in dynamic peers." \ "Must re-join canonical server: ${:canonicalServerLocation}" ns_log notice "... myLocation: ${:myLocation}" ns_log notice "... dynamic_peers: $dynamic_peers" :send_join_request_to_canonical_server } } # # Update cluster_peer_nodes if necessary # set oldConfig [lsort [nsv_get cluster cluster_peer_nodes]] set newConfig [lsort [:peer_nodes $dynamic_peers]] if {$newConfig ne $oldConfig} { # # The cluster configuration has changed # ns_log notice "cluster config changed:\nOLD $oldConfig\nNEW $newConfig" nsv_set cluster cluster_peer_nodes $newConfig } } :public method last_contact {location} { # # Return the milliseconds 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 $clicksms } } :public method last_request {location} { # # Return the milliseconds since the last request from the # denoted server. If there is no data available, the # return values is empty. # if {[nsv_get cluster $location-last-request clicksms]} { return $clicksms } } :method reachable {location} { #:log "reachable $location" set d [ns_parseurl $location] #ns_log notice "reachable: $location -> $d" set result 0 dict with d { switch $proto { "udp" { # # assume, udp is always reachable # set result 1 } "http" - "https" { # # We can check via ns_connchan # try { #ns_logctl severity Debug(connchan) on ns_connchan connect $host $port } on error {} { # # Not reachable, stick with the default 0 # } on ok {chan} { set result 1 ns_connchan close $chan } } } } :log "node $location is reachable: $result" \ "last_contact [:last_contact $location]" \ "last_request [:last_request $location]" if {$result} { nsv_set cluster $location-last-contact [clock clicks -milliseconds] } return $result } :method is_current_server {location} { # # Check, if the provided location is the current server. # We expect the that the method "setup" was already called. # set result [expr {$location in ${:myLocations}}] #ns_log notice "is_current_server called with proto -> $location -> $result" return $result } :method is_configured_server {locations} { # # Check, if one of the provided locations is in the # currently configured cluster nodes. # foreach location $locations { if {$location in ${:configured_cluster_hosts}} { return 1 } } return 0 } :public method is_canonical_server {location} { # # Check, if provided location belongs to the canonical # server specs. The canonical server might listen on # multiple protocols, IP addresses and ports. # if { ![info exists :canonicalServer] || ${:canonicalServer} 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 location [:qualified_location $location] set result [expr {$location in ${:canonicalServerLocation}}] return $result } :public method current_server_is_canonical_server {} { # # Check, if the current server is the canonical_server. # if { ![info exists :canonicalServer] || ${:canonicalServer} 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 result [:is_canonical_server ${:myLocation}] # set result 0 # foreach location ${:myLocations} { # if {[:is_canonical_server $location]} { # set result 1 # break # } # } #:log "current_server_is_canonical_server $result" return $result } :public method current_server_is_dynamic_cluster_peer {} { # # We are a dynamic cluster peer, when we are not the # canonical server neither isted in the static server # locations. # if {${:current_server_is_canonical_server}} { return 0 } return [expr {${:myLocation} ni ${:staticServerLocations}}] } :method external_location {qualified_location} { # # For addresses communicated to container-external # entities, we have to map container-internal IP addresses # to external accessible addresses. # ns_log notice "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX NOT USED !!!!!!!!!!!!!!!" set containerMapping [::acs::container mapping] if {$containerMapping ne ""} { set d [ns_parseurl $qualified_location] dict with d { # # # TODO must be host from containerMapping # set internal [ns_addrbyhost host.docker.internal] if {$host in [list $internal host.docker.internal 127.0.0.1]} { set qualified_location [util::join_location \ -noabbrev \ -proto $proto \ -hostname 127.0.0.1 \ -port $port] } } } return $qualified_location } :public method qualified_location {location} { # # Return a canonical representation of the provided # location, where the DNS name is resolved and the # protocol and port is always included. When there is no # protocol provided, HTTP is assumed. Provide defaults, # when no port is included in the passed-in # location. # # Note, that there is no default provided for non-HTTP* # locations, so these must contain the 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]] } set label [dict get $d port]/tcp set containerMapping [acs::container mapping] # catch { # ns_log notice "check container mapping for $label: $d" # ns_log notice "... internal?[expr {[dict get $d host] eq {host.docker.internal}}]" # ns_log notice "... mapping? [expr {$containerMapping ne {}}]" # ns_log notice "... label? [dict exists $containerMapping $label]" # ns_log notice "... port= [dict get $containerMapping $label port]" # } if {$containerMapping ne "" && [dict get $d host] eq "host.docker.internal" && [dict exists $containerMapping $label] && [dict get $containerMapping $label port] < 32768 } { # Ephemeral ports on Linux are typically 32768-60999 # https://en.wikipedia.org/wiki/Ephemeral_port #ns_log notice "... there is a container mapping for $d -> [dict get $containerMapping $label]" set d [dict get $containerMapping $label] } else { # # In theory, an input location might map to multiple # values, when e.g., a provided DNS name refers to # multiple IP addresses. For now, we just return always a # single value. # # To return all IP addresses, we could use "ns_addrbyhost # -all ..." instead. # dict set d host [ns_addrbyhost [dict get $d host]] } set d [:map_inaddr_any -dict $d] dict with d { set result [util::join_location -noabbrev -proto $proto -hostname $host -port $port] } return $result } :method map_inaddr_any {-dict:switch location} { # # When the preferred location match returns INADDR_ANY, # map it to "localhost" (which is certainly a valid member # in this range, valid for IPv4 and IPv6). # set d [expr {$dict ? $location : [ns_parseurl $location]}] if {[dict get $d host] in {0.0.0.0 ::}} { set location [expr {$dict ? $d : [util::join_location -noabbrev \ -proto [dict get $d proto] \ -hostname [ns_addrbyhost localhost] \ -port [dict get $d port]] }] } return $location } :method preferred_location {locations:1..n} { # # Return the preferred location. # set preferred_location_regexp [parameter::get \ -package_id $::acs::kernel_id \ -parameter ClusterPreferredLocationRegexp \ -default https:// ] set preferred_location "" foreach location $locations { if {[regexp $preferred_location_regexp $location]} { set preferred_location $location break } } if {$preferred_location eq ""} { set preferred_location [lindex $locations 0] } return [:map_inaddr_any $preferred_location] } :method current_server_locations { {-network_drivers {nssock nsssl nsudp}} } { # # Return a list of valid locations of the current server. # # Since "ns_driver info" is not yet available at the time, # the *-init files are loaded, this method goes a long way # to check for properties of all of the loaded modules. # Network drivers with empty "port" or port == 0 are # ignored. # set result {} set protos {nssock http nsssl https nsudp udp nscoap coap} set module_file_regexp [join [dict keys $protos] |] set containerMapping [::acs::container mapping] if {$containerMapping ne ""} { # # We have a container mapping. Return locations from # this mappings as externally callable locations. # foreach {label mapping} $containerMapping { dict with mapping { lappend result [util::join_location \ -proto $proto \ -hostname $host \ -port $port] } } } else { # # Standard setup, no docker involved. We determine the # network configuration of the current node from the # configuration settings. # foreach module_section [list ns/server/[ns_info server]/modules ns/modules] { set modules [ns_configsection $module_section] if {$modules ne ""} { foreach {module file} [ns_set array $modules] { # # To obtain independence of the driver name, we # check whether the name of the binary (*.so # or *.dylib) is one of the supported driver # modules. # if {![regexp ($module_file_regexp) $file . module_type]} { continue } #ns_log notice "current_server_locations: use module <$module> $file" set driver_section [ns_driversection -driver $module] foreach ip [ns_config $driver_section address] { foreach port [ns_config -int $driver_section port] { if {$port == 0} { continue } lappend result [:qualified_location \ [util::join_location \ -proto [dict get $protos $module_type] \ -hostname $ip \ -port $port]] } } } } } } set result [lsort -unique $result] ns_log notice "[self] current_server_locations returns $result" return $result } :method send_dynamic_cluster_reconfigure_request {operation} { # # Send a cluster reconfigure request to the canonical server. # set location ${:canonicalServerLocation} set returnLocation [:external_location ${:myLocation}] :log "send $operation request to $location providing return location $returnLocation" set r [:send $location [self] ${operation}_request $returnLocation] #:log "... $operation request returned $r" if {[dict exists $r body]} { # # During startup/separation caches might not be in # sync. Therefore, we have lost confidence in our # caches and clear these. # :log "$operation request returned [dict get $r body], flushing all my caches" acs::cache_flush_all } } :public method send_join_request_to_canonical_server {} { # # Send a join request to the canonical server. # :send_dynamic_cluster_reconfigure_request join } :public method send_disconnect_request_to_canonical_server {} { # # Send a disconnect request to the canonical server. # :send_dynamic_cluster_reconfigure_request disconnect } :public method dynamic_cluster_reconfigure {operation qualifiedLocation} -returns boolean { # # Reconfigure the cluster via "join" or "disconnect" operation, # when running on the canonical server. The result of the # reconfiguration is a changed list of # DynamicClusterPeers. The method returns a boolean value # indicating success. # ns_log notice "Cluster reconfigure $operation from '$qualifiedLocation'" set success 1 # # To be ultra-conservative, we could allow cluster # reconfigure operations only on the canonical # server. This would require also to alter the # acs-admin/cluster page to show the trash icon only when # the page is executed on the canonical server. # if {0 && ![:current_server_is_canonical_server]} { ns_log warning "Cluster reconfigure rejected," \ "since it was received by a non-canonical server" set success 0 } else { # # We know, we are running on the canonical server, and # we know that the request is trustworthy. # ns_log notice "Cluster reconfigure $qualifiedLocation accepted from $qualifiedLocation" set dynamicClusterNodes [:dynamic_cluster_nodes] switch $operation { "join" { set dynamicClusterNodes \ [lsort -unique [concat $dynamicClusterNodes $qualifiedLocation]] } "disconnect" { set dynamicClusterNodes \ [lsearch -inline -all -not -exact $dynamicClusterNodes $qualifiedLocation] } default { ns_log warning "Cluster reconfigure rejected," \ "received invalid operation '$operation'" return 0 } } # # 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 "[self] reconfigure $operation leads to DynamicClusterPeers $dynamicClusterNodes" } return $success } :public method join_request {peerLocation} -returns boolean { # # Server received a request to join dynamic cluster nodes from $peerLocation. # #ns_log notice "Server received a join request" #ns_log notice "... ns_conn host <[ns_conn host]> peer <[ns_conn peeraddr]>" #ns_log notice "... ns_conn port <[ns_conn port]> peerport <[ns_conn peerport]>" #ns_log notice "... peerLocation <$peerLocation> qualified [:qualified_location $peerLocation]" #set headers [join [lmap {key value} [ns_set array [ns_conn headers]] {set _ "$key: $value\n... "}]] #ns_log notice "... headers $headers" return [:dynamic_cluster_reconfigure join [:qualified_location $peerLocation]] } :public method disconnect_request {peerLocation} -returns boolean { # # Server received a request to disconnect $peerLocation from dynamic cluster nodes. # return [:dynamic_cluster_reconfigure disconnect [:qualified_location $peerLocation]] } :method peer_nodes {dynamic_peers} { # # Determine the peer nodes of the server cluster. These # are cluster nodes which will receive intra-server # commands. # set :configured_cluster_hosts {} set peer_nodes {} foreach location [server_cluster_all_hosts] { # # Since the input can depend on erroneous user input, # use "try" to ease debugging. # try { :qualified_location $location } on ok {qualified_location} { lappend :configured_cluster_hosts $qualified_location } on error {errorMsg} { ns_log notice "ignore $location (:qualified_location returned $errorMsg)" continue } if {[:is_current_server $qualified_location]} { #array:log "$qualified_location is the current server" continue } # # For dynamic cluster peers, check the reachability # if {$qualified_location in $dynamic_peers && ![:reachable $qualified_location] } { ns_log warning "cluster node lost contact to dynamic cluster peer: $qualified_location" continue } lappend peer_nodes $qualified_location } #:log "final peer_nodes <$peer_nodes>" return $peer_nodes } :public method register_nodes {{-startup:switch false}} { # # Register the defined cluster nodes by # creating/recreating cluster node objects. # :log ":register_nodes startup $startup" # # Configure base configuration values # # set dynamic_peers [:dynamic_cluster_nodes] # At startup, when we are running on the canonical server, # check, whether the existing dynamic cluster nodes are # still reachable. When the canonical server is started # before the other cluster nodes, this parameter should be # empty. However, when the canonical server is restarted, # there might be some of the peer nodes already active. # if {$startup && ${:current_server_is_canonical_server} && $dynamic_peers ne "" } { # # When we are starting the canonical server, it resets # the potentially pre-existing dynamic nodes unless # these are reachable. # set old_peer_locations $dynamic_peers :log "canonical server starts with existing DynamicClusterPeers nodes: $old_peer_locations" # # Keep the reachable cluster nodes in # "DynamicClusterPeers". # set new_peer_locations {} foreach location $old_peer_locations { if {[:reachable $location]} { lappend new_peer_locations $location } } if {$new_peer_locations ne $old_peer_locations} { # # Update the DynamicClusterPeers in the database # such that the other nodes will pick it up as # well. # :log "updating DynamicClusterPeers to '$new_peer_locations' epoch [ns_ictl epoch]" parameter::set_value \ -package_id $::acs::kernel_id \ -parameter DynamicClusterPeers \ -value [lsort $new_peer_locations] set dynamic_peers $new_peer_locations } } # # Determine the peer nodes. # set cluster_peer_nodes [:peer_nodes $dynamic_peers] nsv_set cluster cluster_peer_nodes $cluster_peer_nodes #:log "cluster_peer_nodes <$cluster_peer_nodes>" if {![:is_configured_server ${:myLocations}]} { # # Current node is not pre-registered. # ns_log notice "Current host ${:myLocation} is not included in ${:configured_cluster_hosts}" if {![:current_server_is_canonical_server]} { ns_log notice "... must join at canonical server ${:canonicalServerLocation}" :send_join_request_to_canonical_server } } else { #ns_log notice "Current host ${:myLocation} is included in ${:configured_cluster_hosts}" } } :public method secret_configured {} { # # Check, whether the secret for signing messages in the # intra-cluster talk is configured. # # More checks for different secret definition methods # might be added. # set secret [:secret] return [expr {$secret ne ""}] } :method secret {} { # # Return secret used for signing messages # return [ns_config ns/server/[ns_info server]/acs ClusterSecret] } # # Methods for message encoding/decoding # :method "message sign" {message} { # # Return signature for message # #:log "message sign: $message" return [ns_crypto::hmac string -digest sha256 [:secret] $message] } :method "message verify" {message signature} { # # Verify if the signature of the message is ok and return # boolean value. # #:log "message verify {$message $signature}" set local_signature [ns_crypto::hmac string -digest sha256 [:secret] $message] return [expr {$local_signature eq $signature}] } :method "message encode" {cmd} { set timestamp [clock clicks -milliseconds] append result \ cmd=[ns_urlencode $cmd] \ &f=[ns_urlencode ${:myLocation}] \ &t=$timestamp \ &s=[:message sign [list $cmd $timestamp]] } :method "message decode" {} { # # Return a dict of the decoded message # TODO: add timestamp? # dict set r cmd [ns_queryget cmd] dict set r peer [ns_queryget f] dict set r timestamp [ns_queryget t] dict set r signature [ns_queryget s] dict set r peeraddr [ns_conn peeraddr] dict with r { if {![:message verify [list $cmd $timestamp] $signature]} { error "received message from $peeraddr does not match signature: $r" } } return $r } # # Methods for message delivery # :public method send {{-delivery ns_http} location args} { # # Send a command by different means to the cluster node # for intra-server talk. # # Valid delivery methods are # - ns_http (for HTTP and HTTPS) # - connchan (for HTTP and HTTPS) # - udp (plain UDP only) # :log "outgoing request to $location // $args" set t0 [clock clicks -microseconds] switch $delivery { #connchan - #udp - ns_http {set result [:${delivery}_send $location {*}$args]} default {error "unknown delivery method '$delivery'"} } ns_log notice "-cluster: $location $args sent" \ "total [expr {([clock clicks -microseconds] - $t0)/1000.0}]ms" return $result } :method ns_http_send {location args} { #:log "outgoing ns_http request to $location // $args" try { #ns_logctl severity Debug(task) on ns_http run $location/${:url}?[:message encode $args] } on error {errorMsg} { ns_log warning "-cluster: send message to $location/${:url}?cmd=[ns_urlencode $args] failed: $errorMsg" set result "" } on ok {result} { ns_log notice "-cluster: response $result" } return $result } } # # Define the acs::cluster object, since this is used, e.g., in # "acs::clusterwide", which is used quite early during boot. # acs::Cluster create ::acs::cluster { # # Configured cluster object, keeping the state of the cluster # configuration. The interaction with the cluster is performed # over this object. # # @see Class ::acs:Cluster } # # Refetch setup on reload operations of this file. # if {[ns_ictl epoch] > 0 && [server_cluster_enabled_p]} { ::acs::cluster setup } } # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End:
