Merge feature/dynamic-firewalld-control to master (#6717)

`git show`:
```
commit 37a497e (HEAD -> private/bengangy/merge-firewalld, origin/private/bengangy/merge-firewalld)
Merge: e2ba3d7 351f29c
Author: Bengang Yuan <[email protected]>
Date:   Mon Oct 20 06:35:06 2025 +0000

    Merge branch 'feature/dynamic-firewalld-control' into private/bengangy/merge-firewalld

diff --cc ocaml/idl/datamodel_host.ml
index be78d7f,1958e3813..29b5610
--- a/ocaml/idl/datamodel_host.ml
+++ b/ocaml/idl/datamodel_host.ml
@@@ -2696,7 -2657,7 +2704,8 @@@ let t
        ; set_ssh_enabled_timeout
        ; set_console_idle_timeout
        ; set_ssh_auto_mode
 +      ; get_tracked_user_agents
+       ; update_firewalld_service_status
        ]
      ~contents:
        ([
diff --cc ocaml/xapi/message_forwarding.ml
index 5741291,1082d0cd8..af2b1aa
--- a/ocaml/xapi/message_forwarding.ml
+++ b/ocaml/xapi/message_forwarding.ml
@@@ -4117,12 -4115,9 +4117,16 @@@ functo
          let remote_fn = Client.Host.set_ssh_auto_mode ~self ~value in
          do_op_on ~local_fn ~__context ~host:self ~remote_fn

 +      let get_tracked_user_agents ~__context ~self =
 +        info "Host.get_tracked_user_agents: host = '%s'"
 +          (host_uuid ~__context self) ;
 +        let local_fn = Local.Host.get_tracked_user_agents ~self in
 +        let remote_fn = Client.Host.get_tracked_user_agents ~self in
 +        do_op_on ~local_fn ~__context ~host:self ~remote_fn
++
+       let update_firewalld_service_status ~__context =
+         info "Host.update_firewalld_service_status" ;
+         Local.Host.update_firewalld_service_status ~__context
      end

      module Host_crashdump = struct
diff --cc ocaml/xapi/xapi_globs.ml
index 4244df7,f43ec6b8e..fcbc917
--- a/ocaml/xapi/xapi_globs.ml
+++ b/ocaml/xapi/xapi_globs.ml
@@@ -1339,10 -1330,14 +1343,18 @@@ let ssh_monitor_service = ref "xapi-ssh

  let ssh_auto_mode_default = ref true

+ type firewall_backend_type = Firewalld | Iptables
+
+ (* Firewall backend to use. iptables in XS 8, firewalld in XS 9. *)
+ let firewall_backend = ref Iptables
+
+ (* For firewalld, if dynamic control firewalld service. *)
+ let dynamic_control_firewalld_service = ref true
+
 +let secure_boot_path =
 +  ref
 +    "/sys/firmware/efi/efivars/SecureBoot-8be4df61-93ca-11d2-aa0d-00e098032b8c"
 +
  (* Fingerprint of default patch key *)
  let citrix_patch_key =
    "NERDNTUzMDMwRUMwNDFFNDI4N0M4OEVCRUFEMzlGOTJEOEE5REUyNg=="
diff --cc ocaml/xapi/xapi_host.ml
index fab30bf,0358bcfed..90062c7
--- a/ocaml/xapi/xapi_host.ml
+++ b/ocaml/xapi/xapi_host.ml
@@@ -3340,6 -3356,62 +3363,66 @@@ let set_console_idle_timeout ~__contex
      Helpers.internal_error "Failed to set console timeout: %Ld: %s" value
        (Printexc.to_string e)

 +let get_tracked_user_agents ~__context ~self =
 +  let _ : [`host] Ref.t = self in
 +  Xapi_tracked_user_agents.get ()
