CP-24903: new error network_incompatible_purposes

Define this type of error, and raise it as and where appropriate.

Signed-off-by: Thomas Sanders <[email protected]>

Author: thomassa

ocaml/idl/datamodel.ml

@@ -566,6 +566,8 @@ let _ =
     ~doc:"You tried to create a PIF, but the network you tried to attach it to is already attached to some other PIF, and so the creation failed." ();
   error Api_errors.cannot_destroy_system_network [ "network" ]
     ~doc:"You tried to destroy a system network: these cannot be destroyed." ();
+  error Api_errors.network_incompatible_purposes ["new_purpose"; "conflicting_purpose"]
+    ~doc:"You tried to add a purpose to a network but the new purpose is not compatible with an existing purpose of the network or other networks." ();
   error Api_errors.pif_is_physical ["PIF"]
     ~doc:"You tried to destroy a PIF, but it represents an aspect of the physical host configuration, and so cannot be destroyed.  The parameter echoes the PIF handle you gave." ();
   error Api_errors.pif_is_vlan ["PIF"]

ocaml/xapi-consts/api_errors.ml

@@ -99,6 +99,8 @@ let operation_not_allowed = "OPERATION_NOT_ALLOWED"
 let operation_blocked = "OPERATION_BLOCKED"
 let network_already_connected = "NETWORK_ALREADY_CONNECTED"
 let network_unmanaged = "NETWORK_UNMANAGED"
+let network_incompatible_purposes = "NETWORK_INCOMPATIBLE_PURPOSES"
+
 let cannot_destroy_system_network = "CANNOT_DESTROY_SYSTEM_NETWORK"
 let pif_is_physical = "PIF_IS_PHYSICAL"
 let pif_is_vlan = "PIF_IS_VLAN"

ocaml/xapi/xapi_network.ml

@@ -332,27 +332,33 @@ let with_networks_attached_for_vm ~__context ?host ~vm f =
 
 let assert_can_add_purpose ~__context ~network ~current newval =
   let sop (*string-of-porpoise*) = Record_util.network_purpose_to_string in
+  let reject str =
+    raise Api_errors.(Server_error (network_incompatible_purposes, [ (sop newval); str ]))
+  in
   if (List.mem `himn current) then (
-    info "Existing network purpose %s is not compatible with any other purpose." (sop `himn)
+    info "Existing network purpose %s is not compatible with any other purpose." (sop `himn);
+    reject (sop `himn)
   );
   if (List.mem `unmanaged current) then (
-    info "Existing network purpose %s is not compatible with any other purpose." (sop `unmanaged)
+    info "Existing network purpose %s is not compatible with any other purpose." (sop `unmanaged);
+    reject (sop `unmanaged)
   );
-
   let assert_no_net_has_bad_porpoise bads =
     (* Sadly we can't use Db.Network.get_refs_where because the expression
      * type doesn't allow searching for a value inside a list. *)
     Db.Network.get_all ~__context |>
     List.iter (fun nwk ->
       Db.Network.get_purposes ~__context ~self:nwk |>
       List.iter (fun suspect -> if (List.mem suspect bads) then
-        info "Cannot set new network purpose %s when there is a network with purpose %s" (sop newval) (sop suspect)
+        info "Cannot set new network purpose %s when there is a network with purpose %s" (sop newval) (sop suspect);
+        reject (sop suspect)
       )
     )
   in
   match newval with
   | `himn | `unmanaged -> if current <> [] then (
-      info "New network purpose %s is not compatible with any other purpose" (sop porpoise)
+      info "New network purpose %s is not compatible with any other purpose" (sop porpoise);
+      reject "any"
     )
   | `management -> if (List.mem `guest current) then (
       info "Combining network purposes %s and %s is inadvisable for security reasons, but not prevented." (sop `management) (sop `guest)