Add logging of interface definition file loading.

Move the high level load_interface_definitions function from Reference_tree
to Startup.

5 files changed, 26 insertions, 14 deletions

diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index 8c8e515..45789eb 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -122,17 +122,6 @@ let load_from_xml reftree file =
     | Xml.File_not_found msg -> raise (Bad_interface_definition msg)
     | Xml.Error e -> raise (Bad_interface_definition (Xml.error e))
 
-let load_interface_definitions dir =
-    let relative_paths = FileUtil.ls dir in
-    let absolute_paths =
-        try Ok (List.map Util.absolute_path relative_paths)
-        with Sys_error no_dir_msg -> Error no_dir_msg
-    in
-    try match absolute_paths with
-        | Ok paths  -> Ok (List.fold_left load_from_xml default paths)
-        | Error msg -> Error msg
-    with Bad_interface_definition msg -> Error msg
-
 (* Validation function *)
 
 let has_illegal_characters name =
diff --git a/src/reference_tree.mli b/src/reference_tree.mli
index 6db696a..33813d5 100644
--- a/src/reference_tree.mli
+++ b/src/reference_tree.mli
@@ -14,6 +14,8 @@ type ref_node_data = {
     secret: bool;
 }
 
+exception Bad_interface_definition of string
+
 exception Validation_error of string
 
 type t = ref_node_data Vytree.t
@@ -24,8 +26,6 @@ val default : t
 
 val load_from_xml : t -> string -> t
 
-val load_interface_definitions : string -> (t, string) result
-
 val validate_path : string -> t -> string list -> string list * string option
 
 val is_multi : t -> string list -> bool
diff --git a/src/startup.ml b/src/startup.ml
index 69849e0..34c1127 100644
--- a/src/startup.ml
+++ b/src/startup.ml
@@ -5,6 +5,9 @@ let panic msg =
     Lwt_log.fatal msg |> Lwt.ignore_result;
     exit 1
 
+let log_info msg = Lwt_log.info msg |> Lwt.ignore_result; ()
+
+
 (** Setup the default logger *)
 let setup_logger daemonize log_file template =
     (** 
@@ -84,3 +87,21 @@ let load_config_failsafe main fallback =
             | Ok config -> config
             | Error msg -> panic (Printf.sprintf "Failed to load fallback config %s: %s, exiting" fallback msg)
         end
+
+(* Load interface definitions from a directory into a reference tree *)
+let load_interface_definitions dir =
+    let open Reference_tree in
+    let relative_paths = FileUtil.ls dir in
+    let absolute_paths =
+        try Ok (List.map Util.absolute_path relative_paths)
+        with Sys_error no_dir_msg -> Error no_dir_msg
+    in
+    let load_aux tree file =
+        log_info @@ Printf.sprintf "Loading interface definitions from %s" file;
+        load_from_xml tree file
+    in
+    try begin match absolute_paths with
+        | Ok paths  -> Ok (List.fold_left load_aux default paths)
+        | Error msg -> Error msg end
+    with Bad_interface_definition msg -> Error msg
+
diff --git a/src/startup.mli b/src/startup.mli
index 2191bdb..c32ddea 100644
--- a/src/startup.mli
+++ b/src/startup.mli
@@ -15,3 +15,5 @@ val create_server :
 val load_config : string -> (Config_tree.t, string) result
 
 val load_config_failsafe : string -> string -> Config_tree.t
+
+val load_interface_definitions : string -> (Reference_tree.t, string) result
diff --git a/src/vyconfd.ml b/src/vyconfd.ml
index 3f0c62b..81dd2aa 100644
--- a/src/vyconfd.ml
+++ b/src/vyconfd.ml
@@ -180,7 +180,7 @@ let main_loop basepath world () =
 
 let load_interface_definitions dir =
     let open Session in
-    let reftree = Reference_tree.load_interface_definitions dir in
+    let reftree = Startup.load_interface_definitions dir in
     match reftree with
     | Ok r -> r
     | Error s -> Startup.panic s