diff --git a/.ocamlformat b/.ocamlformat
index b4d356a7..ea8e56a8 100644
--- a/.ocamlformat
+++ b/.ocamlformat
@@ -1,5 +1,4 @@
 profile=ocamlformat
-version=0.14.1
 indicate-multiline-delimiters=closing-on-separate-line
 if-then-else=fit-or-vertical
 dock-collection-brackets=true
diff --git a/lib/debug.ml b/lib/debug.ml
index 96442986..71e7fc74 100644
--- a/lib/debug.ml
+++ b/lib/debug.ml
@@ -47,9 +47,11 @@ module ThreadLocalTable = struct
     IntMap.find_opt id t.tbl
 end
 
-let names = ThreadLocalTable.make ()
+type task = {desc: string; client: string option}
 
-let tasks = ThreadLocalTable.make ()
+let tasks : task ThreadLocalTable.t = ThreadLocalTable.make ()
+
+let names : string ThreadLocalTable.t = ThreadLocalTable.make ()
 
 let gettimestring () =
   let time = Unix.gettimeofday () in
@@ -67,11 +69,18 @@ let escape = Astring.String.Ascii.escape
 
 let format include_time brand priority message =
   let id = get_thread_id () in
-  let name =
-    match ThreadLocalTable.find names with Some x -> x | None -> ""
-  in
-  let task =
-    match ThreadLocalTable.find tasks with Some x -> x | None -> ""
+  let task, name =
+    (* if the task's client is known, attach it to the task's name *)
+    let name =
+      match ThreadLocalTable.find names with Some x -> x | None -> ""
+    in
+    match ThreadLocalTable.find tasks with
+    | None ->
+        ("", name)
+    | Some {desc; client= None} ->
+        (desc, name)
+    | Some {desc; client= Some client} ->
+        (desc, Printf.sprintf "%s->%s" client name)
   in
   Printf.sprintf "[%s%5s||%d %s|%s|%s] %s"
     (if include_time then gettimestring () else "")
@@ -201,8 +210,8 @@ let log_backtrace_exn ?(level = Syslog.Err) ?(msg = "error") exn _bt =
 
 let log_backtrace e bt = log_backtrace_exn e bt
 
-let with_thread_associated task f x =
-  ThreadLocalTable.add tasks task ;
+let with_thread_associated ?client desc f x =
+  ThreadLocalTable.add tasks {desc; client} ;
   let result = Backtrace.with_backtraces (fun () -> f x) in
   ThreadLocalTable.remove tasks ;
   match result with
@@ -212,7 +221,7 @@ let with_thread_associated task f x =
       (* This function is a top-level exception handler typically used on fresh
          threads. This is the last chance to do something with the backtrace *)
       output_log "backtrace" Syslog.Err "error"
-        (Printf.sprintf "%s failed with exception %s" task
+        (Printf.sprintf "%s failed with exception %s" desc
            (Printexc.to_string exn)) ;
       log_backtrace exn bt ;
       raise exn
diff --git a/lib/debug.mli b/lib/debug.mli
index ca224e72..78b17cd5 100644
--- a/lib/debug.mli
+++ b/lib/debug.mli
@@ -20,7 +20,7 @@ val init_logs : unit -> unit
 
 (** {2 Associate a task to the current actions} *)
 
-val with_thread_associated : string -> ('a -> 'b) -> 'a -> 'b
+val with_thread_associated : ?client:string -> string -> ('a -> 'b) -> 'a -> 'b
 (** Do an action with a task name associated with the current thread *)
 
 (** {2 Associate a name to the current thread} *)
diff --git a/lib/task_server.ml b/lib/task_server.ml
index 531204ce..a0397508 100644
--- a/lib/task_server.ml
+++ b/lib/task_server.ml
@@ -93,6 +93,7 @@ functor
       ; test_cancel_at: int option  (** index of the cancel point to trigger *)
       ; mutable backtrace: Backtrace.t  (** on error, a backtrace *)
       ; mutable cancellable: bool
+      ; mutable destroy_on_finish: bool
     }
 
     and tasks = {
@@ -149,26 +150,43 @@ functor
             )
         ; backtrace= Backtrace.empty
         ; cancellable= true
