CA-423369: fix suspend-SR space check (backport) (#6883)

Unfortunately, the SR size and utilisation fields are only set after an
SR scan, and the new space check has been incorrectly rejecting suspends
in some cases.

Fix this by just catching the error from `VDI.create` and raising the
new error to make it clear that it is the suspend SR that is out of
space.

Fixes 9402e88.

(cherry picked from commit 45e2ea9)

Author: edwintorok

ocaml/xapi/helpers.ml

@@ -1134,44 +1134,31 @@ let get_sr_free_space ~__context ~sr =
   Int64.sub size utilisation
 
 (* Returns an SR suitable for suspending this VM *)
-let choose_suspend_sr ~__context ~vm ~required_space =
+let choose_suspend_sr ~__context ~vm =
   (* If the VM.suspend_SR exists, use that. If it fails, try the Pool.suspend_image_SR. *)
   (* If that fails, try the Host.suspend_image_SR. *)
   let vm_sr = Db.VM.get_suspend_SR ~__context ~self:vm in
   let pool = get_pool ~__context in
   let pool_sr = Db.Pool.get_suspend_image_SR ~__context ~self:pool in
   let resident_on = Db.VM.get_resident_on ~__context ~self:vm in
   let host_sr = Db.Host.get_suspend_image_sr ~__context ~self:resident_on in
-  let sr =
-    match
-      ( check_sr_exists_for_host ~__context ~self:vm_sr ~host:resident_on
-      , check_sr_exists_for_host ~__context ~self:pool_sr ~host:resident_on
-      , check_sr_exists_for_host ~__context ~self:host_sr ~host:resident_on
-      )
-    with
-    | Some x, _, _ ->
-        x
-    | _, Some x, _ ->
-        x
-    | _, _, Some x ->
-        x
-    | None, None, None ->
-        raise
-          (Api_errors.Server_error
-             (Api_errors.vm_no_suspend_sr, [Ref.string_of vm])
-          )
-  in
-  let free_space = get_sr_free_space ~__context ~sr in
-  if free_space < required_space then (
-    let sr_str = Ref.string_of sr in
-    error "%s: SR %s free=%Ld needed=%Ld" __FUNCTION__ sr_str free_space
-      required_space ;
-    raise
-      (Api_errors.Server_error
-         (Api_errors.sr_suspend_space_insufficient, [sr_str])
-      )
-  ) else
-    sr
+  match
+    ( check_sr_exists_for_host ~__context ~self:vm_sr ~host:resident_on
+    , check_sr_exists_for_host ~__context ~self:pool_sr ~host:resident_on
+    , check_sr_exists_for_host ~__context ~self:host_sr ~host:resident_on
+    )
+  with
+  | Some x, _, _ ->
+      x
+  | _, Some x, _ ->
+      x
+  | _, _, Some x ->
+      x
+  | None, None, None ->
+      raise
+        (Api_errors.Server_error
+           (Api_errors.vm_no_suspend_sr, [Ref.string_of vm])
+        )
 
 (* return the operations filtered for cancels functions *)
 let cancel_tasks ~__context ~ops ~all_tasks_in_db

ocaml/xapi/xapi_xenops.ml

@@ -3994,10 +3994,7 @@ let suspend ~__context ~self =
         in
         Int64.(ram |> add vgpu |> add 104857600L)
       in
-      let suspend_SR =
-        Helpers.choose_suspend_sr ~__context ~vm:self
-          ~required_space:space_needed
-      in
+      let suspend_SR = Helpers.choose_suspend_sr ~__context ~vm:self in
       let sm_config =
         [
           (Constants._sm_vm_hint, id)
@@ -4007,11 +4004,22 @@ let suspend ~__context ~self =
       in
       Helpers.call_api_functions ~__context (fun rpc session_id ->
           let vdi =
-            XenAPI.VDI.create ~rpc ~session_id ~name_label:"Suspend image"
-              ~name_description:"Suspend image" ~sR:suspend_SR
-              ~virtual_size:space_needed ~sharable:false ~read_only:false
-              ~_type:`suspend ~other_config:[] ~xenstore_data:[] ~sm_config
-              ~tags:[]
+            try
+              XenAPI.VDI.create ~rpc ~session_id ~name_label:"Suspend image"
+                ~name_description:"Suspend image" ~sR:suspend_SR
+                ~virtual_size:space_needed ~sharable:false ~read_only:false
+                ~_type:`suspend ~other_config:[] ~xenstore_data:[] ~sm_config
+                ~tags:[]
+            with Api_errors.Server_error ("SR_BACKEND_FAILURE_44", _) ->
+              let sr_uuid = Db.SR.get_uuid ~__context ~self:suspend_SR in
+              error "Not enough free space on suspend SR %s; need %Ld B" sr_uuid
+                space_needed ;
+              raise
+                (Api_errors.Server_error
+                   ( Api_errors.sr_suspend_space_insufficient
+                   , [Ref.string_of suspend_SR]
+                   )
+                )
           in
           let d = disk_of_vdi ~__context ~self:vdi |> Option.get in
           Db.VM.set_suspend_VDI ~__context ~self ~value:vdi ;