# HG changeset patch
# User Marcus Granado <marcus.granado@xxxxxxxxxx>
# Date 1282322886 -3600
# Node ID f8298e1caacd3a2a5323388ac9d44a4ae12bf98d
# Parent  5ed6061cd4377edb0e9d46a31a69fd9a1dabbf7a
CP-1807: validate key names and values for vmpp map fields

Signed-off-by: Marcus Granado <marcus.granado@xxxxxxxxxxxxx>

diff -r 5ed6061cd437 -r f8298e1caacd ocaml/idl/api_errors.ml
--- a/ocaml/idl/api_errors.ml
+++ b/ocaml/idl/api_errors.ml
@@ -389,6 +389,9 @@
 let crl_name_invalid = "CRL_NAME_INVALID"
 let crl_corrupt = "CRL_CORRUPT"
 
+let vmpp_has_vm = "VMPP_HAS_VM"
+let vmpp_archive_more_frequent_than_backup = "VMPP_ARCHIVE_MORE_FREQUENT_THAN_BACKUP"
+
 let ssl_verify_error = "SSL_VERIFY_ERROR"
 
 let cannot_enable_redo_log = "CANNOT_ENABLE_REDO_LOG"
diff -r 5ed6061cd437 -r f8298e1caacd ocaml/idl/datamodel.ml
--- a/ocaml/idl/datamodel.ml
+++ b/ocaml/idl/datamodel.ml
@@ -987,6 +987,11 @@
   error Api_errors.crl_corrupt ["name"]
     ~doc:"The specified CRL is corrupt or unreadable." ();
 
+  error Api_errors.vmpp_has_vm []
+    ~doc:"There is at least on VM assigned to this protection policy." ();
+  error Api_errors.vmpp_archive_more_frequent_than_backup []
+    ~doc:"Archive more frequent than backup." ();
+
   error Api_errors.ssl_verify_error ["reason"]
     ~doc:"The remote system's SSL certificate failed to verify against our certificate library." ();
 	
@@ -5908,7 +5913,7 @@
     Ref _vmpp, "self", "The protection policy";
     Bool, "value", "true to mark this protection policy's backup is running"
   ]
-  ~doc:"This call marks that a protection policy's backup is running"
+  ~doc:"Set the value of the is_backup_running field"
   ~allowed_roles:_R_LOCAL_ROOT_ONLY
   ~hide_from_docs:true
   ()
@@ -5920,10 +5925,178 @@
     Ref _vmpp, "self", "The protection policy";
     Bool, "value", "true to mark this protection policy's archive is running"
   ]
-  ~doc:"This call marks that a protection policy's archive is running"
+  ~doc:"Set the value of the is_archive_running field"
   ~allowed_roles:_R_LOCAL_ROOT_ONLY
   ~hide_from_docs:true
   ()
+let vmpp_set_is_alarm_enabled = call ~flags:[`Session]
+  ~name:"set_is_alarm_enabled"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    Bool, "value", "true if alarm is enabled for this policy"
+  ]
+  ~doc:"Set the value of the is_alarm_enabled field"
+  ~allowed_roles:_R_POOL_OP
+  ()
+let vmpp_set_archive_frequency = call ~flags:[`Session]
+  ~name:"set_archive_frequency"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    vmpp_archive_frequency, "value", "the archive frequency"
+  ]
+  ~doc:"Set the value of the archive_frequency field"
+  ~allowed_roles:_R_POOL_OP
+  ()
+let vmpp_set_archive_target_type = call ~flags:[`Session]
+  ~name:"set_archive_target_type"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    vmpp_archive_target_type, "value", "the archive target config type"
+  ]
+  ~doc:"Set the value of the archive_target_config_type field"
+  ~allowed_roles:_R_POOL_OP
+  ()
+let vmpp_set_backup_frequency = call ~flags:[`Session]
+  ~name:"set_backup_frequency"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    vmpp_backup_frequency, "value", "the backup frequency"
+  ]
+  ~doc:"Set the value of the backup_frequency field"
+  ~allowed_roles:_R_POOL_OP
+  ()
+let vmpp_set_backup_schedule = call ~flags:[`Session]
+  ~name:"set_backup_schedule"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    Map(String,String), "value", "the value to set"
+  ]
+  ()
+let vmpp_set_archive_target_config = call ~flags:[`Session]
+  ~name:"set_archive_target_config"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    Map(String,String), "value", "the value to set"
+  ]
+  ()
+let vmpp_set_archive_schedule = call ~flags:[`Session]
+  ~name:"set_archive_schedule"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    Map(String,String), "value", "the value to set"
+  ]
+  ()
+let vmpp_set_alarm_config = call ~flags:[`Session]
+  ~name:"set_alarm_config"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    Map(String,String), "value", "the value to set"
+  ]
+  ()
+let vmpp_add_to_backup_schedule = call ~flags:[`Session]
+  ~name:"add_to_backup_schedule"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    String, "key", "the key to add";
+    String, "value", "the value to add";
+  ]
+  ()
+let vmpp_add_to_archive_target_config = call ~flags:[`Session]
+  ~name:"add_to_archive_target_config"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    String, "key", "the key to add";
+    String, "value", "the value to add";
+  ]
+  ()
+let vmpp_add_to_archive_schedule = call ~flags:[`Session]
+  ~name:"add_to_archive_schedule"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    String, "key", "the key to add";
+    String, "value", "the value to add";
+  ]
+  ()
+let vmpp_add_to_alarm_config = call ~flags:[`Session]
+  ~name:"add_to_alarm_config"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    String, "key", "the key to add";
+    String, "value", "the value to add";
+  ]
+  ()
+let vmpp_remove_from_backup_schedule = call ~flags:[`Session]
+  ~name:"remove_from_backup_schedule"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    String, "key", "the key to remove";
+  ]
+  ()
+let vmpp_remove_from_archive_target_config = call ~flags:[`Session]
+  ~name:"remove_from_archive_target_config"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    String, "key", "the key to remove";
+  ]
+  ()
+let vmpp_remove_from_archive_schedule = call ~flags:[`Session]
+  ~name:"remove_from_archive_schedule"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    String, "key", "the key to remove";
+  ]
+  ()
+let vmpp_remove_from_alarm_config = call ~flags:[`Session]
+  ~name:"remove_from_alarm_config"
+  ~in_oss_since:None
+  ~in_product_since:rel_cowley
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmpp, "self", "The protection policy";
+    String, "key", "the key to remove";
+  ]
+  ()
 let vmpp =
   create_obj ~in_db:true ~in_product_since:rel_cowley ~in_oss_since:None ~internal_deprecated_since:None ~persist:PersistEverything ~gen_constructor_destructor:true ~name:_vmpp ~descr:"VM Protection Policy"
     ~gen_events:true
