diff --git a/doc/content/design/coverage/index.md b/doc/content/design/coverage/index.md index 3b3f6ec3ec7..27ccd0d469a 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,7 @@ terminated by receiving the `TERM` signal, a signal handler must be installed: let stop signal = - printf "caught signal %d\n" signal; + printf "caught signal %a\n" Debug.Pp.signal signal; exit 0 Sys.set_signal Sys.sigterm (Sys.Signal_handle stop) @@ -149,8 +149,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 +176,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 +196,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 +207,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 +226,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 +243,8 @@ library which executables then depend on: MainIs: set_domain_uuid.ml Install: false BuildDepends: - xenctrl, - uuidm, + xenctrl, + uuidm, cmdliner, profiling # <-- here @@ -252,7 +252,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/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 4a8dc687989..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,36 +371,6 @@ 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 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 a3c0fd60d35..c4affe38628 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" + Fmt.(to_to_string Dump.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 = Fmt.(to_to_string Dump.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..02c9dc6a0ed 100644 --- a/ocaml/nbd/src/dune +++ b/ocaml/nbd/src/dune @@ -4,7 +4,7 @@ (libraries cmdliner consts - + fmt local_xapi_session lwt lwt.unix diff --git a/ocaml/networkd/bin/network_server.ml b/ocaml/networkd/bin/network_server.ml index b398ca93b8c..8cc5e9ea908 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 %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 c6f70769313..8a64a576897 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 ; + 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 68dde2a1c48..4d1ede48abd 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -109,9 +109,9 @@ let call_script ?(log_output = Always) ?env ?stdin ?timeout script args = | 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 %a" Debug.Pp.signal n | Unix.WSTOPPED n -> - Printf.sprintf "was stopped by signal %d" 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/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..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 %d" 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 d647c25fd67..1f0f6f153e9 100644 --- a/ocaml/xcp-rrdd/lib/plugin/utils.ml +++ b/ocaml/xcp-rrdd/lib/plugin/utils.ml @@ -63,8 +63,8 @@ let exec_cmd (module D : Debug.DEBUG) ~cmdstring ~(f : string -> 'a option) = | 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 %a" pid Debug.Pp.signal s | Unix.WSTOPPED s -> - D.debug "Process %d was stopped by signal %d" pid 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 0ba4edeb71c..4e80c34ac28 100644 --- a/ocaml/xenopsd/lib/cancellable_subprocess.ml +++ b/ocaml/xenopsd/lib/cancellable_subprocess.ml @@ -76,16 +76,16 @@ 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 -> if !cancelled then ( debug - "Subprocess %s exited with signal %d and cancel requested; \ + "Subprocess %s exited with signal %a and cancel requested; \ raising Cancelled" - cmd n ; + cmd Debug.Pp.signal s ; 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 %a" cmd Debug.Pp.signal s ; + raise (Spawn_internal_error (err, out, Unix.WSIGNALED s)) ) ) | Success (_, Failure (_, exn)) | Failure (_, exn) -> 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 a0b192e6824..cb79fd20991 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 %a" Debug.Pp.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