++
+ let get_nbd_interfaces ~__context ~self =
+   let pifs = Db.Host.get_PIFs ~__context ~self in
+   let allowed_connected_networks =
+     (* We use Valid_ref_list to continue processing the list in case some
+        network refs are null or invalid *)
+     Valid_ref_list.filter_map
+       (fun pif ->
+         let network = Db.PIF.get_network ~__context ~self:pif in
+         let purpose = Db.Network.get_purpose ~__context ~self:network in
+         if List.mem `nbd purpose || List.mem `insecure_nbd purpose then
+           Some network
+         else
+           None
+       )
+       pifs
+   in
+   let interfaces =
+     List.map
+       (fun network -> Db.Network.get_bridge ~__context ~self:network)
+       allowed_connected_networks
+   in
+   Xapi_stdext_std.Listext.List.setify interfaces
+
+ let update_firewalld_service_status ~__context =
+   let open Firewall in
+   let enable_firewalld_service service =
+     try Firewalld.update_firewall_status service Enabled with _ -> ()
+   in
+   match !Xapi_globs.firewall_backend with
+   | Firewalld ->
+       let self = Helpers.get_localhost ~__context in
+       let is_enabled = function
+         | Dlm ->
+             Xapi_clustering.Daemon.is_enabled ()
+         | Http ->
+             not (Db.Host.get_https_only ~__context ~self)
+         | Nbd ->
+             get_nbd_interfaces ~__context ~self <> []
+         | Ssh ->
+             Db.Host.get_ssh_enabled ~__context ~self
+         | Vxlan ->
+             List.exists
+               (fun tunnel ->
+                 Db.PIF.get_currently_attached ~__context
+                   ~self:(Db.Tunnel.get_access_PIF ~__context ~self:tunnel)
+               )
+               (Db.Tunnel.get_all ~__context)
+         | Xenha ->
+             (* Only xha needs to enable firewalld service. Other HA cluster
+                stacks don't need. *)
+             bool_of_string (Localdb.get Constants.ha_armed)
+             && Localdb.get Constants.ha_cluster_stack
+                = !Xapi_globs.cluster_stack_default
+       in
+       List.iter
+         (fun s -> if is_enabled s then enable_firewalld_service s)
+         all_service_types
+   | Iptables ->
+       debug "No need to update firewalld service status when using iptables"
diff --cc ocaml/xapi/xapi_host.mli
index 4adb72d,b3aa2d467..316ee9f
--- a/ocaml/xapi/xapi_host.mli
+++ b/ocaml/xapi/xapi_host.mli
@@@ -592,5 -590,15 +592,18 @@@ val schedule_disable_ssh_job
  val set_ssh_auto_mode :
    __context:Context.t -> self:API.ref_host -> value:bool -> unit

 +val get_tracked_user_agents :
 +  __context:Context.t -> self:API.ref_host -> (string * string) list
++
+ val get_nbd_interfaces : __context:Context.t -> self:API.ref_host -> string list
+
+ val update_firewalld_service_status : __context:Context.t -> unit
+ (* Update the status of all the firewalld services to match the state of the
+    corresponding services.
+    This function is used in 2 scenarios:
+    1. When xapi starts, to ensure that all the firewalld services are in the
+       correct state.
+    2. When the firewalld restarts, all firewalld services are reset to the
+       default status. This function should be called to update these firewalld
+       services to the correct status. Xapi will expose an xe command line for
+       this scenario. *)
```

Author: BengangY

ocaml/idl/datamodel.ml

@@ -10704,6 +10704,7 @@ let emergency_calls =
   ; (Datamodel_host.t, Datamodel_host.emergency_disable_tls_verification)
   ; (Datamodel_host.t, Datamodel_host.emergency_reenable_tls_verification)
   ; (Datamodel_host.t, Datamodel_host.emergency_clear_mandatory_guidance)
+  ; (Datamodel_host.t, Datamodel_host.update_firewalld_service_status)
   ]
 
 (** Whitelist of calls that will not get forwarded from the slave to master via the unix domain socket *)

ocaml/idl/datamodel_host.ml

@@ -2518,6 +2518,14 @@ let set_ssh_auto_mode =
       ]
     ~allowed_roles:_R_POOL_ADMIN ()
 
+let update_firewalld_service_status =
+  call ~name:"update_firewalld_service_status" ~flags:[`Session] ~lifecycle:[]
+    ~pool_internal:true ~hide_from_docs:true
+    ~doc:
+      "Update firewalld services based on the corresponding xapi services \
+       status."
+    ~allowed_roles:_R_POOL_OP ()
+
 let latest_synced_updates_applied_state =
   Enum
     ( "latest_synced_updates_applied_state"
@@ -2697,6 +2705,7 @@ let t =
       ; set_console_idle_timeout
       ; set_ssh_auto_mode
       ; get_tracked_user_agents
+      ; update_firewalld_service_status
       ]
     ~contents:
       ([

ocaml/idl/datamodel_lifecycle.ml

@@ -225,6 +225,8 @@ let prototyped_of_message = function
       Some "22.26.0"
   | "VTPM", "create" ->
       Some "22.26.0"
+  | "host", "update_firewalld_service_status" ->
+      Some "25.30.0-next"
   | "host", "set_ssh_auto_mode" ->
       Some "25.27.0"
   | "host", "set_console_idle_timeout" ->

ocaml/xapi-cli-server/cli_frontend.ml

@@ -2922,6 +2922,19 @@ let rec cmdtable_data : (string * cmd_spec) list =
       ; flags= [Neverforward]
       }
     )
