CP-45016: Clean up the source VM earlier

Previously the source VM is cleaned up at the very end of the migration,
after the destination VM is up and running. This has caused problems for
SMAPIv3 SRs as the new VM needs to plug in the new VBD which requires a
datapath activate on the VDI which is currently in use by the old VM
(and the mirroring process). This window needs to be reduced since we
cannot have two datapath activated at the same time.

Signed-off-by: Vincent Liu <[email protected]>

Author: Vincent-lau

ocaml/xenopsd/lib/xenops_server.ml

@@ -2732,6 +2732,23 @@ and perform_exn ?result (op : operation) (t : Xenops_task.task_handle) : unit =
             ) ;
             debug "VM.migrate: Synchronisation point 1"
           in
+          let pause_src_vm () =
+            debug
+              "VM.migrate: pause src vm before allowing destination to proceed" ;
+            (* cleanup tmp src VM *)
+            let atomics =
+              [
+                VM_hook_script_stable
+                  ( id
+                  , Xenops_hooks.VM_pre_destroy
+                  , Xenops_hooks.reason__suspend
+                  , new_src_id
+                  )
+              ]
+              @ atomics_of_operation (VM_shutdown (new_src_id, None))
+            in
+            perform_atomics atomics t
+          in
           let final_handshake () =
             Handshake.send vm_fd Handshake.Success ;
             debug "VM.migrate: Synchronisation point 3" ;
@@ -2772,7 +2789,10 @@ and perform_exn ?result (op : operation) (t : Xenops_task.task_handle) : unit =
              the main VM migration sequence. *)
           match VGPU_DB.ids id with
           | [] ->
-              first_handshake () ; save () ; final_handshake ()
+              first_handshake () ;
+              save () ;
+              pause_src_vm () ;
+              final_handshake ()
           | (_vm_id, dev_id) :: _ ->
               let url =
                 make_url "/migrate/vgpu/"
@@ -2789,20 +2809,12 @@ and perform_exn ?result (op : operation) (t : Xenops_task.task_handle) : unit =
                   first_handshake () ;
                   save ~vgpu_fd:(FD vgpu_fd) ()
               ) ;
+              pause_src_vm () ;
               final_handshake ()
       ) ;
-      (* cleanup tmp src VM *)
-      let atomics =
-        [
-          VM_hook_script_stable
-            ( id
-            , Xenops_hooks.VM_pre_destroy
-            , Xenops_hooks.reason__suspend
-            , new_src_id
-            )
-        ]
-        @ atomics_of_operation (VM_shutdown (new_src_id, None))
-        @ [
+      let cleanup_src_vm () =
+        let atomics =
+          [
             VM_hook_script_stable
               ( id
               , Xenops_hooks.VM_post_destroy
@@ -2811,8 +2823,10 @@ and perform_exn ?result (op : operation) (t : Xenops_task.task_handle) : unit =
               )
           ; VM_remove new_src_id
           ]
+        in
+        perform_atomics atomics t
       in
-      perform_atomics atomics t
+      cleanup_src_vm ()
   | VM_receive_memory
       {
         vmr_id= id