+        ; destroy_on_finish= false
         }
       in
       Mutex.execute tasks.m (fun () ->
           tasks.task_map := SMap.add t.id t !(tasks.task_map)) ;
       t
 
+    (* Remove the task from the id -> task mapping. NB any active thread will
+       still continue. *)
+    let destroy task =
+      let tasks = task.tasks in
+      Mutex.execute tasks.m (fun () ->
+          tasks.task_map := SMap.remove task.id !(tasks.task_map))
+
+    let task_finished item =
+      if item.destroy_on_finish then (
+        debug "Auto-destroying task %s" item.id ;
+        destroy item
+      )
+
     (* [run t] executes the task body, updating the fields of [t] *)
     let run item =
-      try
-        let start = Unix.gettimeofday () in
-        let result = item.f item in
-        let duration = Unix.gettimeofday () -. start in
-        item.state <- Interface.Task.Completed {Interface.Task.duration; result} ;
-        debug "Task %s completed; duration = %.0f" item.id duration
-      with e ->
-        Backtrace.is_important e ;
-        error "Task %s failed; %s" item.id (Printexc.to_string e) ;
-        item.backtrace <- Backtrace.remove e ;
-        let e = e |> Interface.marshal_exn in
-        item.state <- Interface.Task.Failed e
+      ( try
+          let start = Unix.gettimeofday () in
+          let result = item.f item in
+          let duration = Unix.gettimeofday () -. start in
+          item.state <-
+            Interface.Task.Completed {Interface.Task.duration; result} ;
+          debug "Task %s completed; duration = %.0f" item.id duration
+        with e ->
+          Backtrace.is_important e ;
+          error "Task %s failed; %s" item.id (Printexc.to_string e) ;
+          item.backtrace <- Backtrace.remove e ;
+          let e = e |> Interface.marshal_exn in
+          item.state <- Interface.Task.Failed e
+      ) ;
+      task_finished item
 
     let find_locked tasks id =
       try SMap.find id !(tasks.task_map)
@@ -219,13 +237,6 @@ functor
       Mutex.execute tasks.m (fun () ->
           SMap.bindings !(tasks.task_map) |> List.map snd)
 
-    (* Remove the task from the id -> task mapping. NB any active thread will
-       still continue. *)
-    let destroy task =
-      let tasks = task.tasks in
-      Mutex.execute tasks.m (fun () ->
-          tasks.task_map := SMap.remove task.id !(tasks.task_map))
-
     let cancel task =
       let callbacks =
         Mutex.execute task.tm (fun () ->
@@ -287,4 +298,17 @@ functor
              cancellable *)
           check_cancelling_locked task ;
           task.cancellable <- false)
+
+    let destroy_on_finish t =
+      t.destroy_on_finish <- true ;
+      let already_finished =
+        Mutex.execute t.tm @@ fun () ->
+        t.destroy_on_finish <- true ;
+        match t.state with
+        | Interface.Task.Pending _ ->
+            false
+        | Interface.Task.Completed _ | Interface.Task.Failed _ ->
+            true
+      in
+      if already_finished then task_finished t
   end
diff --git a/lib/task_server.mli b/lib/task_server.mli
index 5ab32947..cffd7d92 100644
--- a/lib/task_server.mli
+++ b/lib/task_server.mli
@@ -113,4 +113,9 @@ module Task : functor (Interface : INTERFACE) -> sig
 
   (* Set a task not cancellable *)
   val prohibit_cancellation : task_handle -> unit
+
+  (* When the task finishes automatically destroy it to avoid resource leaks.
+     Useful for asynchronous tasks that we don't wait for.
+  *)
+  val destroy_on_finish : task_handle -> unit
 end
diff --git a/lib_test/idl_test_common.ml b/lib_test/idl_test_common.ml
index a211d878..9709969b 100644
--- a/lib_test/idl_test_common.ml
+++ b/lib_test/idl_test_common.ml
@@ -33,15 +33,15 @@ module type CONFIG = sig
 end
 
 module type MARSHALLER = sig
-  val string_of_call : Rpc.call -> string
+  val string_of_call : ?strict:bool -> Rpc.call -> string
 
   val call_of_string : string -> Rpc.call
 
-  val string_of_response : Rpc.response -> string
+  val string_of_response : ?strict:bool -> Rpc.response -> string
 
   val response_of_string : string -> Rpc.response
 
