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 <[email protected]>

Author: psafont

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)

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

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

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

ocaml/libs/xapi-compression/xapi_compression.ml

@@ -123,22 +123,17 @@ 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 ->
             ()
         | Unix.WEXITED i ->
             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

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

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

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

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
   )
 )

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 ()
     )
     ()