diff --git a/clock.opam b/clock.opam
new file mode 100644
index 00000000000..44c24235c58
--- /dev/null
+++ b/clock.opam
@@ -0,0 +1,32 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Xapi's library for managing time"
+maintainer: ["Xapi project maintainers"]
+authors: ["Jonathan Ludlam" "Pau Ruiz Safont"]
+license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception"
+homepage: "https://xapi-project.github.io/"
+bug-reports: "https://github.com/xapi-project/xen-api/issues"
+depends: [
+  "dune" {>= "3.0"}
+  "ocaml" {>= "4.12"}
+  "alcotest" {with-test}
+  "astring"
+  "mtime"
+  "ptime"
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/xapi-project/xen-api.git"
diff --git a/dune-project b/dune-project
index 87ebda7a964..3240d722d69 100644
--- a/dune-project
+++ b/dune-project
@@ -15,6 +15,20 @@
   (name zstd)
 )
 
+
+(package
+  (name clock)
+  (synopsis "Xapi's library for managing time")
+  (authors "Jonathan Ludlam" "Pau Ruiz Safont")
+  (depends
+    (ocaml (>= 4.12))
+    (alcotest :with-test)
+    astring
+    mtime
+    ptime
+  )
+)
+
 (package
   (name xapi-rrdd-plugin)
 )