-  val to_string : Rpc.t -> string
+  val to_string : ?strict:bool -> Rpc.t -> string
 
   val of_string : string -> Rpc.t
 end
@@ -54,11 +54,13 @@ module TJsonrpc : MARSHALLER = struct
   (* there is a ?strict parameter, and the signature would not match *)
   let of_string s = of_string s
 
+  let to_string ?(strict : _) t = to_string t
+
   let response_of_string r = response_of_string r
 
-  let string_of_call call = string_of_call call
+  let string_of_call ?(strict : _) call = string_of_call call
 
-  let string_of_response response = string_of_response response
+  let string_of_response ?(strict : _) response = string_of_response response
 end
 
 module TXmlrpc : MARSHALLER = struct
@@ -69,6 +71,12 @@ module TXmlrpc : MARSHALLER = struct
   let response_of_string s = response_of_string s
 
   let of_string s = of_string s
+
+  let to_string ?(strict : _) t = to_string t
+
+  let string_of_call ?(strict : _) call = string_of_call call
+
+  let string_of_response ?(strict : _) response = string_of_response response
 end
 
 (** The following module implements test cases that write test RPC requests and
@@ -105,7 +113,7 @@ module GenTestData (C : CONFIG) (M : MARSHALLER) = struct
 
   open M
 
-  let declare name _ ty =
+  let declare_ response_needed name _ ty =
     let rec inner :
         type b. ((string * Rpc.t) list * Rpc.t list) list -> b fn -> unit =
      fun params -> function
@@ -170,8 +178,8 @@ module GenTestData (C : CONFIG) (M : MARSHALLER) = struct
                   | _ ->
                       Rpc.Dict named :: List.rev unnamed
                 in
-                let call = Rpc.call wire_name args in
-                call)
+                let rpccall = if response_needed then Rpc.notif else Rpc.call in
+                rpccall wire_name args)
               params
           in
           List.iteri
