Add path validation functionality.

4 files changed, 129 insertions, 14 deletions

diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index 8c42bd5..4cd124a 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -13,6 +13,8 @@ type t = ref_node_data Vytree.t
 
 exception Bad_interface_definition of string
 
+exception Validation_error of string
+
 let default_data = {
     node_type = Vytree.Other;
     constraints = [];
@@ -104,3 +106,53 @@ let load_from_xml reftree file =
     in
     let xml = Xml.parse_file file in
     xml_to_reftree xml reftree
+
+(* Validation function *)
+
+(* A path 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 rec validate_path validators node path =
+    let show_path p = Util.string_of_path (List.rev p) in
+    let rec aux node path acc =
+        let data = Vytree.data_of_node node in
+        match data.node_type with
+        | Vytree.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 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)))
+             | p :: ps -> raise (Validation_error (Printf.sprintf "Path %s is too long" (show_path acc))))
+        | Vytree.Tag ->
+            (match path with
+             | p :: p' :: ps ->
+                 if (Value_checker.validate_any validators 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 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))))
+        | Vytree.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 []
diff --git a/src/reference_tree.mli b/src/reference_tree.mli
index f588144..701adf0 100644
--- a/src/reference_tree.mli
+++ b/src/reference_tree.mli
@@ -9,8 +9,12 @@ type ref_node_data = {
     owner: string option;
 }
 
+exception Validation_error of string
+
 type t = ref_node_data Vytree.t
 
 val default_data : ref_node_data
 
 val load_from_xml : t -> string -> t
+
+val validate_path : (string, string) Hashtbl.t -> t -> string list -> string list * string option
diff --git a/test/data/interface_definition_sample.xml b/test/data/interface_definition_sample.xml
index b74a415..26f4c80 100644
--- a/test/data/interface_definition_sample.xml
+++ b/test/data/interface_definition_sample.xml
@@ -1,23 +1,34 @@
 <?xml version="1.0"?>
 <interfaceDefinition>
-  <node name="login" owner="login">
+  <node name="system">
     <children>
-      <tagNode name="user">
-        <properties>
-          <help>User name</help>
-          <constraint>
-            <regex>[a-z][a-zA-Z0-9]+</regex>
-          </constraint>
-          <constraintErrorMessage>User name must start with a letter and consist of letters and digits</constraintErrorMessage>
-        </properties>
+      <node name="login" owner="login">
         <children>
-          <leafNode name="full-name">
+          <tagNode name="user">
             <properties>
-              <help>User full name</help>
+              <help>User name</help>
+              <constraint>
+                <regex>[a-zA-Z][a-zA-Z0-9\-]+</regex>
+              </constraint>
+              <constraintErrorMessage>User name must start with a letter and consist of letters and digits</constraintErrorMessage>
             </properties>
-          </leafNode>
+            <children>
+              <leafNode name="full-name">
+                <properties>
+                  <help>User full name</help>
+                </properties>
+              </leafNode>
+            </children>
+          </tagNode>
         </children>
-      </tagNode>
+      </node>
+      <leafNode name="host-name">
+        <properties>
+          <constraint>
+            <regex>[a-zA-Z][a-zA-Z0-9\-]</regex>
+          </constraint>
+        </properties>
+      </leafNode>
     </children>
   </node>
 </interfaceDefinition>
diff --git a/test/reference_tree_test.ml b/test/reference_tree_test.ml
index 52e5a8d..8c969ab 100644
--- a/test/reference_tree_test.ml
+++ b/test/reference_tree_test.ml
@@ -1,14 +1,62 @@
 open OUnit2
 open Reference_tree
 
+let validators = Hashtbl.create 256
+let () = Hashtbl.add validators "anything" "true";
+         Hashtbl.add validators "nothing" "false"
+
+let raises_validation_error f =
+    try f (); false
+    with Validation_error _ -> true
+
 let test_load_valid_definition test_ctxt =
     let r = Vytree.make default_data "root" in
     let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
-    assert_equal (Vytree.list_children r) ["login"]
+    assert_equal (Vytree.list_children r) ["system"]
+
+(* Path validation tests *)
+let test_validate_path_leaf_valid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (validate_path validators r ["system"; "host-name"; "test"]) (["system"; "host-name"], Some "test")
+
+let test_validate_path_leaf_invalid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (raises_validation_error (fun () -> validate_path validators r ["system"; "host-name"; "1234"])) true
+
+let test_validate_path_leaf_incomplete test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (raises_validation_error (fun () -> validate_path validators r ["system"; "host-name"])) true
+
+let test_validate_path_tag_node_complete_valid test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (validate_path validators r ["system"; "login"; "user"; "test"; "full-name"; "test user"])
+                 (["system"; "login"; "user"; "test"; "full-name";], Some "test user")
+
+let test_validate_path_tag_node_invalid_name test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (raises_validation_error (fun () -> validate_path validators r ["system"; "login"; "user"; "999"; "full-name"; "test user"]))
+                 true
+
+let test_validate_path_tag_node_incomplete test_ctxt =
+    let r = Vytree.make default_data "root" in
+    let r = load_from_xml r (in_testdata_dir test_ctxt ["interface_definition_sample.xml"]) in
+    assert_equal (raises_validation_error (fun () -> validate_path validators r ["system"; "login"; "user"])) true
+
 
 let suite =
     "Util tests" >::: [
         "test_load_valid_definition" >:: test_load_valid_definition;
+        "test_validate_path_leaf_valid" >:: test_validate_path_leaf_valid;
+        "test_validate_path_leaf_invalid" >:: test_validate_path_leaf_invalid;
+        "test_validate_path_leaf_incomplete" >:: test_validate_path_leaf_incomplete;
+        "test_validate_path_tag_node_complete_valid" >:: test_validate_path_tag_node_complete_valid;
+        "test_validate_path_tag_node_invalid_name" >:: test_validate_path_tag_node_invalid_name;
+        "test_validate_path_tag_node_incomplete" >:: test_validate_path_tag_node_incomplete;
     ]
 
 let () =