summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/reference_tree.ml11
-rw-r--r--src/reference_tree.mli4
-rw-r--r--src/startup.ml21
-rw-r--r--src/startup.mli2
-rw-r--r--src/vyconfd.ml2
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