CA-423576: fix cli_progress_bar crashes (#6892)

cli_progress_bar is used by `xe --progress`, and I've reused it in my
test code in #6858.
However >90% of my test runs failed on various machines due to a
`String.blit` exception from `cli_progress_bar`.

There are 2 possible reasons, not sure which one caused the failure, but
I've fixed both, and now I have a lot more green tests (and the failures
are due to actual bugs in the product, not bugs in the progress bar):
* if the ETA printed would be >99h (even just temporarily) then we'd
overflow the buffer's size and raise an exception. `%02d` means at least
2 digits, not at most!
* if time goes backwards then we'd get a negative ETA and try to print a
`-` and overflow the buffer size again and raise an exception. Replaced
it with monotonic time

This also contains an improvement I've made on the other PR to print
total time in `ms` (to avoid having to solve rebase conflicts twice in
the 2 PRs). This avoids printing awkward looking lines like Total time
00:00:00, when it actually took 0.9s maybe.

Author: edwintorok

ocaml/xapi-cli-server/cli_progress_bar.ml

@@ -25,7 +25,7 @@ module Make (T : Floatable) = struct
     ; width: int
     ; line: bytes
     ; mutable spin_index: int
-    ; start_time: float
+    ; start_time: Mtime_clock.counter
     ; mutable summarised: bool
   }
 
@@ -44,7 +44,7 @@ module Make (T : Floatable) = struct
     String.blit prefix_s 0 line 0 prefix ;
     String.blit suffix_s 0 line (width - suffix - 1) suffix ;
     let spin_index = 0 in
-    let start_time = Unix.gettimeofday () in
+    let start_time = Mtime_clock.counter () in
     {
       max_value
     ; current_value
@@ -55,6 +55,9 @@ module Make (T : Floatable) = struct
     ; summarised= false
     }
 
+  let elapsed t =
+    1e-9 *. (Mtime_clock.count t.start_time |> Mtime.Span.to_float_ns)
+
   let percent t =
     int_of_float T.(to_float t.current_value /. to_float t.max_value *. 100.)
 
@@ -70,10 +73,20 @@ module Make (T : Floatable) = struct
     let h = secs / 3600 in
     let m = secs mod 3600 / 60 in
     let s = secs mod 60 in
-    Printf.sprintf "%02d:%02d:%02d" h m s
+    let str = Printf.sprintf "%02d:%02d:%02d" h m s in
+    if String.length str > 8 then
+      (* negative or > 99 hours *)
+      let str = Printf.sprintf "%05d:%02d" h m in
+      if String.length str > 8 then
+        (* still too long, >11 years *)
+        "++:++:++"
+      else
+        str
+    else
+      str
 
   let eta t =
-    let time_so_far = Unix.gettimeofday () -. t.start_time in
+    let time_so_far = elapsed t in
     let total_time =
       T.(to_float t.max_value /. to_float t.current_value) *. time_so_far
     in
@@ -108,8 +121,8 @@ module Make (T : Floatable) = struct
   let summarise t =
     if not t.summarised then (
       t.summarised <- true ;
-      Printf.sprintf "Total time: %s\n"
-        (hms (int_of_float (Unix.gettimeofday () -. t.start_time)))
+      Format.asprintf "Total time: %a@." Mtime.Span.pp
+        (Mtime_clock.count t.start_time)
     ) else
       ""
 end

ocaml/xapi-cli-server/dune

@@ -8,9 +8,16 @@
     (run %{gen} utils --filter-internal --filter closed)))
 )
 
+(library
+  (name cli_progress_bar)
+  (modules cli_progress_bar)
+  (libraries mtime mtime.clock.os)
+ )
+
 (library
   (name xapi_cli_server)
   (modes best)
+  (modules (:standard \ cli_progress_bar))
   (libraries
     astring
     base64
@@ -37,6 +44,7 @@
     xapi-client
     xapi-cli-protocol
     xapi_aux
+    cli_progress_bar
     clock
     xapi-stdext-pervasives
     xapi-stdext-std