+  ; ( "host-update-firewalld-service-status"
+    , {
+        reqd= []
+      ; optn= []
+      ; help=
+          "Update firewalld services status based the corresponding xapi \
+           services status."
+      ; implementation=
+          No_fd_local_session
+            Cli_operations.host_update_firewalld_service_status
+      ; flags= [Neverforward]
+      }
+    )
   ; ( "diagnostic-compact"
     , {
         reqd= []

ocaml/xapi-cli-server/cli_operations.ml

@@ -5451,6 +5451,9 @@ let host_retrieve_wlb_evacuate_recommendations printer rpc session_id params =
 let host_shutdown_agent _printer rpc session_id _params =
   ignore (Client.Host.shutdown_agent ~rpc ~session_id)
 
+let host_update_firewalld_service_status _printer rpc session_id _params =
+  ignore (Client.Host.update_firewalld_service_status ~rpc ~session_id)
+
 let vdi_import fd _printer rpc session_id params =
   let filename = List.assoc "filename" params in
   let vdi =

ocaml/xapi/dbsync_slave.ml

@@ -135,16 +135,19 @@ let refresh_localhost_info ~__context info =
   ) else
     Db.Host.remove_from_other_config ~__context ~self:host
       ~key:Xapi_globs.host_no_local_storage ;
-  let script_output =
-    Helpers.call_script !Xapi_globs.firewall_port_config_script ["check"; "80"]
+  let status =
+    match Db.Host.get_https_only ~__context ~self:host with
+    | true ->
+        Firewall.Disabled
+    | false ->
+        Firewall.Enabled
   in
-  try
-    let network_state = Scanf.sscanf script_output "Port 80 open: %B" Fun.id in
-    Db.Host.set_https_only ~__context ~self:host ~value:network_state
-  with _ ->
-    Helpers.internal_error
-      "unexpected output from /etc/xapi.d/plugins/firewall-port: %s"
-      script_output
+  let module Fw =
+    ( val Firewall.firewall_provider !Xapi_globs.firewall_backend
+        : Firewall.FIREWALL
+      )
+  in
+  Fw.update_firewall_status Firewall.Http status
 (*************** update database tools ******************)
 
 (** Record host memory properties in database *)

ocaml/xapi/dune

@@ -262,7 +262,9 @@
     System_domains
     Xapi_psr
     Xapi_services
-    Xapi_udhcpd))))
+    Xapi_udhcpd)
+   ((pps ppx_deriving.enum)
+    Firewall))))
 
 (library
  (name xapi_internal_server_only)

ocaml/xapi/firewall.ml

@@ -0,0 +1,175 @@
+(*
+ * Copyright (c) Cloud Software Group, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+module D = Debug.Make (struct let name = __MODULE__ end)
+
+open D
+
+type service_type = Dlm | Nbd | Ssh | Vxlan | Http | Xenha [@@deriving enum]
+
+type status = Enabled | Disabled
+
+type protocol = TCP | UDP
+
+(* 1. For firewalld, xapi is always responsible for dynamically controlling
+      firewalld services.
+   2. For legacy iptables compatibility:
+      - Certain iptables ports (such as 4789 for VXLAN) are managed dynamically.
+      - Other ports (such as 22 for SSH) do not require dynamic control, as they
+        are already enabled when the host boots up.
+      - The `dynamic_control_iptables_port` parameter is used to decide if the
+        ports should be controlled dynamically when iptables is selected.
+*)
+type service_info = {
+    name: string
+  ; port: int
+  ; protocol: protocol
+  ; dynamic_control_iptables_port: bool
+}
+
+let all_service_types =
+  let length = max_service_type - min_service_type + 1 in
+  List.init length (fun i ->
+      service_type_of_enum (min_service_type + i) |> Option.get
+  )
+
+let status_to_string = function Enabled -> "enabled" | Disabled -> "disabled"
+
+let protocol_to_string = function TCP -> "tcp" | UDP -> "udp"
+
+let service_type_to_service_info = function
+  | Dlm ->
+      {
+        name= "dlm"
+      ; port= !Xapi_globs.xapi_clusterd_port
+      ; protocol= TCP
+      ; dynamic_control_iptables_port= true
+      }
+  | Nbd ->
+      {
+        name= "nbd"
+      ; port= 10809
+      ; protocol= TCP
+      ; dynamic_control_iptables_port= true
+      }
+  | Ssh ->
+      {
+        name= "ssh"
+      ; port= 22
+      ; protocol= TCP
+      ; dynamic_control_iptables_port= false
+      }
+  | Vxlan ->
+      {
+        name= "vxlan"
+      ; port= 4789
+      ; protocol= UDP
+      ; dynamic_control_iptables_port= true
+      }
+  | Http ->
+      {
+        name= "xapi-insecure"
+      ; port= Constants.http_port
+      ; protocol= TCP
+      ; dynamic_control_iptables_port= true
+      }
+  | Xenha ->
+      {
+        name= "xenha"
+      ; port= Xapi_globs.xha_udp_port
+      ; protocol= UDP
+      ; dynamic_control_iptables_port= false
+      }
+
+module type FIREWALL = sig
+  val update_firewall_status :
+    ?interfaces:string list -> service_type -> status -> unit
+end
+
+module Firewalld : FIREWALL = struct
+  let update_firewall_status ?(interfaces = []) service status =
+    if !Xapi_globs.dynamic_control_firewalld_service then (
+      let service_option =
+        match status with
+        | Enabled ->
+            "--add-service"
+        | Disabled ->
+            "--remove-service"
+      in
+      let service_info = service_type_to_service_info service in
+      ( match interfaces with
+      | _ :: _ when service = Nbd ->
+          let interface_list = String.concat ", " interfaces in
+          debug
+            "%s: Enable NBD service as the following interfaces are used for \
+             NBD: [%s]"
+            __FUNCTION__ interface_list
+      | _ ->
+          ()
+      ) ;
+      try
+        Helpers.call_script !Xapi_globs.firewall_cmd
+          [service_option; service_info.name]
+        |> ignore
+      with e ->
+        error
+          "%s: Failed to update firewall service (%s) to (%s) with error: %s"
+          __FUNCTION__ service_info.name (status_to_string status)
+          (Printexc.to_string e) ;
+        Helpers.internal_error "Failed to update firewall service (%s)"
+          service_info.name
+    )
+end
+
+module Iptables : FIREWALL = struct
+  let update_firewall_status ?(interfaces = []) service status =
+    let service_info = service_type_to_service_info service in
+    if service_info.dynamic_control_iptables_port then (
+      try
+        match service with
+        | Dlm | Ssh | Vxlan | Http | Xenha ->
+            let op =
+              match status with Enabled -> "open" | Disabled -> "close"
+            in
+            Helpers.call_script
+              !Xapi_globs.firewall_port_config_script
+              [
+                op
+              ; string_of_int service_info.port
+              ; protocol_to_string service_info.protocol
+              ]
+            |> ignore
+        | Nbd ->
+            (* For legacy iptables, NBD port needs to be precisely controlled on
+               each interface *)
+            let args = "set" :: interfaces in
+            Helpers.call_script !Xapi_globs.nbd_firewall_config_script args
+            |> ignore
+      with e ->
+        error
+          "%s: Failed to update firewall service (%s) to (%s) with error: %s"
+          __FUNCTION__ service_info.name (status_to_string status)
+          (Printexc.to_string e) ;
+        Helpers.internal_error "Failed to update firewall service (%s)"
+          service_info.name
+    )
+end
+
+let firewall_provider (backend : Xapi_globs.firewall_backend_type) :
+    (module FIREWALL) =
+  match backend with
+  | Firewalld ->
+      (module Firewalld)
+  | Iptables ->
+      (module Iptables)

ocaml/xapi/firewall.mli

@@ -0,0 +1,38 @@
+(*
+ * Copyright (c) Cloud Software Group, Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type service_type = Dlm | Nbd | Ssh | Vxlan | Http | Xenha
+
+type status = Enabled | Disabled
+
+val all_service_types : service_type list
+
+module type FIREWALL = sig
+  val update_firewall_status :
+    ?interfaces:string list -> service_type -> status -> unit
+  (** [update_firewall_status] updates the firewalld service status based on the
+      status of the corresponding service.
+
+      [interfaces]  is a list of bridge names of the Network objects whose
+      purpose is `nbd` or `insecure_nbd`. [interfaces] is only used to controll
+      the NBD iptables port dynamically, to specify which interfaces are
+      permitted for NBD connections.
+  *)
+end
+
+module Firewalld : FIREWALL
+
+module Iptables : FIREWALL
+
+val firewall_provider : Xapi_globs.firewall_backend_type -> (module FIREWALL)

ocaml/xapi/message_forwarding.ml

@@ -4123,6 +4123,10 @@ functor
         let local_fn = Local.Host.get_tracked_user_agents ~self in
         let remote_fn = Client.Host.get_tracked_user_agents ~self in
         do_op_on ~local_fn ~__context ~host:self ~remote_fn
+
+      let update_firewalld_service_status ~__context =
+        info "Host.update_firewalld_service_status" ;
+        Local.Host.update_firewalld_service_status ~__context
     end
 
     module Host_crashdump = struct