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 ;