Replace ha_operation_would_break_failover_plan with constraint errors (#6666)

Now the HA shared SR and network constraint violations are used when
plugging and unplugging.

When unplugging a pbd or pif, enabling a host, or adding a vbd or vif,
the shared SR or network constraint violations could be violated, but
the error used in these cases was that the operation blocked the
failover planning. This was confusing because the main reason was not
mentioned in the error. Instead use the
shared constraint violation error, and log a more descriptive message in
the logs as info, because these can happen during normal operation and
there's nothing dodgy going on.

I previously wanted to know Tina's opinion on how we change the reason
in a way that can be better treated by clients and internationalized,
but saw that the error used was simply not the right one.

Author: psafont

ocaml/xapi/xapi_ha_vm_failover.ml

@@ -1223,9 +1223,6 @@ let assert_configuration_change_preserves_ha_plan ~__context c =
             "assert_configuration_change_preserves_ha_plan: plan exists after \
              change"
       | Plan_exists_excluding_non_agile_VMs | No_plan_exists ->
-          debug
-            "assert_configuration_change_preserves_ha_plan: proposed change \
-             breaks plan" ;
           raise
             (Api_errors.Server_error
                (Api_errors.ha_operation_would_break_failover_plan, [])
@@ -1413,8 +1410,9 @@ let restart_auto_run_vms ~__context ~last_live_set ~live_set n =
   let open TaskChains.Infix in
   (* execute the plan *)
   Helpers.call_api_functions ~__context (fun rpc session_id ->
-      (* Helper function to start a VM somewhere. If the HA overcommit protection stops us then disable it and try once more.
-         			   Returns true if the VM was restarted and false otherwise. *)
+      (* Helper function to start a VM somewhere. If the HA overcommit
+         protection stops us then disable it and try once more. Returns true if
+         the VM was restarted and false otherwise. *)
       let restart_vm vm ?host () =
         let go () =
           ( if Xapi_fist.simulate_restart_failure () then
@@ -1579,10 +1577,11 @@ let restart_auto_run_vms ~__context ~last_live_set ~live_set n =
       in
       gc_table last_start_attempt ;
       gc_table restart_failed ;
-      (* Consider restarting the best-effort VMs we *think* have failed (but we might get this wrong --
-         			   ok since this is 'best-effort'). NOTE we do not use the restart_vm function above as this will mark the
-         			   pool as overcommitted if an HA_OPERATION_WOULD_BREAK_FAILOVER_PLAN is received (although this should never
-         			   happen it's better safe than sorry) *)
+      (* Consider restarting the best-effort VMs we *think* have failed (but we
+         might get this wrong -- ok since this is 'best-effort'). NOTE we do
+         not use the restart_vm function above as this will mark the pool as
+         overcommitted if an HA_OPERATION_WOULD_BREAK_FAILOVER_PLAN is received
+         (although this should never happen it's better safe than sorry) *)
       let is_best_effort r =
         r.API.vM_ha_restart_priority = Constants.ha_restart_best_effort
         && r.API.vM_power_state = `Halted

ocaml/xapi/xapi_pbd.ml

@@ -114,13 +114,18 @@ let abort_if_storage_attached_to_protected_vms ~__context ~self =
           (fun vbd ->
             let vdi = Db.VBD.get_VDI ~__context ~self:vbd in
             if List.mem vdi vdis then (
-              warn
-                "PBD.unplug will make protected VM %s not agile since it has a \
-                 VBD attached to VDI %s"
-                (Ref.string_of vm_ref) (Ref.string_of vdi) ;
+              let vm = Ref.string_of vm_ref in
+              let pbd = Ref.string_of self in
+              let sr = Ref.string_of sr in
+              info
+                "The protected VM %s must remain agile and blocked the \
+                 operation. The PBD %s of must be plugged to ensure this. This \
+                 happened because the SR %s is used by both the VM and the \
+                 PBD."
+                vm pbd sr ;
               raise
-                (Api_errors.Server_error
-                   (Api_errors.ha_operation_would_break_failover_plan, [])
+                Api_errors.(
+                  Server_error (ha_constraint_violation_sr_not_shared, [sr])
                 )
             )
           )

ocaml/xapi/xapi_pif.ml

@@ -271,13 +271,17 @@ let abort_if_network_attached_to_protected_vms ~__context ~self =
     List.iter
       (fun vm ->
         if Helpers.is_xha_protected ~__context ~self:vm then (
-          warn
-            "PIF.unplug will make protected VM %s not agile since it has a VIF \
-             attached to network %s"
-            (Ref.string_of vm) (Ref.string_of net) ;
+          let vm = Ref.string_of vm in
+          let pif = Ref.string_of self in
+          let net = Ref.string_of net in
+          info
+            "The protected VM %s must remain agile and blocked the operation. \
+             PIF %s must be plugged this. This happened because network %s is \
+             used by both the VM and the PIF"
+            vm pif net ;
           raise
-            (Api_errors.Server_error
-               (Api_errors.ha_operation_would_break_failover_plan, [])
+            Api_errors.(
+              Server_error (ha_constraint_violation_network_not_shared, [net])
             )
         )
       )

ocaml/xapi/xapi_vbd_helpers.ml

@@ -358,24 +358,17 @@ let assert_attachable ~__context ~self =
 
 let assert_doesnt_make_vm_non_agile ~__context ~vm ~vdi =
   let pool = Helpers.get_pool ~__context in
-  let properly_shared =
-    Agility.is_sr_properly_shared ~__context
-      ~self:(Db.VDI.get_SR ~__context ~self:vdi)
-  in
+  let sr = Db.VDI.get_SR ~__context ~self:vdi in
+  let properly_shared = Agility.is_sr_properly_shared ~__context ~self:sr in
   if
     true
     && Db.Pool.get_ha_enabled ~__context ~self:pool
     && (not (Db.Pool.get_ha_allow_overcommit ~__context ~self:pool))
     && Helpers.is_xha_protected ~__context ~self:vm
     && not properly_shared
-  then (
-    warn "Attaching VDI %s makes VM %s not agile" (Ref.string_of vdi)
-      (Ref.string_of vm) ;
-    raise
-      (Api_errors.Server_error
-         (Api_errors.ha_operation_would_break_failover_plan, [])
-      )
-  )
+  then
+    let sr = Ref.string_of sr in
+    raise Api_errors.(Server_error (ha_constraint_violation_sr_not_shared, [sr]))
 
 let update_allowed_operations ~__context ~self : unit =
   let all = Db.VBD.get_record_internal ~__context ~self in

ocaml/xapi/xapi_vif_helpers.ml

@@ -267,19 +267,18 @@ let create ~__context ~device ~network ~vM ~mAC ~mTU ~other_config
     raise (Api_errors.Server_error (Api_errors.mac_invalid, [mAC])) ;
   (* Make people aware that non-shared networks being added to VMs makes them not agile *)
   let pool = Helpers.get_pool ~__context in
-  if
-    true
-    && Db.Pool.get_ha_enabled ~__context ~self:pool
-    && (not (Db.Pool.get_ha_allow_overcommit ~__context ~self:pool))
-    && Helpers.is_xha_protected ~__context ~self:vM
-    && not (Agility.is_network_properly_shared ~__context ~self:network)
-  then (
-    warn "Creating VIF %s makes VM %s not agile" (Ref.string_of ref)
-      (Ref.string_of vM) ;
-    raise
-      (Api_errors.Server_error
-         (Api_errors.ha_operation_would_break_failover_plan, [])
-      )
+  ( if
+      true
+      && Db.Pool.get_ha_enabled ~__context ~self:pool
+      && (not (Db.Pool.get_ha_allow_overcommit ~__context ~self:pool))
+      && Helpers.is_xha_protected ~__context ~self:vM
+      && not (Agility.is_network_properly_shared ~__context ~self:network)
+    then
+      let net = Ref.string_of network in
+      raise
+        Api_errors.(
+          Server_error (ha_constraint_violation_network_not_shared, [net])
+        )
   ) ;
   (* Check to make sure the device is unique *)
   Xapi_stdext_threads.Threadext.Mutex.execute m (fun () ->
@@ -291,8 +290,7 @@ let create ~__context ~device ~network ~vM ~mAC ~mTU ~other_config
       in
       let new_device = int_of_string device in
       if List.exists (fun (_, d) -> d = new_device) all_vifs_with_devices then
-        raise
-          (Api_errors.Server_error (Api_errors.device_already_exists, [device])) ;
+        raise Api_errors.(Server_error (device_already_exists, [device])) ;
 
       (* If the VM uses a PVS_proxy, then the proxy _must_ be associated with
          the VIF that has the lowest device number. Check that the new VIF