From d32815b2182a14b1a56466cded912ff009bf0ebc Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T5528: add support for cstore_diff function

---
 src/config_diff.ml  | 26 +++++++++++++++++---------
 src/config_diff.mli | 10 +++++++++-
 2 files changed, 26 insertions(+), 10 deletions(-)

(limited to 'src')

diff --git a/src/config_diff.ml b/src/config_diff.ml
index 3529a5d..6fd57c6 100644
--- a/src/config_diff.ml
+++ b/src/config_diff.ml
@@ -27,6 +27,7 @@ module Diff_cstore = struct
     type t = { left: Config_tree.t;
                right: Config_tree.t;
                handle: int;
+               out: string;
              }
 end
 
@@ -43,19 +44,23 @@ let eval_result : type a. a result -> a = function
 type 'a diff_func = ?recurse:bool -> string list -> 'a result -> change -> 'a result
 
 let make_diff_trees l r = Diff_tree { left = l; right = r;
-                                  add = (Config_tree.make "");
-                                  sub = (Config_tree.make "");
-                                  del = (Config_tree.make "");
-                                  inter = (Config_tree.make "");
+                                add = (Config_tree.make "");
+                                sub = (Config_tree.make "");
+                                del = (Config_tree.make "");
+                                inter = (Config_tree.make "");
 }
 
