Skip to content

Commit

Permalink
Merge 8e66bf0 into 6c4d425
Browse files Browse the repository at this point in the history
  • Loading branch information
@sharady
sharady committed Aug 21, 2017
2 parents 6c4d425 + 8e66bf0 commit b2bc176
Show file tree
Hide file tree
Showing 2 changed files with 39 additions and 13 deletions.
27 changes: 20 additions & 7 deletions ocaml/xapi/cli_operations.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -646,12 +646,13 @@ let make_param_funs getall getallrecs getbyuuid record class_name def_filters de
let p_set (printer : printer) rpc session_id params =
let record = get_record rpc session_id (List.assoc "uuid" params) in
let set_params = List.filter (fun (p,_) -> not (List.mem p ("uuid"::stdparams))) params in
let set_map_params = Hashtbl.create 10 in

let set_field (k,v) =
let field_type = get_field_type k record in
match field_type with
| Map s ->
let field=field_lookup record s in
let field = field_lookup record s in
let n = String.length s in
let key = String.sub k (n + 1) (String.length k - n - 1) in
let get_map = match field.get_map with
Expand All @@ -662,11 +663,21 @@ let make_param_funs getall getallrecs getbyuuid record class_name def_filters de
match field.set_in_map with
| Some set_in_map -> set_in_map key v
| None ->
let add_to_map = match field.add_to_map with Some f -> f | None -> failwith ("Map field '"^s^"' is read-only.") in
let remove_from_map = match field.remove_from_map with Some f -> f | None -> failwith (Printf.sprintf "Records broken (field %s)" s) in
let map = get_map () in
if List.mem_assoc key map then remove_from_map key;
add_to_map key v
(* If set_map is present then accumulate all (key, value) pairs. *)
match field.set_map with
| Some set_map ->
if not (Hashtbl.mem set_map_params set_map) then
Hashtbl.add set_map_params set_map [(key, v)]
else begin
let existing_params = Hashtbl.find set_map_params set_map in
Hashtbl.replace set_map_params set_map (existing_params @ [(key, v)])
end
| None ->
let add_to_map = match field.add_to_map with Some f -> f | None -> failwith ("Map field '"^s^"' is read-only.") in
let remove_from_map = match field.remove_from_map with Some f -> f | None -> failwith (Printf.sprintf "Records broken (field %s)" s) in
let map = get_map () in
if List.mem_assoc key map then remove_from_map key;
add_to_map key v
end
| Set s -> failwith "Cannot param-set on set fields"
| Normal ->
Expand All @@ -684,7 +695,8 @@ let make_param_funs getall getallrecs getbyuuid record class_name def_filters de
| (Invalid_argument "bool_of_string") -> failwith ("Parameter "^k^" must be a boolean (true or false)")
| e -> raise e
in
List.iter set_field set_params
List.iter set_field set_params;
Hashtbl.iter (fun func params -> func params) set_map_params
in

let p_add (printer : printer) rpc session_id params =
Expand Down Expand Up @@ -737,6 +749,7 @@ let make_param_funs getall getallrecs getbyuuid record class_name def_filters de
let settable = List.map (fun r -> r.name) (List.filter (fun r -> r.set <> None) all) in
let settable = settable @ (List.map (fun r -> r.name ^ ":") (List.filter (fun r -> r.add_to_map <> None) all)) in
let settable = settable @ (List.map (fun r -> r.name ^ ":") (List.filter (fun r -> r.set_in_map <> None) all)) in
let settable = settable @ (List.map (fun r -> r.name ^ ":") (List.filter (fun r -> r.set_map <> None) all)) in
let addable = List.map (fun r -> r.name) (List.filter (fun r -> r.add_to_set <> None || r.add_to_map <> None) all) in
let clearable = List.map (fun r -> r.name) (List.filter (fun r -> r.set <> None || r.get_set <> None || r.get_map <> None) all) in
(* We need the names of the set and map filters *)
Expand Down
25 changes: 19 additions & 6 deletions ocaml/xapi/records.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,6 +50,7 @@ type field = { name: string;
add_to_map: (string -> string -> unit) option;
remove_from_map: (string -> unit) option;
set_in_map: (string -> string -> unit) option; (* Change the value of an existing map field, without using add/remove *)
set_map: ((string * string) list -> unit) option; (* Set the (key, value) pairs to an existing map field *)
expensive: bool; (* Simply means an extra API call is required to get it *)
hidden: bool; (* Meaning we don't show it unless it's *explicitly* asked for (i.e. hidden from *-list and *-param-list *)
deprecated: bool;
Expand All @@ -62,13 +63,21 @@ type ('a,'b) record = { getref : unit -> 'a Ref.t;
setrefrec : 'a Ref.t * 'b -> unit;
fields : field list; }

let make_field ?add_to_set ?remove_from_set ?add_to_map ?remove_from_map ?set_in_map ?set ?get_set ?get_map ?(expensive=false) ?(hidden=false) ?(deprecated=false) ?(case_insensitive=false) ~name ~get () =
{ name = name; get = get; set = set;
add_to_set = add_to_set; remove_from_set = remove_from_set;
add_to_map = add_to_map; remove_from_map = remove_from_map;
let make_field ?add_to_set ?remove_from_set ?add_to_map ?remove_from_map ?set_in_map ?set_map ?set ?get_set ?get_map ?(expensive=false) ?(hidden=false) ?(deprecated=false) ?(case_insensitive=false) ~name ~get () =
{ name = name;
get = get;
set = set;
add_to_set = add_to_set;
remove_from_set = remove_from_set;
add_to_map = add_to_map;
remove_from_map = remove_from_map;
set_in_map = set_in_map;
get_set = get_set; get_map = get_map; expensive = expensive;
hidden = hidden; case_insensitive = case_insensitive;
set_map = set_map;
get_set = get_set;
get_map = get_map;
expensive = expensive;
hidden = hidden;
case_insensitive = case_insensitive;
deprecated = deprecated
}

Expand Down Expand Up @@ -1003,6 +1012,10 @@ let vm_record rpc session_id vm =
~get:(fun () -> string_of_bool (x ()).API.vM_requires_reboot) ();
make_field ~name:"reference-label"
~get:(fun () -> (x ()).API.vM_reference_label) ();
make_field ~name:"bios-strings"
~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.vM_bios_strings)
~get_map:(fun () -> (x ()).API.vM_bios_strings)
~set_map:(fun x -> Client.VM.set_bios_strings rpc session_id vm x)();
]}

let host_crashdump_record rpc session_id host =
Expand Down

0 comments on commit b2bc176

Please sign in to comment.