CA-397599 XSI-1704 implement setter for blocked ops manually

ocaml/idl/datamodel_vm.ml

@@ -1219,6 +1219,46 @@ let power_behaviour =
             ]
          )
 
+let set_blocked_operations =
+call ~name:"set_blocked_operations"
+  ~in_product_since:rel_orlando (* but updated 2024 *)
+  ~doc:
+    "Update list of operations which have been explicitly blocked and an \
+     error code"
+  ~params:
+    [
+      (Ref _vm, "self", "The VM")
+    ; (Map (operations, String), "value", "Blocked operations")
+    ]
+  ~allowed_roles:_R_VM_ADMIN
+  ()
+
+let add_to_blocked_operations =
+call ~name:"add_to_blocked_operations"
+  ~in_product_since:rel_orlando (* but updated 2024 *)
+  ~doc:
+    "Update list of operations which have been explicitly blocked and an \
+     error code"
+  ~params:
+    [
+      (Ref _vm, "self", "The VM")
+    ; (operations, "key", "Blocked operation")
+    ; (String, "value", "Error code")
+    ]
+  ~allowed_roles:_R_VM_ADMIN
+  ()
+
+let remove_from_blocked_operations =
+call ~name:"remove_from_blocked_operations"
+  ~in_product_since:rel_orlando (* but updated 2024 *)
+  ~doc:
+    "Update list of operations which have been explicitly blocked and an \
+     error code"
+  ~params:
+    [(Ref _vm, "self", "The VM"); (operations, "key", "Blocked operation")]
+  ~allowed_roles:_R_VM_ADMIN
+  ()
+
 let assert_operation_valid = call
     ~in_oss_since:None
     ~in_product_since:rel_rio
@@ -1357,6 +1397,9 @@ let set_NVRAM_EFI_variables = call ~flags:[`Session]
                   set_domain_type;
                   set_HVM_boot_policy;
                   set_NVRAM_EFI_variables;
+                  set_blocked_operations;
+                  add_to_blocked_operations;
+                  remove_from_blocked_operations
                 ]
       ~contents:
         ([ uid _vm;
@@ -1414,7 +1457,8 @@ let set_NVRAM_EFI_variables = call ~flags:[`Session]
            field ~writer_roles:_R_VM_POWER_ADMIN ~qualifier:DynamicRO ~in_product_since:rel_orlando ~default_value:(Some (VString ""))           ~ty:String          "transportable_snapshot_id" "Transportable ID of the snapshot VM";
            field ~qualifier:DynamicRO ~in_product_since:rel_orlando ~ty:(Map(String, Ref _blob)) ~default_value:(Some (VMap [])) "blobs" "Binary blobs associated with this VM";
            field ~writer_roles:_R_VM_OP ~in_product_since:rel_orlando ~default_value:(Some (VSet [])) ~ty:(Set String) "tags" "user-specified tags for categorization purposes";
-           field ~in_product_since:rel_orlando ~default_value:(Some (VMap [])) ~qualifier:RW ~ty:(Map(operations, String)) "blocked_operations" "List of operations which have been explicitly blocked and an error code";
+           field ~in_product_since:rel_orlando ~default_value:(Some (VMap []))
+           ~qualifier:StaticRO ~ty:(Map(operations, String)) "blocked_operations" "List of operations which have been explicitly blocked and an error code";
 
            field ~writer_roles:_R_VM_POWER_ADMIN ~qualifier:DynamicRO ~in_product_since:rel_midnight_ride ~default_value:(Some (VMap []))    ~ty:(Map (String, String)) "snapshot_info"     "Human-readable information concerning this snapshot";
            field ~writer_roles:_R_VM_POWER_ADMIN ~qualifier:DynamicRO ~in_product_since:rel_midnight_ride ~default_value:(Some (VString "")) ~ty:String                 "snapshot_metadata" "Encoded information about the VM's metadata this is a snapshot of";

ocaml/idl/schematest.ml

@@ -1,7 +1,7 @@
 let hash x = Digest.string x |> Digest.to_hex
 
 (* BEWARE: if this changes, check that schema has been bumped accordingly *)
-let last_known_schema_hash = "61f913df730ae846efa35ae474a64e1d"
+let last_known_schema_hash = "2f2edeb0e435f0bb99cc251db51a3707"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/xapi/message_forwarding.ml

@@ -2770,6 +2770,23 @@ functor
         (* called by varstored, bypasses VM powerstate check *)
         info "VM.set_NVRAM_EFI_variables: self = '%s'" (vm_uuid ~__context self) ;
         Local.VM.set_NVRAM_EFI_variables ~__context ~self ~value
+
+      let set_blocked_operations ~__context ~self ~value =
+        info "VM.set_blocked_operations: self = '%s'" (vm_uuid ~__context self) ;
+        Local.VM.set_blocked_operations ~__context ~self ~value ;
+        Xapi_vm_lifecycle.update_allowed_operations ~__context ~self
+
+      let add_to_blocked_operations ~__context ~self ~key ~value =
+        info "VM.add_to_blocked_operations: self = '%s'"
+          (vm_uuid ~__context self) ;
+        Local.VM.add_to_blocked_operations ~__context ~self ~key ~value ;
+        Xapi_vm_lifecycle.update_allowed_operations ~__context ~self
+
+      let remove_from_blocked_operations ~__context ~self ~key =
+        info "VM.remove_from_blocked_operations: self = '%s'"
+          (vm_uuid ~__context self) ;
+        Local.VM.remove_from_blocked_operations ~__context ~self ~key ;
+        Xapi_vm_lifecycle.update_allowed_operations ~__context ~self
     end
 
     module VM_metrics = struct end

ocaml/xapi/xapi_vm.ml

@@ -1659,6 +1659,15 @@ let set_domain_type ~__context ~self ~value =
   Db.VM.set_HVM_boot_policy ~__context ~self
     ~value:(derive_hvm_boot_policy ~domain_type:value)
 
+let set_blocked_operations ~__context ~self ~value =
+  Db.VM.set_blocked_operations ~__context ~self ~value
+
+let add_to_blocked_operations ~__context ~self ~key ~value =
+  Db.VM.add_to_blocked_operations ~__context ~self ~key ~value
+
+let remove_from_blocked_operations ~__context ~self ~key =
+  Db.VM.remove_from_blocked_operations ~__context ~self ~key
+
 let set_HVM_boot_policy ~__context ~self ~value =
   Db.VM.set_domain_type ~__context ~self
     ~value:(derive_domain_type ~hVM_boot_policy:value) ;

ocaml/xapi/xapi_vm.mli

@@ -411,3 +411,19 @@ val set_HVM_boot_policy :
 
 val set_NVRAM_EFI_variables :
   __context:Context.t -> self:API.ref_VM -> value:string -> unit
+
+val set_blocked_operations :
+     __context:Context.t
+  -> self:API.ref_VM
+  -> value:(API.vm_operations * string) list
+  -> unit
+
+val add_to_blocked_operations :
+     __context:Context.t
+  -> self:API.ref_VM
+  -> key:API.vm_operations
+  -> value:string
+  -> unit
+
+val remove_from_blocked_operations :
+  __context:Context.t -> self:API.ref_VM -> key:API.vm_operations -> unit