@@ -5934,6 +6107,22 @@
       vmpp_archive_now;
       vmpp_set_is_backup_running;
       vmpp_set_is_archive_running;
+      vmpp_set_backup_frequency;
+      vmpp_set_backup_schedule;
+      vmpp_set_archive_frequency;
+      vmpp_set_archive_schedule;
+      vmpp_set_archive_target_type;
+      vmpp_set_archive_target_config;
+      vmpp_set_is_alarm_enabled;
+      vmpp_set_alarm_config;
+      vmpp_add_to_backup_schedule;
+      vmpp_add_to_archive_target_config;
+      vmpp_add_to_archive_schedule;
+      vmpp_add_to_alarm_config;
+      vmpp_remove_from_backup_schedule;
+      vmpp_remove_from_archive_target_config;
+      vmpp_remove_from_archive_schedule;
+      vmpp_remove_from_alarm_config;
     ]
     ~contents:[
       uid _vmpp;
@@ -5941,19 +6130,19 @@
       field ~qualifier:RW ~ty:Bool "is_policy_enabled" "enable or disable this policy" ~default_value:(Some (VBool true));
       field ~qualifier:RW ~ty:vmpp_backup_type "backup_type" "type of the backup sub-policy";
       field ~qualifier:RW ~ty:Int "backup_retention_value" "maximum number of backups that should be stored at any time" ~default_value:(Some (VInt 1L));
-      field ~qualifier:RW ~ty:vmpp_backup_frequency "backup_frequency" "frequency of the backup schedule";
-      field ~qualifier:RW ~ty:(Map (String,String)) "backup_schedule" "schedule of the backup containing 'frequency', 'hour', 'min', 'days'. Date/time-related information is in XenServer Local Timezone";
+      field ~qualifier:StaticRO ~ty:vmpp_backup_frequency "backup_frequency" "frequency of the backup schedule";
+      field ~qualifier:StaticRO ~ty:(Map (String,String)) "backup_schedule" "schedule of the backup containing 'hour', 'min', 'days'. Date/time-related information is in XenServer Local Timezone";
       field ~qualifier:DynamicRO ~ty:Bool "is_backup_running" "true if this protection policy's backup is running";
       field ~qualifier:RW ~ty:DateTime "backup_last_run_time" "time of the last backup" ~default_value:(Some(VDateTime(Date.of_float 0.)));
-      field ~qualifier:RW ~ty:vmpp_archive_target_type "archive_target_type" "type of the archive target config" ~default_value:(Some (VEnum "none"));
-      field ~qualifier:RW ~ty:(Map (String,String)) "archive_target_config" "configuration for the archive, including its 'type' in {'cifs','nfs'}" ~default_value:(Some (VMap []));
-      field ~qualifier:RW ~ty:vmpp_archive_frequency "archive_frequency" "frequency of the archive schedule" ~default_value:(Some (VEnum "never"));
-      field ~qualifier:RW ~ty:(Map (String,String)) "archive_schedule" "schedule of the archive containing 'frequency', 'hour', 'min', 'days'. Date/time-related information is in XenServer Local Timezone" ~default_value:(Some (VMap []));
+      field ~qualifier:StaticRO ~ty:vmpp_archive_target_type "archive_target_type" "type of the archive target config" ~default_value:(Some (VEnum "none"));
+      field ~qualifier:StaticRO ~ty:(Map (String,String)) "archive_target_config" "configuration for the archive, including its 'location', 'username', 'password'" ~default_value:(Some (VMap []));
+      field ~qualifier:StaticRO ~ty:vmpp_archive_frequency "archive_frequency" "frequency of the archive schedule" ~default_value:(Some (VEnum "never"));
+      field ~qualifier:StaticRO ~ty:(Map (String,String)) "archive_schedule" "schedule of the archive containing 'hour', 'min', 'days'. Date/time-related information is in XenServer Local Timezone" ~default_value:(Some (VMap []));
       field ~qualifier:DynamicRO ~ty:Bool "is_archive_running" "true if this protection policy's archive is running";
       field ~qualifier:RW ~ty:DateTime "archive_last_run_time" "time of the last archive" ~default_value:(Some(VDateTime(Date.of_float 0.)));
       field ~qualifier:DynamicRO ~ty:(Set (Ref _vm)) "VMs" "all VMs attached to this protection policy";
-      field ~qualifier:RW ~ty:Bool "is_alarm_enabled" "true if alarm is enabled for this policy" ~default_value:(Some (VBool false));
-      field ~qualifier:RW ~ty:(Map (String,String)) "alarm_config" "configuration for the alarm" ~default_value:(Some (VMap []));
+      field ~qualifier:StaticRO ~ty:Bool "is_alarm_enabled" "true if alarm is enabled for this policy" ~default_value:(Some (VBool false));
+      field ~qualifier:StaticRO ~ty:(Map (String,String)) "alarm_config" "configuration for the alarm" ~default_value:(Some (VMap []));
       field ~qualifier:DynamicRO ~ty:(Set (String)) "recent_alerts" "recent alerts" ~default_value:(Some (VSet []));
     ]
     ()
