@@ -16,17 +16,19 @@
*)
open Stdext
+module SymbolMap = Map.Make(Symbol)
+
module Node = struct
type t = {
name: Symbol.t;
perms: Perms.Node.t;
value: string;
- children: t list;
+ children: t SymbolMap.t;
}
let create _name _perms _value =
- { name = Symbol.of_string _name; perms = _perms; value = _value; children = []; }
+ { name = Symbol.of_string _name; perms = _perms; value = _value; children = SymbolMap.empty; }
let get_owner node = Perms.Node.get_owner node.perms
let get_children node = node.children
@@ -42,38 +44,34 @@ let set_value node nvalue =
let set_perms node nperms = { node with perms = nperms }
let add_child node child =
- { node with children = child :: node.children }
+ let children = SymbolMap.add child.name child node.children in
+ { node with children }
let exists node childname =
let childname = Symbol.of_string childname in
- List.exists (fun n -> Symbol.equal n.name childname) node.children
+ SymbolMap.mem childname node.children
let find node childname =
let childname = Symbol.of_string childname in
- List.find (fun n -> Symbol.equal n.name childname) node.children
+ SymbolMap.find childname node.children
let replace_child node child nchild =
- (* this is the on-steroid version of the filter one-replace one *)
- let rec replace_one_in_list l =
- match l with
- | [] -> []
- | h :: tl when Symbol.equal h.name child.name -> nchild :: tl
- | h :: tl -> h :: replace_one_in_list tl
- in
- { node with children = (replace_one_in_list node.children) }
+ { node with
+ children = SymbolMap.update child.name
+ (function None -> None | Some _ -> Some nchild)
+ node.children
+ }
let del_childname node childname =
let sym = Symbol.of_string childname in
- let rec delete_one_in_list l =
- match l with
- | [] -> raise Not_found
- | h :: tl when Symbol.equal h.name sym -> tl
- | h :: tl -> h :: delete_one_in_list tl
- in
- { node with children = (delete_one_in_list node.children) }
+ { node with children =
+ SymbolMap.update sym
+ (function None -> raise Not_found | Some _ -> None)
+ node.children
+ }
let del_all_children node =
- { node with children = [] }
+ { node with children = SymbolMap.empty }
(* check if the current node can be accessed by the current connection with rperm permissions *)
let check_perm node connection request =
@@ -87,7 +85,7 @@ let check_owner node connection =
raise Define.Permission_denied;
end
-let rec recurse fct node = fct node; List.iter (recurse fct) node.children
+let rec recurse fct node = fct node; SymbolMap.iter (fun _ -> recurse fct) node.children
let unpack node = (Symbol.to_string node.name, node.perms, node.value)
@@ -321,7 +319,7 @@ let ls store perm path =
Node.check_perm cnode perm Perms.READ;
cnode.Node.children in
Path.apply store.root path do_ls in
- List.rev (List.map (fun n -> Symbol.to_string n.Node.name) children)
+ SymbolMap.fold (fun k _ accu -> Symbol.to_string k :: accu) children []
let getperms store perm path =
if path = [] then
@@ -350,7 +348,7 @@ let traversal root_node f =
let rec _traversal path node =
f path node;
let node_path = Path.of_path_and_name path (Symbol.to_string node.Node.name) in
- List.iter (_traversal node_path) node.Node.children
+ SymbolMap.iter (fun _ -> _traversal node_path) node.Node.children
in
_traversal [] root_node
@@ -31,6 +31,10 @@ let equal a b =
(* compare using physical equality, both members have to be part of the above weak table *)
a == b
+let compare a b =
+ if equal a b then 0
+ else -(String.compare a b)
+
let stats () =
let len, entries, _, _, _, _ = WeakTable.stats tbl in
len, entries
@@ -32,6 +32,9 @@ val to_string : t -> string
val equal: t -> t -> bool
(** Compare two symbols for equality *)
+val compare: t -> t -> int
+(** Compare two symbols *)
+
(** {6 Statistics } *)
val stats : unit -> int * int
This changes the output of xenstore-ls to be sorted. Previously the keys were listed in the order in which they were inserted in. docs/misc/xenstore.txt doesn't specify in what order keys are listed. Map.update is used to retain semantics with replace_child: only an existing child is replaced, if it wasn't part of the original map we don't add it. Similarly exception behaviour is retained for del_childname and related functions. Entries are stored in reverse sort order, so that upon Map.fold the constructed list is sorted in ascending order and there is no need for a List.rev. Signed-off-by: Edwin Török <edvin.torok@citrix.com> --- tools/ocaml/xenstored/store.ml | 46 +++++++++++++++----------------- tools/ocaml/xenstored/symbol.ml | 4 +++ tools/ocaml/xenstored/symbol.mli | 3 +++ 3 files changed, 29 insertions(+), 24 deletions(-)