CP-311102: Make migration timeouts configurable

Also improve the logging a little (e.g. log "suspend" rather than
"shutdown" when suspending).

Signed-off-by: Rob Hoes <rob.hoes@citrix.com>

Author: robhoes

ocaml/xenopsd/lib/xenopsd.ml

@@ -77,6 +77,10 @@ let vm_guest_agent_xenstore_quota = ref 128
 
 let vm_guest_agent_xenstore_quota_warn_interval = ref 3600
 
+let vm_suspend_timeout = ref 1200.
+
+let vm_suspend_ack_timeout = ref 30.
+
 let oxenstored_conf = ref "/etc/xen/oxenstored.conf"
 
 let for_each_line path f =
@@ -320,6 +324,17 @@ let options =
     , (fun () -> string_of_bool !Xenops_server.xenopsd_vbd_plug_unplug_legacy)
     , "False if we want to split the plug atomic into attach/activate"
     )
+  ; ( "vm-suspend-timeout"
+    , Arg.Set_float vm_suspend_timeout
+    , (fun () -> string_of_float !vm_suspend_timeout)
+    , "Time in seconds within a VM is expected to suspend after acknowledging \
+       the suspend request"
+    )
+  ; ( "vm-suspend-ack-timeout"
+    , Arg.Set_float vm_suspend_ack_timeout
+    , (fun () -> string_of_float !vm_suspend_ack_timeout)
+    , "Time in seconds within a VM is expected to acknowledge a suspend request"
+    )
   ]
 
 let path () = Filename.concat !sockets_path "xenopsd"

ocaml/xenopsd/xc/domain.ml

@@ -778,8 +778,11 @@ let shutdown_wait_for_ack (t : Xenops_task.task_handle) ~timeout ~xc ~xs domid
     Xenctrl.domain_shutdown xc domid (shutdown_to_xc_shutdown req)
   ) else (
     debug
-      "VM = %s; domid = %d; Waiting for domain to acknowledge shutdown request"
-      uuid domid ;
+      "VM = %s; domid = %d; Waiting for domain to acknowledge %s request \
+       (timeout = %.0fs)"
+      uuid domid
+      (string_of_shutdown_reason req)
+      timeout ;
     let path = control_shutdown ~xs domid in
     let cancel = Domain domid in
     if
@@ -788,8 +791,8 @@ let shutdown_wait_for_ack (t : Xenops_task.task_handle) ~timeout ~xc ~xs domid
         [Watch.key_to_disappear path]
         t ~xs ~timeout ()
     then
-      info "VM = %s; domid = %d; Domain acknowledged shutdown request" uuid
-        domid
+      info "VM = %s; domid = %d; Domain acknowledged %s request" uuid domid
+        (string_of_shutdown_reason req)
     else
       debug "VM = %s; domid = %d; Domain disappeared" uuid domid
   )

ocaml/xenopsd/xc/xenops_server_xen.ml

@@ -2712,7 +2712,7 @@ module VM = struct
         with Watch.Timeout _ -> false
     )
 
-  let wait_shutdown task vm _reason timeout =
+  let wait_shutdown task vm reason timeout =
     let is_vm_event = function
       | Dynamic.Vm id when id = vm.Vm.id ->
           debug "EVENT on our VM: %s" id ;
@@ -2859,7 +2859,9 @@ module VM = struct
                   not
                     ( with_tracing ~task
                         ~name:"VM_save_domain_suspend_callback_request_shutdown"
-                    @@ fun () -> request_shutdown task vm Suspend 30.
+                    @@ fun () ->
+                      request_shutdown task vm Suspend
+                        !Xenopsd.vm_suspend_ack_timeout
                     )
                 then
                   raise (Xenopsd_error Failed_to_acknowledge_suspend_request) ;
@@ -2870,14 +2872,25 @@ module VM = struct
                 | _ ->
                     ()
                 ) ;
+                let suspend_timeout = !Xenopsd.vm_suspend_timeout in
                 if
                   not
                     ( with_tracing ~task
                         ~name:"VM_save_domain_suspend_callback_wait_shutdown"
-                    @@ fun () -> wait_shutdown task vm Suspend 1200.
+                    @@ fun () ->
+                      debug
+                        "VM = %s; domid = %d; Waiting for domain to suspend \
+                         (timeout = %.0fs)"
+                        vm.Vm.id domid suspend_timeout ;
+                      wait_shutdown task vm Suspend suspend_timeout
                     )
                 then
-                  raise (Xenopsd_error (Failed_to_suspend (vm.Vm.id, 1200.)))
+                  raise
+                    (Xenopsd_error
+                       (Failed_to_suspend (vm.Vm.id, suspend_timeout))
+                    )
+                else
+                  debug "VM = %s; domid = %d; Domain suspended" vm.Vm.id domid
             ) ;
             (* Record the final memory usage of the domain so we know how much
                to allocate for the resume *)