diff -r 5ed6061cd437 -r f8298e1caacd ocaml/xapi/xapi_vmpp.ml
--- a/ocaml/xapi/xapi_vmpp.ml
+++ b/ocaml/xapi/xapi_vmpp.ml
@@ -16,50 +16,6 @@
 
 let vmpr_plugin = "vmpr"
 
-(*
-    val protect_now : __context:Context.t -> self:ref_VMPP -> unit
-    val archive_now : __context:Context.t -> self:ref_VM -> unit
-    val test_archive_settings :
-      __context:Context.t -> settings:API.string_to_string_map -> unit
-    val create :
-      __context:Context.t ->
-      name_label:string ->
-      name_description:string ->
-      is_policy_enabled:bool ->
-      backup_frequency:API.vmpp_backup_frequency ->
-      backup_retention_value:int64 ->
-      backup_schedule:API.string_to_string_map ->
-      backup_last_run_time:API.datetime ->
-      archive_target_config_type:API.vmpp_archive_target_config_type ->
-      archive_target_config:API.string_to_string_map ->
-      archive_frequency:API.vmpp_archive_frequency ->
-      archive_schedule:API.string_to_string_map ->
-      archive_last_run_time:API.datetime ->
-      is_alarm_enabled:bool ->
-      alarm_config:API.string_to_string_map -> API.ref_VMPP
-    val destroy : __context:Context.t -> self:API.ref_VMPP -> unit
-*)
-
-let create ~__context ~name_label ~name_description ~is_policy_enabled
-  ~backup_type ~backup_retention_value ~backup_frequency ~backup_schedule ~backup_last_run_time
-  ~archive_target_type ~archive_target_config ~archive_frequency ~archive_schedule  ~archive_last_run_time
-  ~is_alarm_enabled ~alarm_config
-: API.ref_VMPP =
-  let ref=Ref.make() in
-  let uuid=Uuid.to_string (Uuid.make_uuid()) in
-  Db.VMPP.create ~__context ~ref ~uuid
-    ~name_label ~name_description ~is_policy_enabled
-    ~backup_type ~backup_retention_value
-    ~backup_frequency ~backup_schedule ~backup_last_run_time
-    ~is_backup_running:false ~is_archive_running:false
-    ~archive_target_config ~archive_target_type
-    ~archive_frequency ~archive_schedule ~archive_last_run_time
-    ~is_alarm_enabled ~alarm_config ~recent_alerts:[];
-  ref
-
-let destroy ~__context ~self = 
-  Db.VMPP.destroy ~__context ~self
-
 let protect_now ~__context ~vmpp = 
   let vmpp_uuid = Db.VMPP.get_uuid ~__context ~self:vmpp in
   let args = [ "vmpp_uuid", vmpp_uuid ] in
@@ -80,7 +36,440 @@
 
 let set_is_backup_running ~__context ~self ~value =
   Db.VMPP.set_is_backup_running ~__context ~self ~value
+
 let set_is_archive_running ~__context ~self ~value =
   Db.VMPP.set_is_archive_running ~__context ~self ~value
 
