CA-244657: Allow xapi to overwrite the cancellation policy at higher …

…level

Currently, many xenopsd tasks support cancellation. The cancellation at xenopsd
level usually means just abruptly stopping the low-level operation and do some
limited cleanup.  Sometime, the result is not necessarily a user would expect
from higher level point of view. For example, some operations are destructive,
so that a cancellation won't leave the objects involved in their original
status but some status unexpected to the user. Also, some operations are
implemented as combinations of a sequence of different tasks underlying, so
cancellations at different stages will lead to different results/behaviors,
which could further confuse the users.

Currently when calling from xapi down to xenopsd, the cancellability of the
xapi task is simply bound to that of the underlying xenopsd tasks. This patch
adds an extra flag to allow overwriting this if necessary.

Signed-off-by: Zheng Li <zheng.li3@citrix.com>

ocaml/xapi/taskHelper.ml

@@ -240,16 +240,18 @@ let task_to_id_exn task =
        Hashtbl.find task_to_id_tbl task
     )
 
-let register_task __context id =
+let register_task __context ?(cancellable=true) id =
   let task = Context.get_task_id __context in
   Mutex.execute task_tbl_m
     (fun () ->
        Hashtbl.replace id_to_task_tbl id task;
        Hashtbl.replace task_to_id_tbl task id;
     );
-  (* Since we've bound the XenAPI Task to the xenopsd Task, and the xenopsd Task
-     	   is cancellable, mark the XenAPI Task as cancellable too. *)
-  set_cancellable ~__context;
+  (* We bind the XenAPI Task to the xenopsd Task, which is capable of
+     cancellation at the low level. If this is not desired behavior, overwrite
+     it with the cancellable flag. *)
+  if cancellable then set_cancellable ~__context
+  else set_not_cancellable ~__context;
   ()
 
 let unregister_task __context id =

ocaml/xapi/taskHelper.mli

@@ -46,7 +46,7 @@ type id =
 
 val id_to_task_exn : id -> API.ref_task
 val task_to_id_exn : API.ref_task -> id
-val register_task : Context.t -> id -> unit
+val register_task : Context.t -> ?cancellable:bool -> id -> unit
 val unregister_task : Context.t -> id -> unit
 
 

ocaml/xapi/xapi_xenops.ml

@@ -1898,7 +1898,7 @@ let update_vgpu ~__context id =
 exception Not_a_xenops_task
 let wrap queue_name id = TaskHelper.Xenops (queue_name, id)
 let unwrap x = match x with | TaskHelper.Xenops (queue_name, id) -> queue_name, id | _ -> raise Not_a_xenops_task
-let register_task __context queue_name id = TaskHelper.register_task __context (wrap queue_name id); id
+let register_task __context ?cancellable queue_name id = TaskHelper.register_task __context ?cancellable (wrap queue_name id); id
 let unregister_task __context queue_name id = TaskHelper.unregister_task __context (wrap queue_name id); id
 
 let update_task ~__context queue_name id =
@@ -2365,11 +2365,11 @@ let update_debug_info __context t =
          debug "Failed to add %s = %s to task %s: %s" k v (Ref.string_of task) (Printexc.to_string e)
     ) debug_info
 
-let sync_with_task_result __context queue_name x =
+let sync_with_task_result __context ?cancellable queue_name x =
   let dbg = Context.string_of_task __context in
-  x |> register_task __context queue_name |> wait_for_task queue_name dbg |> unregister_task __context queue_name |> success_task queue_name (update_debug_info __context) dbg
+  x |> register_task __context ?cancellable queue_name |> wait_for_task queue_name dbg |> unregister_task __context queue_name |> success_task queue_name (update_debug_info __context) dbg
 
-let sync_with_task __context queue_name x = sync_with_task_result __context queue_name x |> ignore
+let sync_with_task __context ?cancellable queue_name x = sync_with_task_result __context ?cancellable queue_name x |> ignore
 
 let sync __context queue_name x =
   let dbg = Context.string_of_task __context in