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

Author: psafont

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,16 +244,16 @@ library which executables then depend on:
 			MainIs:             set_domain_uuid.ml
 			Install:            false
 			BuildDepends:
-				xenctrl, 
-				uuidm, 
+				xenctrl,
+				uuidm,
 				cmdliner,
 				profiling			# <-- here
 
 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
 

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

ocaml/nbd/src/cleanup.ml

@@ -218,15 +218,21 @@ 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) ;
         flush stderr ;
         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"

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

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

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" ;

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

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

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
 

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