@@ -451,19 +465,17 @@ This package provides an Lwt compatible interface to the library.")
 (package
   (name xapi-stdext-date)
   (synopsis "Xapi's standard library extension, Dates")
+  (authors "Jonathan Ludlam")
   (depends
-    (ocaml (>= 4.12))
-    (alcotest :with-test)
-    astring
-    base-unix
+    (clock (= :version))
     ptime
-    (odoc :with-doc)
   )
 )
 
 (package
   (name xapi-stdext-encodings)
   (synopsis "Xapi's standard library extension, Encodings")
+  (authors "Jonathan Ludlam")
   (depends
     (ocaml (>= 4.13.0))
     (alcotest (and (>= 0.6.0) :with-test))
@@ -477,6 +489,7 @@ This package provides an Lwt compatible interface to the library.")
 (package
   (name xapi-stdext-pervasives)
   (synopsis "Xapi's standard library extension, Pervasives")
+  (authors "Jonathan Ludlam")
   (depends
     (ocaml (>= 4.08))
     logs
@@ -498,6 +511,7 @@ This package provides an Lwt compatible interface to the library.")
 (package
   (name xapi-stdext-threads)
   (synopsis "Xapi's standard library extension, Threads")
+  (authors "Jonathan Ludlam")
   (depends
     ocaml
     base-threads
@@ -510,6 +524,7 @@ This package provides an Lwt compatible interface to the library.")
 (package
   (name xapi-stdext-unix)
   (synopsis "Xapi's standard library extension, Unix")
+  (authors "Jonathan Ludlam")
   (depends
     (ocaml (>= 4.12.0))
     base-unix
@@ -524,6 +539,7 @@ This package provides an Lwt compatible interface to the library.")
 (package
   (name xapi-stdext-zerocheck)
   (synopsis "Xapi's standard library extension, Zerocheck")
+  (authors "Jonathan Ludlam")
   (depends
     ocaml
     (odoc :with-doc)
diff --git a/ocaml/libs/clock/date.ml b/ocaml/libs/clock/date.ml
new file mode 100644
index 00000000000..a4a43cde623
--- /dev/null
+++ b/ocaml/libs/clock/date.ml
@@ -0,0 +1,170 @@
+(* Copyright (C) Cloud Software Group Inc.
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; version 2.1 only. with the special
+   exception on linking described in file LICENSE.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU Lesser General Public License for more details.
+*)
+
+let months =
+  [|
+     "Jan"
+   ; "Feb"
+   ; "Mar"
+   ; "Apr"
+   ; "May"
+   ; "Jun"
+   ; "Jul"
+   ; "Aug"
+   ; "Sep"
+   ; "Oct"
+   ; "Nov"
+   ; "Dec"
+  |]
+
+let days = [|"Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat"|]
+
+type print_timezone = Empty | TZ of string
+
+(* we must store the print_type with iso8601 to handle the case where the local time zone is UTC *)
+type t = Ptime.date * Ptime.time * print_timezone
+
+let utc = TZ "Z"
+
+let of_dt print_type dt =
+  let date, time = dt in
+  (date, time, print_type)
+
+let to_dt (date, time, _) = (date, time)
+
+let best_effort_iso8601_to_rfc3339 x =
+  (* (a) add dashes
+   * (b) add UTC tz if no tz provided *)
+  let x =
+    try
+      Scanf.sscanf x "%04d%02d%02dT%s" (fun y mon d rest ->
+          Printf.sprintf "%04d-%02d-%02dT%s" y mon d rest
+      )
+    with _ -> x
+  in
+  let tz =
+    try
+      Scanf.sscanf x "%04d-%02d-%02dT%02d:%02d:%02d%s" (fun _ _ _ _ _ _ tz ->
+          Some tz
+      )
+    with _ -> None
+  in
+  match tz with
+  | None | Some "" ->
+      (* the caller didn't specify a tz. we must try to add one so that ptime can at least attempt to parse *)
+      (Printf.sprintf "%sZ" x, Empty)
+  | Some tz ->
+      (x, TZ tz)
+
+let of_iso8601 x =
+  let rfc3339, print_timezone = best_effort_iso8601_to_rfc3339 x in
+  match Ptime.of_rfc3339 rfc3339 |> Ptime.rfc3339_error_to_msg with
+  | Error _ ->
+      invalid_arg (Printf.sprintf "%s: %s" __FUNCTION__ x)
+  | Ok (t, tz, _) -> (
+    match tz with
+    | None | Some 0 ->
+        Ptime.to_date_time t |> of_dt print_timezone
+    | Some _ ->
+        invalid_arg (Printf.sprintf "%s: %s" __FUNCTION__ x)
+  )
+
+let to_rfc3339 ((y, mon, d), ((h, min, s), _), print_type) =
+  match print_type with
+  | TZ tz ->
+      Printf.sprintf "%04i%02i%02iT%02i:%02i:%02i%s" y mon d h min s tz
+  | Empty ->
+      Printf.sprintf "%04i%02i%02iT%02i:%02i:%02i" y mon d h min s
+
+(* Extracted from tondering.dk/claus/cal/chrweek.php#calcdow *)
+let weekday ~year ~mon ~day =
+  let a = (14 - mon) / 12 in
+  let y = year - a in
+  let m = mon + (12 * a) - 2 in
+  (day + y + (y / 4) - (y / 100) + (y / 400) + (31 * m / 12)) mod 7
+
+let to_rfc822 ((year, mon, day), ((h, min, s), _), print_type) =
+  let timezone =
+    match print_type with Empty | TZ "Z" -> "GMT" | TZ tz -> tz
+  in
+  let weekday = weekday ~year ~mon ~day in
+  Printf.sprintf "%s, %d %s %d %02d:%02d:%02d %s" days.(weekday) day
+    months.(mon - 1)
+    year h min s timezone
+
+let to_ptime_t t =
+  match to_dt t |> Ptime.of_date_time with
+  | Some t ->
+      t
+  | None ->
+      let _, (_, offset), _ = t in
+      invalid_arg
+        (Printf.sprintf "%s: dt='%s', offset='%i' is invalid" __FUNCTION__
+           (to_rfc3339 t) offset
+        )
+
+let to_ptime = to_ptime_t
+
+let of_ptime t = Ptime.to_date_time t |> of_dt utc
+
+let of_unix_time s =
+  match Ptime.of_float_s s with
+  | None ->
+      invalid_arg (Printf.sprintf "%s: %f" __FUNCTION__ s)
+  | Some t ->
+      of_ptime t
+
+let to_unix_time t = to_ptime_t t |> Ptime.to_float_s
+
+let _localtime current_tz_offset t =
+  let tz_offset_s = current_tz_offset |> Option.value ~default:0 in
+  let localtime = t |> Ptime.to_date_time ~tz_offset_s |> of_dt Empty in
+  let _, (_, localtime_offset), _ = localtime in
+  if localtime_offset <> tz_offset_s then
+    invalid_arg
+      (Printf.sprintf "%s: offsets don't match. offset='%i', t='%s'"
+         __FUNCTION__ tz_offset_s (Ptime.to_rfc3339 t)
+      ) ;
+  localtime
+
+let _localtime_string current_tz_offset t =
+  _localtime current_tz_offset t |> to_rfc3339
+
+let localtime () =
+  _localtime (Ptime_clock.current_tz_offset_s ()) (Ptime_clock.now ())
+
+let now () = of_ptime (Ptime_clock.now ())
+
+let epoch = of_ptime Ptime.epoch
+
+let is_earlier ~than t = Ptime.is_earlier ~than:(to_ptime than) (to_ptime t)
+
+let is_later ~than t = Ptime.is_later ~than:(to_ptime than) (to_ptime t)
+
+let diff a b = Ptime.diff (to_ptime a) (to_ptime b)
+
+let compare_print_tz a b =
+  match (a, b) with
+  | Empty, Empty ->
+      0
+  | TZ a_s, TZ b_s ->
+      String.compare a_s b_s
+  | Empty, TZ _ ->
+      -1
+  | TZ _, Empty ->
+      1
+
+let compare ((_, _, a_z) as a) ((_, _, b_z) as b) =
+  let ( <?> ) a b = if a = 0 then b else a in
+  Ptime.compare (to_ptime a) (to_ptime b) <?> compare_print_tz a_z b_z
+
+let eq x y = compare x y = 0
diff --git a/ocaml/libs/clock/date.mli b/ocaml/libs/clock/date.mli
new file mode 100644
index 00000000000..2a0123813b3
--- /dev/null
+++ b/ocaml/libs/clock/date.mli
@@ -0,0 +1,76 @@
+(*
+ * Copyright (C) 2006-2009 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+(** date-time with support for keeping timezone for ISO 8601 conversion *)
+type t
+
+(** Conversions *)
+
+val of_ptime : Ptime.t -> t
+(** Convert ptime to time in UTC *)
+
+val to_ptime : t -> Ptime.t
+(** Convert date/time to a ptime value: the number of seconds since 00:00:00
+    UTC, 1 Jan 1970. Assumes the underlying {!t} is in UTC *)
+
+val of_unix_time : float -> t
+(** Convert calendar time [x] (as returned by e.g. Unix.time), to time in UTC *)
+
+val to_unix_time : t -> float
+(** Convert date/time to a unix timestamp: the number of seconds since
+    00:00:00 UTC, 1 Jan 1970. Assumes the underlying {!t} is in UTC *)
+
+val to_rfc822 : t -> string
+(** Convert date/time to email-formatted (RFC 822) string. *)
+
+val to_rfc3339 : t -> string
+(** Convert date/time to an RFC-3339-formatted string. It also complies with
+    the ISO 8601 format *)
+
+val of_iso8601 : string -> t
+(** Convert ISO 8601 formatted string to a date/time value. Does not accept a
+    timezone annotated datetime - i.e. string must be UTC, and end with a Z *)
+
+val epoch : t
+(** 00:00:00 UTC, 1 Jan 1970, in UTC *)
+
+val now : unit -> t
+(** Count the number of seconds passed since 00:00:00 UTC, 1 Jan 1970, in UTC *)
+
+val _localtime_string : Ptime.tz_offset_s option -> Ptime.t -> string
+(** exposed for testing *)
+
+val localtime : unit -> t
+(** Count the number of seconds passed since 00:00:00 UTC, 1 Jan 1970, in local
+    time *)
+
+(** Comparisons *)
+
+val eq : t -> t -> bool
+(** [eq a b] returns whether [a] and [b] are equal *)
+
+val compare : t -> t -> int
+(** [compare a b] returns -1 if [a] is earlier than [b], 1 if [a] is later than
+    [b] or the ordering of the timezone printer *)
+
+val is_earlier : than:t -> t -> bool
+(** [is_earlier ~than a] returns whether the timestamp [a] happens before
+    [than] *)
+
+val is_later : than:t -> t -> bool
+(** [is_later ~than a] returns whether the timestamp [a] happens after [than]
+    *)
+
+val diff : t -> t -> Ptime.Span.t
+(** [diff a b] returns the span of time corresponding to [a - b] *)
diff --git a/ocaml/libs/clock/dune b/ocaml/libs/clock/dune
new file mode 100644
index 00000000000..009e2ba7176
--- /dev/null
+++ b/ocaml/libs/clock/dune
@@ -0,0 +1,20 @@
+(library
+  (name clock)
+  (public_name clock)
+  (modules date timer)
+  (libraries
+    astring
+    fmt
+    (re_export mtime)
+    mtime.clock.os
+    (re_export ptime)
+    ptime.clock.os
+  )
+)
+
+(tests
+  (names test_date test_timer)
+  (package clock)
+  (modules test_date test_timer)
+  (libraries alcotest clock fmt mtime ptime qcheck-core qcheck-core.runner)
+)
diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/test.ml b/ocaml/libs/clock/test_date.ml
similarity index 97%
rename from ocaml/libs/xapi-stdext/lib/xapi-stdext-date/test.ml
rename to ocaml/libs/clock/test_date.ml
index c839722d81f..78f673f635c 100644
--- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/test.ml
+++ b/ocaml/libs/clock/test_date.ml
@@ -1,4 +1,4 @@
-open Xapi_stdext_date.Date
+open Clock.Date
 
 let check_float = Alcotest.(check @@ float 1e-2)
 
@@ -26,8 +26,7 @@ let tests =
     (* UTC is valid *)
     let non_utc = "2020-12-20T18:10:19+02:00" in
     let exn =
-      Invalid_argument
-        "Xapi_stdext_date__Date.of_iso8601: 2020-12-20T18:10:19+02:00"
+      Invalid_argument "Clock__Date.of_iso8601: 2020-12-20T18:10:19+02:00"
     in
     Alcotest.check_raises "only UTC is accepted" exn (fun () ->
         of_iso8601 non_utc |> ignore
diff --git a/ocaml/libs/clock/test_date.mli b/ocaml/libs/clock/test_date.mli
new file mode 100644
index 00000000000..e69de29bb2d
diff --git a/ocaml/libs/clock/test_timer.ml b/ocaml/libs/clock/test_timer.ml
new file mode 100644
index 00000000000..2d5e20d7d8a
--- /dev/null
+++ b/ocaml/libs/clock/test_timer.ml
@@ -0,0 +1,233 @@
+module Timer = Clock.Timer
+module Gen = QCheck2.Gen
+module Test = QCheck2.Test
+
+module QCheck_alcotest = struct
+  (* SPDX: BSD-2-Clause
+     From github.com/c-cube/qcheck
+  *)
+
+  module Q = QCheck2
+  module T = QCheck2.Test
+  module Raw = QCheck_base_runner.Raw
+
+  let seed_ =
+    lazy
+      (let s =
+         try int_of_string @@ Sys.getenv "QCHECK_SEED"
+         with _ -> Random.self_init () ; Random.int 1_000_000_000
+       in
+       Printf.printf "qcheck random seed: %d\n%!" s ;
+       s
+      )
+
+  let default_rand () =
+    (* random seed, for repeatability of tests *)
+    Random.State.make [|Lazy.force seed_|]
+
+  let verbose_ =
+    lazy
+      ( match Sys.getenv "QCHECK_VERBOSE" with
+      | "1" | "true" ->
+          true
+      | _ ->
+          false
+      | exception Not_found ->
+          false
+      )
+
+  let long_ =
+    lazy
+      ( match Sys.getenv "QCHECK_LONG" with
+      | "1" | "true" ->
+          true
+      | _ ->
+          false
+      | exception Not_found ->
+          false
+      )
+
+  let to_alcotest ?(colors = false) ?(verbose = Lazy.force verbose_)
+      ?(long = Lazy.force long_) ?(debug_shrink = None) ?debug_shrink_list
+      ?(rand = default_rand ()) (t : T.t) =
+    let (T.Test cell) = t in
+    let handler name cell r =
+      match (r, debug_shrink) with
+      | QCheck2.Test.Shrunk (step, x), Some out ->
+          let go =
+            match debug_shrink_list with
+            | None ->
+                true
+            | Some test_list ->
+                List.mem name test_list
+          in
+          if not go then
+            ()
+          else
+            QCheck_base_runner.debug_shrinking_choices ~colors ~out ~name cell
+              ~step x
+      | _ ->
+          ()
+    in
+    let print = Raw.print_std in
+    let name = T.get_name cell in
+    let run () =
+      let call = Raw.callback ~colors ~verbose ~print_res:true ~print in
+      T.check_cell_exn ~long ~call ~handler ~rand cell
+    in
+    ((name, `Slow, run) : unit Alcotest.test_case)
+end
+
+let spans =
+  Gen.oneofa ([|1; 100; 300|] |> Array.map (fun v -> Mtime.Span.(v * ms)))
+
+let test_timer_remaining =
+  let print = Fmt.to_to_string Mtime.Span.pp in
+  Test.make ~name:"Timer.remaining" ~print spans @@ fun duration ->
+  let timer = Timer.start ~duration in
+  let half = Timer.span_to_s duration /. 2. in
+  let elapsed = Mtime_clock.counter () in
+  Printf.printf "Sleeping for %f seconds...\n" half ;
+  Unix.sleepf half ;
+  let actual = Mtime_clock.count elapsed in
+  (* We expect to have slept [half] seconds, but we could've been woken up later
+     by the OS, it'll never be exact. Check that we're not too far off, or the
+     Expired / Remaining test below will be wrong.
+     The following equation must hold:
+     [duration / 2 <= actual < duration]
+  *)
+  QCheck2.assume (Timer.span_is_shorter actual ~than:duration) ;
+  QCheck2.assume
+    (not (Timer.span_is_shorter Mtime.Span.(2 * actual) ~than:duration)) ;
+  let () =
+    match Timer.remaining timer with
+    | Expired t ->
+        Test.fail_reportf
+          "Expected to have spare time, but got excess: %a. Duration: %a, \
+           actual: %a, timer: %a"
+          Mtime.Span.pp t Mtime.Span.pp duration Mtime.Span.pp actual Timer.pp
+          timer
+    | Remaining t ->
+        if Timer.span_is_longer Mtime.Span.(2 * t) ~than:duration then
+          Test.fail_reportf
+            "Expected to have less than half spare time, but got: %a. \
+             Duration: %a, actual: %a, timer: %a"
+            Mtime.Span.pp t Mtime.Span.pp duration Mtime.Span.pp actual Timer.pp
+            timer
+  in
+
+  (* 3 * half > duration, so we expect Excess to be reported now *)
+  Unix.sleepf (2. *. half) ;
+  let actual = Mtime_clock.count elapsed in
+  QCheck2.assume (Timer.span_is_longer actual ~than:duration) ;
+  let () =
+    match Timer.remaining timer with
+    | Expired _ ->
+        ()
+    | Remaining t ->
+        Test.fail_reportf
+          "Expected to have excess time, but got spare: %a. Duration: %a, \
+           actual: %a, timer: %a"
+          Mtime.Span.pp t Mtime.Span.pp duration Mtime.Span.pp actual Timer.pp
+          timer
+  in
+  if not (Timer.has_expired timer) then
+    Test.fail_reportf "Expected Timer to have expired. Duration: %a, timer: %a"
+      Mtime.Span.pp duration Timer.pp timer ;
+  true
+
+let tests_timer = List.map QCheck_alcotest.to_alcotest [test_timer_remaining]
+
+let combinations =
+  let pair x y = (x, y) in
+  let rec loop acc = function
+    | x :: xs ->
+        let acc = List.map (pair x) xs :: acc in
+        loop acc xs
+    | [] ->
+        List.(concat (rev acc))
+  in
+  loop []
+
+let test_span_compare =
+  let shortest = Mtime.Span.zero in
+  let long = Mtime.Span.of_uint64_ns Int64.max_int in
+  let longest = Mtime.Span.of_uint64_ns (-1L) in
+  let spec = combinations [shortest; long; longest] in
+  let pp_spec () = Fmt.str "%a" (Fmt.Dump.pair Mtime.Span.pp Mtime.Span.pp) in
+  let test_shorter (a, b) () =
+    let ( < ) a b = Mtime.Span.compare a b < 0 in
+    Alcotest.(check bool)
+      "is_shorter doesn't match compare" (a < b)
+      (Timer.span_is_shorter a ~than:b)
+  in
+  let tests_shorter =
+    List.map
+      (fun t ->
+        (Printf.sprintf "is_shorter %a" pp_spec t, `Quick, test_shorter t)
+      )
+      spec
+  in
+  let test_longer (a, b) () =
+    let ( > ) a b = Mtime.Span.compare a b > 0 in
+    Alcotest.(check bool)
+      "is_longer doesn't match compare" (a > b)
+      (Timer.span_is_longer a ~than:b)
+  in
+  let tests_longer =
+    List.map
+      (fun t -> (Printf.sprintf "is_longer %a" pp_spec t, `Quick, test_longer t))
+      spec
+  in
+  List.concat [tests_shorter; tests_longer]
+
+let test_conversion_to_s =
+  let shortest = Mtime.Span.zero in
+  let long = Mtime.Span.(104 * day) in
+  let longer = Mtime.Span.(105 * day) in
+  let spec = [(shortest, 0.); (long, 8.9856e+06); (longer, 9.072e+06)] in
+  let pp_spec () = Fmt.str "%a" Fmt.(Dump.pair Mtime.Span.pp float) in
+  let test_span_to_s (input, expected) () =
+    let actual = Timer.span_to_s input in
+    Alcotest.(check (float Float.epsilon))
+      "seconds match span length" expected actual
+  in
+  List.map
+    (fun t ->
+      (Printf.sprintf "span_to_s %a" pp_spec t, `Quick, test_span_to_s t)
+    )
+    spec
+
+let test_conversion_from_s =
+  let span = Alcotest.testable Mtime.Span.pp Mtime.Span.equal in
+  let shortest = 0. in
+  let short_enough = 9_007_199.254_740_991 in
+  let too_long = 9_007_199.254_740_992 in
+  let neg = -1. in
+  let spec =
+    let open Mtime.Span in
+    [
+      (shortest, Some zero)
+    ; (short_enough, Some (9_007_199_254_740_991 * ns))
+    ; (too_long, None)
+    ; (neg, None)
+    ]
+  in
+  let pp_spec () =
+    Fmt.str "%a" Fmt.(Dump.pair float (Dump.option Mtime.Span.pp))
+  in
+  let test_span_to_s (input, expected) () =
+    let actual = Timer.s_to_span input in
+    Alcotest.(check @@ option span)
+      "span length matches seconds" expected actual
+  in
+  List.map
+    (fun t ->
+      (Printf.sprintf "span_to_s %a" pp_spec t, `Quick, test_span_to_s t)
+    )
+    spec
+
+let tests_span =
+  List.concat [test_conversion_to_s; test_conversion_from_s; test_span_compare]
+
+let () = Alcotest.run "Timer" [("Timer", tests_timer); ("Span", tests_span)]
diff --git a/ocaml/libs/clock/test_timer.mli b/ocaml/libs/clock/test_timer.mli
new file mode 100644
index 00000000000..e69de29bb2d
diff --git a/ocaml/libs/clock/timer.ml b/ocaml/libs/clock/timer.ml
new file mode 100644
index 00000000000..b4ef6dadaf9
--- /dev/null
+++ b/ocaml/libs/clock/timer.ml
@@ -0,0 +1,54 @@
+type t = {elapsed: Mtime_clock.counter; duration: Mtime.Span.t}
+
+type countdown = Remaining of Mtime.Span.t | Expired of Mtime.Span.t
+
+let span_is_shorter a ~than:b = Mtime.Span.compare a b < 0
+
+let span_is_longer a ~than:b = Mtime.Span.compare a b > 0
+
+let start ~duration = {elapsed= Mtime_clock.counter (); duration}
+
+let duration {duration; _} = duration
+
+let elapsed t = Mtime_clock.count t.elapsed
+
+let remaining t =
+  let elapsed = Mtime_clock.count t.elapsed in
+  let difference = Mtime.Span.abs_diff elapsed t.duration in
+  if span_is_shorter elapsed ~than:t.duration then
+    Remaining difference
+  else
+    Expired difference
+
+let has_expired t =
+  let elapsed = Mtime_clock.count t.elapsed in
+  not (span_is_shorter elapsed ~than:t.duration)
+
+let shorten_by dur t =
+  let duration =
+    if span_is_longer dur ~than:t.duration then
+      Mtime.Span.zero
+    else
+      Mtime.Span.abs_diff dur t.duration
+  in
+  {t with duration}
+
+let extend_by dur t =
+  let duration = Mtime.Span.add dur t.duration in
+  {t with duration}
+
+let pp =
+  let open Fmt in
+  record
+    [
+      field "elapsed" elapsed Mtime.Span.pp
+    ; field "duration" duration Mtime.Span.pp
+    ]
+
+(* Conversion functions *)
+
+(* Rounding errors when there are more than 2^44 seconds, or about ~55 years.
+   *)
+let span_to_s span = Mtime.Span.to_float_ns span |> fun ns -> ns *. 1e-9
+
+let s_to_span s = Mtime.Span.of_float_ns (s *. 1e9 |> Float.round)
diff --git a/ocaml/libs/clock/timer.mli b/ocaml/libs/clock/timer.mli
new file mode 100644
index 00000000000..8a60bb89382
--- /dev/null
+++ b/ocaml/libs/clock/timer.mli
@@ -0,0 +1,59 @@
+(** This module is useful for knowing that a set amount of time has passed
+    since a particular moment in time. For example, to know when pasta is
+    cooked al dente. They are meant to be used by polling them. *)
+type t
+
+type countdown = Remaining of Mtime.Span.t | Expired of Mtime.Span.t
+
+val start : duration:Mtime.Span.t -> t
+(** [start ~duration] starts a timer that expires after [duration] has elapsed.
+    The elapsed time is counted in monotonic time, not in POSIX time. *)
+
+val duration : t -> Mtime.Span.t
+(** [duration timer] returns the amount of time after which the timer expires,
+    from the moment it was started. *)
+
+val has_expired : t -> bool
+(** [has_expired timer] returns whether [timer] has reached its duration. *)
+
+val elapsed : t -> Mtime.Span.t
+(** [elapsed timer] returns the amount of time elapsed since [timer] was
+    started. *)
+
+val remaining : t -> countdown
+(** [remaining timer] returns the amount of time left until [timer] expires or
+    the amount of time since it expired. *)
+
+val shorten_by : Mtime.Span.t -> t -> t
+(** [shorten_by amount timer] creates a new timer with the duration of [timer]
+    shortened by [amount]. The starting time doesn't change. The duration of a
+    timer cannot go below 0. When a timer has a duration of 0, it's always
+    considered expired. *)
+
+val extend_by : Mtime.Span.t -> t -> t
+(** [extend_by amount timer] creates a new timer with the duration of [timer]
+    delayed by [amount]. The starting time doesn't change. *)
+
+val pp : t Fmt.t
+(** [pp] pretty-prints the timer. It uses the system clock to calculate
+    the elapsed time every time the timer is printed. *)
+
+(** Mtime.Span helpers *)
+
+val span_is_shorter : Mtime.Span.t -> than:Mtime.Span.t -> bool
+(** [is_shorter dur ~than] returns whether [dur] lasts less than [than]. *)
+
+val span_is_longer : Mtime.Span.t -> than:Mtime.Span.t -> bool
+(** [is_longer dur ~than] returns whether [dur] lasts more than [than]. *)
+
+val span_to_s : Mtime.Span.t -> float
+(** [span_to_s span] converts a time span into seconds, represented by a float.
+    When the span is longer than ~55 years, rounding errors appear. Avoid
+    whenever possible, this is unavoidable when using Thread.wait functions and
+    related. *)
+
+val s_to_span : float -> Mtime.Span.t option
+(** [s_to_span seconds] converts a float representing seconds to a timespan.
+    Returns None when [seconds] is negative, is not a number or larger than
+    ~104 days. Avoid whenever possible, some RPC function already use this so
+    it needs to be available. *)
diff --git a/ocaml/libs/log/debug.ml b/ocaml/libs/log/debug.ml
index b4a5721b9e3..a38051a3cfb 100644
--- a/ocaml/libs/log/debug.ml
+++ b/ocaml/libs/log/debug.ml
@@ -352,3 +352,5 @@ functor
       try f ()
       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
diff --git a/ocaml/libs/log/debug.mli b/ocaml/libs/log/debug.mli
index af1b214b2fe..f6301c3d587 100644
--- a/ocaml/libs/log/debug.mli
+++ b/ocaml/libs/log/debug.mli
@@ -88,3 +88,7 @@ module Make : functor (_ : BRAND) -> DEBUG
 val is_disabled : string -> Syslog.level -> bool
 (** [is_disabled brand level] returns [true] if logging for [brand] at [level]
     is disabled, * otherwise returns [false]. *)
+
+module Pp : sig
+  val mtime_span : unit -> Mtime.Span.t -> string
+end
diff --git a/ocaml/libs/log/dune b/ocaml/libs/log/dune
index b8b637e7bf5..fdfd739d082 100644
--- a/ocaml/libs/log/dune
+++ b/ocaml/libs/log/dune
@@ -6,6 +6,8 @@
    (names syslog_stubs))
  (libraries
    astring
+   fmt
+   mtime
    logs
    threads.posix
    xapi-backtrace
diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.ml
index 77f3994fe68..45e9bba5efb 100644
--- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.ml
+++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/date.ml
@@ -12,163 +12,7 @@
  * GNU Lesser General Public License for more details.
  *)
 
-let months =
-  [|
-     "Jan"
-   ; "Feb"
-   ; "Mar"
-   ; "Apr"
-   ; "May"
-   ; "Jun"
-   ; "Jul"
-   ; "Aug"
-   ; "Sep"
-   ; "Oct"
-   ; "Nov"
-   ; "Dec"
-  |]
-
-let days = [|"Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat"|]
-
-type print_timezone = Empty | TZ of string
-
-(* we must store the print_type with iso8601 to handle the case where the local time zone is UTC *)
-type t = Ptime.date * Ptime.time * print_timezone
-
-let utc = TZ "Z"
-
-let of_dt print_type dt =
-  let date, time = dt in
-  (date, time, print_type)
-
-let to_dt (date, time, _) = (date, time)
-
-let best_effort_iso8601_to_rfc3339 x =
-  (* (a) add dashes
-   * (b) add UTC tz if no tz provided *)
-  let x =
-    try
-      Scanf.sscanf x "%04d%02d%02dT%s" (fun y mon d rest ->
-          Printf.sprintf "%04d-%02d-%02dT%s" y mon d rest
-      )
-    with _ -> x
-  in
-  let tz =
-    try
-      Scanf.sscanf x "%04d-%02d-%02dT%02d:%02d:%02d%s" (fun _ _ _ _ _ _ tz ->
-          Some tz
-      )
-    with _ -> None
-  in
-  match tz with
-  | None | Some "" ->
-      (* the caller didn't specify a tz. we must try to add one so that ptime can at least attempt to parse *)
-      (Printf.sprintf "%sZ" x, Empty)
-  | Some tz ->
-      (x, TZ tz)
-
-let of_iso8601 x =
-  let rfc3339, print_timezone = best_effort_iso8601_to_rfc3339 x in
-  match Ptime.of_rfc3339 rfc3339 |> Ptime.rfc3339_error_to_msg with
-  | Error _ ->
-      invalid_arg (Printf.sprintf "%s: %s" __FUNCTION__ x)
-  | Ok (t, tz, _) -> (
-    match tz with
-    | None | Some 0 ->
-        Ptime.to_date_time t |> of_dt print_timezone
-    | Some _ ->
-        invalid_arg (Printf.sprintf "%s: %s" __FUNCTION__ x)
-  )
-
-let to_rfc3339 ((y, mon, d), ((h, min, s), _), print_type) =
-  match print_type with
-  | TZ tz ->
-      Printf.sprintf "%04i%02i%02iT%02i:%02i:%02i%s" y mon d h min s tz
-  | Empty ->
-      Printf.sprintf "%04i%02i%02iT%02i:%02i:%02i" y mon d h min s
-
-let weekday ~year ~mon ~day =
-  let a = (14 - mon) / 12 in
-  let y = year - a in
-  let m = mon + (12 * a) - 2 in
-  (day + y + (y / 4) - (y / 100) + (y / 400) + (31 * m / 12)) mod 7
-
-let to_rfc822 ((year, mon, day), ((h, min, s), _), print_type) =
-  let timezone =
-    match print_type with Empty | TZ "Z" -> "GMT" | TZ tz -> tz
-  in
-  let weekday = weekday ~year ~mon ~day in
-  Printf.sprintf "%s, %d %s %d %02d:%02d:%02d %s" days.(weekday) day
-    months.(mon - 1)
-    year h min s timezone
-
-let to_ptime_t t =
-  match to_dt t |> Ptime.of_date_time with
-  | Some t ->
-      t
-  | None ->
-      let _, (_, offset), _ = t in
-      invalid_arg
-        (Printf.sprintf "%s: dt='%s', offset='%i' is invalid" __FUNCTION__
-           (to_rfc3339 t) offset
-        )
-
-let to_ptime = to_ptime_t
-
-let of_ptime t = Ptime.to_date_time t |> of_dt utc
-
-let of_unix_time s =
-  match Ptime.of_float_s s with
-  | None ->
-      invalid_arg (Printf.sprintf "%s: %f" __FUNCTION__ s)
-  | Some t ->
-      of_ptime t
-
-let to_unix_time t = to_ptime_t t |> Ptime.to_float_s
-
-let _localtime current_tz_offset t =
-  let tz_offset_s = current_tz_offset |> Option.value ~default:0 in
-  let localtime = t |> Ptime.to_date_time ~tz_offset_s |> of_dt Empty in
-  let _, (_, localtime_offset), _ = localtime in
-  if localtime_offset <> tz_offset_s then
-    invalid_arg
-      (Printf.sprintf "%s: offsets don't match. offset='%i', t='%s'"
-         __FUNCTION__ tz_offset_s (Ptime.to_rfc3339 t)
-      ) ;
-  localtime
-
-let _localtime_string current_tz_offset t =
-  _localtime current_tz_offset t |> to_rfc3339
-
-let localtime () =
-  _localtime (Ptime_clock.current_tz_offset_s ()) (Ptime_clock.now ())
-
-let now () = of_ptime (Ptime_clock.now ())
-
-let epoch = of_ptime Ptime.epoch
-
-let is_earlier ~than t = Ptime.is_earlier ~than:(to_ptime than) (to_ptime t)
-
-let is_later ~than t = Ptime.is_later ~than:(to_ptime than) (to_ptime t)
-
-let diff a b = Ptime.diff (to_ptime a) (to_ptime b)
-
-let compare_print_tz a b =
-  match (a, b) with
-  | Empty, Empty ->
-      0
-  | TZ a_s, TZ b_s ->
-      String.compare a_s b_s
-  | Empty, TZ _ ->
-      -1
-  | TZ _, Empty ->
-      1
-
-let compare ((_, _, a_z) as a) ((_, _, b_z) as b) =
-  let ( <?> ) a b = if a = 0 then b else a in
-  Ptime.compare (to_ptime a) (to_ptime b) <?> compare_print_tz a_z b_z
-
-let eq x y = compare x y = 0
+include Clock.Date
 
 let never = epoch
 
diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/dune b/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/dune
index c2ed6c448da..8566d86e12c 100644
--- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/dune
+++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-date/dune
@@ -1,16 +1,6 @@
 (library
   (name xapi_stdext_date)
   (public_name xapi-stdext-date)
-  (modules :standard \ test)
-  (libraries astring
-             ptime
-             ptime.clock.os
-             unix)
-)
-
-(test
-  (name test)
-  (package xapi-stdext-date)
-  (modules test)
-  (libraries alcotest xapi-stdext-date ptime)
+  (modules :standard)
+  (libraries clock ptime)
 )
diff --git a/ocaml/xapi-guard/lib/disk_cache.ml b/ocaml/xapi-guard/lib/disk_cache.ml
index 5e8b9bb0650..9674a4ff01b 100644
--- a/ocaml/xapi-guard/lib/disk_cache.ml
+++ b/ocaml/xapi-guard/lib/disk_cache.ml
@@ -398,9 +398,9 @@ end = struct
     let* failed = retry true in
     ( if failed then
         let elapsed = Mtime_clock.count counter in
-        D.debug "%s: Pushed %s after trying for %s" __FUN
+        D.debug "%s: Pushed %s after trying for %a" __FUN
           (print_key (uuid, timestamp, key))
-          (Fmt.to_to_string Mtime.Span.pp elapsed)
+          Debug.Pp.mtime_span elapsed
     ) ;
     Lwt.return_unit
 
diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml
index c31ed490a0d..c8bf2adaa8b 100644
--- a/ocaml/xapi/xapi_globs.ml
+++ b/ocaml/xapi/xapi_globs.ml
@@ -951,7 +951,12 @@ let ignore_vtpm_unimplemented = ref false
 
 let evacuation_batch_size = ref 10
 
-type xapi_globs_spec_ty = Float of float ref | Int of int ref
+type xapi_globs_spec =
+  | Float of float ref
+  | Int of int ref
+  | ShortDurationFromSeconds of Mtime.Span.t ref
+      (** From float, max of 104 days *)
+  | LongDurationFromSeconds of Mtime.Span.t ref  (** From int *)
 
 let extauth_ad_backend = ref "winbind"
 
@@ -1120,13 +1125,41 @@ let options_of_xapi_globs_spec =
   List.map
     (fun (name, ty) ->
       ( name
-      , (match ty with Float x -> Arg.Set_float x | Int x -> Arg.Set_int x)
+      , ( match ty with
+        | Float x ->
+            Arg.Set_float x
+        | Int x ->
+            Arg.Set_int x
+        | ShortDurationFromSeconds x ->
+            Arg.Float
+              (fun y ->
+                match Clock.Timer.s_to_span y with
+                | Some y ->
+                    x := y
+                | None ->
+                    D.warn
+                      "Ignoring argument '%s', invalid float being used: %f. \
+                       (it only allows durations of less than 104 days)"
+                      name y
+              )
+        | LongDurationFromSeconds x ->
+            Arg.Int (fun y -> x := Mtime.Span.(y * s))
+        )
       , (fun () ->
           match ty with
           | Float x ->
               string_of_float !x
           | Int x ->
               string_of_int !x
+          | ShortDurationFromSeconds x ->
+              let literal =
+                Mtime.Span.to_uint64_ns !x |> fun ns ->
+                Int64.div ns 1_000_000_000L |> Int64.to_int |> string_of_int
+              in
+              Fmt.str "%s (%a)" literal Mtime.Span.pp !x
+          | LongDurationFromSeconds x ->
+              let literal = Clock.Timer.span_to_s !x |> string_of_float in
+              Fmt.str "%s (%a)" literal Mtime.Span.pp !x
         )
       , Printf.sprintf "Set the value of '%s'" name
       )
diff --git a/quality-gate.sh b/quality-gate.sh
index b504ed69d1b..7bc8f35cf0a 100755
--- a/quality-gate.sh
+++ b/quality-gate.sh
@@ -25,7 +25,7 @@ verify-cert () {
 }
 
 mli-files () {
-  N=515
+  N=514
   # do not count ml files from the tests in ocaml/{tests/perftest/quicktest}
   MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)
   MLS=$(git  ls-files -- '**/*.ml'  | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)
diff --git a/xapi-stdext-date.opam b/xapi-stdext-date.opam
index 10658f8b54e..ee8aa096ab2 100644
--- a/xapi-stdext-date.opam
+++ b/xapi-stdext-date.opam
@@ -2,16 +2,13 @@
 opam-version: "2.0"
 synopsis: "Xapi's standard library extension, Dates"
 maintainer: ["Xapi project maintainers"]
-authors: ["xen-api@lists.xen.org"]
+authors: ["Jonathan Ludlam"]
 license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception"
 homepage: "https://xapi-project.github.io/"
 bug-reports: "https://github.com/xapi-project/xen-api/issues"
 depends: [
   "dune" {>= "3.0"}
-  "ocaml" {>= "4.12"}
-  "alcotest" {with-test}
-  "astring"
-  "base-unix"
+  "clock" {= version}
   "ptime"
   "odoc" {with-doc}
 ]
diff --git a/xapi-stdext-encodings.opam b/xapi-stdext-encodings.opam
index 51ef29fe35f..c0f8c27c5e7 100644
--- a/xapi-stdext-encodings.opam
+++ b/xapi-stdext-encodings.opam
@@ -2,7 +2,7 @@
 opam-version: "2.0"
 synopsis: "Xapi's standard library extension, Encodings"
 maintainer: ["Xapi project maintainers"]
-authors: ["xen-api@lists.xen.org"]
+authors: ["Jonathan Ludlam"]
 license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception"
 homepage: "https://xapi-project.github.io/"
 bug-reports: "https://github.com/xapi-project/xen-api/issues"
diff --git a/xapi-stdext-pervasives.opam b/xapi-stdext-pervasives.opam
index 3dc2d169718..83f4f2da1da 100644
--- a/xapi-stdext-pervasives.opam
+++ b/xapi-stdext-pervasives.opam
@@ -2,7 +2,7 @@
 opam-version: "2.0"
 synopsis: "Xapi's standard library extension, Pervasives"
 maintainer: ["Xapi project maintainers"]
-authors: ["xen-api@lists.xen.org"]
+authors: ["Jonathan Ludlam"]
 license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception"
 homepage: "https://xapi-project.github.io/"
 bug-reports: "https://github.com/xapi-project/xen-api/issues"
diff --git a/xapi-stdext-threads.opam b/xapi-stdext-threads.opam
index 714a2e01575..de9699fe2e3 100644
--- a/xapi-stdext-threads.opam
+++ b/xapi-stdext-threads.opam
@@ -2,7 +2,7 @@
 opam-version: "2.0"
 synopsis: "Xapi's standard library extension, Threads"
 maintainer: ["Xapi project maintainers"]
-authors: ["xen-api@lists.xen.org"]
+authors: ["Jonathan Ludlam"]
 license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception"
 homepage: "https://xapi-project.github.io/"
 bug-reports: "https://github.com/xapi-project/xen-api/issues"
diff --git a/xapi-stdext-unix.opam b/xapi-stdext-unix.opam
index 8a7fc149f44..a20dfbb34e0 100644
--- a/xapi-stdext-unix.opam
+++ b/xapi-stdext-unix.opam
@@ -2,7 +2,7 @@
 opam-version: "2.0"
 synopsis: "Xapi's standard library extension, Unix"
 maintainer: ["Xapi project maintainers"]
-authors: ["xen-api@lists.xen.org"]
+authors: ["Jonathan Ludlam"]
 license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception"
 homepage: "https://xapi-project.github.io/"
 bug-reports: "https://github.com/xapi-project/xen-api/issues"
diff --git a/xapi-stdext-zerocheck.opam b/xapi-stdext-zerocheck.opam
index 8f070a416f3..fce24fb209d 100644
--- a/xapi-stdext-zerocheck.opam
+++ b/xapi-stdext-zerocheck.opam
@@ -2,7 +2,7 @@
 opam-version: "2.0"
 synopsis: "Xapi's standard library extension, Zerocheck"
 maintainer: ["Xapi project maintainers"]
-authors: ["xen-api@lists.xen.org"]
+authors: ["Jonathan Ludlam"]
 license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception"
 homepage: "https://xapi-project.github.io/"
 bug-reports: "https://github.com/xapi-project/xen-api/issues"