-let make_diff_string l r = Diff_string {
-                               left = l; right = r;
-                               skel = (Config_tree.make "");
-                               ppath = [];
-                               udiff = "";
+let make_diff_string l r = Diff_string { left = l; right = r;
+                                skel = (Config_tree.make "");
+                                ppath = [];
+                                udiff = "";
                            }
 
+let make_diff_cstore l r h = Diff_cstore { left = l; right = r;
+                                handle = h;
+                                out = "";
+}
+
 let name_of n = Vytree.name_of_node n
 let data_of n = Vytree.data_of_node n
 let children_of n = Vytree.children_of_node n
@@ -75,6 +80,9 @@ module TreeOrd = struct
 end
 module ChildrenS = Set.Make(TreeOrd)
 
+(* unordered set of values *)
+module ValueSet = Set.Make(String)
+
 let (^~) (node : Config_tree.t) (node' : Config_tree.t) =
   name_of node = name_of node' &&
   (data_of node).values <> (data_of node').values
diff --git a/src/config_diff.mli b/src/config_diff.mli
index 6adf5a7..af8f87d 100644
--- a/src/config_diff.mli
+++ b/src/config_diff.mli
@@ -1,3 +1,4 @@
+type change = Unchanged | Added | Subtracted | Updated of string list
 
 module Diff_tree : sig
     type t = { left: Config_tree.t;
@@ -11,7 +12,7 @@ end
 
 module Diff_string : sig
     type t = { left: Config_tree.t;
-               right : Config_tree.t;
+               right: Config_tree.t;
                skel: Config_tree.t;
                ppath: string list;
                udiff: string;
@@ -22,6 +23,7 @@ module Diff_cstore : sig
     type t = { left: Config_tree.t;
                right: Config_tree.t;
                handle: int;
+               out: string;
              }
 end
 
@@ -30,6 +32,11 @@ type _ result =
     | Diff_string : Diff_string.t -> Diff_string.t result
     | Diff_cstore : Diff_cstore.t -> Diff_cstore.t result
 
+val eval_result : 'a result -> 'a
+
+type 'a diff_func = ?recurse:bool -> string list -> 'a result -> change -> 'a result
+val diff : string list -> 'a diff_func -> 'a result -> Config_tree.t option * Config_tree.t option -> 'a result
+
 exception Incommensurable
 exception Empty_comparison
 exception Nonexistent_child
@@ -38,3 +45,4 @@ val diff_tree : string list -> 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
 val mask_tree : Config_tree.t -> Config_tree.t -> Config_tree.t
+val make_diff_cstore : Config_tree.t -> Config_tree.t -> int -> Diff_cstore.t result
-- 
cgit v1.2.3


From d3ad1f32a18b9c3bb1ed6cd580af2b699b80fab3 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: add simplified render_at_level

---
 src/config_tree.ml  | 8 ++++++++
 src/config_tree.mli | 2 ++
 2 files changed, 10 insertions(+)

(limited to 'src')

diff --git a/src/config_tree.ml b/src/config_tree.ml
index b725f2d..f12461c 100644
--- a/src/config_tree.ml
+++ b/src/config_tree.ml
@@ -287,6 +287,14 @@ let render_commands ?(op=Set) node path =
 
 let render_config ?(ord_val=false) = Renderer.render_config ~ord_val:ord_val
 
+let render_at_level node path =
+    let node =
+        match path with
+        | [] -> node
+        | _ -> Vytree.get node path
+    in
+    render_config node
+
 let render_json = JSONRenderer.render_json
 
 let render_json_ast c = to_yojson c |> Yojson.Safe.to_string
diff --git a/src/config_tree.mli b/src/config_tree.mli
index 749a416..001c607 100644
--- a/src/config_tree.mli
+++ b/src/config_tree.mli
@@ -50,3 +50,5 @@ val render_config : ?ord_val:bool -> t -> string
 val render_json : t -> string
 
 val render_json_ast : t -> string
+
+val render_at_level : t -> string list -> string
-- 
cgit v1.2.3


From bff171c651592f27ea8e55db99c88f8ab076b0cd Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: move validate_path from vyconf

---
 src/reference_tree.ml  | 85 ++++++++++++++++++++++++++++++++++++++++++--------
 src/reference_tree.mli | 11 +++----
 src/util.ml            | 16 ++++++++++
 src/util.mli           |  4 +++
 src/value_checker.ml   | 44 ++++++++++++++++++++++++++
 src/value_checker.mli  | 12 +++++++
 6 files changed, 152 insertions(+), 20 deletions(-)
 create mode 100644 src/value_checker.ml
 create mode 100644 src/value_checker.mli

(limited to 'src')

diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index 4889734..d6249b8 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -8,11 +8,6 @@ let node_type_to_yojson = function
     | Tag -> `String "tag"
     | Other -> `String "other"
 
-type value_constraint =
-    | Regex of string [@name "regex"]
-    | External of string * string option [@name "exec"]
-    [@@deriving yojson]
-
 type completion_help_type =
     | List of string [@name "list"]
     | Path of string [@name "path"]
@@ -21,8 +16,8 @@ type completion_help_type =
 
 type ref_node_data = {
     node_type: node_type;
-    constraints: value_constraint list;
-    constraint_group: value_constraint list;
+    constraints: Value_checker.value_constraint list;
+    constraint_group: Value_checker.value_constraint list;
     constraint_error_message: string;
     completion_help: completion_help_type list;
     help: string;
@@ -128,13 +123,13 @@ let load_constraint_from_xml d c =
     let aux d c =
         match c with
         | Xml.Element ("regex", _, [Xml.PCData s]) ->
-            let cs = (Regex s) :: d.constraints in
+            let cs = (Value_checker.Regex s) :: d.constraints in
             {d with constraints=cs}
         | Xml.Element ("validator", [("name", n); ("argument", a)], _) ->
-            let cs = (External (n, Some a)) :: d.constraints in
+            let cs = (Value_checker.External (n, Some a)) :: d.constraints in
             {d with constraints=cs}
         | Xml.Element ("validator", [("name", n)], _) ->
-            let cs = (External (n, None)) :: d.constraints in
+            let cs = (Value_checker.External (n, None)) :: d.constraints in
             {d with constraints=cs}
         | _ -> raise (Bad_interface_definition "Malformed constraint")
     in Xml.fold aux d c
@@ -143,13 +138,13 @@ let load_constraint_group_from_xml d c =
     let aux d c =
         match c with
         | Xml.Element ("regex", _, [Xml.PCData s]) ->
-            let cs = (Regex s) :: d.constraint_group in
+            let cs = (Value_checker.Regex s) :: d.constraint_group in
             {d with constraint_group=cs}
         | Xml.Element ("validator", [("name", n); ("argument", a)], _) ->
-            let cs = (External (n, Some a)) :: d.constraint_group in
+            let cs = (Value_checker.External (n, Some a)) :: d.constraint_group in
             {d with constraint_group=cs}
         | Xml.Element ("validator", [("name", n)], _) ->
-            let cs = (External (n, None)) :: d.constraint_group in
+            let cs = (Value_checker.External (n, None)) :: d.constraint_group in
             {d with constraint_group=cs}
         | _ -> raise (Bad_interface_definition "Malformed constraint")
     in Xml.fold aux d c
@@ -229,6 +224,70 @@ let load_from_xml reftree file =
         let s = Printf.sprintf ": line %d in file %s" pos.eline file in
         raise (Bad_interface_definition ((Xml.error_msg msg)^s))
 
+(* Validation function *)
+
+let has_illegal_characters name =
+    (** Checks if string name has illegal characters in it.
+        All whitespace, curly braces, square brackets, and quotes
+        are disallowed due to their special significance to the curly config
+        format parser *)
+    try Some (Pcre.get_substring (Pcre.exec ~pat:"[\\s\\{\\}\\[\\]\"\'#]" name) 0)
+    with Not_found -> None
+
+(** Takes a list of string that represents a configuration path that may have
+    node value at the end, validates it, and splits it into path and value parts.
+
+   A list of strings is a valid path that can be created in the config tree unless:
+     1. It's a tag node without a child
+     2. It's a non-valueless leaf node without a value
+     3. It's a valueless node with a value
+     4. It's a non-valueless leaf node with garbage after the value
+     5. It's a non-leaf, non-tag node with a name that doesn't exist
+        in the reference tree
+ *)
+let validate_path validators_dir node path =
+    let show_path p = Printf.sprintf "[%s]" @@ Util.string_of_list (List.rev p) in
+    let rec aux node path acc =
+        let data = Vytree.data_of_node node in
+        match data.node_type with
+        | Leaf ->
+            (match path with
+             | [] ->
+                 if data.valueless then (List.rev acc, None)
+                 else raise (Validation_error
+                   (Printf.sprintf "Node %s requires a value" (show_path acc) ))
+             | [p] ->
+                 if not data.valueless then
+                     (if (Value_checker.validate_any validators_dir data.constraints p) then (List.rev acc, Some p)
+                     else raise (Validation_error data.constraint_error_message))
+                 else raise (Validation_error
+                   (Printf.sprintf "Node %s cannot have a value" (show_path acc)))
+             | _ -> raise (Validation_error (Printf.sprintf "Path %s is too long" (show_path acc))))
+        | Tag ->
+            (match path with
+             | p :: p' :: ps ->
+                 (match (has_illegal_characters p) with
+                 | Some c -> raise (Validation_error (Printf.sprintf "Illegal character \"%s\" in node name \"%s\"" c p))
+                 | None ->
+                     if (Value_checker.validate_any validators_dir data.constraints p) then
+                         let child = Vytree.find node p' in
+                         (match child with
+                          | Some c -> aux c ps (p' :: p :: acc)
+                          | None -> raise (Validation_error (Printf.sprintf "Node %s has no child %s" (show_path acc) p')))
+                     else raise (Validation_error (Printf.sprintf "%s is not a valid child name for node %s" p (show_path acc))))
+             | [p] -> if (Value_checker.validate_any validators_dir data.constraints p) then (List.rev acc, None)
+                          else raise (Validation_error (Printf.sprintf "Node %s has no child %s" (show_path acc) p))
+             | _ -> raise (Validation_error (Printf.sprintf "Path %s is incomplete" (show_path acc))))
+        | Other ->
+            (match path with
+             | [] -> (List.rev acc, None)
+             | p :: ps ->
+                 let child = Vytree.find node p in
+                 (match child with
+                  | Some c -> aux c ps (p :: acc)
+                  | None -> raise (Validation_error ((Printf.sprintf "Path %s is incomplete" (show_path acc))))))
+    in aux node path []
+
 let is_multi reftree path =
     let data = Vytree.get_data reftree path in
     data.multi
diff --git a/src/reference_tree.mli b/src/reference_tree.mli
index a18d875..9d512db 100644
--- a/src/reference_tree.mli
+++ b/src/reference_tree.mli
@@ -3,11 +3,6 @@ type node_type =
     | Tag
     | Other
 
-type value_constraint =
-    | Regex of string [@name "regex"]
-    | External of string * string option [@name "exec"]
-    [@@deriving yojson]
-
 type completion_help_type =
     | List of string [@name "list"]
     | Path of string [@name "path"]
@@ -16,8 +11,8 @@ type completion_help_type =
 
 type ref_node_data = {
     node_type: node_type;
-    constraints: value_constraint list;
-    constraint_group: value_constraint list;
+    constraints: Value_checker.value_constraint list;
+    constraint_group: Value_checker.value_constraint list;
     constraint_error_message: string;
     completion_help: completion_help_type list;
     help: string;
@@ -43,6 +38,8 @@ val default : t
 
 val load_from_xml : t -> string -> t
 
+val validate_path : string -> t -> string list -> string list * string option
+
 val is_multi : t -> string list -> bool
 
 val is_hidden : t -> string list -> bool
diff --git a/src/util.ml b/src/util.ml
index 168589d..047cfc9 100644
--- a/src/util.ml
+++ b/src/util.ml
@@ -85,3 +85,19 @@ let lexical_numeric_compare s t =
 (** Convert a relative path to an absolute path based on the current working directory *)
 let absolute_path relative_path =
     FilePath.make_absolute (Sys.getcwd ()) relative_path
+
+(** Convert a list of strings to a string of unquoted, space separated words *)
+let string_of_list ss =
+    let rec aux xs acc =
+        match xs with
+        | [] -> acc
+        | x :: xs' -> aux xs' (Printf.sprintf "%s %s" acc x)
+    in
+    match ss with
+    | [] -> ""
+    | x :: xs -> Printf.sprintf "%s%s" x (aux xs "")
+
+(** Convert a list of strings to JSON *)
+let json_of_list ss =
+    let ss = List.map (fun x -> `String x) ss in
+    Yojson.Safe.to_string (`List ss)
diff --git a/src/util.mli b/src/util.mli
index f9bfba6..e882607 100644
--- a/src/util.mli
+++ b/src/util.mli
@@ -9,3 +9,7 @@ val default : 'a -> 'a option -> 'a
 val lexical_numeric_compare : string -> string -> int
 
 val absolute_path : FilePath.filename -> FilePath.filename
+
+val string_of_list : string list -> string
+
+val json_of_list : string list -> string
diff --git a/src/value_checker.ml b/src/value_checker.ml
new file mode 100644
index 0000000..818185a
--- /dev/null
+++ b/src/value_checker.ml
@@ -0,0 +1,44 @@
+module F = Filename
+
+(*type value_constraint = Regex of string | External of string * string
+option*)
+type value_constraint =
+    | Regex of string [@name "regex"]
+    | External of string * string option [@name "exec"]
+    [@@deriving yojson]
+
+exception Bad_validator of string
+
+let validate_value dir value_constraint value =
+    match value_constraint with
+    | Regex s ->
+        (try
+           let _ = Pcre.exec ~pat:s value in true
+       with Not_found -> false)
+    | External (v, c) ->
+        (* XXX: Using Unix.system is a bad idea on multiple levels,
+                especially when the input comes directly from the user...
+                We should do something about it.
+         *)
+        let validator = F.concat dir v in
+        let arg = Option.value c ~default:"" in
+        let safe_arg = Printf.sprintf "'%s'" (Pcre.qreplace ~pat:"\"" ~templ:"\\\"" arg) in
+        let result = Unix.system (Printf.sprintf "%s %s %s" validator safe_arg value) in
+        match result with
+        | Unix.WEXITED 0 -> true
+        | Unix.WEXITED 127 -> raise (Bad_validator (Printf.sprintf "Could not execute validator %s" validator))
+        | _ -> false
+
+(* If no constraints given, consider it valid.
+   Otherwise consider it valid if it satisfies at least
+   one constraint *)
+let validate_any validators constraints value =
+    let rec aux validators constraints value  =
+        match constraints with
+        | [] -> false
+        | c :: cs -> if validate_value validators c value then true
+                     else aux validators cs value
+    in
+    match constraints with
+    | [] -> true
+    | _ -> aux validators constraints value
diff --git a/src/value_checker.mli b/src/value_checker.mli
new file mode 100644
index 0000000..b5091f5
--- /dev/null
+++ b/src/value_checker.mli
@@ -0,0 +1,12 @@
+(*type value_constraint = Regex of string | External of string * string option*)
+
+type value_constraint =
+    | Regex of string [@name "regex"]
+    | External of string * string option [@name "exec"]
+    [@@deriving yojson]
+
+exception Bad_validator of string
+
+val validate_value : string -> value_constraint -> string -> bool
+
+val validate_any : string -> value_constraint list -> string -> bool
-- 
cgit v1.2.3


From 223652d81e2e373d6aa518bc7215ea9ddf933af0 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: minor changes to support vyconf tests

---
 src/reference_tree.ml  | 10 +++++-----
 src/reference_tree.mli |  2 ++
 2 files changed, 7 insertions(+), 5 deletions(-)

(limited to 'src')

diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index d6249b8..89bf14e 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -74,7 +74,7 @@ let completion_help_type_of_string v s =
     | _ -> raise (Bad_interface_definition
                   (Printf.sprintf "list, path, or script expected, %s found" s))
 
-(** Find a child node in xml-lite *)
+(** Find a child node in xml-light *)
 let find_xml_child name xml =
     let find_aux e =
         match e with
@@ -113,7 +113,7 @@ let load_completion_help_from_xml d c =
         match c with
         | Xml.Element (_, _, [Xml.PCData s]) ->
                 l @ [completion_help_type_of_string (Xml.tag c) s]
-        | _ -> raise (Bad_interface_definition "Malformed completion help")
+        | _ -> raise (Bad_interface_definition ("Malformed completion help :" ^ Xml.to_string c))
     in Xml.fold aux [] c in
     let l = d.completion_help in
     let l' = l @ res in
@@ -131,7 +131,7 @@ let load_constraint_from_xml d c =
         | Xml.Element ("validator", [("name", n)], _) ->
             let cs = (Value_checker.External (n, None)) :: d.constraints in
             {d with constraints=cs}
-        | _ -> raise (Bad_interface_definition "Malformed constraint")
+        | _ -> raise (Bad_interface_definition ("Malformed constraint: " ^ Xml.to_string c))
     in Xml.fold aux d c
 
 let load_constraint_group_from_xml d c =
@@ -146,7 +146,7 @@ let load_constraint_group_from_xml d c =
         | Xml.Element ("validator", [("name", n)], _) ->
             let cs = (Value_checker.External (n, None)) :: d.constraint_group in
             {d with constraint_group=cs}
-        | _ -> raise (Bad_interface_definition "Malformed constraint")
+        | _ -> raise (Bad_interface_definition ("Malformed constraint: " ^ Xml.to_string c))
     in Xml.fold aux d c
 
 let data_from_xml d x =
@@ -166,7 +166,7 @@ let data_from_xml d x =
             {d with priority=Some i}
         | Xml.Element ("hidden", _, _) -> {d with hidden=true}
         | Xml.Element ("secret", _, _) -> {d with secret=true}
-        | _ -> raise (Bad_interface_definition "Malformed property tag")
+        | _ -> raise (Bad_interface_definition ("Malformed property tag: " ^ Xml.to_string x))
     in Xml.fold aux d x
 
 let rec insert_from_xml basepath reftree xml =
diff --git a/src/reference_tree.mli b/src/reference_tree.mli
index 9d512db..2c2a03d 100644
--- a/src/reference_tree.mli
+++ b/src/reference_tree.mli
@@ -38,6 +38,8 @@ val default : t
 
 val load_from_xml : t -> string -> t
 
+val find_xml_child : string -> Xml_light_types.xml -> Xml_light_types.xml option
+
 val validate_path : string -> t -> string list -> string list * string option
 
 val is_multi : t -> string list -> bool
-- 
cgit v1.2.3


From bcf21129981d4541f7ae9a88ae3bdb4b297bfc17 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: add functor for internal rep

---
 src/config_tree.ml     |  2 ++
 src/config_tree.mli    |  2 ++
 src/internal.ml        | 29 +++++++++++++++++++++++++++++
 src/internal.mli       | 15 +++++++++++++++
 src/reference_tree.ml  | 12 +++++++++---
 src/reference_tree.mli |  6 +++---
 6 files changed, 60 insertions(+), 6 deletions(-)
 create mode 100644 src/internal.ml
 create mode 100644 src/internal.mli

(limited to 'src')

diff --git a/src/config_tree.ml b/src/config_tree.ml
index f12461c..89f85bf 100644
--- a/src/config_tree.ml
+++ b/src/config_tree.ml
@@ -22,6 +22,8 @@ let default_data = {
     leaf = false;
 }
 
+let default = Vytree.make default_data ""
+
 let make name = Vytree.make default_data name
 
 let op_to_string op =
diff --git a/src/config_tree.mli b/src/config_tree.mli
index 001c607..c05bab9 100644
--- a/src/config_tree.mli
+++ b/src/config_tree.mli
@@ -17,6 +17,8 @@ type t = config_node_data Vytree.t [@@deriving yojson]
 
 val default_data : config_node_data
 
+val default : t
+
 val make : string -> t
 
 val create_node : t -> string list -> t
diff --git a/src/internal.ml b/src/internal.ml
new file mode 100644
index 0000000..0c761e0
--- /dev/null
+++ b/src/internal.ml
@@ -0,0 +1,29 @@
+module type T =
+    sig
+        type t
+        val to_yojson : t -> Yojson.Safe.t
+        val of_yojson : Yojson.Safe.t -> t Ppx_deriving_yojson_runtime.error_or
+        val default : t
+    end
+
+module type FI = functor (M: T) ->
+    sig
+        val write_internal : M.t -> string -> unit
+        val read_internal : string -> M.t
+    end
+
+module Make : FI = functor (M: T) -> struct
+    let write_internal x file_name =
+        let yt = M.to_yojson x in
+        let ys = Yojson.Safe.to_string yt in
+        let oc = open_out file_name in
+        Printf.fprintf oc "%s" ys; close_out oc
+
+    let read_internal file_name =
+        let ic = open_in file_name in
+        let ys = really_input_string ic (in_channel_length ic) in
+        let yt = Yojson.Safe.from_string ys in
+        let ct_res = M.of_yojson yt in
+        let ct = Result.value ct_res ~default:M.default in
+        close_in ic; ct
+end
diff --git a/src/internal.mli b/src/internal.mli
new file mode 100644
index 0000000..33918c7
--- /dev/null
+++ b/src/internal.mli
@@ -0,0 +1,15 @@
+module type T =
+    sig
+        type t
+        val to_yojson : t -> Yojson.Safe.t
+        val of_yojson : Yojson.Safe.t -> t Ppx_deriving_yojson_runtime.error_or
+        val default : t
+    end
+
+module type FI = functor (M : T) ->
+    sig
+      val write_internal : M.t -> string -> unit
+      val read_internal : string -> M.t
+    end
+
+module Make : FI
diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index 89bf14e..e920209 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -8,11 +8,17 @@ let node_type_to_yojson = function
     | Tag -> `String "tag"
     | Other -> `String "other"
 
+let node_type_of_yojson = function
+    | `String "leaf" -> Ok Leaf
+    | `String "tag" -> Ok Tag
+    | `String "other" -> Ok Other
+    | json -> Error (Yojson.Safe.to_string json)
+
 type completion_help_type =
     | List of string [@name "list"]
     | Path of string [@name "path"]
     | Script of string [@name "script"]
-    [@@deriving to_yojson]
+    [@@deriving yojson]
 
 type ref_node_data = {
     node_type: node_type;
@@ -29,9 +35,9 @@ type ref_node_data = {
     default_value: string option;
     hidden: bool;
     secret: bool;
-} [@@deriving to_yojson]
+} [@@deriving yojson]
 
-type t = ref_node_data Vytree.t [@@deriving to_yojson]
+type t = ref_node_data Vytree.t [@@deriving yojson]
 
 exception Bad_interface_definition of string
 
diff --git a/src/reference_tree.mli b/src/reference_tree.mli
index 2c2a03d..129e5db 100644
--- a/src/reference_tree.mli
+++ b/src/reference_tree.mli
@@ -7,7 +7,7 @@ type completion_help_type =
     | List of string [@name "list"]
     | Path of string [@name "path"]
     | Script of string [@name "script"]
-    [@@deriving to_yojson]
+    [@@deriving yojson]
 
 type ref_node_data = {
     node_type: node_type;
@@ -24,9 +24,9 @@ type ref_node_data = {
     default_value: string option;
     hidden: bool;
     secret: bool;
-} [@@deriving to_yojson]
+} [@@deriving yojson]
 
-type t = ref_node_data Vytree.t [@@deriving to_yojson]
+type t = ref_node_data Vytree.t [@@deriving yojson]
 
 exception Bad_interface_definition of string
 
-- 
cgit v1.2.3


From 22478789c282dc379e7d7ce1c910a9a301f7b49b Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: add optional arg to write internal rep during build

---
 src/generate.ml  | 9 +++++++--
 src/generate.mli | 2 +-
 2 files changed, 8 insertions(+), 3 deletions(-)

(limited to 'src')

diff --git a/src/generate.ml b/src/generate.ml
index e7801c5..632c678 100644
--- a/src/generate.ml
+++ b/src/generate.ml
@@ -2,6 +2,8 @@
 exception Load_error of string
 exception Write_error of string
 
+module I = Internal.Make(Reference_tree)
+
 let load_interface_definitions dir =
     let open Reference_tree in
     let dir_paths = FileUtil.ls dir in
@@ -20,7 +22,7 @@ let load_interface_definitions dir =
         | Error msg -> Error msg end
     with Bad_interface_definition msg -> Error msg
 
-let reference_tree_to_json from_dir to_file =
+let reference_tree_to_json ?(internal_cache="") from_dir to_file =
     let ref_tree_result =
         load_interface_definitions from_dir
     in
@@ -36,4 +38,7 @@ let reference_tree_to_json from_dir to_file =
         with Sys_error msg -> raise (Write_error msg)
     in
     Printf.fprintf oc "%s" out;
-    close_out oc
+    close_out oc;
+    match internal_cache with
+    | "" -> ()
+    | _ -> I.write_internal ref_tree internal_cache
diff --git a/src/generate.mli b/src/generate.mli
index e121d1f..6f8e775 100644
--- a/src/generate.mli
+++ b/src/generate.mli
@@ -2,4 +2,4 @@ exception Load_error of string
 exception Write_error of string
 
 val load_interface_definitions : string -> (Reference_tree.t, string) result
-val reference_tree_to_json : string -> string -> unit
+val reference_tree_to_json : ?internal_cache:string -> string -> string -> unit
-- 
cgit v1.2.3


From bd64f4508d72d1b2f0c613b5012ad6dc9507f3c6 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: add function refpath: config path -> reference_tree path

---
 src/reference_tree.ml  | 11 +++++++++++
 src/reference_tree.mli |  2 ++
 2 files changed, 13 insertions(+)

(limited to 'src')

diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index e920209..353a152 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -340,6 +340,17 @@ let get_completion_data reftree path =
         (data.node_type, data.multi, data.help)
     in List.map aux (Vytree.children_of_node @@ Vytree.get reftree path)
 
+(* Convert from config path to reference tree path *)
+let refpath reftree path =
+    let rec aux acc p =
+    match acc, p with
+    | [], h :: tl -> aux (acc @ [h]) tl
+    | _, [h] -> if is_tag reftree acc then acc else acc @ [h]
+    | _, h :: h' :: tl -> if is_tag reftree acc then aux (acc @ [h']) tl
+                          else aux (acc @ [h]) ([h'] @ tl)
+    | _, [] -> acc
+    in aux [] path
+
 module JSONRenderer =
 struct
     let render_data data =
diff --git a/src/reference_tree.mli b/src/reference_tree.mli
index 129e5db..964380e 100644
--- a/src/reference_tree.mli
+++ b/src/reference_tree.mli
@@ -62,4 +62,6 @@ val get_value_help : t -> string list -> (string * string) list
 
 val get_completion_data : t -> string list -> (node_type * bool * string) list
 
+val refpath : t -> string list -> string list
+
 val render_json : t -> string
-- 
cgit v1.2.3


From ca5096b699b8123000c84dbccab8690d98b42546 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: util list_of_path: config path str -> config path list

Allow for single-quoted values containing whitespace, as used by vyconf
vycli for option --path.
---
 src/util.ml  | 9 +++++++++
 src/util.mli | 2 ++
 2 files changed, 11 insertions(+)

(limited to 'src')

diff --git a/src/util.ml b/src/util.ml
index 047cfc9..cbee955 100644
--- a/src/util.ml
+++ b/src/util.ml
@@ -101,3 +101,12 @@ let string_of_list ss =
 let json_of_list ss =
     let ss = List.map (fun x -> `String x) ss in
     Yojson.Safe.to_string (`List ss)
+
+(** Split string on whitespace, excluding single-quoted phrases,
+    as needed for parsing vyconf request path option **)
+let list_of_path p =
+    let seg = String.trim p |> String.split_on_char '\'' in
+    match seg with
+    | [h] -> Pcre.split ~pat:"\\s+" h
+    | h :: h' :: _ -> (Pcre.split ~pat:"\\s+" h) @ [h']
+    | _ -> []
diff --git a/src/util.mli b/src/util.mli
index e882607..9a52268 100644
--- a/src/util.mli
+++ b/src/util.mli
@@ -13,3 +13,5 @@ val absolute_path : FilePath.filename -> FilePath.filename
 val string_of_list : string list -> string
 
 val json_of_list : string list -> string
+
+val list_of_path : string -> string list
-- 
cgit v1.2.3


From 8bb9e607eb1c7b0a701292a36583c91f4a0cdc7b Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: update value_checker to return validator output on error

---
 src/dune              |   2 +-
 src/reference_tree.ml | 140 +++++++++++++++++++++++++++++++++++++-------------
 src/value_checker.ml  |  80 ++++++++++++++++++++---------
 src/value_checker.mli |   6 ++-
 4 files changed, 165 insertions(+), 63 deletions(-)

(limited to 'src')

diff --git a/src/dune b/src/dune
index 2bbe602..0932138 100644
--- a/src/dune
+++ b/src/dune
@@ -6,7 +6,7 @@
 (library
  (name vyos1x)
  (public_name vyos1x-config)
- (libraries yojson menhirLib fileutils pcre xml-light)
+ (libraries yojson menhirLib fileutils pcre xml-light unix containers)
  (preprocess (pps ppx_deriving_yojson))
  (foreign_stubs
   (language c)
diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index 353a152..6472cb5 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -245,11 +245,12 @@ let has_illegal_characters name =
 
    A list of strings is a valid path that can be created in the config tree unless:
      1. It's a tag node without a child
-     2. It's a non-valueless leaf node without a value
-     3. It's a valueless node with a value
-     4. It's a non-valueless leaf node with garbage after the value
-     5. It's a non-leaf, non-tag node with a name that doesn't exist
-        in the reference tree
+     2. It's a tag node with an invalid tag value
+     3. It's a non-valueless leaf node without a value
+     4. It's a valueless leaf node with a value
+     5. It's a non-valueless leaf node with an invalid value
+     6. It's a node that is neither leaf nor tag value with a name that
+        doesn't exist in the reference tree
  *)
 let validate_path validators_dir node path =
     let show_path p = Printf.sprintf "[%s]" @@ Util.string_of_list (List.rev p) in
@@ -257,41 +258,106 @@ let validate_path validators_dir node path =
         let data = Vytree.data_of_node node in
         match data.node_type with
         | Leaf ->
-            (match path with
-             | [] ->
-                 if data.valueless then (List.rev acc, None)
-                 else raise (Validation_error
-                   (Printf.sprintf "Node %s requires a value" (show_path acc) ))
-             | [p] ->
+            begin
+            match path with
+            | [] ->
+                if data.valueless then (List.rev acc, None)
+                else
+                let msg =
+                    Printf.sprintf "Configuration path %s requires a value" (show_path acc)
+                in raise (Validation_error msg)
+            | [p] ->
                  if not data.valueless then
-                     (if (Value_checker.validate_any validators_dir data.constraints p) then (List.rev acc, Some p)
-                     else raise (Validation_error data.constraint_error_message))
-                 else raise (Validation_error
-                   (Printf.sprintf "Node %s cannot have a value" (show_path acc)))
-             | _ -> raise (Validation_error (Printf.sprintf "Path %s is too long" (show_path acc))))
+                     let res, out =
+                         try Value_checker.validate_any validators_dir data.constraints p
+                         with Value_checker.Bad_validator msg -> raise (Validation_error msg)
+                     in
+                     match res with
+                     | true -> (List.rev acc, Some p)
+                     | false ->
+                        raise (Validation_error (out ^ data.constraint_error_message))
+                 else
+                     let msg = Printf.sprintf "Node %s cannot have a value" (show_path acc)
+                     in raise (Validation_error msg)
+            | _ ->
+                let msg = Printf.sprintf "Path %s is too long" (show_path acc)
+                in raise (Validation_error msg)
+            end
         | Tag ->
-            (match path with
-             | p :: p' :: ps ->
-                 (match (has_illegal_characters p) with
-                 | Some c -> raise (Validation_error (Printf.sprintf "Illegal character \"%s\" in node name \"%s\"" c p))
-                 | None ->
-                     if (Value_checker.validate_any validators_dir data.constraints p) then
-                         let child = Vytree.find node p' in
-                         (match child with
-                          | Some c -> aux c ps (p' :: p :: acc)
-                          | None -> raise (Validation_error (Printf.sprintf "Node %s has no child %s" (show_path acc) p')))
-                     else raise (Validation_error (Printf.sprintf "%s is not a valid child name for node %s" p (show_path acc))))
-             | [p] -> if (Value_checker.validate_any validators_dir data.constraints p) then (List.rev acc, None)
-                          else raise (Validation_error (Printf.sprintf "Node %s has no child %s" (show_path acc) p))
-             | _ -> raise (Validation_error (Printf.sprintf "Path %s is incomplete" (show_path acc))))
+            begin
+            match path with
+            | p :: p' :: ps ->
+                begin
+                match (has_illegal_characters p) with
+                | Some c ->
+                    let msg =
+                        Printf.sprintf "Illegal character \"%s\" in node name \"%s\"" c p
+                    in raise (Validation_error msg)
+                | None ->
+                    let res, out =
+                        try Value_checker.validate_any validators_dir data.constraints p
+                        with Value_checker.Bad_validator msg -> raise (Validation_error msg)
+                    in
+                    begin
+                    match res with
+                    | true ->
+                        let child = Vytree.find node p' in
+                        begin
+                        match child with
+                        | Some c -> aux c ps (p' :: p :: acc)
+                        | None ->
+                            let msg =
+                                Printf.sprintf "Node %s has no child %s" (show_path acc) p'
+                            in raise (Validation_error msg)
+                        end
+                    | false ->
+                        let msg =
+                            Printf.sprintf "%s is not a valid child name for node %s" p (show_path acc)
+                        in
+                        let ret = Printf.sprintf "%s\n%s\n%s" out data.constraint_error_message msg
+                        in raise (Validation_error ret)
+                    end
+                end
+            | [p] ->
+                begin
+                match (has_illegal_characters p) with
+                | Some c ->
+                    let msg =
+                        Printf.sprintf "Illegal character \"%s\" in node name \"%s\"" c p
+                    in raise (Validation_error msg)
+                | None ->
+                    let res, out =
+                        try Value_checker.validate_any validators_dir data.constraints p
+                        with Value_checker.Bad_validator msg -> raise (Validation_error msg)
+                    in
+                    begin
+                    match res with
+                    | true -> (List.rev acc, None)
+                    | false ->
+                        let msg =
+                            Printf.sprintf "%s is not a valid child name for node %s" p (show_path acc)
+                        in
+                        let ret = Printf.sprintf "%s\n%s\n%s" out data.constraint_error_message msg
+                        in raise (Validation_error ret)
+                    end
+                end
+            | _ ->
+                let msg =
+                    Printf.sprintf "Configuration path %s requires a value" (show_path acc)
+                in raise (Validation_error msg)
+            end
         | Other ->
-            (match path with
-             | [] -> (List.rev acc, None)
-             | p :: ps ->
-                 let child = Vytree.find node p in
-                 (match child with
-                  | Some c -> aux c ps (p :: acc)
-                  | None -> raise (Validation_error ((Printf.sprintf "Path %s is incomplete" (show_path acc))))))
+            begin
+            match path with
+            | [] -> (List.rev acc, None)
+            | p :: ps ->
+                let child = Vytree.find node p in
+                match child with
+                | Some c -> aux c ps (p :: acc)
+                | None ->
+                    let msg = Printf.sprintf "Path %s is incomplete" (show_path acc)
+                    in raise (Validation_error msg)
+            end
     in aux node path []
 
 let is_multi reftree path =
diff --git a/src/value_checker.ml b/src/value_checker.ml
index 818185a..69bfeec 100644
--- a/src/value_checker.ml
+++ b/src/value_checker.ml
@@ -1,7 +1,6 @@
 module F = Filename
 
-(*type value_constraint = Regex of string | External of string * string
-option*)
+(*type value_constraint = Regex of string | External of string * string option*)
 type value_constraint =
     | Regex of string [@name "regex"]
     | External of string * string option [@name "exec"]
@@ -9,36 +8,71 @@ type value_constraint =
 
 exception Bad_validator of string
 
-let validate_value dir value_constraint value =
+let validate_value dir buf value_constraint value =
     match value_constraint with
     | Regex s ->
-        (try
-           let _ = Pcre.exec ~pat:s value in true
+      (try
+          let _ = Pcre.exec ~pat:(Printf.sprintf "^%s$" s) value in true
        with Not_found -> false)
     | External (v, c) ->
-        (* XXX: Using Unix.system is a bad idea on multiple levels,
-                especially when the input comes directly from the user...
-                We should do something about it.
-         *)
+      (* XXX: Unix.open_process_in is "shelling out", which is a bad idea on multiple levels,
+         especially when the input comes directly from the user...
+         We should do something about it.
+       *)
         let validator = F.concat dir v in
-        let arg = Option.value c ~default:"" in
-        let safe_arg = Printf.sprintf "'%s'" (Pcre.qreplace ~pat:"\"" ~templ:"\\\"" arg) in
-        let result = Unix.system (Printf.sprintf "%s %s %s" validator safe_arg value) in
+        let cmd =
+            match c with
+            | Some arg ->
+                let safe_arg = Printf.sprintf "'%s'" (Pcre.qreplace ~pat:"\"" ~templ:"\\\"" arg) in
+                Printf.sprintf "%s %s \'%s\' 2>&1" validator safe_arg value
+            | None ->
+                Printf.sprintf "%s \'%s\' 2>&1" validator value
+        in
+        let chan = Unix.open_process_in cmd in
+        let out = try CCIO.read_all chan with _ -> "" in
+        let result = Unix.close_process_in chan in
         match result with
         | Unix.WEXITED 0 -> true
-        | Unix.WEXITED 127 -> raise (Bad_validator (Printf.sprintf "Could not execute validator %s" validator))
-        | _ -> false
+        | Unix.WEXITED 127 ->
+            raise (Bad_validator (Printf.sprintf "Could not execute validator %s" validator))
+        | _ ->
+            let () = Buffer.add_string buf out in
+            false
 
 (* If no constraints given, consider it valid.
-   Otherwise consider it valid if it satisfies at least
-   one constraint *)
+   Otherwise consider it valid if it satisfies at least one constraint *)
 let validate_any validators constraints value =
-    let rec aux validators constraints value  =
+    let buf = Buffer.create 4096 in
+    let validate_exists validators constraints value =
         match constraints with
-        | [] -> false
-        | c :: cs -> if validate_value validators c value then true
-                     else aux validators cs value
+        | [] -> true
+        | _ ->
+            List.exists (fun c -> validate_value validators buf c value) constraints
     in
-    match constraints with
-    | [] -> true
-    | _ -> aux validators constraints value
+    match validate_exists validators constraints value with
+    | true ->
+        let () = Buffer.clear buf in
+        true, ""
+    | false ->
+        let out = Buffer.contents buf in
+        let () = Buffer.clear buf in
+        false, out
+
+(* If no constraints given, consider it valid.
+   Otherwise consider it valid if it satisfies all constraints *)
+let validate_all validators constraints value =
+    let buf = Buffer.create 4096 in
+    let validate_forall validators constraints value =
+        match constraints with
+        | [] -> true
+        | _ ->
+            List.for_all (fun c -> validate_value validators buf c value) constraints
+    in
+    match validate_forall validators constraints value with
+    | true ->
+        let () = Buffer.clear buf in
+        true, ""
+    | false ->
+        let out = Buffer.contents buf in
+        let () = Buffer.clear buf in
+        false, out
diff --git a/src/value_checker.mli b/src/value_checker.mli
index b5091f5..92a2f22 100644
--- a/src/value_checker.mli
+++ b/src/value_checker.mli
@@ -7,6 +7,8 @@ type value_constraint =
 
 exception Bad_validator of string
 
-val validate_value : string -> value_constraint -> string -> bool
+val validate_value : string -> Buffer.t -> value_constraint -> string -> bool
 
-val validate_any : string -> value_constraint list -> string -> bool
+val validate_any : string -> value_constraint list -> string -> bool * string
+
+val validate_all : string -> value_constraint list -> string -> bool * string
-- 
cgit v1.2.3


From 73e0836d9d64c9dbbf53b82d18ab84e525f59ad6 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: validate_path returns unit instead of (path, value)

Splitting of path arg into (path, value), as originally returned by
validate_path, is now handled by a utility function. validate_path
returns unit on success and raises error with output on failure.
---
 src/reference_tree.ml  | 57 ++++++++++++++++++++++++++++++++++++++++----------
 src/reference_tree.mli |  4 +++-
 src/value_checker.ml   |  8 +++----
 src/value_checker.mli  |  4 ++--
 4 files changed, 55 insertions(+), 18 deletions(-)

(limited to 'src')

diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index 6472cb5..bda7b0e 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -261,20 +261,20 @@ let validate_path validators_dir node path =
             begin
             match path with
             | [] ->
-                if data.valueless then (List.rev acc, None)
+                if data.valueless then ()
                 else
                 let msg =
                     Printf.sprintf "Configuration path %s requires a value" (show_path acc)
                 in raise (Validation_error msg)
             | [p] ->
                  if not data.valueless then
-                     let res, out =
+                     let res =
                          try Value_checker.validate_any validators_dir data.constraints p
                          with Value_checker.Bad_validator msg -> raise (Validation_error msg)
                      in
                      match res with
-                     | true -> (List.rev acc, Some p)
-                     | false ->
+                     | None -> ()
+                     | Some out ->
                         raise (Validation_error (out ^ data.constraint_error_message))
                  else
                      let msg = Printf.sprintf "Node %s cannot have a value" (show_path acc)
@@ -294,13 +294,13 @@ let validate_path validators_dir node path =
                         Printf.sprintf "Illegal character \"%s\" in node name \"%s\"" c p
                     in raise (Validation_error msg)
                 | None ->
-                    let res, out =
+                    let res =
                         try Value_checker.validate_any validators_dir data.constraints p
                         with Value_checker.Bad_validator msg -> raise (Validation_error msg)
                     in
                     begin
                     match res with
-                    | true ->
+                    | None ->
                         let child = Vytree.find node p' in
                         begin
                         match child with
@@ -310,7 +310,7 @@ let validate_path validators_dir node path =
                                 Printf.sprintf "Node %s has no child %s" (show_path acc) p'
                             in raise (Validation_error msg)
                         end
-                    | false ->
+                    | Some out ->
                         let msg =
                             Printf.sprintf "%s is not a valid child name for node %s" p (show_path acc)
                         in
@@ -326,14 +326,14 @@ let validate_path validators_dir node path =
                         Printf.sprintf "Illegal character \"%s\" in node name \"%s\"" c p
                     in raise (Validation_error msg)
                 | None ->
-                    let res, out =
+                    let res =
                         try Value_checker.validate_any validators_dir data.constraints p
                         with Value_checker.Bad_validator msg -> raise (Validation_error msg)
                     in
                     begin
                     match res with
-                    | true -> (List.rev acc, None)
-                    | false ->
+                    | None -> ()
+                    | Some out ->
                         let msg =
                             Printf.sprintf "%s is not a valid child name for node %s" p (show_path acc)
                         in
@@ -349,7 +349,7 @@ let validate_path validators_dir node path =
         | Other ->
             begin
             match path with
-            | [] -> (List.rev acc, None)
+            | [] -> ()
             | p :: ps ->
                 let child = Vytree.find node p in
                 match child with
@@ -360,6 +360,41 @@ let validate_path validators_dir node path =
             end
     in aux node path []
 
+(* This is only to be used after the path has been validated *)
+let split_path node path =
+    let rec aux node path acc =
+        let data = Vytree.data_of_node node in
+        match data.node_type with
+        | Leaf ->
+            begin
+            match path with
+            | [] -> (List.rev acc, None)
+            | [p] -> (List.rev acc, Some p)
+            | _ -> (List.rev acc, None)
+            end
+        | Tag ->
+            begin
+            match path with
+            | p :: p' :: ps ->
+                (let child = Vytree.find node p' in
+                match child with
+                | Some c -> aux c ps (p' :: p :: acc)
+                | None -> (List.rev acc, None))
+            | [_] -> (List.rev acc, None)
+            | _ -> (List.rev acc, None)
+            end
+        | Other ->
+            begin
+            match path with
+            | [] -> (List.rev acc, None)
+            | p :: ps ->
+                let child = Vytree.find node p in
+                match child with
+                | Some c -> aux c ps (p :: acc)
+                | None -> (List.rev acc, None)
+            end
+    in aux node path []
+
 let is_multi reftree path =
     let data = Vytree.get_data reftree path in
     data.multi
diff --git a/src/reference_tree.mli b/src/reference_tree.mli
index 964380e..a8d4efa 100644
--- a/src/reference_tree.mli
+++ b/src/reference_tree.mli
@@ -40,7 +40,9 @@ val load_from_xml : t -> string -> t
 
 val find_xml_child : string -> Xml_light_types.xml -> Xml_light_types.xml option
 
-val validate_path : string -> t -> string list -> string list * string option
+val validate_path : string -> t -> string list -> unit
+
+val split_path : t -> string list -> string list * string option
 
 val is_multi : t -> string list -> bool
 
diff --git a/src/value_checker.ml b/src/value_checker.ml
index 69bfeec..65013d4 100644
--- a/src/value_checker.ml
+++ b/src/value_checker.ml
@@ -52,11 +52,11 @@ let validate_any validators constraints value =
     match validate_exists validators constraints value with
     | true ->
         let () = Buffer.clear buf in
-        true, ""
+        None
     | false ->
         let out = Buffer.contents buf in
         let () = Buffer.clear buf in
-        false, out
+        Some out
 
 (* If no constraints given, consider it valid.
    Otherwise consider it valid if it satisfies all constraints *)
@@ -71,8 +71,8 @@ let validate_all validators constraints value =
     match validate_forall validators constraints value with
     | true ->
         let () = Buffer.clear buf in
-        true, ""
+        None
     | false ->
         let out = Buffer.contents buf in
         let () = Buffer.clear buf in
-        false, out
+        Some out
diff --git a/src/value_checker.mli b/src/value_checker.mli
index 92a2f22..d4ae516 100644
--- a/src/value_checker.mli
+++ b/src/value_checker.mli
@@ -9,6 +9,6 @@ exception Bad_validator of string
 
 val validate_value : string -> Buffer.t -> value_constraint -> string -> bool
 
-val validate_any : string -> value_constraint list -> string -> bool * string
+val validate_any : string -> value_constraint list -> string -> string option
 
-val validate_all : string -> value_constraint list -> string -> bool * string
+val validate_all : string -> value_constraint list -> string -> string option
-- 
cgit v1.2.3


From ccc933e9fae78aaacf48d1e9f68e654dbe0bff1a Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: fix typo in quoting arg

---
 src/value_checker.ml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'src')

diff --git a/src/value_checker.ml b/src/value_checker.ml
index 65013d4..06e3dc7 100644
--- a/src/value_checker.ml
+++ b/src/value_checker.ml
@@ -23,7 +23,7 @@ let validate_value dir buf value_constraint value =
         let cmd =
             match c with
             | Some arg ->
-                let safe_arg = Printf.sprintf "'%s'" (Pcre.qreplace ~pat:"\"" ~templ:"\\\"" arg) in
+                let safe_arg = Printf.sprintf "%s" (Pcre.qreplace ~pat:"\"" ~templ:"\\\"" arg) in
                 Printf.sprintf "%s %s \'%s\' 2>&1" validator safe_arg value
             | None ->
                 Printf.sprintf "%s \'%s\' 2>&1" validator value
-- 
cgit v1.2.3


From 9ff89e508f81ce71c9073f096fd27c73d4259987 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: format error output

---
 src/reference_tree.ml | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

(limited to 'src')

diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index bda7b0e..0efaf56 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -240,6 +240,10 @@ let has_illegal_characters name =
     try Some (Pcre.get_substring (Pcre.exec ~pat:"[\\s\\{\\}\\[\\]\"\'#]" name) 0)
     with Not_found -> None
 
+let format_out l =
+    let fl = List.filter (fun s -> (String.length s) > 0) l in
+    String.concat "\n\n" fl
+
 (** Takes a list of string that represents a configuration path that may have
     node value at the end, validates it, and splits it into path and value parts.
 
@@ -275,7 +279,8 @@ let validate_path validators_dir node path =
                      match res with
                      | None -> ()
                      | Some out ->
-                        raise (Validation_error (out ^ data.constraint_error_message))
+                        let ret = format_out [out; data.constraint_error_message]
+                        in raise (Validation_error ret)
                  else
                      let msg = Printf.sprintf "Node %s cannot have a value" (show_path acc)
                      in raise (Validation_error msg)
@@ -314,7 +319,7 @@ let validate_path validators_dir node path =
                         let msg =
                             Printf.sprintf "%s is not a valid child name for node %s" p (show_path acc)
                         in
-                        let ret = Printf.sprintf "%s\n%s\n%s" out data.constraint_error_message msg
+                        let ret = format_out [out; data.constraint_error_message; msg]
                         in raise (Validation_error ret)
                     end
                 end
@@ -337,7 +342,7 @@ let validate_path validators_dir node path =
                         let msg =
                             Printf.sprintf "%s is not a valid child name for node %s" p (show_path acc)
                         in
-                        let ret = Printf.sprintf "%s\n%s\n%s" out data.constraint_error_message msg
+                        let ret = format_out [out; data.constraint_error_message; msg]
                         in raise (Validation_error ret)
                     end
                 end
-- 
cgit v1.2.3


From 45c65c695d6df0cb9cd46ef12245b59514b53549 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: catch bad_validator error

---
 src/value_checker.ml | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

(limited to 'src')

diff --git a/src/value_checker.ml b/src/value_checker.ml
index 06e3dc7..d94f99d 100644
--- a/src/value_checker.ml
+++ b/src/value_checker.ml
@@ -47,7 +47,9 @@ let validate_any validators constraints value =
         match constraints with
         | [] -> true
         | _ ->
-            List.exists (fun c -> validate_value validators buf c value) constraints
+            try
+                List.exists (fun c -> validate_value validators buf c value) constraints
+            with Bad_validator e -> let () = Buffer.add_string buf e in false
     in
     match validate_exists validators constraints value with
     | true ->
@@ -66,7 +68,9 @@ let validate_all validators constraints value =
         match constraints with
         | [] -> true
         | _ ->
-            List.for_all (fun c -> validate_value validators buf c value) constraints
+            try
+                List.for_all (fun c -> validate_value validators buf c value) constraints
+            with Bad_validator e -> let () = Buffer.add_string buf e in false
     in
     match validate_forall validators constraints value with
     | true ->
-- 
cgit v1.2.3


From c94254e4a5771d4cabc0d373210cdd3362501b9d Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Thu, 24 Oct 2024 11:04:39 -0500
Subject: T6718: inject environment variables required by certain validators

---
 src/value_checker.ml | 2 ++
 1 file changed, 2 insertions(+)

(limited to 'src')

diff --git a/src/value_checker.ml b/src/value_checker.ml
index d94f99d..9e6dae8 100644
--- a/src/value_checker.ml
+++ b/src/value_checker.ml
@@ -28,6 +28,8 @@ let validate_value dir buf value_constraint value =
             | None ->
                 Printf.sprintf "%s \'%s\' 2>&1" validator value
         in
+        let () = Unix.putenv "vyos_libexec_dir" "/usr/libexec/vyos" in
+        let () = Unix.putenv "vyos_validators_dir" "/usr/libexec/vyos/validators" in
         let chan = Unix.open_process_in cmd in
         let out = try CCIO.read_all chan with _ -> "" in
         let result = Unix.close_process_in chan in
-- 
cgit v1.2.3