@@ -229,6 +237,10 @@ module GenTestData (C : CONFIG) (M : MARSHALLER) = struct
       , `Quick
       , test_fn )
       :: !tests
+
+  let declare name desc_list ty = declare_ false name desc_list ty
+
+  let declare_notification name desc_list ty = declare_ true name desc_list ty
 end
 
 let get_arg call has_named name is_opt =
@@ -315,8 +327,8 @@ module TestOldRpcs (C : CONFIG) (M : MARSHALLER) = struct
     | Returning (_, _) ->
         false
 
-  let declare : string -> string list -> 'a fn -> _ res =
-   fun name _ ty ->
+  let declare_ : bool -> string -> string list -> 'a fn -> _ res =
+   fun _notification name _ ty ->
     ( (* Sanity check: ensure the description has been set before we declare any
          RPCs *)
     match !description with
@@ -430,4 +442,8 @@ module TestOldRpcs (C : CONFIG) (M : MARSHALLER) = struct
         responses
     in
     tests := !tests @ request_tests @ response_tests
+
+  let declare name desc_list ty = declare_ false name desc_list ty
+
+  let declare_notification name desc_list ty = declare_ true name desc_list ty
 end
diff --git a/rrd/dune b/rrd/dune
index 99763bb1..8051f3a9 100644
--- a/rrd/dune
+++ b/rrd/dune
@@ -30,7 +30,7 @@
 (library
  (name xcp_rrd)
  (public_name xapi-idl.rrd)
- (modules (:standard \ data_source rrd_interface rrd_cli))
+ (modules (:standard \ data_source rrd_interface))
  (flags (:standard -w -39))
  (libraries
    rpclib.core
@@ -42,18 +42,3 @@
  (wrapped false)
  (preprocess (pps ppx_deriving_rpc)))
 
-(executable
- (name rrd_cli)
- (modules rrd_cli)
- (libraries
-   cmdliner
-   rpclib.cmdliner
-   rpclib.markdown
-   xapi-idl.rrd
- ))
-
-(rule
- (alias runtest)
- (deps (:x rrd_cli.exe))
- (action (run %{x})))
-
diff --git a/rrd/rrd_cli.ml b/rrd/rrd_cli.ml
deleted file mode 100644
index 0046a252..00000000
--- a/rrd/rrd_cli.ml
+++ /dev/null
@@ -1,27 +0,0 @@
-(* Rrd CLI *)
-
-module Cmds = Rrd_interface.RPC_API (Cmdlinergen.Gen ())
-
-let version_str description =
-  let maj, min, mic = description.Idl.Interface.version in
-  Printf.sprintf "%d.%d.%d" maj min mic
-
-let default_cmd =
-  let doc =
-    String.concat ""
-      [
-        "A CLI for the Db monitoring API. This allows scripting of the Rrd \
-         daemon "
-      ; "for testing and debugging. This tool is not intended to be used as an "
-      ; "end user tool"
-      ]
-  in
-  ( Cmdliner.Term.(ret (const (fun _ -> `Help (`Pager, None)) $ const ()))
-  , Cmdliner.Term.info "rrd_cli" ~version:(version_str Cmds.description) ~doc )
-
-let cli () =
-  let rpc = Rrd_client.rpc in
-  Cmdliner.Term.eval_choice default_cmd
-    (List.map (fun t -> t rpc) (Cmds.implementation ()))
-
-let _ = cli ()
diff --git a/rrd/rrd_interface.ml b/rrd/rrd_interface.ml
index 9a9c6035..bf2633b4 100644
--- a/rrd/rrd_interface.ml
+++ b/rrd/rrd_interface.ml
@@ -246,6 +246,15 @@ module RPC_API (R : RPC) = struct
       ]
       (rem_addr_opt_p @-> unit_p @-> returning unit_p rrd_err)
 
+  let save_rrds =
+    declare "save_rrds"
+      [
+        "Backs up RRD data to disk on localhost. This should be done \
+         periodically to ensure"
+      ; "that if the host crashes we don't lose too much data."
+      ]
+      (unit_p @-> returning unit_p rrd_err)
+
   let archive_rrd =
     declare "archive_rrd"
       [
diff --git a/xen/dune b/xen/dune
index abd8acf6..5a9de348 100644
--- a/xen/dune
+++ b/xen/dune
@@ -15,7 +15,7 @@
  (name xcp_xen_interface)
  (public_name xapi-idl.xen.interface)
  (modules xenops_interface)
- (flags (:standard -w -39))
+ (flags (:standard -w -39-27))
  (libraries
    rpclib.core
    threads
diff --git a/xen/xenops_interface.ml b/xen/xenops_interface.ml
index cebe545c..55c69dbb 100644
--- a/xen/xenops_interface.ml
+++ b/xen/xenops_interface.ml
@@ -197,6 +197,53 @@ module Network = struct
   type ts = t list [@@deriving rpcty]
 end
 
+module CPU_policy : sig
+  type 'a t
+
+  val of_string : 'a -> string -> 'a t
+
+  val to_string : 'a t -> string
+
+  val vm : [`vm] t Rpc.Types.def
+
+  val host : [`host] t Rpc.Types.def
+
+  val typ_of : 'a -> 'a t Rpc.Types.typ
+end = struct
+  type 'a t = string [@@deriving rpc]
+
+  let of_string _ s = s
+
+  let to_string s = s
+
+  let typ_of a =
+    Rpc.Types.(
+      Abstract
+        {
+          aname= "CPU_policy.t"
+        ; test_data= []
+        ; rpc_of= rpc_of_t ()
+        ; of_rpc= (fun x -> Ok (t_of_rpc a x))
+        }
+    )
+
+  let vm =
+    Rpc.Types.
+      {name= "CPU_policy.vm"; description= ["VM CPU policy"]; ty= typ_of `vm}
+
+  let host =
+    Rpc.Types.
+      {
+        name= "CPU_policy.host"
+      ; description= ["Host CPU policy"]
+      ; ty= typ_of `host
+      }
+end
+
+type host_cpu_policy = [`host] CPU_policy.t
+
+let typ_of_host_cpu_policy = CPU_policy.typ_of `host
+
 module Pci = struct
   include Xcp_pci
 
@@ -461,12 +508,11 @@ module Host = struct
     ; model: string
     ; stepping: string
     ; flags: string
-    ; features: int64 array
-    ; features_pv: int64 array
-    ; features_hvm: int64 array
-    ; features_pv_host: int64 array
-    ; features_hvm_host: int64 array
-    ; features_oldstyle: int64 array
+    ; features: host_cpu_policy
+    ; features_pv: host_cpu_policy
+    ; features_hvm: host_cpu_policy
+    ; features_pv_host: host_cpu_policy
+    ; features_hvm_host: host_cpu_policy
   }
   [@@deriving rpcty]
 
@@ -551,6 +597,11 @@ module XenopsAPI (R : RPC) = struct
       declare "Task.list"
         ["List all the current tasks"]
         (debug_info_p @-> returning task_list_p err)
+
+    let destroy_on_finish =
+      declare "Task.destroy_on_finish"
+        ["Ensures the task will be destroyed when it finishes"]
+        (debug_info_p @-> task_id_p @-> returning unit_p err)
   end
 
   module HOST = struct
@@ -577,13 +628,6 @@ module XenopsAPI (R : RPC) = struct
       Param.mk ~description:["The list of features"] ~name:"features"
         Host.guest_agent_feature_list
 
-    type cpu_features_array = int64 array [@@deriving rpcty]
-
-    let cpu_features_array_p =
-      Param.mk
-        ~description:["An array containing the raw CPU feature flags"]
-        ~name:"features_array" cpu_features_array
-
     let stat =
       declare "HOST.stat"
         ["Get the state of the host"]
@@ -611,13 +655,35 @@ module XenopsAPI (R : RPC) = struct
       declare "HOST.update_guest_agent_features" []
         (debug_info_p @-> feature_list_p @-> returning unit_p err)
 
-    let upgrade_cpu_features =
-      let is_hvm_p = Param.mk ~name:"is_hvm" Types.bool in
-      declare "HOST.upgrade_cpu_features" []
+    let combine_cpu_policies =
+      let policy1_p =
+        Param.mk ~description:["CPU policy 1"] ~name:"policy1" CPU_policy.host
+      in
+      let policy2_p =
+        Param.mk ~description:["CPU policy 2"] ~name:"policy2" CPU_policy.host
+      in
+      let policy3_p =
+        Param.mk ~description:["Combined CPU policy"] ~name:"policy3"
+          CPU_policy.host
+      in
+      declare "HOST.combine_cpu_policies"
+        ["Combine CPU policy to get a common subset"]
+        (debug_info_p @-> policy1_p @-> policy2_p @-> returning policy3_p err)
+
+    let is_compatible =
+      let vm_policy_p =
+        Param.mk ~description:["VM CPU policy"] ~name:"vm_policy" CPU_policy.vm
+      in
+      let host_policy_p =
+        Param.mk ~description:["Host CPU policy"] ~name:"host_policy"
+          CPU_policy.host
+      in
+      declare "HOST.is_compatible"
+        ["Check whether a VM can live-migrate to or resume on a host"]
         (debug_info_p
-        @-> cpu_features_array_p
-        @-> is_hvm_p
-        @-> returning cpu_features_array_p err
+        @-> vm_policy_p
+        @-> host_policy_p
+        @-> returning (Param.mk Types.bool) err
         )
   end
 
@@ -811,6 +877,13 @@ module XenopsAPI (R : RPC) = struct
         @-> Param.mk ~name:"metadata" Types.string
         @-> returning vm_id_p err
         )
+
+    let import_metadata_async =
+      declare "VM.import_metadata_async" []
+        (debug_info_p
+        @-> Param.mk ~name:"metadata" Types.string
+        @-> returning task_id_p err
+        )
   end
 
   module PCI = struct
diff --git a/xen/xenops_types.ml b/xen/xenops_types.ml
index 87aaa353..d9ab03ad 100644
--- a/xen/xenops_types.ml
+++ b/xen/xenops_types.ml
@@ -160,6 +160,7 @@ module Vm = struct
     ; pci_msitranslate: bool
     ; pci_power_mgmt: bool
     ; has_vendor_device: bool [@default false]
+    ; generation_id: string option
   }
   [@@deriving rpcty, sexp]
 
@@ -194,6 +195,7 @@ module Vm = struct
     ; nomigrate: bool  (** true means VM must not migrate *)
     ; nested_virt: bool  (** true means VM uses nested virtualisation *)
     ; domain_type: domain_type
+    ; featureset: string
   }
   [@@deriving rpcty, sexp]
 end