diff --git a/ocaml/forkexecd/lib/fe_argv.ml b/ocaml/forkexecd/lib/fe_argv.ml index 5c5247ad551..e7f6a5eeb41 100644 --- a/ocaml/forkexecd/lib/fe_argv.ml +++ b/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}) diff --git a/ocaml/forkexecd/lib/forkhelpers.ml b/ocaml/forkexecd/lib/forkhelpers.ml index ef1ca459f16..7b7fc0b2247 100644 --- a/ocaml/forkexecd/lib/forkhelpers.ml +++ b/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)) -> diff --git a/ocaml/forkexecd/src/child.ml b/ocaml/forkexecd/src/child.ml index 0bdb5fc1dc1..ef4ad887f31 100644 --- a/ocaml/forkexecd/src/child.ml +++ b/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 diff --git a/ocaml/forkexecd/src/fe_debug.ml b/ocaml/forkexecd/src/fe_debug.ml index 21bf64c45b6..f1a0df2a17e 100644 --- a/ocaml/forkexecd/src/fe_debug.ml +++ b/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 diff --git a/ocaml/libs/log/debug.ml b/ocaml/libs/log/debug.ml index a38051a3cfb..5e63bc2b008 100644 --- a/ocaml/libs/log/debug.ml +++ b/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) ; diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.ml index 8d6d07e012a..2dfd45a7d18 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-encodings/encodings.ml +++ b/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 diff --git a/ocaml/mpathalert/mpathalert.ml b/ocaml/mpathalert/mpathalert.ml index 1ad0daedcec..c236f602702 100644 --- a/ocaml/mpathalert/mpathalert.ml +++ b/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 diff --git a/ocaml/perftest/perfdebug.ml b/ocaml/perftest/perfdebug.ml index c7bdb0e03e7..4c71c8e8ce1 100644 --- a/ocaml/perftest/perfdebug.ml +++ b/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 diff --git a/ocaml/rrd2csv/src/rrd2csv.ml b/ocaml/rrd2csv/src/rrd2csv.ml index bc6022584bd..4e36e581e5b 100644 --- a/ocaml/rrd2csv/src/rrd2csv.ml +++ b/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 diff --git a/ocaml/xapi/certificates_sync.ml b/ocaml/xapi/certificates_sync.ml index 281f63b2154..e578d10e084 100644 --- a/ocaml/xapi/certificates_sync.ml +++ b/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])) diff --git a/ocaml/xapi/import.ml b/ocaml/xapi/import.ml index d695b94469a..bc9d3e1db0b 100644 --- a/ocaml/xapi/import.ml +++ b/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 diff --git a/ocaml/xapi/importexport.ml b/ocaml/xapi/importexport.ml index 12562e53c1b..869aac2a5f0 100644 --- a/ocaml/xapi/importexport.ml +++ b/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 diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 33bcbb7a958..a186b2e8b76 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/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' -> ( diff --git a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml index fede0f4b0d7..80691b0ab9d 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml +++ b/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 diff --git a/ocaml/xe-cli/newcli.ml b/ocaml/xe-cli/newcli.ml index 6768c413c73..3cf21e39abb 100644 --- a/ocaml/xe-cli/newcli.ml +++ b/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 diff --git a/ocaml/xenopsd/lib/xenops_server.ml b/ocaml/xenopsd/lib/xenops_server.ml index 30fc7ea16ac..c7fc910ea33 100644 --- a/ocaml/xenopsd/lib/xenops_server.ml +++ b/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)) diff --git a/ocaml/xenopsd/pvs/pvs_proxy_setup.ml b/ocaml/xenopsd/pvs/pvs_proxy_setup.ml index 8e73cc91696..f7f6f70cb87 100644 --- a/ocaml/xenopsd/pvs/pvs_proxy_setup.ml +++ b/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) diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index a9dabdd9159..6d47a2489ef 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/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 diff --git a/ocaml/xenopsd/xc/domain.ml b/ocaml/xenopsd/xc/domain.ml index f78e7179e6a..d822a1a41cc 100644 --- a/ocaml/xenopsd/xc/domain.ml +++ b/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 -> diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index c94bbd16b3e..a3317194f24 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/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))