diff --git a/ocaml/xapi/locking_helpers.ml b/ocaml/xapi/locking_helpers.ml
index 894410de15..a5f7ab4c08 100644
--- a/ocaml/xapi/locking_helpers.ml
+++ b/ocaml/xapi/locking_helpers.ml
@@ -137,10 +137,6 @@ let is_process name = function
 let string_of_resource r = r.str
 
 module Thread_state = struct
-  type waiting = Tracing.Span.t option * Tracing.Span.t option
-
-  type acquired = Tracing.Span.t option
-
   type time = float
 
   type t = {
@@ -150,8 +146,13 @@ module Thread_state = struct
     ; mutable task: API.ref_task
     ; mutable name: string
     ; mutable waiting_for: resource
+    ; mutable parent: Tracing.Span.t option
+    ; mutable span: Tracing.Span.t option
   }
 
+  type waiting = t
+  type acquired = t
+
   let acquired_resources t =
     if t.last_acquired_resource.kind = No_resource then
       t.acquired_resources_other
@@ -167,6 +168,8 @@ module Thread_state = struct
     ; task= Ref.null
     ; name= ""
     ; waiting_for= none
+    ; parent = None
+    ; span = None
     }
 
   let thread_states = Thread_local_storage.make make_empty
@@ -201,43 +204,38 @@ module Thread_state = struct
   let now () = Unix.gettimeofday ()
 
   let waiting_for ?parent resource =
-    let span =
-      match (parent : Tracing.Span.t option) with
-      | None ->
-          None
+    let ts = get_states () in
+    let () = match (parent : Tracing.Span.t option) with
+      | None -> ()
       | Some _ -> (
           let name = resource.waiting_str in
           let tracer = Tracing.get_tracer ~name in
           match Tracing.Tracer.start ~tracer ~name ~parent () with
           | Ok span ->
-              Some (parent, span)
+              ts.parent <- parent;
+              ts.span <- span;
           | Error e ->
               D.warn "Failed to start tracing: %s" (Printexc.to_string e) ;
-              None
         )
     in
-    let ts = get_states () in
     ts.waiting_for <- resource ;
-    span
+    ts
 
-  let acquired resource parent =
-    let span =
-      match parent with
-      | None ->
-          None
-      | Some (parent, span) -> (
-          let (_ : Tracing.Span.t option) = Tracing.Tracer.finish span in
+  let acquired resource ts =
+    let () = match ts.parent with
+      | None -> ()
+      | Some _ -> (
+          let (_ : Tracing.Span.t option) = Tracing.Tracer.finish ts.span in
           let name = resource.acquired_str in
           let tracer = Tracing.get_tracer ~name in
-          match Tracing.Tracer.start ~tracer ~name ~parent () with
+          match Tracing.Tracer.start ~tracer ~name ~parent:ts.parent () with
           | Ok span ->
-              span
+              ts.span <- span
           | Error e ->
               D.warn "Failed to start tracing: %s" (Printexc.to_string e) ;
-              None
+              ts.span <- None
         )
     in
-    let ts = get_states () in
     ts.waiting_for <- none ;
     if ts.last_acquired_resource.kind <> No_resource then
       ts.acquired_resources_other <-
@@ -245,12 +243,11 @@ module Thread_state = struct
         :: ts.acquired_resources_other ;
     ts.last_acquired_resource <- resource ;
     ts.last_acquired_at <- now () ;
-    span
+    ts
 
-  let released resource span =
-    let (_ : Tracing.Span.t option) = Tracing.Tracer.finish span in
-    let ts = get_states () in
-    if ts.last_acquired_resource = resource then
+  let released resource ts =
+    let (_ : Tracing.Span.t option) = Tracing.Tracer.finish ts.span in
+    if ts.last_acquired_resource == resource then
       ts.last_acquired_resource <- none
     else
       ts.acquired_resources_other <-
diff --git a/ocaml/xapi/locking_helpers.mli b/ocaml/xapi/locking_helpers.mli
index 73f6258822..4f4be176d3 100644
--- a/ocaml/xapi/locking_helpers.mli
+++ b/ocaml/xapi/locking_helpers.mli
@@ -36,10 +36,10 @@ module Thread_state : sig
   val with_named_thread : string -> API.ref_task -> (unit -> 'a) -> 'a
   (** Called when a thread becomes associated with a particular task *)
 
-  val waiting_for : ?parent:Tracing.Span.t -> resource -> waiting option
+  val waiting_for : ?parent:Tracing.Span.t -> resource -> waiting
   (** Called when a thread is about to block waiting for a resource to be free *)
 
-  val acquired : resource -> waiting option -> acquired
+  val acquired : resource -> waiting -> acquired
   (** Called when a thread acquires a resource *)
 
   val released : resource -> acquired -> unit
diff --git a/ocaml/xapi/xapi.ml b/ocaml/xapi/xapi.ml
index 7877bef7a0..da1b7d350e 100644
--- a/ocaml/xapi/xapi.ml
+++ b/ocaml/xapi/xapi.ml
@@ -166,11 +166,13 @@ let register_callback_fns () =
   Xapi_cli.rpc_fun := Some fake_rpc ;
   let acquired = ref None in
   let set_stunnelpid _task_opt pid =
+    let resource = Locking_helpers.process ("stunnel", pid) in
+    let waiting = Locking_helpers.Thread_state.waiting_for resource in
     acquired :=
       Some
         (Locking_helpers.Thread_state.acquired
            (Locking_helpers.process ("stunnel", pid))
-           None
+            waiting
         )
   in
   let unset_stunnelpid _task_opt pid =