xapi_vm_migrate: add capabilities to migration not supported by sr error (xapi-project#6829)

The error does not make it clear at all what are the capabilities that
are stopping it from supporting migration, which makes debugging issues
difficult, add a string that contains them. This can be easily ignored
by default in clients, but the information is easily available if
needed.

We have come up with an issue where the migration is blocked, but the SM
seems to report the correct capabilities, so more information is needed
to understand the error.

Author: psafont

ocaml/idl/datamodel_errors.ml

@@ -1059,7 +1059,7 @@ let _ =
     ~doc:"The VDI mirroring cannot be performed" () ;
   error Api_errors.too_many_storage_migrates ["number"]
     ~doc:"You reached the maximal number of concurrently migrating VMs." () ;
-  error Api_errors.sr_does_not_support_migration ["sr"]
+  error Api_errors.sr_does_not_support_migration ["sr"; "capabilities"]
     ~doc:"Cannot migrate a VDI to or from an SR that doesn't support migration."
     () ;
   error Api_errors.vm_failed_shutdown_ack ["vm"]

ocaml/xapi/xapi_vm_migrate.ml

@@ -160,19 +160,25 @@ end))
 
 open Storage_interface
 
+let supported_on ~ops sr sr_features =
+  let open Smint.Feature in
+  let missing =
+    List.filter (fun op -> not (has_capability op sr_features)) ops
+  in
+  if missing <> [] then
+    let missing = List.map capability_to_string missing |> String.concat ";" in
+    let msg = [Ref.string_of sr; missing] in
+    raise Api_errors.(Server_error (sr_does_not_support_migration, msg))
+
 let assert_sr_support_operations ~__context ~vdi_map ~remote ~local_ops
     ~remote_ops =
   let op_supported_on_source_sr vdi ops =
-    let open Smint.Feature in
-    (* Check VDIs must not be present on SR which doesn't have required capability *)
+    (* Check VDIs must not be present on SR which doesn't have required
+       capability *)
     let source_sr = Db.VDI.get_SR ~__context ~self:vdi in
     let sr_record = Db.SR.get_record_internal ~__context ~self:source_sr in
     let sr_features = Xapi_sr_operations.features_of_sr ~__context sr_record in
-    if not (List.for_all (fun op -> has_capability op sr_features) ops) then
-      raise
-        (Api_errors.Server_error
-           (Api_errors.sr_does_not_support_migration, [Ref.string_of source_sr])
-        )
+    supported_on ~ops source_sr sr_features
   in
   let op_supported_on_dest_sr sr ops sm_record remote =
     let open Smint.Feature in
@@ -187,11 +193,7 @@ let assert_sr_support_operations ~__context ~vdi_map ~remote ~local_ops
       | _ ->
           []
     in
-    if not (List.for_all (fun op -> has_capability op sm_features) ops) then
-      raise
-        (Api_errors.Server_error
-           (Api_errors.sr_does_not_support_migration, [Ref.string_of sr])
-        )
+    supported_on ~ops sr sm_features
   in
   let is_sr_matching local_vdi_ref remote_sr_ref =
     let source_sr_ref = Db.VDI.get_SR ~__context ~self:local_vdi_ref in