CP-53779: Guard all Tgroup library call behind tgroups-enabled

ocaml/xapi-consts/constants.ml

@@ -418,3 +418,7 @@ let observer_components_all =
   ; observer_component_xapi_clusterd
   ; observer_component_smapi
   ]
+
+let tgroups_enabled = ref false
+
+let when_tgroups_enabled f = if !tgroups_enabled then f () else ()

ocaml/xapi/server_helpers.ml

@@ -141,7 +141,8 @@ let do_dispatch ?session_id ?forward_op ?self:_ supports_async called_fn_name
       Context.of_http_req ?session_id ~internal_async_subtask ~generate_task_for
         ~supports_async ~label ~http_req ~fd ()
     in
-    ( if !Xapi_globs.tgroups_enabled then
+
+    Constants.when_tgroups_enabled (fun () ->
         let identity =
           try
             Option.map
@@ -164,6 +165,7 @@ let do_dispatch ?session_id ?forward_op ?self:_ supports_async called_fn_name
         in
         Tgroup.of_creator (Tgroup.Group.Creator.make ?identity ())
     ) ;
+
     let sync () =
       let need_complete = not (Context.forwarded_task __context) in
       exec_with_context ~__context ~need_complete ~called_async

ocaml/xapi/xapi.ml

@@ -1062,8 +1062,8 @@ let server_init () =
           ; ( "Initialize cgroups via tgroup"
             , []
             , fun () ->
-                if !Xapi_globs.tgroups_enabled then
-                  Tgroup.Cgroup.init Xapi_globs.xapi_requests_cgroup
+                Constants.when_tgroups_enabled @@ fun () ->
+                Tgroup.Cgroup.init Xapi_globs.xapi_requests_cgroup
             )
           ; ( "Registering SMAPIv1 plugins"
             , [Startup.OnlyMaster]

ocaml/xapi/xapi_globs.ml

@@ -1077,8 +1077,6 @@ let disable_webserver = ref false
 
 let test_open = ref 0
 
-let tgroups_enabled = ref false
-
 let xapi_requests_cgroup =
   "/sys/fs/cgroup/cpu/control.slice/xapi.service/request"
 
@@ -1697,8 +1695,8 @@ let other_options =
     , "Disable the host webserver"
     )
   ; ( "tgroups-enabled"
-    , Arg.Set tgroups_enabled
-    , (fun () -> string_of_bool !tgroups_enabled)
+    , Arg.Set Constants.tgroups_enabled
+    , (fun () -> string_of_bool !Constants.tgroups_enabled)
     , "Turn on tgroups classification"
     )
   ; event_from_entry

ocaml/xapi/xapi_session.ml

@@ -686,7 +686,10 @@ let consider_touching_session rpc session_id =
 (* Make sure the pool secret matches *)
 let slave_login_common ~__context ~host_str ~psecret =
   Context.with_tracing ~__context __FUNCTION__ @@ fun __context ->
-  Tgroup.of_creator (Tgroup.Group.Creator.make ~intrapool:true ()) ;
+  Constants.when_tgroups_enabled (fun () ->
+      Tgroup.of_creator (Tgroup.Group.Creator.make ~intrapool:true ())
+  ) ;
+
   if not (Helpers.PoolSecret.is_authorized psecret) then (
     let msg = "Pool credentials invalid" in
     debug "Failed to authenticate slave %s: %s" host_str msg ;
@@ -882,8 +885,11 @@ let login_with_password ~__context ~uname ~pwd ~version:_ ~originator =
   | Some `root ->
       (* in this case, the context origin of this login request is a unix socket bound locally to a filename *)
       (* we trust requests from local unix filename sockets, so no need to authenticate them before login *)
-      Tgroup.of_creator
-        Tgroup.Group.(Creator.make ~identity:Identity.root_identity ()) ;
+      Constants.when_tgroups_enabled (fun () ->
+          Tgroup.of_creator
+            Tgroup.Group.(Creator.make ~identity:Identity.root_identity ())
+      ) ;
+
       login_no_password_common ~__context ~uname:(Some uname) ~originator
         ~host:(Helpers.get_localhost ~__context)
         ~pool:false ~is_local_superuser:true ~subject:Ref.null ~auth_user_sid:""
@@ -928,8 +934,12 @@ let login_with_password ~__context ~uname ~pwd ~version:_ ~originator =
           do_local_auth uname pwd ;
           debug "Success: local auth, user %s from %s" uname
             (Context.get_origin __context) ;
-          Tgroup.of_creator
-            Tgroup.Group.(Creator.make ~identity:Identity.root_identity ()) ;
+
+          Constants.when_tgroups_enabled (fun () ->
+              Tgroup.of_creator
+                Tgroup.Group.(Creator.make ~identity:Identity.root_identity ())
+          ) ;
+
           login_no_password_common ~__context ~uname:(Some uname) ~originator
             ~host:(Helpers.get_localhost ~__context)
             ~pool:false ~is_local_superuser:true ~subject:Ref.null
@@ -1225,10 +1235,16 @@ let login_with_password ~__context ~uname ~pwd ~version:_ ~originator =
                 Caching.memoize ~__context uname pwd
                   ~slow_path:query_external_auth
               in
-              Tgroup.of_creator
-                Tgroup.Group.(
-                  Creator.make ~identity:(Identity.make subject_identifier) ()
-                ) ;
+
+              Constants.when_tgroups_enabled (fun () ->
+                  Tgroup.of_creator
+                    Tgroup.Group.(
+                      Creator.make
+                        ~identity:(Identity.make subject_identifier)
+                        ()
+                    )
+              ) ;
+
               login_no_password_common ~__context ~uname:(Some uname)
                 ~originator
                 ~host:(Helpers.get_localhost ~__context)