From 5b86063ccfc77c49e82b097b6b0608bf41025e66 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 14 Jan 2025 15:32:18 +0000 Subject: [PATCH 1/2] Log proper names for POSIX signals The integer values that OCaml uses for signals should never be printed as they are. They can cause confusion because they don't match the C POSIX values. Change the unixext function that converts them to string to stop building a list and finding a value in the list to instead use pattern-matching. Also added some more values that got introduced in OCaml 4.03, and return a more compact value for unknown signals, following the same format as Fmt.Dump.signal Signed-off-by: Pau Ruiz Safont --- doc/content/design/coverage/index.md | 39 +++++---- .../lib/xapi-stdext-unix/unixext.ml | 86 ++++++++++++------- ocaml/nbd/src/cleanup.ml | 8 +- ocaml/nbd/src/dune | 2 +- ocaml/networkd/bin/network_server.ml | 3 +- ocaml/xapi-guard/lib/server_interface.ml | 3 +- ocaml/xapi/helpers.ml | 5 +- ocaml/xcp-rrdd/bin/rrdd/dune | 2 - ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml | 2 +- ocaml/xcp-rrdd/lib/plugin/utils.ml | 5 +- ocaml/xenopsd/lib/cancellable_subprocess.ml | 11 +-- ocaml/xenopsd/lib/xenopsd.ml | 7 +- 12 files changed, 107 insertions(+), 66 deletions(-) diff --git a/doc/content/design/coverage/index.md b/doc/content/design/coverage/index.md index 3b3f6ec3ec7..fae989b4867 100644 --- a/doc/content/design/coverage/index.md +++ b/doc/content/design/coverage/index.md @@ -8,7 +8,7 @@ revision: 2 We would like to add optional coverage profiling to existing [OCaml] projects in the context of [XenServer] and [XenAPI]. This article -presents how we do it. +presents how we do it. Binaries instrumented for coverage profiling in the XenServer project need to run in an environment where several services act together as @@ -21,7 +21,7 @@ isolation. To build binaries with coverage profiling, do: ./configure --enable-coverage - make + make Binaries will log coverage data to `/tmp/bisect*.out` from which a coverage report can be generated in `coverage/`: @@ -38,7 +38,7 @@ and logs during execution data to in-memory data structures. Before an instrumented binary terminates, it writes the logged data to a file. This data can then be analysed with the `bisect-ppx-report` tool, to produce a summary of annotated code that highlights what part of a -codebase was executed. +codebase was executed. [BisectPPX] has several desirable properties: @@ -65,13 +65,13 @@ abstracted by OCamlfind (OCaml's library manager) and OCamlbuild # build it with instrumentation from bisect_ppx ocamlbuild -use-ocamlfind -pkg bisect_ppx -pkg unix example.native - + # execute it - generates files ./bisect*.out ./example.native - + # generate report bisect-ppx-report -I _build -html coverage bisect000* - + # view coverage/index.html Summary: @@ -86,7 +86,7 @@ will be instrumented during compilation. Behind the scenes `ocamlfind` makes sure that the compiler uses a preprocessing step that instruments the code. -## Signal Handling +## Signal Handling During execution the code instrumentation leads to the collection of data. This code registers a function with `at_exit` that writes the data @@ -98,7 +98,8 @@ terminated by receiving the `TERM` signal, a signal handler must be installed: let stop signal = - printf "caught signal %d\n" signal; + let name = Xapi_stdext_unix.Unixext.string_of_signal signal in + printf "caught signal %s\n" name; exit 0 Sys.set_signal Sys.sigterm (Sys.Signal_handle stop) @@ -149,8 +150,8 @@ environment variable. This can happen on the command line: BISECT_FILE=/tmp/example ./example.native -In the context of XenServer we could do this in startup scripts. -However, we added a bit of code +In the context of XenServer we could do this in startup scripts. +However, we added a bit of code val Coverage.init: string -> unit @@ -176,12 +177,12 @@ Goals for instrumentation are: * what files are instrumented should be obvious and easy to manage * instrumentation must be optional, yet easy to activate -* avoid methods that require to keep several files in sync like multiple +* avoid methods that require to keep several files in sync like multiple `_oasis` files * avoid separate Git branches for instrumented and non-instrumented code -In the ideal case, we could introduce a configuration switch +In the ideal case, we could introduce a configuration switch `./configure --enable-coverage` that would prepare compilation for coverage instrumentation. While [Oasis] supports the creation of such switches, they cannot be used to control build dependencies like @@ -196,7 +197,7 @@ rules in file `_tags.coverage` that cause files to be instrumented: leads to the execution of this code during preparation: - coverage: _tags _tags.coverage + coverage: _tags _tags.coverage test ! -f _tags.orig && mv _tags _tags.orig || true cat _tags.coverage _tags.orig > _tags @@ -207,7 +208,7 @@ could be tweaked to instrument only some files: <**/*.native>: pkg_bisect_ppx When `make coverage` is not called, these rules are not active and -hence, code is not instrumented for coverage. We believe that this +hence, code is not instrumented for coverage. We believe that this solution to control instrumentation meets the goals from above. In particular, what files are instrumented and when is controlled by very few lines of declarative code that lives in the main repository of a @@ -226,14 +227,14 @@ coverage analysis are: The `_oasis` file bundles the files under `profiling/` into an internal library which executables then depend on: - # Support files for profiling + # Support files for profiling Library profiling CompiledObject: best Path: profiling Install: false Findlibname: profiling Modules: Coverage - BuildDepends: + BuildDepends: Executable set_domain_uuid CompiledObject: best @@ -243,8 +244,8 @@ library which executables then depend on: MainIs: set_domain_uuid.ml Install: false BuildDepends: - xenctrl, - uuidm, + xenctrl, + uuidm, cmdliner, profiling # <-- here @@ -252,7 +253,7 @@ The `Makefile` target `coverage` primes the project for a profiling build: # make coverage - prepares for building with coverage analysis - coverage: _tags _tags.coverage + coverage: _tags _tags.coverage test ! -f _tags.orig && mv _tags _tags.orig || true cat _tags.coverage _tags.orig > _tags diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml index 4a8dc687989..caa5e620b4a 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml @@ -371,35 +371,63 @@ let kill_and_wait ?(signal = Sys.sigterm) ?(timeout = 10.) pid = raise Process_still_alive ) -let string_of_signal x = - let table = - [ - (Sys.sigabrt, "SIGABRT") - ; (Sys.sigalrm, "SIGALRM") - ; (Sys.sigfpe, "SIGFPE") - ; (Sys.sighup, "SIGHUP") - ; (Sys.sigill, "SIGILL") - ; (Sys.sigint, "SIGINT") - ; (Sys.sigkill, "SIGKILL") - ; (Sys.sigpipe, "SIGPIPE") - ; (Sys.sigquit, "SIGQUIT") - ; (Sys.sigsegv, "SIGSEGV") - ; (Sys.sigterm, "SIGTERM") - ; (Sys.sigusr1, "SIGUSR1") - ; (Sys.sigusr2, "SIGUSR2") - ; (Sys.sigchld, "SIGCHLD") - ; (Sys.sigcont, "SIGCONT") - ; (Sys.sigstop, "SIGSTOP") - ; (Sys.sigttin, "SIGTTIN") - ; (Sys.sigttou, "SIGTTOU") - ; (Sys.sigvtalrm, "SIGVTALRM") - ; (Sys.sigprof, "SIGPROF") - ] - in - if List.mem_assoc x table then - List.assoc x table - else - Printf.sprintf "(ocaml signal %d with an unknown name)" x +let string_of_signal = function + | s when s = Sys.sigabrt -> + "SIGABRT" + | s when s = Sys.sigalrm -> + "SIGALRM" + | s when s = Sys.sigfpe -> + "SIGFPE" + | s when s = Sys.sighup -> + "SIGHUP" + | s when s = Sys.sigill -> + "SIGILL" + | s when s = Sys.sigint -> + "SIGINT" + | s when s = Sys.sigkill -> + "SIGKILL" + | s when s = Sys.sigpipe -> + "SIGPIPE" + | s when s = Sys.sigquit -> + "SIGQUIT" + | s when s = Sys.sigsegv -> + "SIGSEGV" + | s when s = Sys.sigterm -> + "SIGTERM" + | s when s = Sys.sigusr1 -> + "SIGUSR1" + | s when s = Sys.sigusr2 -> + "SIGUSR2" + | s when s = Sys.sigchld -> + "SIGCHLD" + | s when s = Sys.sigcont -> + "SIGCONT" + | s when s = Sys.sigstop -> + "SIGSTOP" + | s when s = Sys.sigttin -> + "SIGTTIN" + | s when s = Sys.sigttou -> + "SIGTTOU" + | s when s = Sys.sigvtalrm -> + "SIGVTALRM" + | s when s = Sys.sigprof -> + "SIGPROF" + | s when s = Sys.sigbus -> + "SIGBUS" + | s when s = Sys.sigpoll -> + "SIGPOLL" + | s when s = Sys.sigsys -> + "SIGSYS" + | s when s = Sys.sigtrap -> + "SIGTRAP" + | s when s = Sys.sigurg -> + "SIGURG" + | s when s = Sys.sigxcpu -> + "SIGXCPU" + | s when s = Sys.sigxfsz -> + "SIGXFSZ" + | s -> + Printf.sprintf "SIG(%d)" s let with_polly f = let polly = Polly.create () in diff --git a/ocaml/nbd/src/cleanup.ml b/ocaml/nbd/src/cleanup.ml index a3c0fd60d35..15294e3a02d 100644 --- a/ocaml/nbd/src/cleanup.ml +++ b/ocaml/nbd/src/cleanup.ml @@ -218,6 +218,11 @@ module Runtime = struct Printf.eprintf "SIGINT received - exiting" ; flush stderr ; exit 0 + | Signal n -> + Printf.eprintf "unexpected signal %s in signal handler - exiting" + (Xapi_stdext_unix.Unixext.string_of_signal n) ; + flush stderr ; + exit 1 | e -> Printf.eprintf "unexpected exception %s in signal handler - exiting" (Printexc.to_string e) ; @@ -225,8 +230,9 @@ module Runtime = struct exit 1 let cleanup_resources signal = + let name = Xapi_stdext_unix.Unixext.string_of_signal signal in let cleanup () = - Lwt_log.warning_f "Caught signal %d, cleaning up" signal >>= fun () -> + Lwt_log.warning_f "Caught signal %s, cleaning up" name >>= fun () -> (* First we have to close the open file descriptors corresponding to the VDIs we plugged to dom0. Otherwise the VDI.unplug call would hang. *) ignore_exn_log_error "Caught exception while closing open block devices" diff --git a/ocaml/nbd/src/dune b/ocaml/nbd/src/dune index 076e6884786..6c8c576295f 100644 --- a/ocaml/nbd/src/dune +++ b/ocaml/nbd/src/dune @@ -4,7 +4,6 @@ (libraries cmdliner consts - local_xapi_session lwt lwt.unix @@ -20,6 +19,7 @@ xapi-consts xapi-inventory xapi-types + xapi-stdext-unix xen-api-client-lwt ) ) diff --git a/ocaml/networkd/bin/network_server.ml b/ocaml/networkd/bin/network_server.ml index b398ca93b8c..8c3b78946f3 100644 --- a/ocaml/networkd/bin/network_server.ml +++ b/ocaml/networkd/bin/network_server.ml @@ -53,7 +53,8 @@ let on_shutdown signal = let dbg = "shutdown" in Debug.with_thread_associated dbg (fun () -> - debug "xcp-networkd caught signal %d; performing cleanup actions." signal ; + debug "xcp-networkd caught signal %s; performing cleanup actions." + (Xapi_stdext_unix.Unixext.string_of_signal signal) ; write_config () ) () diff --git a/ocaml/xapi-guard/lib/server_interface.ml b/ocaml/xapi-guard/lib/server_interface.ml index c6f70769313..fc09c32c520 100644 --- a/ocaml/xapi-guard/lib/server_interface.ml +++ b/ocaml/xapi-guard/lib/server_interface.ml @@ -38,7 +38,8 @@ let shutdown = Lwt_switch.create () let () = let cleanup n = - debug "Triggering cleanup on signal %d, and waiting for servers to stop" n ; + let n = Fmt.(to_to_string Dump.signal n) in + debug "Triggering cleanup on signal %s, and waiting for servers to stop" n ; Lwt.async (fun () -> let* () = Lwt_switch.turn_off shutdown in info "Cleanup complete, exiting" ; diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index 68dde2a1c48..3323788a856 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -104,14 +104,15 @@ let call_script ?(log_output = Always) ?env ?stdin ?timeout script args = (ExnHelper.string_of_exn e) ; raise e | Forkhelpers.Spawn_internal_error (stderr, stdout, status) as e -> + let signal = Unixext.string_of_signal in let message = match status with | Unix.WEXITED n -> Printf.sprintf "exited with code %d" n | Unix.WSIGNALED n -> - Printf.sprintf "was killed by signal %d" n + Printf.sprintf "was killed by signal %s" (signal n) | Unix.WSTOPPED n -> - Printf.sprintf "was stopped by signal %d" n + Printf.sprintf "was stopped by signal %s" (signal n) in if should_log_output_on_failure then debug "%s %s %s [stdout = '%s'; stderr = '%s']" script diff --git a/ocaml/xcp-rrdd/bin/rrdd/dune b/ocaml/xcp-rrdd/bin/rrdd/dune index c31182e4142..b8419b12fb8 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/dune +++ b/ocaml/xcp-rrdd/bin/rrdd/dune @@ -5,7 +5,6 @@ (modules (:standard \ xcp_rrdd)) (libraries astring - ezxenstore gzip http_lib @@ -41,7 +40,6 @@ (modules xcp_rrdd) (libraries astring - ezxenstore.core ezxenstore.watch forkexec diff --git a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml index bb0285b4b18..4cdc21a289f 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml +++ b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml @@ -735,7 +735,7 @@ let configure_writers () = (** we need to make sure we call exit on fatal signals to make sure profiling data is dumped *) let stop err writers signal = - debug "caught signal %d" signal ; + debug "caught signal %s" (Xapi_stdext_unix.Unixext.string_of_signal signal) ; List.iter (fun (_, writer) -> writer.Rrd_writer.cleanup ()) writers ; exit err diff --git a/ocaml/xcp-rrdd/lib/plugin/utils.ml b/ocaml/xcp-rrdd/lib/plugin/utils.ml index d647c25fd67..a0db8d6269f 100644 --- a/ocaml/xcp-rrdd/lib/plugin/utils.ml +++ b/ocaml/xcp-rrdd/lib/plugin/utils.ml @@ -59,12 +59,13 @@ let exec_cmd (module D : Debug.DEBUG) ~cmdstring ~(f : string -> 'a option) = (try loop () with End_of_file -> ()) ; Unix.close out_readme ; let pid, status = Forkhelpers.waitpid pid in + let signal = Xapi_stdext_unix.Unixext.string_of_signal in ( match status with | Unix.WEXITED n -> D.debug "Process %d exited normally with code %d" pid n | Unix.WSIGNALED s -> - D.debug "Process %d was killed by signal %d" pid s + D.debug "Process %d was killed by signal %s" pid (signal s) | Unix.WSTOPPED s -> - D.debug "Process %d was stopped by signal %d" pid s + D.debug "Process %d was stopped by signal %s" pid (signal s) ) ; List.rev !vals diff --git a/ocaml/xenopsd/lib/cancellable_subprocess.ml b/ocaml/xenopsd/lib/cancellable_subprocess.ml index 0ba4edeb71c..097be7d3014 100644 --- a/ocaml/xenopsd/lib/cancellable_subprocess.ml +++ b/ocaml/xenopsd/lib/cancellable_subprocess.ml @@ -76,16 +76,17 @@ let run (task : Xenops_task.task_handle) ?env ?stdin fds raise (Spawn_internal_error (err, out, Unix.WEXITED n)) | Unix.WSTOPPED n -> raise (Spawn_internal_error (err, out, Unix.WSTOPPED n)) - | Unix.WSIGNALED n -> + | Unix.WSIGNALED s -> + let signal = Unixext.string_of_signal s in if !cancelled then ( debug - "Subprocess %s exited with signal %d and cancel requested; \ + "Subprocess %s exited with signal %s and cancel requested; \ raising Cancelled" - cmd n ; + cmd signal ; Xenops_task.raise_cancelled task ) else ( - debug "Subprocess %s exited with signal %d" cmd n ; - raise (Spawn_internal_error (err, out, Unix.WSIGNALED n)) + debug "Subprocess %s exited with signal %s" cmd signal ; + raise (Spawn_internal_error (err, out, Unix.WSIGNALED s)) ) ) | Success (_, Failure (_, exn)) | Failure (_, exn) -> diff --git a/ocaml/xenopsd/lib/xenopsd.ml b/ocaml/xenopsd/lib/xenopsd.ml index a0b192e6824..6f3b2bff058 100644 --- a/ocaml/xenopsd/lib/xenopsd.ml +++ b/ocaml/xenopsd/lib/xenopsd.ml @@ -459,8 +459,11 @@ let main backend = ~rpc_fn () in (* we need to catch this to make sure at_exit handlers are triggered. In - particuar, triggers for the bisect_ppx coverage profiling *) - let signal_handler n = debug "caught signal %d" n ; exit 0 in + particular, triggers for the bisect_ppx coverage profiling *) + let signal_handler n = + debug "caught signal %s" (Unixext.string_of_signal n) ; + exit 0 + in Sys.set_signal Sys.sigpipe Sys.Signal_ignore ; Sys.set_signal Sys.sigterm (Sys.Signal_handle signal_handler) ; Xenops_utils.set_fs_backend From c0fbb69d391b2d2341ba9e50dc04d7c02611e234 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 14 Jan 2025 16:46:48 +0000 Subject: [PATCH 2/2] Debug: add pretty-printing function for signals When signals are are written to logs, the POSIX name should be used to minimize confusion. It makes sense that the function that does this is in the logging library instead of the unix one, as most users will be already be using the logging library, but not all the unix one. Moving it there also allows for a more ergonomic usage with the logging functions. Signed-off-by: Pau Ruiz Safont --- doc/content/design/coverage/index.md | 3 +- ocaml/forkexecd/src/child.ml | 4 +- ocaml/libs/log/debug.ml | 6 +- ocaml/libs/log/debug.mli | 4 ++ .../libs/xapi-compression/xapi_compression.ml | 9 +-- .../lib/xapi-stdext-unix/unixext.ml | 58 ------------------- .../lib/xapi-stdext-unix/unixext.mli | 4 -- ocaml/nbd/src/cleanup.ml | 4 +- ocaml/nbd/src/dune | 2 +- ocaml/networkd/bin/network_server.ml | 4 +- ocaml/xapi-guard/lib/server_interface.ml | 4 +- ocaml/xapi/helpers.ml | 5 +- ocaml/xapi/sm_exec.ml | 2 +- ocaml/xapi/xapi_extensions.ml | 3 +- ocaml/xapi/xapi_plugins.ml | 7 +-- ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml | 2 +- ocaml/xcp-rrdd/lib/plugin/utils.ml | 5 +- ocaml/xenopsd/lib/cancellable_subprocess.ml | 7 +-- ocaml/xenopsd/lib/suspend_image.ml | 8 +-- ocaml/xenopsd/lib/xenopsd.ml | 2 +- 20 files changed, 37 insertions(+), 106 deletions(-) diff --git a/doc/content/design/coverage/index.md b/doc/content/design/coverage/index.md index fae989b4867..27ccd0d469a 100644 --- a/doc/content/design/coverage/index.md +++ b/doc/content/design/coverage/index.md @@ -98,8 +98,7 @@ terminated by receiving the `TERM` signal, a signal handler must be installed: let stop signal = - let name = Xapi_stdext_unix.Unixext.string_of_signal signal in - printf "caught signal %s\n" name; + printf "caught signal %a\n" Debug.Pp.signal signal; exit 0 Sys.set_signal Sys.sigterm (Sys.Signal_handle stop) diff --git a/ocaml/forkexecd/src/child.ml b/ocaml/forkexecd/src/child.ml index 1512e3af851..5f79f2fb6c9 100644 --- a/ocaml/forkexecd/src/child.ml +++ b/ocaml/forkexecd/src/child.ml @@ -111,11 +111,11 @@ let report_child_exit comms_sock args child_pid status = Fe.WEXITED n | Unix.WSIGNALED n -> log_failure args child_pid - (Printf.sprintf "exited with signal: %s" (Unixext.string_of_signal n)) ; + (Printf.sprintf "exited with signal: %a" Debug.Pp.signal n) ; Fe.WSIGNALED n | Unix.WSTOPPED n -> log_failure args child_pid - (Printf.sprintf "stopped with signal: %s" (Unixext.string_of_signal n)) ; + (Printf.sprintf "stopped with signal: %a" Debug.Pp.signal n) ; Fe.WSTOPPED n in let result = Fe.Finished pr in diff --git a/ocaml/libs/log/debug.ml b/ocaml/libs/log/debug.ml index 5e63bc2b008..2f73cd47aca 100644 --- a/ocaml/libs/log/debug.ml +++ b/ocaml/libs/log/debug.ml @@ -353,4 +353,8 @@ functor with e -> log_backtrace_internal ~level:Syslog.Debug ~msg:"debug" e () end -module Pp = struct let mtime_span () = Fmt.str "%a" Mtime.Span.pp end +module Pp = struct + let mtime_span () = Fmt.to_to_string Mtime.Span.pp + + let signal () = Fmt.(to_to_string Dump.signal) +end diff --git a/ocaml/libs/log/debug.mli b/ocaml/libs/log/debug.mli index f6301c3d587..4ba72886ce6 100644 --- a/ocaml/libs/log/debug.mli +++ b/ocaml/libs/log/debug.mli @@ -91,4 +91,8 @@ val is_disabled : string -> Syslog.level -> bool module Pp : sig val mtime_span : unit -> Mtime.Span.t -> string + + val signal : unit -> int -> string + (** signal pretty-prints an ocaml signal number as its POSIX name, see + {Fmt.Dump.signal} *) end diff --git a/ocaml/libs/xapi-compression/xapi_compression.ml b/ocaml/libs/xapi-compression/xapi_compression.ml index a0ca8bdc6d5..7349cdef732 100644 --- a/ocaml/libs/xapi-compression/xapi_compression.ml +++ b/ocaml/libs/xapi-compression/xapi_compression.ml @@ -123,7 +123,6 @@ module Make (Algorithm : ALGORITHM) = struct error "%s" msg ; failwith msg in Unixfd.safe_close close_later ; - let open Xapi_stdext_unix in match snd (Forkhelpers.waitpid pid) with | Unix.WEXITED 0 -> () @@ -131,14 +130,10 @@ module Make (Algorithm : ALGORITHM) = struct failwith_error (Printf.sprintf "exit code %d" i) | Unix.WSIGNALED i -> failwith_error - (Printf.sprintf "killed by signal: %s" - (Unixext.string_of_signal i) - ) + (Printf.sprintf "killed by signal: %a" Debug.Pp.signal i) | Unix.WSTOPPED i -> failwith_error - (Printf.sprintf "stopped by signal: %s" - (Unixext.string_of_signal i) - ) + (Printf.sprintf "stopped by signal: %a" Debug.Pp.signal i) ) let compress fd f = go Compress Active fd f diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml index caa5e620b4a..111599f89d5 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.ml @@ -371,64 +371,6 @@ let kill_and_wait ?(signal = Sys.sigterm) ?(timeout = 10.) pid = raise Process_still_alive ) -let string_of_signal = function - | s when s = Sys.sigabrt -> - "SIGABRT" - | s when s = Sys.sigalrm -> - "SIGALRM" - | s when s = Sys.sigfpe -> - "SIGFPE" - | s when s = Sys.sighup -> - "SIGHUP" - | s when s = Sys.sigill -> - "SIGILL" - | s when s = Sys.sigint -> - "SIGINT" - | s when s = Sys.sigkill -> - "SIGKILL" - | s when s = Sys.sigpipe -> - "SIGPIPE" - | s when s = Sys.sigquit -> - "SIGQUIT" - | s when s = Sys.sigsegv -> - "SIGSEGV" - | s when s = Sys.sigterm -> - "SIGTERM" - | s when s = Sys.sigusr1 -> - "SIGUSR1" - | s when s = Sys.sigusr2 -> - "SIGUSR2" - | s when s = Sys.sigchld -> - "SIGCHLD" - | s when s = Sys.sigcont -> - "SIGCONT" - | s when s = Sys.sigstop -> - "SIGSTOP" - | s when s = Sys.sigttin -> - "SIGTTIN" - | s when s = Sys.sigttou -> - "SIGTTOU" - | s when s = Sys.sigvtalrm -> - "SIGVTALRM" - | s when s = Sys.sigprof -> - "SIGPROF" - | s when s = Sys.sigbus -> - "SIGBUS" - | s when s = Sys.sigpoll -> - "SIGPOLL" - | s when s = Sys.sigsys -> - "SIGSYS" - | s when s = Sys.sigtrap -> - "SIGTRAP" - | s when s = Sys.sigurg -> - "SIGURG" - | s when s = Sys.sigxcpu -> - "SIGXCPU" - | s when s = Sys.sigxfsz -> - "SIGXFSZ" - | s -> - Printf.sprintf "SIG(%d)" s - let with_polly f = let polly = Polly.create () in let finally () = Polly.close polly in diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli index bec31c222a6..047935b475c 100644 --- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli +++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-unix/unixext.mli @@ -122,10 +122,6 @@ exception Process_still_alive val kill_and_wait : ?signal:int -> ?timeout:float -> int -> unit -val string_of_signal : int -> string -(** [string_of_signal x] translates an ocaml signal number into - * a string suitable for logging. *) - val proxy : Unix.file_descr -> Unix.file_descr -> unit val really_read : Unix.file_descr -> bytes -> int -> int -> unit diff --git a/ocaml/nbd/src/cleanup.ml b/ocaml/nbd/src/cleanup.ml index 15294e3a02d..c4affe38628 100644 --- a/ocaml/nbd/src/cleanup.ml +++ b/ocaml/nbd/src/cleanup.ml @@ -220,7 +220,7 @@ module Runtime = struct exit 0 | Signal n -> Printf.eprintf "unexpected signal %s in signal handler - exiting" - (Xapi_stdext_unix.Unixext.string_of_signal n) ; + Fmt.(to_to_string Dump.signal n) ; flush stderr ; exit 1 | e -> @@ -230,7 +230,7 @@ module Runtime = struct exit 1 let cleanup_resources signal = - let name = Xapi_stdext_unix.Unixext.string_of_signal signal in + let name = Fmt.(to_to_string Dump.signal signal) in let cleanup () = Lwt_log.warning_f "Caught signal %s, cleaning up" name >>= fun () -> (* First we have to close the open file descriptors corresponding to the diff --git a/ocaml/nbd/src/dune b/ocaml/nbd/src/dune index 6c8c576295f..02c9dc6a0ed 100644 --- a/ocaml/nbd/src/dune +++ b/ocaml/nbd/src/dune @@ -4,6 +4,7 @@ (libraries cmdliner consts + fmt local_xapi_session lwt lwt.unix @@ -19,7 +20,6 @@ xapi-consts xapi-inventory xapi-types - xapi-stdext-unix xen-api-client-lwt ) ) diff --git a/ocaml/networkd/bin/network_server.ml b/ocaml/networkd/bin/network_server.ml index 8c3b78946f3..8cc5e9ea908 100644 --- a/ocaml/networkd/bin/network_server.ml +++ b/ocaml/networkd/bin/network_server.ml @@ -53,8 +53,8 @@ let on_shutdown signal = let dbg = "shutdown" in Debug.with_thread_associated dbg (fun () -> - debug "xcp-networkd caught signal %s; performing cleanup actions." - (Xapi_stdext_unix.Unixext.string_of_signal signal) ; + debug "xcp-networkd caught signal %a; performing cleanup actions." + Debug.Pp.signal signal ; write_config () ) () diff --git a/ocaml/xapi-guard/lib/server_interface.ml b/ocaml/xapi-guard/lib/server_interface.ml index fc09c32c520..8a64a576897 100644 --- a/ocaml/xapi-guard/lib/server_interface.ml +++ b/ocaml/xapi-guard/lib/server_interface.ml @@ -38,8 +38,8 @@ let shutdown = Lwt_switch.create () let () = let cleanup n = - let n = Fmt.(to_to_string Dump.signal n) in - debug "Triggering cleanup on signal %s, and waiting for servers to stop" n ; + debug "Triggering cleanup on signal %a, and waiting for servers to stop" + Debug.Pp.signal n ; Lwt.async (fun () -> let* () = Lwt_switch.turn_off shutdown in info "Cleanup complete, exiting" ; diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index 3323788a856..4d1ede48abd 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -104,15 +104,14 @@ let call_script ?(log_output = Always) ?env ?stdin ?timeout script args = (ExnHelper.string_of_exn e) ; raise e | Forkhelpers.Spawn_internal_error (stderr, stdout, status) as e -> - let signal = Unixext.string_of_signal in let message = match status with | Unix.WEXITED n -> Printf.sprintf "exited with code %d" n | Unix.WSIGNALED n -> - Printf.sprintf "was killed by signal %s" (signal n) + Printf.sprintf "was killed by signal %a" Debug.Pp.signal n | Unix.WSTOPPED n -> - Printf.sprintf "was stopped by signal %s" (signal n) + Printf.sprintf "was stopped by signal %a" Debug.Pp.signal n in if should_log_output_on_failure then debug "%s %s %s [stdout = '%s'; stderr = '%s']" script diff --git a/ocaml/xapi/sm_exec.ml b/ocaml/xapi/sm_exec.ml index 28cdd11e07b..d97e8f41e9b 100644 --- a/ocaml/xapi/sm_exec.ml +++ b/ocaml/xapi/sm_exec.ml @@ -393,7 +393,7 @@ let exec_xmlrpc ~dbg ?context:_ ?(needs_session = true) (driver : string) (Backend_error ( Api_errors.sr_backend_failure , [ - "received signal: " ^ Unixext.string_of_signal i + Printf.sprintf "received signal: %a" Debug.Pp.signal i ; output ; log ] diff --git a/ocaml/xapi/xapi_extensions.ml b/ocaml/xapi/xapi_extensions.ml index dbc38349bdc..301a0a5e686 100644 --- a/ocaml/xapi/xapi_extensions.ml +++ b/ocaml/xapi/xapi_extensions.ml @@ -50,8 +50,7 @@ let call_extension rpc = ( Api_errors.internal_error , [ path - ; Printf.sprintf "signal: %s" - (Xapi_stdext_unix.Unixext.string_of_signal i) + ; Printf.sprintf "signal: %a" Debug.Pp.signal i ; output ; log ] diff --git a/ocaml/xapi/xapi_plugins.ml b/ocaml/xapi/xapi_plugins.ml index 68447081136..3d9b7f0a2d0 100644 --- a/ocaml/xapi/xapi_plugins.ml +++ b/ocaml/xapi/xapi_plugins.ml @@ -49,12 +49,7 @@ let call_plugin session_id plugin_name fn_name args = raise (Api_errors.Server_error ( Api_errors.xenapi_plugin_failure - , [ - Printf.sprintf "signal: %s" - (Xapi_stdext_unix.Unixext.string_of_signal i) - ; output - ; log - ] + , [Printf.sprintf "signal: %a" Debug.Pp.signal i; output; log] ) ) | Forkhelpers.Spawn_internal_error (log, output, Unix.WEXITED _) -> diff --git a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml index 4cdc21a289f..afca11c3ced 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml +++ b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml @@ -735,7 +735,7 @@ let configure_writers () = (** we need to make sure we call exit on fatal signals to make sure profiling data is dumped *) let stop err writers signal = - debug "caught signal %s" (Xapi_stdext_unix.Unixext.string_of_signal signal) ; + debug "caught signal %a" Debug.Pp.signal signal ; List.iter (fun (_, writer) -> writer.Rrd_writer.cleanup ()) writers ; exit err diff --git a/ocaml/xcp-rrdd/lib/plugin/utils.ml b/ocaml/xcp-rrdd/lib/plugin/utils.ml index a0db8d6269f..1f0f6f153e9 100644 --- a/ocaml/xcp-rrdd/lib/plugin/utils.ml +++ b/ocaml/xcp-rrdd/lib/plugin/utils.ml @@ -59,13 +59,12 @@ let exec_cmd (module D : Debug.DEBUG) ~cmdstring ~(f : string -> 'a option) = (try loop () with End_of_file -> ()) ; Unix.close out_readme ; let pid, status = Forkhelpers.waitpid pid in - let signal = Xapi_stdext_unix.Unixext.string_of_signal in ( match status with | Unix.WEXITED n -> D.debug "Process %d exited normally with code %d" pid n | Unix.WSIGNALED s -> - D.debug "Process %d was killed by signal %s" pid (signal s) + D.debug "Process %d was killed by signal %a" pid Debug.Pp.signal s | Unix.WSTOPPED s -> - D.debug "Process %d was stopped by signal %s" pid (signal s) + D.debug "Process %d was stopped by signal %a" pid Debug.Pp.signal s ) ; List.rev !vals diff --git a/ocaml/xenopsd/lib/cancellable_subprocess.ml b/ocaml/xenopsd/lib/cancellable_subprocess.ml index 097be7d3014..4e80c34ac28 100644 --- a/ocaml/xenopsd/lib/cancellable_subprocess.ml +++ b/ocaml/xenopsd/lib/cancellable_subprocess.ml @@ -77,15 +77,14 @@ let run (task : Xenops_task.task_handle) ?env ?stdin fds | Unix.WSTOPPED n -> raise (Spawn_internal_error (err, out, Unix.WSTOPPED n)) | Unix.WSIGNALED s -> - let signal = Unixext.string_of_signal s in if !cancelled then ( debug - "Subprocess %s exited with signal %s and cancel requested; \ + "Subprocess %s exited with signal %a and cancel requested; \ raising Cancelled" - cmd signal ; + cmd Debug.Pp.signal s ; Xenops_task.raise_cancelled task ) else ( - debug "Subprocess %s exited with signal %s" cmd signal ; + debug "Subprocess %s exited with signal %a" cmd Debug.Pp.signal s ; raise (Spawn_internal_error (err, out, Unix.WSIGNALED s)) ) ) diff --git a/ocaml/xenopsd/lib/suspend_image.ml b/ocaml/xenopsd/lib/suspend_image.ml index e08cb53c268..8733b9155cf 100644 --- a/ocaml/xenopsd/lib/suspend_image.ml +++ b/ocaml/xenopsd/lib/suspend_image.ml @@ -275,15 +275,15 @@ let with_conversion_script task name hvm fd f = | Unix.WSIGNALED n -> Error (Failure - (Printf.sprintf "Conversion script exited with signal %s" - (Unixext.string_of_signal n) + (Printf.sprintf "Conversion script exited with signal %a" + Debug.Pp.signal n ) ) | Unix.WSTOPPED n -> Error (Failure - (Printf.sprintf "Conversion script stopped with signal %s" - (Unixext.string_of_signal n) + (Printf.sprintf "Conversion script stopped with signal %a" + Debug.Pp.signal n ) ) ) diff --git a/ocaml/xenopsd/lib/xenopsd.ml b/ocaml/xenopsd/lib/xenopsd.ml index 6f3b2bff058..cb79fd20991 100644 --- a/ocaml/xenopsd/lib/xenopsd.ml +++ b/ocaml/xenopsd/lib/xenopsd.ml @@ -461,7 +461,7 @@ let main backend = (* we need to catch this to make sure at_exit handlers are triggered. In particular, triggers for the bisect_ppx coverage profiling *) let signal_handler n = - debug "caught signal %s" (Unixext.string_of_signal n) ; + debug "caught signal %a" Debug.Pp.signal n ; exit 0 in Sys.set_signal Sys.sigpipe Sys.Signal_ignore ;