CP-50537: Add a guard in xapi_globs, Xapi_globs.tgroups_enabled.

Adds a configurable variable in `xapi_globs`, `tgroups_enabled` that is
meant to ask a guard for tgroup classification of the threads. If the
guard is `false` all Tgroups functionality should act as a no op.

For instance, adding the line:

tgroups-enabled = false

will result in the thread classification being skipped.

Signed-off-by: Gabriel Buica <[email protected]>

Author: GabrielBuica

ocaml/libs/http-lib/http_svr.ml

@@ -560,7 +560,9 @@ let handle_connection ~header_read_timeout ~header_total_timeout
       read_request ?proxy_seen ~read_timeout ~total_timeout
         ~max_length:max_header_length ss
     in
+
     Http.Request.with_originator_of req Tgroup.of_req_originator ;
+
     (* 2. now we attempt to process the request *)
     let finished =
       Option.fold ~none:true

ocaml/libs/tgroup/tgroup.ml

@@ -174,9 +174,13 @@ let of_originator originator =
   originator |> Group.Creator.make |> Cgroup.set_cgroup
 
 let of_req_originator originator =
-  try
-    originator
-    |> Option.value ~default:Group.Originator.(to_string EXTERNAL)
-    |> Group.Originator.of_string
-    |> of_originator
-  with _ -> ()
+  Option.iter
+    (fun _ ->
+      try
+        originator
+        |> Option.value ~default:Group.Originator.(to_string EXTERNAL)
+        |> Group.Originator.of_string
+        |> of_originator
+      with _ -> ()
+    )
+    (Atomic.get Cgroup.cgroup_dir)

ocaml/xapi/xapi.ml

@@ -1060,7 +1060,9 @@ let server_init () =
           ; ("Running startup check", [], startup_check)
           ; ( "Initialize cgroups via tgroup"
             , []
-            , fun () -> Tgroup.Cgroup.init Xapi_globs.xapi_requests_cgroup
+            , fun () ->
+                if !Xapi_globs.tgroups_enabled then
+                  Tgroup.Cgroup.init Xapi_globs.xapi_requests_cgroup
             )
           ; ( "Registering SMAPIv1 plugins"
             , [Startup.OnlyMaster]

ocaml/xapi/xapi_globs.ml

@@ -1055,6 +1055,8 @@ 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"
 
@@ -1621,6 +1623,11 @@ let other_options =
     , (fun () -> !Uuidx.make_default == Uuidx.make_uuid_fast |> string_of_bool)
     , "Use PRNG based UUID generator instead of CSPRNG"
     )
+  ; ( "tgroups-enabled"
+    , Arg.Set tgroups_enabled
+    , (fun () -> string_of_bool !tgroups_enabled)
+    , "Turn on tgroups classification"
+    )
   ]
 
 (* The options can be set with the variable xapiflags in /etc/sysconfig/xapi.