CP-31566 define xenopsd fast resume operation

ocaml/xapi-idl/xen/xenops_interface.ml

@@ -855,6 +855,10 @@ module XenopsAPI (R : RPC) = struct
       declare "VM.resume" []
         (debug_info_p @-> vm_id_p @-> disk_p @-> returning task_id_p err)
 
+    let fast_resume =
+      declare "VM.fast_resume" []
+        (debug_info_p @-> vm_id_p @-> returning task_id_p err)
+
     let s3suspend =
       declare "VM.s3suspend" []
         (debug_info_p @-> vm_id_p @-> returning task_id_p err)

ocaml/xenopsd/cli/main.ml

@@ -317,6 +317,25 @@ let resume_cmd =
   , Cmd.info "resume" ~sdocs:_common_options ~doc ~man
   )
 
+let fast_resume_cmd =
+  let vm = vm_arg "resumed" in
+  let doc = "fast-resume a VM" in
+  let man =
+    [
+      `S "DESCRIPTION"
+    ; `P "Fast-resume a VM."
+    ; `P
+        {|The suspended domain will be resumed
+          and the VM will be left in a Running state.|}
+    ; `S "ERRORS"
+    ; `P "Something about the current power state."
+    ]
+    @ help
+  in
+  ( Term.(ret (const Xn.fast_resume $ common_options_t $ vm))
+  , Cmd.info "fast-resume" ~sdocs:_common_options ~doc ~man
+  )
+
 let pause_cmd =
   let vm = vm_arg "paused" in
   let doc = "pause a VM" in
@@ -491,6 +510,7 @@ let cmds =
   ; reboot_cmd
   ; suspend_cmd
   ; resume_cmd
+  ; fast_resume_cmd
   ; pause_cmd
   ; unpause_cmd
   ; import_cmd

ocaml/xenopsd/cli/xn.ml

@@ -873,6 +873,15 @@ let suspend _copts disk x =
 
 let suspend copts disk x = diagnose_error (need_vm (suspend copts disk) x)
 
+let fast_resume _copts x =
+  let open Vm in
+  let vm, _ = find_by_name x in
+  Client.VM.fast_resume dbg vm.id
+  |> wait_for_task dbg
+  |> success_task ignore_task
+
+let fast_resume copts x = diagnose_error (need_vm (fast_resume copts) x)
+
 let resume _copts disk x =
   (* We don't currently store where the suspend image is *)
   let disk =

ocaml/xenopsd/cli/xn.mli

@@ -47,6 +47,9 @@ val resume :
   -> string option
   -> [> `Error of bool * string | `Ok of unit]
 
+val fast_resume :
+  'a -> string option -> [> `Error of bool * string | `Ok of unit]
+
 val console_connect :
   'a -> string option -> [> `Error of bool * string | `Ok of unit]
 

ocaml/xenopsd/lib/xenops_server.ml

@@ -164,6 +164,7 @@ type atomic =
       (** takes suspend data, plus optionally vGPU state data *)
   | VM_restore of (Vm.id * data * data option)
       (** takes suspend data, plus optionally vGPU state data *)
+  | VM_fast_resume of Vm.id
   | VM_delay of (Vm.id * float)  (** used to suppress fast reboot loops *)
   | VM_rename of (Vm.id * Vm.id * rename_when)
   | VM_import_metadata of (Vm.id * Metadata.t)
@@ -279,6 +280,8 @@ let rec name_of_atomic = function
       "VM_save"
   | VM_restore _ ->
       "VM_restore"
+  | VM_fast_resume _ ->
+      "VM_fast_resume"
   | VM_delay _ ->
       "VM_delay"
   | VM_rename _ ->
@@ -2377,6 +2380,9 @@ let rec perform_atomic ~progress_callback ?result (op : atomic)
       let extras = [] in
       B.VM.restore t progress_callback (VM_DB.read_exn id) vbds vifs data
         vgpu_data extras
+  | VM_fast_resume id ->
+      debug "VM.fast_resume %s" id ;
+      B.VM.resume t (VM_DB.read_exn id)
   | VM_delay (id, t) ->
       debug "VM %s: waiting for %.2f before next VM action" id t ;
       Thread.delay t
@@ -2669,6 +2675,7 @@ and trigger_cleanup_after_failure_atom op t =
   | VM_s3resume id
   | VM_save (id, _, _, _)
   | VM_restore (id, _, _)
+  | VM_fast_resume id
   | VM_delay (id, _)
   | VM_softreboot id ->
       immediate_operation dbg id (VM_check_state id)
@@ -3828,6 +3835,8 @@ module VM = struct
 
   let resume _ dbg id disk = queue_operation dbg id (VM_resume (id, Disk disk))
 
+  let fast_resume _ dbg id = queue_operation dbg id (Atomic (VM_fast_resume id))
+
   let s3suspend _ dbg id = queue_operation dbg id (Atomic (VM_s3suspend id))
 
   let s3resume _ dbg id = queue_operation dbg id (Atomic (VM_s3resume id))
@@ -4409,6 +4418,7 @@ let _ =
   Server.VM.reboot (VM.reboot ()) ;
   Server.VM.suspend (VM.suspend ()) ;
   Server.VM.resume (VM.resume ()) ;
+  Server.VM.fast_resume (VM.fast_resume ()) ;
   Server.VM.s3suspend (VM.s3suspend ()) ;
   Server.VM.s3resume (VM.s3resume ()) ;
   Server.VM.export_metadata (VM.export_metadata ()) ;

ocaml/xenopsd/lib/xenops_server_plugin.ml

@@ -159,6 +159,8 @@ module type S = sig
       -> string list
       -> unit
 
+    val resume : Xenops_task.task_handle -> Vm.t -> unit
+
     val s3suspend : Xenops_task.task_handle -> Vm.t -> unit
 
     val s3resume : Xenops_task.task_handle -> Vm.t -> unit

ocaml/xenopsd/lib/xenops_server_skeleton.ml

@@ -97,6 +97,8 @@ module VM = struct
 
   let restore _ _ _ _ _ _ _ = unimplemented __FUNCTION__
 
+  let resume _ _ = unimplemented __FUNCTION__
+
   let s3suspend _ _ = unimplemented __FUNCTION__
 
   let s3resume _ _ = unimplemented __FUNCTION__

ocaml/xenopsd/xc/domain.ml

@@ -1364,6 +1364,19 @@ let build (task : Xenops_task.task_handle) ~xc ~xs ~store_domid ~console_domid
   build_post ~xc ~xs ~target_mib ~static_max_mib domid domain_type store_mfn
     store_port local_stuff vm_stuff
 
+let resume_post ~xc:_ ~xs domid =
+  let dom_path = xs.Xs.getdomainpath domid in
+  let store_mfn_s = xs.Xs.read (dom_path ^ "/store/ring-ref") in
+  let store_mfn = Nativeint.of_string store_mfn_s in
+  let store_port = int_of_string (xs.Xs.read (dom_path ^ "/store/port")) in
+  xs.Xs.introduce domid store_mfn store_port
+
+let resume (task : Xenops_task.task_handle) ~xc ~xs ~qemu_domid ~domain_type
+    domid =
+  Xenctrl.domain_resume_fast xc domid ;
+  resume_post ~xc ~xs domid ;
+  if domain_type = `hvm then Device.Dm.resume task ~xs ~qemu_domid domid
+
 type suspend_flag = Live | Debug
 
 let dm_flags =

ocaml/xenopsd/xc/domain.mli

@@ -242,6 +242,16 @@ val build :
   -> unit
 (** Restore a domain using the info provided *)
 
+val resume :
+     Xenops_task.Xenops_task.task_handle
+  -> xc:Xenctrl.handle
+  -> xs:Ezxenstore_core.Xenstore.Xs.xsh
+  -> qemu_domid:int
+  -> domain_type:[`hvm | `pv | `pvh]
+  -> domid
+  -> unit
+(** Fast resume *)
+
 val restore :
      Xenops_task.Xenops_task.task_handle
   -> xc:Xenctrl.handle

ocaml/xenopsd/xc/xenops_server_xen.ml

@@ -3021,6 +3021,26 @@ module VM = struct
         Domain.shutdown ~xc ~xs di.Xenctrl.domid Domain.S3Suspend
     )
 
+  let resume t vm =
+    on_domain t vm (fun xc xs task _vm di ->
+        let domid = di.Xenctrl.domid in
+        let qemu_domid = this_domid ~xs in
+        let domain_type =
+          match get_domain_type ~xs di with
+          | Vm.Domain_HVM ->
+              `hvm
+          | Vm.Domain_PV ->
+              `pv
+          | Vm.Domain_PVinPVH ->
+              `pvh
+          | Vm.Domain_PVH ->
+              `pvh
+          | Vm.Domain_undefined ->
+              failwith "undefined domain type: cannot resume"
+        in
+        Domain.resume task ~xc ~xs ~qemu_domid ~domain_type domid
+    )
+
   let s3resume t vm =
     (* XXX: TODO: monitor the guest's response; track the s3 state *)
     on_domain t vm (fun xc _xs _task _vm di ->