Some OCaml 5 build fixes

ocaml/forkexecd/lib/fe_argv.ml

@@ -43,7 +43,7 @@ module Add = struct
   let each f xs = xs |> List.map f |> List.concat |> many
 
   let fmt fmt =
-    Printf.kprintf (fun str s -> ((), {s with argv= str :: s.argv})) fmt
+    Printf.ksprintf (fun str s -> ((), {s with argv= str :: s.argv})) fmt
 
   let file_descr uuid fd s = ((), {s with fds= (uuid, fd) :: s.fds})
 

ocaml/forkexecd/lib/forkhelpers.ml

@@ -82,7 +82,7 @@ let waitpid (sock, pid) =
 let waitpid_nohang (sock, pid) =
   let verbose = false in
   if verbose then D.debug "%s pid=%d" __FUNCTION__ pid ;
-  let fail fmt = Printf.kprintf failwith fmt in
+  let fail fmt = Printf.ksprintf failwith fmt in
   Unix.set_nonblock sock ;
   match Fecomms.read_raw_rpc sock with
   | Ok Fe.(Finished (WEXITED n)) ->

ocaml/forkexecd/src/child.ml

@@ -1,5 +1,5 @@
 let debug (fmt : ('a, unit, string, unit) format4) =
-  Printf.kprintf (fun s -> Printf.fprintf stderr "%s\n" s) fmt
+  Printf.ksprintf (fun s -> Printf.fprintf stderr "%s\n" s) fmt
 
 exception Cancelled
 

ocaml/forkexecd/src/fe_debug.ml

@@ -18,7 +18,7 @@ let gettimestring () =
 let reset () = debug_log := []
 
 let debug (fmt : ('a, unit, string, unit) format4) =
-  Printf.kprintf
+  Printf.ksprintf
     (fun s ->
       debug_log :=
         Printf.sprintf "%s|%d|%s\n" (gettimestring ()) (Unix.getpid ()) s

ocaml/libs/log/debug.ml

@@ -318,7 +318,7 @@ functor
   ->
   struct
     let output level priority (fmt : ('a, unit, string, 'b) format4) =
-      Printf.kprintf
+      Printf.ksprintf
         (fun s ->
           if not (is_disabled Brand.name level) then
             output_log Brand.name level priority s
@@ -336,7 +336,7 @@ functor
     let critical fmt = output Syslog.Crit "critical" fmt
 
     let audit ?(raw = false) (fmt : ('a, unit, string, 'b) format4) =
-      Printf.kprintf
+      Printf.ksprintf
         (fun s ->
           let msg = if raw then s else format true Brand.name "audit" s in
           Syslog.log Syslog.Local6 Syslog.Info (escape msg) ;

ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.ml

@@ -48,7 +48,7 @@ end
 (* === UCS Validators === *)
 
 module type UCS_VALIDATOR = sig
-  val validate : Uchar.t -> unit [@@inline]
+  val validate : Uchar.t -> unit
 end
 
 module UTF8_UCS_validator = struct

ocaml/mpathalert/mpathalert.ml

@@ -37,7 +37,7 @@ let stdout_m = Mutex.create ()
 let debug (fmt : ('a, unit, string, unit) format4) =
   if !print_debug then
     with_lock stdout_m (fun () ->
-        Printf.kprintf
+        Printf.ksprintf
           (fun s ->
             Printf.printf "%s [%d] %s\n"
               (time_of_float (Unix.gettimeofday ()))
@@ -48,7 +48,7 @@ let debug (fmt : ('a, unit, string, unit) format4) =
           fmt
     )
   else
-    Printf.kprintf (Fun.const ()) fmt
+    Printf.ksprintf (Fun.const ()) fmt
 
 type t = {
     host: [`host] Uuidx.t

ocaml/perftest/perfdebug.ml

@@ -15,7 +15,7 @@ let stdout_m = Mutex.create ()
 
 let debug ?(out = stdout) (fmt : ('a, unit, string, unit) format4) =
   Xapi_stdext_threads.Threadext.Mutex.execute stdout_m (fun () ->
-      Printf.kprintf
+      Printf.ksprintf
         (fun s ->
           Printf.fprintf out "%s\n" s ;
           flush stdout

ocaml/rrd2csv/src/rrd2csv.ml

@@ -37,7 +37,7 @@ module Stdout = struct
   let debug (fmt : ('a, unit, string, unit) format4) =
     if !print_debug then
       Xapi_stdext_threads.Threadext.Mutex.execute stdout_m (fun () ->
-          Printf.kprintf
+          Printf.ksprintf
             (fun s ->
               Printf.printf "%s [%d] %s\n"
                 (time_of_float (Unix.gettimeofday ()))
@@ -48,7 +48,7 @@ module Stdout = struct
             fmt
       )
     else
-      Printf.kprintf (fun _ -> ()) fmt
+      Printf.ksprintf (fun _ -> ()) fmt
 
   let string_of_float flt =
     if fst (modf flt) = 0. then

ocaml/xapi/certificates_sync.ml

@@ -100,7 +100,7 @@ let update ~__context =
 
 let internal_error fmt =
   fmt
-  |> Printf.kprintf @@ fun msg ->
+  |> Printf.ksprintf @@ fun msg ->
      error "%s" msg ;
      raise Api_errors.(Server_error (internal_error, [msg]))
 

ocaml/xapi/import.ml

@@ -1832,7 +1832,7 @@ module VTPM : HandlerTools = struct
   type precheck_t = Import of vtpm'
 
   let fail fmt =
-    Printf.kprintf
+    Printf.ksprintf
       (fun msg -> raise Api_errors.(Server_error (import_error_generic, [msg])))
       fmt
 

ocaml/xapi/importexport.ml

@@ -495,7 +495,7 @@ module Devicetype = struct
     | "vtpm" ->
         VTPM
     | other ->
-        let fail fmt = Printf.kprintf failwith fmt in
+        let fail fmt = Printf.ksprintf failwith fmt in
         fail "%s: Type '%s' not one of [%s]" __FUNCTION__ other
           (String.concat "; " (List.map to_string all))
 end

ocaml/xapi/xapi_xenops.ml

@@ -3402,7 +3402,7 @@ let transform_xenops_exn ~__context ~vm queue_name f =
       Backtrace.reraise e e'
     in
     let internal fmt =
-      Printf.kprintf (fun x -> reraise Api_errors.internal_error [x]) fmt
+      Printf.ksprintf (fun x -> reraise Api_errors.internal_error [x]) fmt
     in
     match e with
     | Xenopsd_error e' -> (

ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml

@@ -580,7 +580,7 @@ let bytes_per_mem_vm = 1024
 
 let mem_vm_writer_pages = ((max_supported_vms * bytes_per_mem_vm) + 4095) / 4096
 
-let res_error fmt = Printf.kprintf Result.error fmt
+let res_error fmt = Printf.ksprintf Result.error fmt
 
 let ok x = Result.ok x
 

ocaml/xe-cli/newcli.ml

@@ -60,7 +60,7 @@ let debug fmt =
   let printer s =
     match !debug_channel with Some c -> output_string c s | None -> ()
   in
-  Printf.kprintf printer fmt
+  Printf.ksprintf printer fmt
 
 (* usage message *)
 exception Usage

ocaml/xenopsd/lib/xenops_server.ml

@@ -24,7 +24,7 @@ module D = Debug.Make (struct let name = "xenops_server" end)
 open D
 
 let internal_error fmt =
-  Printf.kprintf
+  Printf.ksprintf
     (fun str ->
       error "%s" str ;
       raise (Xenopsd_error (Internal_error str))

ocaml/xenopsd/pvs/pvs_proxy_setup.ml

@@ -30,7 +30,7 @@ end)
 module XS = Ezxenstore_core.Xenstore
 
 let error fmt =
-  Printf.kprintf
+  Printf.ksprintf
     (fun msg ->
       D.error "%s" msg ;
       Result.error (`Msg msg)

ocaml/xenopsd/xc/device.ml

@@ -38,7 +38,7 @@ let finally = Xapi_stdext_pervasives.Pervasiveext.finally
 let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute
 
 let internal_error fmt =
-  Printf.kprintf
+  Printf.ksprintf
     (fun str ->
       error "%s" str ;
       raise (Xenopsd_error (Internal_error str))
@@ -3628,7 +3628,7 @@ module Dm = struct
     Q.Dm.pci_assign_guest ~xs ~index ~host
 
   let ioemu_failed emu fmt =
-    Printf.kprintf (fun msg -> raise (Ioemu_failed (emu, msg))) fmt
+    Printf.ksprintf (fun msg -> raise (Ioemu_failed (emu, msg))) fmt
 
   let wait_for_vgpu_state states ~timeout ~xs ~domid ~task vgpus =
     let open Xenops_interface.Vgpu in

ocaml/xenopsd/xc/domain.ml

@@ -1529,7 +1529,7 @@ let restore_common (task : Xenops_task.task_handle) ~xc ~xs
             in
             (th, ch)
           in
-          let receive_thread_status threads_and_channels =
+          let[@inline never] receive_thread_status threads_and_channels =
             (* Receive the status from all reader threads and let them exit.
                This happens in two steps to make sure that we are unblocking and
                closing all threads also in case of errors. *)
@@ -1549,9 +1549,7 @@ let restore_common (task : Xenops_task.task_handle) ~xc ~xs
           (* Handle results returned by emu-manager *)
           let emu_manager_results = handle_results () in
           (* Wait for reader threads to complete *)
-          let[@inlined never] thread_status =
-            receive_thread_status threads_and_channels
-          in
+          let thread_status = receive_thread_status threads_and_channels in
           (* Chain all together, and we are done! *)
           let res =
             emu_manager_results >>= fun result ->

ocaml/xenopsd/xc/xenops_server_xen.ml

@@ -31,7 +31,7 @@ let finally = Xapi_stdext_pervasives.Pervasiveext.finally
 let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute
 
 let internal_error fmt =
-  Printf.kprintf
+  Printf.ksprintf
     (fun str ->
       error "%s" str ;
       raise (Xenopsd_error (Internal_error str))