CP-309847: Make HTTP/80 configurable

- Introduce https_only argument for Host.create
- Set https_only from configuration for installation
- Keep https_only from joining host during pool join

Signed-off-by: Lin Liu <[email protected]>

Author: Lin Liu

ocaml/idl/datamodel_host.ml

@@ -1398,6 +1398,14 @@ let create_params =
     ; param_release= numbered_release "25.32.0-next"
     ; param_default= Some (VMap [])
     }
+  ; {
+      param_type= Bool
+    ; param_name= "https_only"
+    ; param_doc=
+        "updates firewall to open or close port 80 depending on the value"
+    ; param_release= numbered_release "25.38.0"
+    ; param_default= Some (VBool false)
+    }
   ]
 
 let create =
@@ -1416,6 +1424,7 @@ let create =
            --console_idle_timeout --ssh_auto_mode options to allow them to be \
            configured for new host"
         )
+      ; (Changed, "25.38.0", "Added --https_only to disable http")
       ]
     ~versioned_params:create_params ~doc:"Create a new host record"
     ~result:(Ref _host, "Reference to the newly created host object.")

ocaml/tests/common/test_common.ml

@@ -175,7 +175,7 @@ let make_host ~__context ?(uuid = make_uuid ()) ?(name_label = "host")
     ?(last_software_update = Date.epoch) ?(last_update_hash = "")
     ?(ssh_enabled = true) ?(ssh_enabled_timeout = 0L) ?(ssh_expiry = Date.epoch)
     ?(console_idle_timeout = 0L) ?(ssh_auto_mode = false) ?(secure_boot = false)
-    () =
+    ?(https_only = false) () =
   let host =
     Xapi_host.create ~__context ~uuid ~name_label ~name_description ~hostname
       ~address ~external_auth_type ~external_auth_service_name
@@ -184,6 +184,7 @@ let make_host ~__context ?(uuid = make_uuid ()) ?(name_label = "host")
       ~last_update_hash ~ssh_enabled ~ssh_enabled_timeout ~ssh_expiry
       ~console_idle_timeout ~ssh_auto_mode ~secure_boot
       ~software_version:(Xapi_globs.software_version ())
+      ~https_only
   in
   Db.Host.set_cpu_info ~__context ~self:host ~value:default_cpu_info ;
   host
@@ -194,15 +195,14 @@ let make_host2 ~__context ?(ref = Ref.make ()) ?(uuid = make_uuid ())
     ?(external_auth_type = "") ?(external_auth_service_name = "")
     ?(external_auth_configuration = []) ?(license_params = [])
     ?(edition = "free") ?(license_server = []) ?(local_cache_sr = Ref.null)
-    ?(chipset_info = []) ?(ssl_legacy = false) () =
+    ?(chipset_info = []) ?(ssl_legacy = false) ?(https_only = false) () =
   let pool = Helpers.get_pool ~__context in
   let tls_verification_enabled =
     Db.Pool.get_tls_verification_enabled ~__context ~self:pool
   in
   Db.Host.create ~__context ~ref ~current_operations:[] ~allowed_operations:[]
     ~software_version:(Xapi_globs.software_version ())
-    ~https_only:false ~enabled:false
-    ~aPI_version_major:Datamodel_common.api_version_major
+    ~enabled:false ~aPI_version_major:Datamodel_common.api_version_major
     ~aPI_version_minor:Datamodel_common.api_version_minor
     ~aPI_version_vendor:Datamodel_common.api_version_vendor
     ~aPI_version_vendor_implementation:
@@ -224,7 +224,7 @@ let make_host2 ~__context ?(ref = Ref.make ()) ?(uuid = make_uuid ())
     ~pending_guidances_recommended:[] ~pending_guidances_full:[]
     ~last_update_hash:"" ~ssh_enabled:true ~ssh_enabled_timeout:0L
     ~ssh_expiry:Date.epoch ~console_idle_timeout:0L ~ssh_auto_mode:false
-    ~secure_boot:false ;
+    ~secure_boot:false ~https_only ;
   ref
 
 let make_pif ~__context ~network ~host ?(device = "eth0")

ocaml/tests/test_host.ml