+(* mini datamodel for type and key value restrictions in the vmpp map fields *)
+type key_type = Enum of string list | EnumSet of string list | IntRange of int*int | String | ReqValue of string | Secret
+let schedule_days_enum = ["Monday";"Tuesday";"Wednesday";"Thursday";"Friday";"Saturday";"Sunday"]
+let schedule_frequency_hourly = "hourly"
+let schedule_frequency_daily = "daily"
+let schedule_frequency_weekly = "weekly"
+let frequency_order = [schedule_frequency_hourly;schedule_frequency_daily;schedule_frequency_weekly]
+let schedule_min_enum = ["0";"15";"30";"45"]
+let backup_schedule_field = "backup-schedule"
+let archive_target_config_field = "archive-target-config"
+let archive_schedule_field = "archive-schedule"
+let alarm_config_field = "alarm-config"
+let archive_target_type_cifs = "cifs"
+let archive_target_type_nfs = "nfs"
+let is_alarm_enabled_true = "true"
+let is_alarm_enabled_false = "false"
+let btype b = if b then is_alarm_enabled_true else is_alarm_enabled_false
+let schedule_min_default = List.hd schedule_min_enum
+let schedule_hour_default = "0"
+let schedule_days_default = List.hd schedule_days_enum 
 
+let more_frequent_than ~a ~b = (* is a more frequent than b? *)
+  if a=b then false
+  else
+  if (List.mem a frequency_order) && (List.mem b frequency_order)
+  then (let rec tst xs = match xs with
+    |[]->false
+    |x::xs->if a=x then true else if b=x then false else tst xs
+    in tst frequency_order
+  )
+  else false (*incomparable*)
+
+(* relations between map types and map keys *)
+let archive_schedule_frequency_enum = [schedule_frequency_daily;schedule_frequency_weekly]
+let backup_schedule_frequency_enum = schedule_frequency_hourly :: archive_schedule_frequency_enum
+let backup_schedule_frequency_hourly_keys = backup_schedule_field,[schedule_frequency_hourly,[Datamodel.vmpp_schedule_min, ((Enum schedule_min_enum), schedule_min_default)]]
+let backup_schedule_frequency_daily_keys = backup_schedule_field,[schedule_frequency_daily,[Datamodel.vmpp_schedule_hour, ((IntRange(0,23)), schedule_hour_default);Datamodel.vmpp_schedule_min, ((Enum schedule_min_enum), schedule_min_default)]]
+let backup_schedule_frequency_weekly_keys = backup_schedule_field,[schedule_frequency_weekly,[Datamodel.vmpp_schedule_hour, ((IntRange(0,23)), schedule_hour_default);Datamodel.vmpp_schedule_min, ((Enum schedule_min_enum), schedule_min_default);Datamodel.vmpp_schedule_days, ((EnumSet schedule_days_enum), schedule_days_default)]]
+let archive_schedule_frequency_daily_keys = match backup_schedule_frequency_daily_keys with f,k -> archive_schedule_field,k
+let archive_schedule_frequency_weekly_keys = match backup_schedule_frequency_weekly_keys with f,k -> archive_schedule_field,k
+let archive_target_config_type_cifs_keys = archive_target_config_field,[archive_target_type_cifs,[Datamodel.vmpp_archive_target_config_location, ((String), "");Datamodel.vmpp_archive_target_config_username, ((String), "");Datamodel.vmpp_archive_target_config_password, ((Secret), "")]]
+let archive_target_config_type_nfs_keys = archive_target_config_field,[archive_target_type_nfs,[Datamodel.vmpp_archive_target_config_location, ((String), "")]]
+
+(* look-up structures, contain allowed map keys in a specific map type *)
+let backup_schedule_keys = backup_schedule_field,(List.map (fun (f,[k])->k) [backup_schedule_frequency_hourly_keys;backup_schedule_frequency_daily_keys;backup_schedule_frequency_weekly_keys])
+let archive_target_config_keys = archive_target_config_field,(List.map (fun (f,[k])->k) [archive_target_config_type_cifs_keys;archive_target_config_type_nfs_keys])
+let archive_schedule_keys = archive_schedule_field,(List.map (fun (f,[k])->k) [archive_schedule_frequency_daily_keys;archive_schedule_frequency_weekly_keys])
+let alarm_config_keys = alarm_config_field,[is_alarm_enabled_true,["email_address", ((String), "");"smtp_server", ((String), "");"smtp_port", ((IntRange(1,65535)), "25")]]
+
+(* look-up structures, contain allowed map keys in all map types *)
+let backup_schedule_all_keys = backup_schedule_field,["",(List.fold_left (fun acc (sf,ks)->acc@ks) [] (let (f,kss)=backup_schedule_keys in kss))]
+let archive_target_config_all_keys = archive_target_config_field,["",(List.fold_left (fun acc (sf,ks)->acc@ks) [] (let (f,kss)=archive_target_config_keys in kss))]
+let archive_schedule_all_keys = archive_schedule_field,["",(List.fold_left (fun acc (sf,ks)->acc@ks) [] (let (f,kss)=archive_schedule_keys in kss))]
+let alarm_config_all_keys = alarm_config_field,["",(List.fold_left (fun acc (sf,ks)->acc@ks) [] (let (f,kss)=alarm_config_keys in kss))]
+
+(* functions to assert the mini datamodel above *)
+
+let err field key value =
+  let msg = if key="" then field else field^":"^key in
+  raise (Api_errors.Server_error (Api_errors.invalid_value, [msg;value]))
+
+let mem value range =
+  try Some
+    (List.find
+      (fun r->(String.lowercase value)=(String.lowercase r))
+      range
+    )
+  with Not_found -> None
+
+let assert_value ~field ~key ~attr ~value =
+  let err v = err field key v in
+  let (ty,default) = attr in
+  match ty with
+	| Enum range -> (match (mem value range) with None->err value|Some v->v)
+	| EnumSet range -> (* enumset is a comma-separated string *)
+      let vs = Stringext.String.split ',' value in
+      List.fold_right 
+       (fun v acc->match (mem v range) with
+        |None->err v
+        |Some v->if acc="" then v else (v^","^acc)
+       )
+       vs
+       ""
+  | IntRange (min,max) ->
+      let v=try int_of_string value with _->err value in
+      if (v<min or v>max) then err value else value
+  | ReqValue required_value -> if value <> required_value then err value else value
+  | Secret|String -> value
+  
+let with_ks ~kss ~fn =
+  let field,kss=kss in
+  let corrected_values = List.filter (fun cv->cv<>None) (List.map (fun ks-> fn field ks) kss) in
+  if List.length corrected_values < 1
+  then []
+  else (match List.hd corrected_values with None->[]|Some cv->cv)
+
+let assert_req_values ~field ~ks ~vs =
+  (* each required values in this ks must match the one in the vs map this key/value belongs to*) 
+  let req_values = List.fold_right
+    (fun (k,attr) acc->match attr with(ReqValue rv),_->(k,rv)::acc|_->acc) ks []
+  in
+  (if vs<>[] then
+    List.iter (fun (k,rv)->
+      if (List.mem_assoc k vs) then (if rv<>(List.assoc k vs) then err field k rv)
+    ) req_values
+  )
+
+let merge xs ys = (* uses xs elements to overwrite ys elements *)
+  let nys = List.map (fun (ky,vy)->if List.mem_assoc ky xs then (ky,(List.assoc ky xs)) else (ky,vy)) ys in
+  let nxs = List.filter (fun (kx,_)->not(List.mem_assoc kx nys)) xs in
+  nxs@nys
+
+let assert_key ~field ~ks ~key ~value =
+  debug "assert_key: field=%s key=[%s] value=[%s]" field key value;
+  (* check if the key and value conform to this ks *)
+  (if not (List.mem_assoc key ks)
+   then
+     err field key value
+   else
+     assert_value ~field ~key ~attr:(List.assoc key ks) ~value
+  )
+
+let assert_keys ~ty ~ks ~value ~db =
+  let value = merge value db in
+  with_ks ~kss:ks ~fn:
+  (fun field (xt,ks) ->
+    debug "assert_keys: field=%s xt=[%s] ty=[%s]" field xt ty;
+    if (xt=ty) then Some
+    (
+      assert_req_values ~field ~ks ~vs:value;
+      (* for this ks, each key value must be valid *)
+      List.map (fun (k,v)-> k,(assert_key ~field ~ks ~key:k ~value:v)) value
+    )
+    else None
+  )
+
+let assert_all_keys ~ty ~ks ~value ~db =
+  let value = merge value db in
+  with_ks ~kss:ks ~fn:
+  (fun field (xt,ks)->
+    debug "assert_all_keys: field=%s xt=[%s] ty=[%s]" field xt ty;
+    if (xt=ty) then Some
+    (
+      assert_req_values ~field ~ks ~vs:value;
+
+(* 
+   currently disabled: too strong for api-bindings:
+   - api-bindings change first the type, and later the maps,
+   - so we cannot currently assert that all map keys are present:
+
+      (* for this ks, all keys must be present *)
+      let ks_keys = Listext.List.setify (let (x,y)=List.split ks in x) in
+		  let value_keys = Listext.List.setify (let (x,y)=List.split value in x) in
+		  let diff = Listext.List.set_difference ks_keys value_keys in
+      (if diff<>[] then err field (List.hd diff) "");
+*)
+
+      (* add missing keys with default values *)
+      let value = List.map (fun (k,(kt,default))->if List.mem_assoc k value then (k,(List.assoc k value)) else (k,default)) ks in
+
+      (* remove extra unexpected keys *)
+      let value = List.fold_right (fun (k,v) acc->if List.mem_assoc k ks then (k,v)::acc else acc) value [] in
+
+      (* for this ks, each key value must be valid *)
+      List.map (fun (k,v)-> k,(assert_key ~field ~ks ~key:k ~value:v)) value
+    )
+    else None
+  )
+
+let assert_non_required_key ~ks ~key ~db =
+  ()
+(* (* currently disabled: unfortunately, key presence integrity is too strict for the CLI, which needs to remove and add keys at will *)
+  with_ks ~kss:ks ~fn:
+  (fun ks->
+    assert_req_values ~ks ~key ~value:"" ~db;
+    (* check if the key is not expected in this ks *)
+    if (List.mem_assoc key ks) then err key ""
+	)
+*)
+
+let map_password_to_secret ~__context ~new_password ~db =
+  let secret_uuid = Uuid.to_string
+    (if List.mem_assoc Datamodel.vmpp_archive_target_config_password db
+    then 
+      Uuid.of_string
+        (List.assoc Datamodel.vmpp_archive_target_config_password db)
+    else
+      Uuid.null
+    )
+  in
+  try
+    let secret_ref = Db.Secret.get_by_uuid ~__context ~uuid:secret_uuid in
+    (* the uuid is a valid uuid in the secrets table *)
+    (if (new_password <> secret_uuid)
+    then (* new_password is not the secret uuid, then update secret *)
+    Db.Secret.set_value ~__context ~self:secret_ref ~value:new_password
+    );
+    secret_uuid
+  with e -> (
+    (* uuid doesn't exist in secrets table, create a new one *)
+    ignore (ExnHelper.string_of_exn e);
+    let new_secret_ref = Ref.make() in
+    let new_secret_uuid = Uuid.to_string(Uuid.make_uuid()) in
+    Db.Secret.create ~__context ~ref:new_secret_ref ~uuid:new_secret_uuid ~value:new_password;
+    new_secret_uuid
+  )
+
+let map_any_passwords_to_secrets ~__context ~value ~db =
+  if List.mem_assoc Datamodel.vmpp_archive_target_config_password value
+  then 
+    let secret = map_password_to_secret ~__context ~db
+      ~new_password:(List.assoc Datamodel.vmpp_archive_target_config_password value)
+    in
+    merge [(Datamodel.vmpp_archive_target_config_password,secret)] value
+  else
+    value
+
+let remove_any_secrets ~__context ~config ~key =
+  if List.mem_assoc key config
+  then
+		let secret_uuid = List.assoc key config in
+    try
+      let secret_ref = Db.Secret.get_by_uuid ~__context ~uuid:secret_uuid in 
+      Db.Secret.destroy ~__context ~self:secret_ref
+    with _ -> (* uuid doesn't exist in secrets table, leave it alone *)
+      ()
+
+let assert_set_backup_frequency ~backup_frequency ~backup_schedule=
+  let ty = XMLRPC.From.string (API.To.vmpp_backup_frequency backup_frequency) in
+  assert_all_keys ~ty ~ks:backup_schedule_keys ~value:backup_schedule ~db:backup_schedule
+
+let assert_archive_target_type_not_none ~archive_target_type ~archive_target_config =
+  let ty = XMLRPC.From.string (API.To.vmpp_archive_target_type archive_target_type) in
+  let archive_target_config = assert_all_keys ~ty ~ks:archive_target_config_keys ~value:archive_target_config ~db:archive_target_config in
+  archive_target_config
+
+let assert_archive_target_type ~archive_target_type ~archive_target_config ~archive_frequency ~archive_schedule =
+  match archive_target_type with
+	| `none -> (* reset archive_frequency to never *)
+      ([], `never, [])
+  | _-> 
+      let archive_target_config = assert_archive_target_type_not_none ~archive_target_type ~archive_target_config in
+     (archive_target_config,archive_frequency,archive_schedule)
+
+let assert_set_archive_frequency ~archive_frequency ~archive_target_type ~archive_target_config ~archive_schedule =
+  match archive_target_type with
+  |`none -> (
+    match archive_frequency with
+    |`never-> ([],[])
+    |_->err "archive_target_type" "" (XMLRPC.From.string (API.To.vmpp_archive_target_type archive_target_type))
+    )
+  |_ -> (
+    match archive_frequency with
+	  |`never -> (archive_target_config,[])
+	  |`always_after_backup ->
+      let archive_target_config = assert_archive_target_type_not_none ~archive_target_type ~archive_target_config in
+      (archive_target_config,[])
+    | _ ->
+      let archive_target_config = assert_archive_target_type_not_none ~archive_target_type ~archive_target_config in
+		  let ty = XMLRPC.From.string (API.To.vmpp_archive_frequency archive_frequency) in
+      let archive_schedule = assert_all_keys ~ty ~ks:archive_schedule_keys ~value:archive_schedule ~db:archive_schedule in
+      (archive_target_config,archive_schedule)
+    )
+
+let assert_set_is_alarm_enabled ~is_alarm_enabled ~alarm_config =
+  if is_alarm_enabled
+  then (
+    assert_all_keys ~ty:(btype is_alarm_enabled) ~ks:alarm_config_keys ~value:alarm_config ~db:alarm_config
+  )
+  else (* do not erase alarm_config if alarm is disabled *)
+    alarm_config
+
+let assert_frequency ~archive_frequency ~backup_frequency =
+  let a = XMLRPC.From.string (API.To.vmpp_archive_frequency archive_frequency) in
+  let b = XMLRPC.From.string (API.To.vmpp_backup_frequency backup_frequency) in
+  if (more_frequent_than ~a ~b)
+  then
+    raise (Api_errors.Server_error (Api_errors.vmpp_archive_more_frequent_than_backup,[]))
+
+(* == the setters with customized key cross-integrity checks == *)
+
+(* 1/3: values of non-map fields can only change if their corresponding maps contain the expected keys *)
+
+let set_backup_frequency ~__context ~self ~value =
+  let archive_frequency = Db.VMPP.get_archive_frequency ~__context ~self in
+  assert_frequency ~archive_frequency ~backup_frequency:value;
+  let backup_schedule = Db.VMPP.get_backup_schedule ~__context ~self in
+  let new_backup_schedule = assert_set_backup_frequency ~backup_frequency:value ~backup_schedule in
+  Db.VMPP.set_backup_frequency ~__context ~self ~value;
+  (* update dependent maps *)
+  Db.VMPP.set_backup_schedule ~__context ~self ~value:new_backup_schedule
+
+let set_archive_frequency ~__context ~self ~value =
+  let backup_frequency = Db.VMPP.get_backup_frequency ~__context ~self in
+  assert_frequency ~archive_frequency:value ~backup_frequency;
+  let archive_schedule = (Db.VMPP.get_archive_schedule ~__context ~self) in
+  let archive_target_config = (Db.VMPP.get_archive_target_config ~__context ~self) in
+  let archive_target_type = (Db.VMPP.get_archive_target_type ~__context ~self) in
+  let (new_archive_target_config,new_archive_schedule) = assert_set_archive_frequency ~archive_frequency:value ~archive_target_type ~archive_target_config ~archive_schedule in
+  Db.VMPP.set_archive_frequency ~__context ~self ~value;
+  (* update dependent maps *)
+  Db.VMPP.set_archive_target_config ~__context ~self ~value:new_archive_target_config;
+  Db.VMPP.set_archive_schedule ~__context ~self ~value:new_archive_schedule
+
+let set_archive_target_type ~__context ~self ~value =
+  let archive_target_config = Db.VMPP.get_archive_target_config ~__context ~self in
+  let archive_frequency = Db.VMPP.get_archive_frequency ~__context ~self in
+  let archive_schedule = Db.VMPP.get_archive_schedule ~__context ~self in
+  let (new_archive_target_config,new_archive_frequency,new_archive_schedule) = assert_archive_target_type ~archive_target_type:value ~archive_target_config ~archive_frequency ~archive_schedule in
+  Db.VMPP.set_archive_target_type ~__context ~self ~value;
+  (* update dependent maps *)
+  Db.VMPP.set_archive_target_config ~__context ~self ~value:new_archive_target_config;
+  Db.VMPP.set_archive_frequency ~__context ~self ~value:new_archive_frequency;
+  Db.VMPP.set_archive_schedule ~__context ~self ~value:new_archive_schedule
+
+let set_is_alarm_enabled ~__context ~self ~value =
+  let alarm_config = Db.VMPP.get_alarm_config ~__context ~self in
+  let new_alarm_config =  assert_set_is_alarm_enabled ~is_alarm_enabled:value ~alarm_config in
+  Db.VMPP.set_is_alarm_enabled ~__context ~self ~value;
+  (* update dependent maps *)
+  Db.VMPP.set_alarm_config ~__context ~self ~value:new_alarm_config
+
+(* 2/3: values of map fields can change as long as the key names and values are valid *)
+
+let set_backup_schedule ~__context ~self ~value =
+  let value = assert_keys ~ty:"" ~ks:backup_schedule_all_keys ~value ~db:(Db.VMPP.get_backup_schedule ~__context ~self) in
+  Db.VMPP.set_backup_schedule ~__context ~self ~value
+
+let add_to_backup_schedule ~__context ~self ~key ~value =
+  let value = List.assoc key (assert_keys ~ty:"" ~ks:backup_schedule_all_keys ~value:[(key,value)] ~db:(Db.VMPP.get_backup_schedule ~__context ~self)) in
+  Db.VMPP.add_to_backup_schedule ~__context ~self ~key ~value
+
+let set_archive_target_config ~__context ~self ~value =
+  let config = (Db.VMPP.get_archive_target_config ~__context ~self) in
+  assert_keys ~ty:"" ~ks:archive_target_config_all_keys ~value ~db:config;
+	let value = map_any_passwords_to_secrets ~__context ~value ~db:config in
+  Db.VMPP.set_archive_target_config ~__context ~self ~value
+
+let add_to_archive_target_config ~__context ~self ~key ~value =
+  let config = (Db.VMPP.get_archive_target_config ~__context ~self) in
+  assert_keys ~ty:"" ~ks:archive_target_config_all_keys ~value:[(key,value)] ~db:config;
+  let value =
+    if key=Datamodel.vmpp_archive_target_config_password
+		then (map_password_to_secret ~__context ~db:config ~new_password:value)
+		else value
+  in
+  Db.VMPP.add_to_archive_target_config ~__context ~self ~key ~value
+
+let set_archive_schedule ~__context ~self ~value =
+  let value = assert_keys ~ty:"" ~ks:archive_schedule_all_keys ~value ~db:(Db.VMPP.get_archive_schedule ~__context ~self) in
+  Db.VMPP.set_archive_schedule ~__context ~self ~value
+
+let add_to_archive_schedule ~__context ~self ~key ~value =
+  let value = List.assoc key (assert_keys ~ty:"" ~ks:archive_schedule_all_keys ~value:[(key,value)] ~db:(Db.VMPP.get_archive_schedule ~__context ~self)) in
+  Db.VMPP.add_to_archive_schedule ~__context ~self ~key ~value
+
+let set_alarm_config ~__context ~self ~value =
+  assert_keys ~ty:"" ~ks:alarm_config_all_keys ~value ~db:(Db.VMPP.get_alarm_config ~__context ~self);
+  Db.VMPP.set_alarm_config ~__context ~self ~value
+
+let add_to_alarm_config ~__context ~self ~key ~value =
+  assert_keys ~ty:"" ~ks:alarm_config_all_keys ~value:[(key,value)] ~db:(Db.VMPP.get_alarm_config ~__context ~self);
+  Db.VMPP.add_to_alarm_config ~__context ~self ~key ~value
+
+(* 3/3: the CLI requires any key in any map to be removed at will *)
+
+let remove_from_backup_schedule ~__context ~self ~key =
+  assert_non_required_key ~ks:backup_schedule_keys ~key ~db:(Db.VMPP.get_backup_schedule ~__context ~self);
+  Db.VMPP.remove_from_backup_schedule ~__context ~self ~key
+
+let remove_from_archive_target_config ~__context ~self ~key =
+  let db = (Db.VMPP.get_archive_target_config ~__context ~self) in
+  assert_non_required_key ~ks:archive_target_config_keys ~key ~db;
+  remove_any_secrets ~__context ~config:db ~key:Datamodel.vmpp_archive_target_config_password;
+  Db.VMPP.remove_from_archive_target_config ~__context ~self ~key
+
+let remove_from_archive_schedule ~__context ~self ~key =
+  assert_non_required_key ~ks:archive_schedule_keys ~key ~db:(Db.VMPP.get_archive_schedule ~__context ~self);
+  Db.VMPP.remove_from_archive_schedule ~__context ~self ~key
+
+let remove_from_alarm_config ~__context ~self ~key =
+  assert_non_required_key ~ks:alarm_config_keys ~key ~db:(Db.VMPP.get_alarm_config ~__context ~self);
+  Db.VMPP.remove_from_alarm_config ~__context ~self ~key
+
+(* constructors/destructors *)
+
+let create ~__context ~name_label ~name_description ~is_policy_enabled
+  ~backup_type ~backup_retention_value ~backup_frequency ~backup_schedule ~backup_last_run_time
+  ~archive_target_type ~archive_target_config ~archive_frequency ~archive_schedule  ~archive_last_run_time
+  ~is_alarm_enabled ~alarm_config
+: API.ref_VMPP =
+
+  (* assert all provided field values, key names and key values are valid *)
+  assert_keys ~ty:(XMLRPC.From.string (API.To.vmpp_backup_frequency backup_frequency)) ~ks:backup_schedule_keys ~value:backup_schedule ~db:[];
+  assert_keys ~ty:(XMLRPC.From.string (API.To.vmpp_archive_frequency archive_frequency)) ~ks:archive_schedule_keys ~value:archive_schedule ~db:[];
+  assert_keys ~ty:(XMLRPC.From.string (API.To.vmpp_archive_target_type archive_target_type)) ~ks:archive_target_config_keys ~value:archive_target_config ~db:[];
+  assert_keys ~ty:(btype is_alarm_enabled) ~ks:alarm_config_keys ~value:alarm_config ~db:[];
+
+  (* assert inter-field constraints and fix values if possible *)
+  let backup_schedule = assert_set_backup_frequency ~backup_frequency ~backup_schedule in
+  let (archive_target_config,archive_schedule) = assert_set_archive_frequency ~archive_frequency ~archive_target_type ~archive_target_config ~archive_schedule in 
+  let alarm_config = assert_set_is_alarm_enabled ~is_alarm_enabled ~alarm_config in
+  let (archive_target_config,_,_) = assert_archive_target_type ~archive_target_type ~archive_target_config ~archive_frequency ~archive_schedule in
+
+	let archive_target_config = map_any_passwords_to_secrets ~__context ~value:archive_target_config ~db:[] in
+
+  (* assert frequency constraints *)
+  assert_frequency ~archive_frequency ~backup_frequency;
+
+  let ref=Ref.make() in
+  let uuid=Uuid.to_string (Uuid.make_uuid()) in
+  Db.VMPP.create ~__context ~ref ~uuid
+    ~name_label ~name_description ~is_policy_enabled
+    ~backup_type ~backup_retention_value
+    ~backup_frequency ~backup_schedule ~backup_last_run_time
+    ~is_backup_running:false ~is_archive_running:false
+    ~archive_target_type ~archive_target_config
+    ~archive_frequency ~archive_schedule ~archive_last_run_time
+    ~is_alarm_enabled ~alarm_config ~recent_alerts:[];
+  ref
+
+let destroy ~__context ~self = 
+  let vms = Db.VMPP.get_VMs ~__context ~self in
+  if List.length vms > 0
+  then ( (* we can't delete a VMPP that contains VMs *)
+    raise (Api_errors.Server_error (Api_errors.vmpp_has_vm,[]))
+  )
+  else ( 
+    let archive_target_config = (Db.VMPP.get_archive_target_config ~__context ~self) in
+    remove_any_secrets ~__context ~config:archive_target_config ~key:Datamodel.vmpp_archive_target_config_password;
+    Db.VMPP.destroy ~__context ~self
+  )
+