ocaml/idl/api_errors.ml | 3 +
ocaml/idl/datamodel.ml | 209 ++++++++++++++++++++-
ocaml/xapi/xapi_vmpp.ml | 477 +++++++++++++++++++++++++++++++++++++++++++----
3 files changed, 635 insertions(+), 54 deletions(-)
# 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
+ )
+
xen-api.hg-12.patch
Description: Text Data
_______________________________________________
xen-api mailing list
xen-api@xxxxxxxxxxxxxxxxxxx
http://lists.xensource.com/mailman/listinfo/xen-api
|
Home