@@ -27,6 +27,7 @@ let add_host __context name =
        ~ssh_enabled:true ~ssh_enabled_timeout:0L ~ssh_expiry:Clock.Date.epoch
        ~console_idle_timeout:0L ~ssh_auto_mode:false ~secure_boot:false
        ~software_version:(Xapi_globs.software_version ())
+       ~https_only:false
     )
 
 (* Creates an unlicensed pool with the maximum number of hosts *)

ocaml/xapi/dbsync_slave.ml

@@ -66,6 +66,7 @@ let create_localhost ~__context info =
         ~console_idle_timeout:Constants.default_console_idle_timeout
         ~ssh_auto_mode:!Xapi_globs.ssh_auto_mode_default
         ~secure_boot:false ~software_version:[]
+        ~https_only:!Xapi_globs.https_only
     in
     ()
 

ocaml/xapi/xapi_globs.ml

@@ -1133,6 +1133,8 @@ let xapi_requests_cgroup =
 
 let genisoimage_path = ref "/usr/bin/genisoimage"
 
+let https_only = ref false
+
 (* Event.{from,next} batching delays *)
 let make_batching name ~delay_before ~delay_between =
   let name = Printf.sprintf "%s_delay" name in
@@ -1834,6 +1836,11 @@ let other_options =
     , (fun () -> string_of_int !max_span_depth)
     , "The maximum depth to which spans are recorded in a trace in Tracing"
     )
+  ; ( "https-only-default"
+    , Arg.Set https_only
+    , (fun () -> string_of_bool !https_only)
+    , "Only expose HTTPS service, disable HTTP/80 in firewall when set to true"
+    )
   ; ( "firewall-backend"
     , Arg.String
         (fun s ->

ocaml/xapi/xapi_host.ml

@@ -1029,7 +1029,7 @@ let create ~__context ~uuid ~name_label ~name_description:_ ~hostname ~address
     ~license_params ~edition ~license_server ~local_cache_sr ~chipset_info
     ~ssl_legacy:_ ~last_software_update ~last_update_hash ~ssh_enabled
     ~ssh_enabled_timeout ~ssh_expiry ~console_idle_timeout ~ssh_auto_mode
-    ~secure_boot ~software_version =
+    ~secure_boot ~software_version ~https_only =
   (* fail-safe. We already test this on the joining host, but it's racy, so multiple concurrent
      pool-join might succeed. Note: we do it in this order to avoid a problem checking restrictions during
      the initial setup of the database *)
@@ -1064,7 +1064,7 @@ let create ~__context ~uuid ~name_label ~name_description:_ ~hostname ~address
     (* no or multiple pools *)
   in
   Db.Host.create ~__context ~ref:host ~current_operations:[]
-    ~allowed_operations:[] ~https_only:false ~software_version ~enabled:false
+    ~allowed_operations:[] ~https_only ~software_version ~enabled:false
     ~aPI_version_major:Datamodel_common.api_version_major
     ~aPI_version_minor:Datamodel_common.api_version_minor
     ~aPI_version_vendor:Datamodel_common.api_version_vendor

ocaml/xapi/xapi_host.mli

@@ -138,6 +138,7 @@ val create :
   -> ssh_auto_mode:bool
   -> secure_boot:bool
   -> software_version:(string * string) list
+  -> https_only:bool
   -> [`host] Ref.t
 
 val destroy : __context:Context.t -> self:API.ref_host -> unit

ocaml/xapi/xapi_pool.ml

@@ -1033,6 +1033,7 @@ let rec create_or_get_host_on_master __context rpc session_id (host_ref, host) :
           create_or_get_sr_on_master __context rpc session_id
             (my_local_cache_sr, my_local_cache_sr_rec)
       in
+
       debug "Creating host object on master" ;
       let ref =
         Client.Host.create ~rpc ~session_id ~uuid:my_uuid
@@ -1060,6 +1061,7 @@ let rec create_or_get_host_on_master __context rpc session_id (host_ref, host) :
           ~ssh_auto_mode:host.API.host_ssh_auto_mode
           ~secure_boot:host.API.host_secure_boot
           ~software_version:host.API.host_software_version
+          ~https_only:host.API.host_https_only
       in
       (* Copy other-config into newly created host record: *)
       no_exn