summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/config_diff.ml74
-rw-r--r--src/config_diff.mli2
-rw-r--r--src/config_tree.ml27
-rw-r--r--src/config_tree.mli2
-rw-r--r--src/vylist.ml6
-rw-r--r--src/vylist.mli1
-rw-r--r--src/vyos1x_parser.mly11
-rw-r--r--src/vytree.ml24
-rw-r--r--src/vytree.mli8
9 files changed, 109 insertions, 46 deletions
diff --git a/src/config_diff.ml b/src/config_diff.ml
index 2c0a91f..9bbd2fd 100644
--- a/src/config_diff.ml
+++ b/src/config_diff.ml
@@ -12,8 +12,7 @@ type diff_trees = {
exception Incommensurable
exception Empty_comparison
-
-module ValueS = Set.Make(struct type t = string let compare = compare end)
+exception Nonexistent_child
let make_diff_trees l r = { left = l; right = r;
add = ref (Config_tree.make "");
@@ -26,6 +25,20 @@ let data_of n = Vytree.data_of_node n
let children_of n = Vytree.children_of_node n
let make data name children = Vytree.make_full data name children
+module ValueOrd = struct
+ type t = string
+ let compare a b =
+ Util.lexical_numeric_compare a b
+end
+module ValueS = Set.Make(ValueOrd)
+
+module TreeOrd = struct
+ type t = Config_tree.t
+ let compare a b =
+ Util.lexical_numeric_compare (name_of a) (name_of b)
+end
+module ChildrenS = Set.Make(TreeOrd)
+
let (^~) (node : Config_tree.t) (node' : Config_tree.t) =
name_of node = name_of node' &&
(data_of node).values <> (data_of node').values
@@ -111,13 +124,13 @@ let rec clone_path ?(recurse=true) ?(set_values=None) old_root new_root path_don
| None -> data_of old_node
in
if recurse then
- Vytree.insert ~children:(children_of old_node) new_root path_total data
+ Vytree.insert ~position:Lexical ~children:(children_of old_node) new_root path_total data
else
- Vytree.insert new_root path_total data
+ Vytree.insert ~position:Lexical new_root path_total data
| name :: names ->
let path_done = path_done @ [name] in
let old_node = Vytree.get old_root path_done in
- let new_root = Vytree.insert new_root path_done (data_of old_node) in
+ let new_root = Vytree.insert ~position:Lexical new_root path_done (data_of old_node) in
clone_path ~recurse:recurse ~set_values:set_values old_root new_root path_done names
let clone ?(recurse=true) ?(set_values=None) old_root new_root path =
@@ -128,16 +141,6 @@ let clone ?(recurse=true) ?(set_values=None) old_root new_root path =
let path_remaining = Vylist.complement path path_existing in
clone_path ~recurse:recurse ~set_values:set_values old_root new_root path_existing path_remaining
-let rec graft_children children stock path =
- match children with
- | [] -> stock
- | x::xs ->
- let stock = Vytree.insert ~children:(children_of x) stock (path @ [name_of x]) (data_of x)
- in graft_children xs stock path
-
-let graft_tree stem stock path =
- graft_children (children_of stem) stock path
-
let is_empty l = (l = [])
(* define the diff_func; in this instance, we imperatively build the difference trees *)
@@ -231,13 +234,10 @@ let compare path left right =
(* wrapper to return diff trees *)
let diff_tree path left right =
let trees = compare path left right in
- let add_node = Config_tree.make "add" in
- let sub_node = Config_tree.make "sub" in
- let int_node = Config_tree.make "inter" in
+ let add_node = make Config_tree.default_data "add" (children_of !(trees.add)) in
+ let sub_node = make Config_tree.default_data "sub" (children_of !(trees.sub)) in
+ let int_node = make Config_tree.default_data "inter" (children_of !(trees.inter)) in
let ret = make Config_tree.default_data "" [add_node; sub_node; int_node] in
- let ret = graft_tree !(trees.add) ret ["add"] in
- let ret = graft_tree !(trees.sub) ret ["sub"] in
- let ret = graft_tree !(trees.inter) ret ["inter"] in
ret
(* wrapper to return trimmed tree for 'delete' commands *)
@@ -352,3 +352,35 @@ let show_diff ?(cmds=false) path left right =
diff [] (unified_diff ~cmds:cmds udiff trees) [(Option.some left, Option.some right)];
if cmds then order_commands udiff;
!udiff
+
+let union_of_values (n : Config_tree.t) (m : Config_tree.t) =
+ let set_n = ValueS.of_list (data_of n).values in
+ let set_m = ValueS.of_list (data_of m).values in
+ ValueS.elements (ValueS.union set_n set_m)
+
+let union_of_children n m =
+ let set_n = ChildrenS.of_list (children_of n) in
+ let set_m = ChildrenS.of_list (children_of m) in
+ ChildrenS.elements (ChildrenS.union set_n set_m)
+
+(* tree_union is currently used only for unit tests, so only values of data
+ are considered. Should there be a reason to expose it in the future,
+ consistency check and union of remaining data will need to be added.
+ *)
+let rec tree_union s t =
+ let child_of_union s t c =
+ let s_c = Vytree.find s (name_of c) in
+ let t_c = Vytree.find t (name_of c) in
+ match s_c, t_c with
+ | Some child, None -> clone s t [(name_of child)]
+ | None, Some _ -> t
+ | Some u, Some v ->
+ if u ^~ v then
+ let values = union_of_values u v in
+ let data = {(data_of v) with Config_tree.values = values} in
+ Vytree.replace t (Vytree.make data (name_of v))
+ else
+ Vytree.replace t (tree_union u v)
+ | None, None -> raise Nonexistent_child
+ in
+ List.fold_left (fun x c -> child_of_union s x c) t (union_of_children s t)
diff --git a/src/config_diff.mli b/src/config_diff.mli
index 4a9a1d3..0f4ebf0 100644
--- a/src/config_diff.mli
+++ b/src/config_diff.mli
@@ -12,6 +12,7 @@ type diff_trees = {
exception Incommensurable
exception Empty_comparison
+exception Nonexistent_child
val make_diff_trees : Config_tree.t -> Config_tree.t -> diff_trees
val clone : ?recurse:bool -> ?set_values:(string list) option -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t
@@ -21,3 +22,4 @@ val compare : string list -> Config_tree.t -> Config_tree.t -> diff_trees
val diff_tree : string list -> Config_tree.t -> Config_tree.t -> Config_tree.t
val trim_tree : Config_tree.t -> Config_tree.t -> Config_tree.t
val show_diff : ?cmds:bool -> string list -> Config_tree.t -> Config_tree.t -> string
+val tree_union : Config_tree.t -> Config_tree.t -> Config_tree.t
diff --git a/src/config_tree.ml b/src/config_tree.ml
index 8c95b1f..a5698dc 100644
--- a/src/config_tree.ml
+++ b/src/config_tree.ml
@@ -159,11 +159,16 @@ struct
(* Rendering config as a VyOS/EdgeOS config file *)
let make_indent indent level = String.make (level * indent) ' '
- let render_values indent_str name values =
+ let render_values ?(ord_val=false) indent_str name values =
match values with
| [] -> Printf.sprintf "%s%s { }\n" indent_str name
| [v] -> Printf.sprintf "%s%s \"%s\"\n" indent_str name (Util.escape_string v)
| _ ->
+ let values =
+ if ord_val then
+ List.sort Util.lexical_numeric_compare values
+ else values
+ in
let rendered = List.map (fun s -> Printf.sprintf "%s%s \"%s\"" indent_str name (Util.escape_string s)) values in
let rendered = String.concat "\n" rendered in
Printf.sprintf "%s\n" rendered
@@ -173,34 +178,34 @@ struct
| None -> ""
| Some c -> Printf.sprintf "%s/* %s */\n" indent c
- let rec render_node indent level node =
+ let rec render_node ?(ord_val=false) indent level node =
let indent_str = make_indent indent level in
let name = Vytree.name_of_node node in
let data = Vytree.data_of_node node in
let is_tag = data.tag in
let comment = render_comment indent_str data.comment in
- let values = render_values indent_str name data.values in
+ let values = render_values ~ord_val:ord_val indent_str name data.values in
let children = Vytree.children_of_node node in
match children with
| [] -> Printf.sprintf "%s%s" comment values
| _ :: _ ->
if is_tag then
begin
- let inner = List.map (render_tag_node_child indent level name) children in
+ let inner = List.map (render_tag_node_child ~ord_val:ord_val indent level name) children in
String.concat "" inner
end
else
begin
- let inner = List.map (render_node indent (level + 1)) children in
+ let inner = List.map (render_node ~ord_val:ord_val indent (level + 1)) children in
let inner = String.concat "" inner in
Printf.sprintf "%s%s%s {\n%s%s}\n" comment indent_str name inner indent_str
end
- and render_tag_node_child indent level parent node =
+ and render_tag_node_child ?(ord_val=false) indent level parent node =
let indent_str = make_indent indent level in
let name = Vytree.name_of_node node in
let data = Vytree.data_of_node node in
let comment = render_comment indent_str data.comment in
- let values = render_values indent_str name data.values in
+ let values = render_values ~ord_val:ord_val indent_str name data.values in
let children = Vytree.children_of_node node in
match children with
(* This produces too much whitespace due to indent_str from values,
@@ -209,13 +214,13 @@ struct
| _ ->
(* Exploiting the fact that immediate children of tag nodes are
never themselves tag nodes *)
- let inner = List.map (render_node indent (level + 1)) children in
+ let inner = List.map (render_node ~ord_val:ord_val indent (level + 1)) children in
let inner = String.concat "" inner in
Printf.sprintf "%s%s%s %s {\n%s%s}\n" comment indent_str parent name inner indent_str
- let render_config node =
+ let render_config ?(ord_val=false) node =
let children = Vytree.children_of_node node in
- let child_configs = List.map (render_node 4 0) children in
+ let child_configs = List.map (render_node ~ord_val:ord_val 4 0) children in
String.concat "" child_configs
end (* Renderer *)
@@ -268,7 +273,7 @@ let render_commands ?(op=Set) node path =
let commands = List.map (Renderer.render_commands ~op:op path) children in
String.concat "\n" commands
-let render_config = Renderer.render_config
+let render_config ?(ord_val=false) = Renderer.render_config ~ord_val:ord_val
let render_json = JSONRenderer.render_json
diff --git a/src/config_tree.mli b/src/config_tree.mli
index 5375c23..990bb49 100644
--- a/src/config_tree.mli
+++ b/src/config_tree.mli
@@ -38,7 +38,7 @@ val get_subtree : ?with_node:bool -> t -> string list -> t
val render_commands : ?op:command -> t -> string list -> string
-val render_config : t -> string
+val render_config : ?ord_val:bool -> t -> string
val render_json : t -> string
diff --git a/src/vylist.ml b/src/vylist.ml
index cd4a32e..c64dd89 100644
--- a/src/vylist.ml
+++ b/src/vylist.ml
@@ -28,6 +28,12 @@ let rec insert_after p x xs =
| y :: ys -> if (p y) then y :: x :: ys
else y :: (insert_after p x ys)
+let rec insert_compare p x xs =
+ match xs with
+ | [] -> [x]
+ | y :: ys -> if (p x y <= 0) then x :: y :: ys
+ else y :: (insert_compare p x ys)
+
let complement xs ys =
let rec aux xs ys =
match xs, ys with
diff --git a/src/vylist.mli b/src/vylist.mli
index 9135bf6..b74a537 100644
--- a/src/vylist.mli
+++ b/src/vylist.mli
@@ -3,5 +3,6 @@ val remove : ('a -> bool) -> 'a list -> 'a list
val replace : ('a -> bool) -> 'a -> 'a list -> 'a list
val insert_before : ('a -> bool) -> 'a -> 'a list -> 'a list
val insert_after : ('a -> bool) -> 'a -> 'a list -> 'a list
+val insert_compare : ('a -> 'a -> int) -> 'a -> 'a list -> 'a list
val complement : 'a list -> 'a list -> 'a list
val in_list : 'a list -> 'a -> bool
diff --git a/src/vyos1x_parser.mly b/src/vyos1x_parser.mly
index ba1c5a7..8b2d7d8 100644
--- a/src/vyos1x_parser.mly
+++ b/src/vyos1x_parser.mly
@@ -20,6 +20,7 @@
(* When merging nodes with values, append values of subsequent nodes to the
first one *)
let merge_data l r = {l with values=(List.append l.values r.values)}
+ let order = Util.lexical_numeric_compare
%}
%token <string> IDENTIFIER
@@ -66,7 +67,8 @@ node:
{
let node =
Vytree.make_full {default_data with comment=comment} name [] in
- let node = List.fold_left Vytree.adopt node (List.rev children) |> Vytree.merge_children merge_data in
+ let node = List.fold_left Vytree.adopt node (List.rev children) |> Vytree.merge_children merge_data order in
+ let node = Vytree.sort_children order node in
try
List.iter find_duplicate_children (Vytree.children_of_node node);
node
@@ -87,8 +89,10 @@ tag_node:
let outer_node = Vytree.make_full {default_data with tag=true} name [] in
let inner_node =
Vytree.make_full {default_data with comment=comment} tag [] in
- let inner_node = List.fold_left Vytree.adopt inner_node (List.rev children) |> Vytree.merge_children merge_data in
+ let inner_node = List.fold_left Vytree.adopt inner_node (List.rev children) |> Vytree.merge_children merge_data order in
+ let inner_node = Vytree.sort_children order inner_node in
let node = Vytree.adopt outer_node inner_node in
+ let node = Vytree.sort_children order node in
try
List.iter find_duplicate_children (Vytree.children_of_node inner_node);
node
@@ -104,7 +108,8 @@ node_content: n = node { n } | n = leaf_node { n } | n = tag_node { n };
| ns = list(node_content); EOF
{
let root = make "" in
- let root = List.fold_left Vytree.adopt root (List.rev ns) |> Vytree.merge_children merge_data in
+ let root = List.fold_left Vytree.adopt root (List.rev ns) |> Vytree.merge_children merge_data order in
+ let root = Vytree.sort_children order root in
try
List.iter find_duplicate_children (Vytree.children_of_node root);
root
diff --git a/src/vytree.ml b/src/vytree.ml
index cda12f0..bd73776 100644
--- a/src/vytree.ml
+++ b/src/vytree.ml
@@ -4,7 +4,7 @@ type 'a t = {
children: 'a t list
} [@@deriving yojson]
-type position = Before of string | After of string | End | Default
+type position = Before of string | After of string | Lexical | End | Default
exception Empty_path
exception Duplicate_child
@@ -27,6 +27,8 @@ let insert_immediate ?(position=Default) node name data children =
| End -> node.children @ [new_node]
| Before s -> Vylist.insert_before (fun x -> x.name = s) new_node node.children
| After s -> Vylist.insert_after (fun x -> x.name = s) new_node node.children
+ | Lexical ->
+ Vylist.insert_compare (fun x y -> Util.lexical_numeric_compare x.name y.name) new_node node.children
in { node with children = children' }
let delete_immediate node name =
@@ -86,6 +88,14 @@ let rec insert ?(position=Default) ?(children=[]) node path data =
let s = Printf.sprintf "Non-existent intermediary node: \'%s\'" name in
raise (Insert_error s)
+let sorted_children_of_node cmp node =
+ let names = list_children node in
+ let names = List.sort cmp names in
+ List.map (find_or_fail node) names
+
+let sort_children cmp node =
+ {node with children = (sorted_children_of_node cmp node)}
+
(** Given a node N check if it has children with duplicate names,
and merge subsequent children's children into the first child by
that name.
@@ -97,9 +107,11 @@ let rec insert ?(position=Default) ?(children=[]) node path data =
may be normal and even expected, such as "ethernet eth0" and "ethernet eth1"
in the "curly" format.
*)
-let merge_children merge_data node =
+let merge_children merge_data cmp node =
(* Given a node N and a list of nodes NS, find all nodes in NS that
- have the same name as N and merge their children into N *)
+ have the same name as N and merge their children into N, sorting
+ children by a comparison function cmp (string -> string -> int) on
+ node names *)
let rec merge_into n ns =
match ns with
| [] -> n
@@ -108,6 +120,7 @@ let merge_children merge_data node =
let children = List.append n.children n'.children in
let data = merge_data n.data n'.data in
let n = {n with children=children; data=data} in
+ let n = sort_children cmp n in
merge_into n ns'
else merge_into n ns'
in
@@ -177,11 +190,6 @@ let children_of_path node path =
let node' = get node path in
list_children node'
-let sorted_children_of_node cmp node =
- let names = list_children node in
- let names = List.sort cmp names in
- List.map (find_or_fail node) names
-
let copy node old_path new_path =
if exists node new_path then raise Duplicate_child else
let child = get node old_path in
diff --git a/src/vytree.mli b/src/vytree.mli
index 451e130..377c9aa 100644
--- a/src/vytree.mli
+++ b/src/vytree.mli
@@ -5,7 +5,7 @@ exception Duplicate_child
exception Nonexistent_path
exception Insert_error of string
-type position = Before of string | After of string | End | Default
+type position = Before of string | After of string | Lexical | End | Default
val make : 'a -> string -> 'a t
val make_full : 'a -> string -> ('a t) list -> 'a t
@@ -19,11 +19,13 @@ val find_or_fail : 'a t -> string -> 'a t
val adopt : 'a t -> 'a t -> 'a t
+val replace : 'a t -> 'a t -> 'a t
+
val insert : ?position:position -> ?children:('a t list) -> 'a t -> string list -> 'a -> 'a t
val insert_multi_level : 'a -> 'a t -> string list -> string list -> 'a -> 'a t
-val merge_children : ('a -> 'a -> 'a) -> 'a t -> 'a t
+val merge_children : ('a -> 'a -> 'a) -> (string -> string -> int) -> 'a t -> 'a t
val delete : 'a t -> string list -> 'a t
@@ -45,6 +47,8 @@ val children_of_path : 'a t -> string list -> string list
val sorted_children_of_node : (string -> string -> int) -> 'a t -> ('a t) list
+val sort_children : (string -> string -> int) -> 'a t -> 'a t
+
val copy : 'a t -> string list -> string list -> 'a t
val move : 'a t -> string list -> position -> 'a t
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-09 19:39:01 +0000