summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/adapter/vyos1x_adapter.ml2
-rw-r--r--src/commit.ml238
-rw-r--r--src/commit.mli42
-rw-r--r--src/dune49
-rw-r--r--src/session.ml52
-rw-r--r--src/session.mli8
-rw-r--r--src/startup.ml31
-rw-r--r--src/startup.mli8
-rw-r--r--src/test_commit_data.ml30
-rw-r--r--src/validate.ml2
-rw-r--r--src/vycall_client.ml93
-rw-r--r--src/vycall_client.mli1
-rw-r--r--src/vycall_pbt.ml313
-rw-r--r--src/vycall_pbt.mli95
-rw-r--r--src/vycli.ml12
-rw-r--r--src/vyconf_client.ml30
-rw-r--r--src/vyconf_client.mli28
-rw-r--r--src/vyconf_config.ml9
-rw-r--r--src/vyconf_config.mli3
-rw-r--r--src/vyconf_pbt.ml222
-rw-r--r--src/vyconf_pbt.mli87
-rw-r--r--src/vyconfd.ml106
22 files changed, 1306 insertions, 155 deletions
diff --git a/src/adapter/vyos1x_adapter.ml b/src/adapter/vyos1x_adapter.ml
index dedb2cd..d4dbac7 100644
--- a/src/adapter/vyos1x_adapter.ml
+++ b/src/adapter/vyos1x_adapter.ml
@@ -44,7 +44,7 @@ let delete_path_reversed handle path _len =
let path = List.rev path in
cstore_delete_path handle path
-module VC = Client.Vyconf_client_session
+module VC = Vyconfd_client.Vyconf_client_session
let get_sockname =
"/var/run/vyconfd.sock"
diff --git a/src/commit.ml b/src/commit.ml
new file mode 100644
index 0000000..19c9844
--- /dev/null
+++ b/src/commit.ml
@@ -0,0 +1,238 @@
+module VT = Vyos1x.Vytree
+module CT = Vyos1x.Config_tree
+module CD = Vyos1x.Config_diff
+module RT = Vyos1x.Reference_tree
+
+exception Commit_error of string
+
+type tree_source = DELETE | ADD
+
+let tree_source_to_yojson = function
+ | DELETE -> `String "DELETE"
+ | ADD -> `String "ADD"
+
+type status = {
+ success : bool;
+ out : string;
+} [@@deriving to_yojson]
+
+type node_data = {
+ script_name: string;
+ priority: int;
+ tag_value: string option;
+ arg_value: string option;
+ path: string list;
+ source: tree_source;
+ reply: status option;
+} [@@deriving to_yojson]
+
+
+let default_node_data = {
+ script_name = "";
+ priority = 0;
+ tag_value = None;
+ arg_value = None;
+ path = [];
+ source = ADD;
+ reply = None;
+}
+
+type commit_data = {
+ session_id: string;
+ dry_run: bool;
+ atomic: bool;
+ background: bool;
+ init: status option;
+ node_list: node_data list;
+ config_diff: CT.t;
+ config_result: CT.t;
+ result : status;
+} [@@deriving to_yojson]
+
+let default_commit_data = {
+ session_id = "";
+ dry_run = false;
+ atomic = false;
+ background = false;
+ init = None;
+ node_list = [];
+ config_diff = CT.default;
+ config_result = CT.default;
+ result = { success = true; out = ""; };
+}
+
+let fail_status msg =
+ { success=false; out=msg }
+
+let lex_order c1 c2 =
+ let c = Vyos1x.Util.lex_order c1.path c2.path in
+ match c with
+ | 0 ->
+ begin
+ match c1.tag_value, c2.tag_value with
+ | Some t1, Some t2 -> Vyos1x.Util.lexical_numeric_compare t1 t2
+ | _ -> 0
+ end
+ | _ as a -> a
+
+module CI = struct
+ type t = node_data
+ let compare a b =
+ match compare a.priority b.priority with
+ | 0 -> lex_order a b
+ | _ as c -> c
+end
+module CS = Set.Make(CI)
+
+let owner_args_from_data p o =
+ let oa = Pcre.split o in
+ let owner = FilePath.basename (List.nth oa 0) in
+ if List.length oa < 2 then owner, None
+ else
+ let var = List.nth oa 1 in
+ let res = Pcre.extract_all ~pat:"\\.\\./" var in
+ let var_pos = Array.length res in
+ let arg_value = Vyos1x.Util.get_last_n p var_pos
+ in owner, arg_value
+
+let add_tag_instance cd cs tv =
+ CS.add { cd with tag_value = Some tv; } cs
+
+let get_node_data rt ct src (path, cs') t =
+ if Vyos1x.Util.is_empty path then
+ (path, cs')
+ else
+ if (VT.name_of_node t) = "" then
+ (path, cs')
+ else
+ let rpath = List.rev path in
+ (* the following is critical to avoid redundant calculations for owner
+ of a tag node, quadratic in the number of tag node values *)
+ if CT.is_tag_value ct rpath then
+ (path, cs')
+ else
+ let rt_path = RT.refpath rt rpath in
+ let priority =
+ match RT.get_priority rt rt_path with
+ | None -> 0
+ | Some s -> int_of_string s
+ in
+ let owner = RT.get_owner rt rt_path in
+ match owner with
+ | None -> (path, cs')
+ | Some owner_str ->
+ let (own, arg) = owner_args_from_data rpath owner_str in
+ let c_data = { default_node_data with
+ script_name = own;
+ priority = priority;
+ arg_value = arg;
+ path = rpath;
+ source = src; }
+ in
+ let tag_values =
+ match RT.is_tag rt rt_path with
+ | false -> []
+ | true -> VT.list_children t
+ in
+ let cs =
+ match tag_values with
+ | [] -> CS.add c_data cs'
+ | _ -> List.fold_left (add_tag_instance c_data) cs' tag_values
+ in (path, cs)
+
+let get_commit_set rt ct src =
+ snd (VT.fold_tree_with_path (get_node_data rt ct src) ([], CS.empty) ct)
+
+(* for initial consistency with the legacy ordering of delete and add
+ queues, enforce the following subtlety: if a path in the delete tree is
+ an owner node, or the tag value thereof, insert in the delete queue; if
+ the path is in a subtree, however, insert in the add queue - cf. T5492
+*)
+let legacy_order del_t a b =
+ let shift c_data (c_del, c_add) =
+ let path =
+ match c_data.tag_value with
+ | None -> c_data.path
+ | Some v -> c_data.path @ [v]
+ in
+ match VT.is_terminal_path del_t path with
+ | false -> CS.remove c_data c_del, CS.add c_data c_add
+ | true -> c_del, c_add
+ in
+ CS.fold shift a (a, b)
+
+let calculate_priority_lists rt diff =
+ let del_tree = CD.get_tagged_delete_tree diff in
+ let add_tree = CT.get_subtree diff ["add"] in
+ let cs_del' = get_commit_set rt del_tree DELETE in
+ let cs_add' = get_commit_set rt add_tree ADD in
+ let cs_del, cs_add = legacy_order del_tree cs_del' cs_add' in
+ List.rev (CS.elements cs_del), CS.elements cs_add
+
+(* The base config_result is the intersection of running and proposed
+ configs:
+ on success, added paths are added; deleted paths are ignored
+ on failure, deleted paths are added back in, added paths ignored
+ *)
+let config_result_update c_data n_data =
+ match n_data.reply with
+ | None -> c_data (* already exluded in calling function *)
+ | Some r ->
+ match r.success, n_data.source with
+ | true, ADD ->
+ let add = CT.get_subtree c_data.config_diff ["add"] in
+ let add_tree = CD.clone add (CT.default) n_data.path in
+ let config = CD.tree_union add_tree c_data.config_result in
+ let result =
+ { success = c_data.result.success && true;
+ out = c_data.result.out ^ r.out; }
+ in
+ { c_data with config_result = config; result = result; }
+ | false, DELETE ->
+ let del = CT.get_subtree c_data.config_diff ["del"] in
+ let add_tree = CD.clone del (CT.default) n_data.path in
+ let config = CD.tree_union add_tree c_data.config_result in
+ let result =
+ { success = c_data.result.success && false;
+ out = c_data.result.out ^ r.out; }
+ in
+ { c_data with config_result = config; result = result; }
+ | true, DELETE ->
+ let result =
+ { success = c_data.result.success && true;
+ out = c_data.result.out ^ r.out; }
+ in
+ { c_data with result = result; }
+ | false, ADD ->
+ let result =
+ { success = c_data.result.success && false;
+ out = c_data.result.out ^ r.out; }
+ in
+ { c_data with result = result; }
+
+
+let commit_update c_data =
+ match c_data.init with
+ | None ->
+ { default_commit_data with
+ init=Some (fail_status "commitd failure: no init status provided")
+ }
+ | Some _ ->
+ let func acc_data nd =
+ match nd.reply with
+ | None ->
+ { default_commit_data with
+ init=Some (fail_status"commitd failure: no reply status provided")
+ }
+ | Some _ -> config_result_update acc_data nd
+ in List.fold_left func c_data c_data.node_list
+
+let make_commit_data ?(dry_run=false) rt at wt id =
+ let diff = CD.diff_tree [] at wt in
+ let del_list, add_list = calculate_priority_lists rt diff in
+ { default_commit_data with
+ session_id = id;
+ dry_run = dry_run;
+ config_diff = diff;
+ config_result = CT.get_subtree diff ["inter"];
+ node_list = del_list @ add_list; }
diff --git a/src/commit.mli b/src/commit.mli
new file mode 100644
index 0000000..01022ec
--- /dev/null
+++ b/src/commit.mli
@@ -0,0 +1,42 @@
+type tree_source = DELETE | ADD
+
+type status = {
+ success : bool;
+ out : string;
+}
+
+type node_data = {
+ script_name: string;
+ priority: int;
+ tag_value: string option;
+ arg_value: string option;
+ path: string list;
+ source: tree_source;
+ reply: status option;
+} [@@deriving to_yojson]
+
+type commit_data = {
+ session_id: string;
+ dry_run: bool;
+ atomic: bool;
+ background: bool;
+ init: status option;
+ node_list: node_data list;
+ config_diff: Vyos1x.Config_tree.t;
+ config_result: Vyos1x.Config_tree.t;
+ result: status;
+} [@@deriving to_yojson]
+
+exception Commit_error of string
+
+val tree_source_to_yojson : tree_source -> [> `String of string ]
+
+val default_node_data : node_data
+
+val default_commit_data : commit_data
+
+val make_commit_data : ?dry_run:bool -> Vyos1x.Reference_tree.t -> Vyos1x.Config_tree.t -> Vyos1x.Config_tree.t -> string -> commit_data
+
+val calculate_priority_lists : Vyos1x.Reference_tree.t -> Vyos1x.Config_tree.t -> node_data list * node_data list
+
+val commit_update : commit_data -> commit_data
diff --git a/src/dune b/src/dune
index 2fef6cc..63e1167 100644
--- a/src/dune
+++ b/src/dune
@@ -4,27 +4,40 @@
(name vyconf_connect)
(public_name vyconf.vyconf-connect)
(modules vyconf_pbt message)
- (libraries lwt lwt.unix lwt_log lwt_ppx ocaml-protoc fileutils ppx_deriving_yojson)
- (preprocess (pps lwt_ppx ppx_deriving_yojson)))
+ (libraries lwt lwt.unix lwt_log lwt_ppx ocaml-protoc ocplib-endian)
+ (preprocess (pps lwt_ppx)))
+
+(library
+ (name vycall_message)
+ (public_name vyconf.vycall-message)
+ (modules vycall_pbt)
+ (libraries ocaml-protoc))
+
+(library
+ (name commitd_client)
+ (public_name vyconf.vycall-client)
+ (modules vycall_client commit)
+ (libraries vyos1x-config vycall_message lwt lwt.unix lwt_log lwt_ppx ocplib-endian)
+ (preprocess (pps lwt_ppx)))
(library
(name vyconfd_config)
- (modules vyconf_config session directories defaults)
- (libraries vyos1x-config vyconf_connect toml sha ppx_deriving.show)
- (preprocess (pps ppx_deriving.show ppx_deriving_yojson)))
+ (public_name vyconf.vyconfd-config)
+ (modules vyconf_config startup session directories defaults)
+ (libraries vyos1x-config vyconf_connect commitd_client toml sha ppx_deriving.show yojson ppx_deriving_yojson)
+ (preprocess (pps lwt_ppx ppx_deriving.show ppx_deriving_yojson)))
(library
- (name client)
+ (name vyconfd_client)
(public_name vyconf.vyconf-client)
(modules vyconf_client vyconf_client_session)
- (libraries vyos1x-config vyconf_connect lwt lwt.unix lwt_log lwt_ppx ocaml-protoc toml sha
- yojson ppx_deriving.show ppx_deriving_yojson)
- (preprocess (pps lwt_ppx ppx_deriving.show ppx_deriving_yojson)))
+ (libraries vyos1x-config vyconf_connect lwt lwt.unix lwt_log lwt_ppx)
+ (preprocess (pps lwt_ppx)))
(executable
(name vyconfd)
(public_name vyconfd)
- (modules vyconfd startup version)
+ (modules vyconfd version)
(libraries vyos1x-config vyconfd_config vyconf_connect)
(preprocess (pps lwt_ppx)))
@@ -32,17 +45,16 @@
(name vycli)
(public_name vycli)
(modules vycli)
- (libraries client)
+ (libraries vyconfd_client)
(preprocess (pps lwt_ppx)))
(executable
(name validate)
(public_name validate)
(modules validate)
- (libraries client))
+ (libraries vyconfd_client))
(rule
- (alias protoc)
(mode promote)
(targets vyconf_pbt.ml vyconf_pbt.mli)
(action
@@ -53,6 +65,17 @@
(run mv src/vyconf.ml src/vyconf_pbt.ml)
(run mv src/vyconf.mli src/vyconf_pbt.mli)))))
+(rule
+ (mode promote)
+ (targets vycall_pbt.ml vycall_pbt.mli)
+ (action
+ (chdir
+ %{project_root}
+ (progn
+ (run ocaml-protoc --ml_out src data/vycall.proto)
+ (run mv src/vycall.ml src/vycall_pbt.ml)
+ (run mv src/vycall.mli src/vycall_pbt.mli)))))
+
(library
(name vyos1x_adapter)
(public_name vyconf.vyos1x-adapter)
diff --git a/src/session.ml b/src/session.ml
index 567f999..24a8153 100644
--- a/src/session.ml
+++ b/src/session.ml
@@ -1,4 +1,5 @@
module CT = Vyos1x.Config_tree
+module CD = Vyos1x.Config_diff
module VT = Vyos1x.Vytree
module RT = Vyos1x.Reference_tree
module D = Directories
@@ -69,6 +70,21 @@ let validate w _s path =
RT.validate_path D.(w.dirs.validators) w.reference_tree path
with RT.Validation_error x -> raise (Session_error x)
+let validate_tree w' t =
+ let validate_path w out path =
+ let res =
+ try
+ RT.validate_path D.(w.dirs.validators) w.reference_tree path;
+ out
+ with RT.Validation_error x -> out ^ x
+ in res
+ in
+ let paths = CT.value_paths_of_tree t in
+ let out = List.fold_left (validate_path w') "" paths in
+ match out with
+ | "" -> ()
+ | _ -> raise (Session_error out)
+
let split_path w _s path =
RT.split_path w.reference_tree path
@@ -78,16 +94,48 @@ let set w s path =
let refpath = RT.refpath w.reference_tree path in
let value_behaviour = if RT.is_multi w.reference_tree refpath then CT.AddValue else CT.ReplaceValue in
let op = CfgSet (path, value, value_behaviour) in
- let config = apply_cfg_op op s.proposed_config in
+ let config =
+ try
+ apply_cfg_op op s.proposed_config |>
+ (fun c -> RT.set_tag_data w.reference_tree c path) |>
+ (fun c -> RT.set_leaf_data w.reference_tree c path)
+ with CT.Useless_set ->
+ raise (Session_error (Printf.sprintf "Useless set, path: %s" (string_of_op op)))
+ in
{s with proposed_config=config; changeset=(op :: s.changeset)}
let delete w s path =
- let _ = validate w s path in
let path, value = split_path w s path in
let op = CfgDelete (path, value) in
let config = apply_cfg_op op s.proposed_config in
{s with proposed_config=config; changeset=(op :: s.changeset)}
+let discard w s =
+ {s with proposed_config=w.running_config}
+
+let session_changed w s =
+ (* structural equality test requires consistent ordering, which is
+ * practised, but may be unreliable; test actual difference
+ *)
+ let diff = CD.diff_tree [] w.running_config s.proposed_config in
+ let add_tree = CT.get_subtree diff ["add"] in
+ let del_tree = CT.get_subtree diff ["del"] in
+ (del_tree <> CT.default) || (add_tree <> CT.default)
+
+let load w s file =
+ let ct = Vyos1x.Config_file.load_config file in
+ match ct with
+ | Error e -> raise (Session_error (Printf.sprintf "Error loading config: %s" e))
+ | Ok config ->
+ validate_tree w config; {s with proposed_config=config;}
+
+let save w s file =
+ let ct = w.running_config in
+ let res = Vyos1x.Config_file.save_config ct file in
+ match res with
+ | Error e -> raise (Session_error (Printf.sprintf "Error saving config: %s" e))
+ | Ok () -> s
+
let get_value w s path =
if not (VT.exists s.proposed_config path) then
raise (Session_error ("Config path does not exist"))
diff --git a/src/session.mli b/src/session.mli
index 2166a80..9b8c5a0 100644
--- a/src/session.mli
+++ b/src/session.mli
@@ -32,6 +32,14 @@ val set : world -> session_data -> string list -> session_data
val delete : world -> session_data -> string list -> session_data
+val discard : world -> session_data -> session_data
+
+val session_changed : world -> session_data -> bool
+
+val load : world -> session_data -> string -> session_data
+
+val save : world -> session_data -> string -> session_data
+
val get_value : world -> session_data -> string list -> string
val get_values : world -> session_data -> string list -> string list
diff --git a/src/startup.ml b/src/startup.ml
index db0d719..20882cb 100644
--- a/src/startup.ml
+++ b/src/startup.ml
@@ -33,7 +33,7 @@ let setup_logger daemonize log_file template =
(** Load the config file or panic if it fails *)
let load_daemon_config path =
- let result = Vyconfd_config.Vyconf_config.load path in
+ let result = Vyconf_config.load path in
match result with
| Ok cfg -> cfg
| Error err ->
@@ -41,13 +41,13 @@ let load_daemon_config path =
(** Check if appliance directories exist and panic if they don't *)
let check_dirs dirs =
- let res = Vyconfd_config.Directories.test dirs in
+ let res = Directories.test dirs in
match res with
| Ok _ -> ()
| Error err -> panic err
let check_validators_dir dirs =
- let res = Vyconfd_config.Directories.test_validators_dir dirs in
+ let res = Directories.test_validators_dir dirs in
match res with
| Ok _ -> ()
| Error err -> panic err
@@ -78,36 +78,16 @@ let create_server accept_connection sock =
Lwt_unix.accept sock >>= accept_connection >>= serve
in serve
-(** Load the appliance configuration file *)
-let load_config file =
- try
- let chan = open_in file in
- let s = really_input_string chan (in_channel_length chan) in
- let config = Vyos1x.Parser.from_string s in
- Ok config
- with
- | Sys_error msg -> Error msg
- | Vyos1x.Util.Syntax_error (opt, msg) ->
- begin
- match opt with
- | None ->
- let out = Printf.sprintf "Parse error: %s\n" msg
- in Error out
- | Some (line, pos) ->
- let out = Printf.sprintf "Parse error: %s line %d pos %d\n" msg line pos
- in Error out
- end
-
(** Load the appliance configuration file or the fallback config *)
let load_config_failsafe main fallback =
- let res = load_config main in
+ let res = Vyos1x.Config_file.load_config main in
match res with
| Ok config -> config
| Error msg ->
Lwt_log.error
(Printf.sprintf "Failed to load config file %s: %s. Attempting to load fallback config %s" main msg fallback) |>
Lwt.ignore_result;
- let res = load_config fallback in
+ let res = Vyos1x.Config_file.load_config fallback in
begin
match res with
| Ok config -> config
@@ -136,5 +116,6 @@ module I = Vyos1x.Internal.Make(Vyos1x.Reference_tree)
let read_reference_tree file =
try
let reftree = I.read_internal file in
+ log_info @@ Printf.sprintf "Reading interface definitions from %s" file;
Ok reftree
with Sys_error msg -> Error msg
diff --git a/src/startup.mli b/src/startup.mli
index 84fb99e..1415953 100644
--- a/src/startup.mli
+++ b/src/startup.mli
@@ -2,11 +2,11 @@ val panic : string -> 'a
val setup_logger : bool -> string option -> Lwt_log.template -> unit Lwt.t
-val load_daemon_config : string -> Vyconfd_config.Vyconf_config.t
+val load_daemon_config : string -> Vyconf_config.t
-val check_dirs : Vyconfd_config.Directories.t -> unit
+val check_dirs : Directories.t -> unit
-val check_validators_dir : Vyconfd_config.Directories.t -> unit
+val check_validators_dir : Directories.t -> unit
val create_socket : string -> Lwt_unix.file_descr Lwt.t
@@ -14,8 +14,6 @@ val create_server :
(Lwt_unix.file_descr * Lwt_unix.sockaddr -> unit Lwt.t) ->
Lwt_unix.file_descr -> unit -> 'a Lwt.t
-val load_config : string -> (Vyos1x.Config_tree.t, string) result
-
val load_config_failsafe : string -> string -> Vyos1x.Config_tree.t
val load_interface_definitions : string -> (Vyos1x.Reference_tree.t, string) result
diff --git a/src/test_commit_data.ml b/src/test_commit_data.ml
new file mode 100644
index 0000000..81b6c19
--- /dev/null
+++ b/src/test_commit_data.ml
@@ -0,0 +1,30 @@
+module CT = Vyos1x.Config_tree
+module FP = FilePath
+
+let active_config_file = ref ""
+let working_config_file = ref ""
+
+let usage = "Usage: " ^ Sys.argv.(0) ^ " [options]"
+
+let args = [
+ ("--running-config", Arg.String (fun s -> active_config_file:= s), "running config file");
+ ("--proposed-config", Arg.String (fun s -> working_config_file := s), "proposed config file");
+ ]
+
+let parse_ct file_name =
+ match file_name with
+ | "" -> CT.make ""
+ | _ ->
+ let ic = open_in file_name in
+ let s = really_input_string ic (in_channel_length ic) in
+ let ct = Vyos1x.Parser.from_string s in
+ close_in ic; ct
+
+let () =
+ let () = Arg.parse args (fun _ -> ()) usage in
+ let af = !active_config_file in
+ let wf = !working_config_file in
+ let at = parse_ct af in
+ let wt = parse_ct wf in
+ let out = Vyconfd_config.Commit.show_commit_data at wt
+ in print_endline out
diff --git a/src/validate.ml b/src/validate.ml
index 7b3b596..875bc7a 100644
--- a/src/validate.ml
+++ b/src/validate.ml
@@ -1,4 +1,4 @@
-open Client.Vyconf_client_session
+open Vyconfd_client.Vyconf_client_session
let path_opt = ref ""
diff --git a/src/vycall_client.ml b/src/vycall_client.ml
new file mode 100644
index 0000000..11bbe3f
--- /dev/null
+++ b/src/vycall_client.ml
@@ -0,0 +1,93 @@
+(* send commit data to Python commit daemon *)
+
+open Vycall_message.Vycall_pbt
+open Commit
+
+module CT = Vyos1x.Config_tree
+module IC = Vyos1x.Internal.Make(CT)
+module FP = FilePath
+
+type t = {
+ ic: Lwt_io.input Lwt_io.channel;
+ oc: Lwt_io.output Lwt_io.channel;
+}
+
+(* explicit translation between commit data and commit protobuf
+ * to keep the commit data opaque to protobuf message definition.
+ * The commit daemon updates the (subset of) commit data with
+ * results of script execution in init/reply fields.
+ *)
+let node_data_to_call nd =
+ { script_name = nd.script_name;
+ tag_value = nd.tag_value;
+ arg_value = nd.arg_value;
+ reply = None
+ }
+
+let call_to_node_data ((c: call), (nd: node_data)) =
+ match c.reply with
+ | None -> nd
+ | Some r -> { nd with reply = Some { success = r.success; out = r.out }}
+
+let commit_data_to_commit_proto cd =
+ { session_id = cd.session_id;
+ dry_run = cd.dry_run;
+ atomic = cd.atomic;
+ background = cd.background;
+ init = None;
+ calls = List.map node_data_to_call cd.node_list;
+ }
+
+let commit_proto_to_commit_data (c: commit) (cd: commit_data) =
+ match c.init with
+ | None -> cd
+ | Some i ->
+ { cd with init = Some { success = i.success; out = i.out };
+ node_list =
+ List.map call_to_node_data (List.combine c.calls cd.node_list);
+ }
+
+(* read/write message from/to socket *)
+let call_write oc msg =
+ let length = Bytes.length msg in
+ let length' = Int32.of_int length in
+ if length' < 0l then failwith (Printf.sprintf "Bad message length: %d" length) else
+ let header = Bytes.create 4 in
+ let () = EndianBytes.BigEndian.set_int32 header 0 length' in
+ let%lwt () = Lwt_io.write_from_exactly oc header 0 4 in
+ Lwt_io.write_from_exactly oc msg 0 length
+
+let call_read ic =
+ let header = Bytes.create 4 in
+ let%lwt () = Lwt_io.read_into_exactly ic header 0 4 in
+ let length = EndianBytes.BigEndian.get_int32 header 0 |> Int32.to_int in
+ if length < 0 then failwith (Printf.sprintf "Bad message length: %d" length) else
+ let buffer = Bytes.create length in
+ let%lwt () = Lwt_io.read_into_exactly ic buffer 0 length in
+ Lwt.return buffer
+
+(* encode/decode commit data *)
+let do_call client request =
+ let enc = Pbrt.Encoder.create () in
+ let () = encode_pb_commit request enc in
+ let msg = Pbrt.Encoder.to_bytes enc in
+ let%lwt () = call_write client.oc msg in
+ let%lwt resp = call_read client.ic in
+ decode_pb_commit (Pbrt.Decoder.of_bytes resp) |> Lwt.return
+
+(* socket management and commit callback *)
+let create sockfile =
+ let open Lwt_unix in
+ let sock = socket PF_UNIX SOCK_STREAM 0 in
+ let%lwt () = connect sock (ADDR_UNIX sockfile) in
+ let ic = Lwt_io.of_fd ~mode:Lwt_io.Input sock in
+ let oc = Lwt_io.of_fd ~mode:Lwt_io.Output sock in
+ Lwt.return { ic=ic; oc=oc; }
+
+let do_commit commit_data =
+ let session = commit_data_to_commit_proto commit_data in
+ let sockfile = "/run/vyos-commitd.sock" in
+ let%lwt client = create sockfile in
+ let%lwt resp = do_call client session in
+ let%lwt () = Lwt_io.close client.oc in
+ Lwt.return(commit_proto_to_commit_data resp commit_data)
diff --git a/src/vycall_client.mli b/src/vycall_client.mli
new file mode 100644
index 0000000..fe19231
--- /dev/null
+++ b/src/vycall_client.mli
@@ -0,0 +1 @@
+val do_commit : Commit.commit_data -> Commit.commit_data Lwt.t
diff --git a/src/vycall_pbt.ml b/src/vycall_pbt.ml
new file mode 100644
index 0000000..715c453
--- /dev/null
+++ b/src/vycall_pbt.ml
@@ -0,0 +1,313 @@
+[@@@ocaml.warning "-27-30-39-44"]
+
+type status = {
+ success : bool;
+ out : string;
+}
+
+type call = {
+ script_name : string;
+ tag_value : string option;
+ arg_value : string option;
+ reply : status option;
+}
+
+type commit = {
+ session_id : string;
+ dry_run : bool;
+ atomic : bool;
+ background : bool;
+ init : status option;
+ calls : call list;
+}
+
+let rec default_status
+ ?success:((success:bool) = false)
+ ?out:((out:string) = "")
+ () : status = {
+ success;
+ out;
+}
+
+let rec default_call
+ ?script_name:((script_name:string) = "")
+ ?tag_value:((tag_value:string option) = None)
+ ?arg_value:((arg_value:string option) = None)
+ ?reply:((reply:status option) = None)
+ () : call = {
+ script_name;
+ tag_value;
+ arg_value;
+ reply;
+}
+
+let rec default_commit
+ ?session_id:((session_id:string) = "")
+ ?dry_run:((dry_run:bool) = false)
+ ?atomic:((atomic:bool) = false)
+ ?background:((background:bool) = false)
+ ?init:((init:status option) = None)
+ ?calls:((calls:call list) = [])
+ () : commit = {
+ session_id;
+ dry_run;
+ atomic;
+ background;
+ init;
+ calls;
+}
+
+type status_mutable = {
+ mutable success : bool;
+ mutable out : string;
+}
+
+let default_status_mutable () : status_mutable = {
+ success = false;
+ out = "";
+}
+
+type call_mutable = {
+ mutable script_name : string;
+ mutable tag_value : string option;
+ mutable arg_value : string option;
+ mutable reply : status option;
+}
+
+let default_call_mutable () : call_mutable = {
+ script_name = "";
+ tag_value = None;
+ arg_value = None;
+ reply = None;
+}
+
+type commit_mutable = {
+ mutable session_id : string;
+ mutable dry_run : bool;
+ mutable atomic : bool;
+ mutable background : bool;
+ mutable init : status option;
+ mutable calls : call list;
+}
+
+let default_commit_mutable () : commit_mutable = {
+ session_id = "";
+ dry_run = false;
+ atomic = false;
+ background = false;
+ init = None;
+ calls = [];
+}
+
+[@@@ocaml.warning "-27-30-39"]
+
+(** {2 Formatters} *)
+
+let rec pp_status fmt (v:status) =
+ let pp_i fmt () =
+ Pbrt.Pp.pp_record_field ~first:true "success" Pbrt.Pp.pp_bool fmt v.success;
+ Pbrt.Pp.pp_record_field ~first:false "out" Pbrt.Pp.pp_string fmt v.out;
+ in
+ Pbrt.Pp.pp_brk pp_i fmt ()
+
+let rec pp_call fmt (v:call) =
+ let pp_i fmt () =
+ Pbrt.Pp.pp_record_field ~first:true "script_name" Pbrt.Pp.pp_string fmt v.script_name;
+ Pbrt.Pp.pp_record_field ~first:false "tag_value" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.tag_value;
+ Pbrt.Pp.pp_record_field ~first:false "arg_value" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.arg_value;
+ Pbrt.Pp.pp_record_field ~first:false "reply" (Pbrt.Pp.pp_option pp_status) fmt v.reply;
+ in
+ Pbrt.Pp.pp_brk pp_i fmt ()
+
+let rec pp_commit fmt (v:commit) =
+ let pp_i fmt () =
+ Pbrt.Pp.pp_record_field ~first:true "session_id" Pbrt.Pp.pp_string fmt v.session_id;
+ Pbrt.Pp.pp_record_field ~first:false "dry_run" Pbrt.Pp.pp_bool fmt v.dry_run;
+ Pbrt.Pp.pp_record_field ~first:false "atomic" Pbrt.Pp.pp_bool fmt v.atomic;
+ Pbrt.Pp.pp_record_field ~first:false "background" Pbrt.Pp.pp_bool fmt v.background;
+ Pbrt.Pp.pp_record_field ~first:false "init" (Pbrt.Pp.pp_option pp_status) fmt v.init;
+ Pbrt.Pp.pp_record_field ~first:false "calls" (Pbrt.Pp.pp_list pp_call) fmt v.calls;
+ in
+ Pbrt.Pp.pp_brk pp_i fmt ()
+
+[@@@ocaml.warning "-27-30-39"]
+
+(** {2 Protobuf Encoding} *)
+
+let rec encode_pb_status (v:status) encoder =
+ Pbrt.Encoder.bool v.success encoder;
+ Pbrt.Encoder.key 1 Pbrt.Varint encoder;
+ Pbrt.Encoder.string v.out encoder;
+ Pbrt.Encoder.key 2 Pbrt.Bytes encoder;
+ ()
+
+let rec encode_pb_call (v:call) encoder =
+ Pbrt.Encoder.string v.script_name encoder;
+ Pbrt.Encoder.key 1 Pbrt.Bytes encoder;
+ begin match v.tag_value with
+ | Some x ->
+ Pbrt.Encoder.string x encoder;
+ Pbrt.Encoder.key 2 Pbrt.Bytes encoder;
+ | None -> ();
+ end;
+ begin match v.arg_value with
+ | Some x ->
+ Pbrt.Encoder.string x encoder;
+ Pbrt.Encoder.key 3 Pbrt.Bytes encoder;
+ | None -> ();
+ end;
+ begin match v.reply with
+ | Some x ->
+ Pbrt.Encoder.nested encode_pb_status x encoder;
+ Pbrt.Encoder.key 4 Pbrt.Bytes encoder;
+ | None -> ();
+ end;
+ ()
+
+let rec encode_pb_commit (v:commit) encoder =
+ Pbrt.Encoder.string v.session_id encoder;
+ Pbrt.Encoder.key 1 Pbrt.Bytes encoder;
+ Pbrt.Encoder.bool v.dry_run encoder;
+ Pbrt.Encoder.key 4 Pbrt.Varint encoder;
+ Pbrt.Encoder.bool v.atomic encoder;
+ Pbrt.Encoder.key 5 Pbrt.Varint encoder;
+ Pbrt.Encoder.bool v.background encoder;
+ Pbrt.Encoder.key 6 Pbrt.Varint encoder;
+ begin match v.init with
+ | Some x ->
+ Pbrt.Encoder.nested encode_pb_status x encoder;
+ Pbrt.Encoder.key 7 Pbrt.Bytes encoder;
+ | None -> ();
+ end;
+ Pbrt.List_util.rev_iter_with (fun x encoder ->
+ Pbrt.Encoder.nested encode_pb_call x encoder;
+ Pbrt.Encoder.key 8 Pbrt.Bytes encoder;
+ ) v.calls encoder;
+ ()
+
+[@@@ocaml.warning "-27-30-39"]
+
+(** {2 Protobuf Decoding} *)
+
+let rec decode_pb_status d =
+ let v = default_status_mutable () in
+ let continue__= ref true in
+ let out_is_set = ref false in
+ let success_is_set = ref false in
+ while !continue__ do
+ match Pbrt.Decoder.key d with
+ | None -> (
+ ); continue__ := false
+ | Some (1, Pbrt.Varint) -> begin
+ v.success <- Pbrt.Decoder.bool d; success_is_set := true;
+ end
+ | Some (1, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(status), field(1)" pk
+ | Some (2, Pbrt.Bytes) -> begin
+ v.out <- Pbrt.Decoder.string d; out_is_set := true;
+ end
+ | Some (2, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(status), field(2)" pk
+ | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
+ done;
+ begin if not !out_is_set then Pbrt.Decoder.missing_field "out" end;
+ begin if not !success_is_set then Pbrt.Decoder.missing_field "success" end;
+ ({
+ success = v.success;
+ out = v.out;
+ } : status)
+
+let rec decode_pb_call d =
+ let v = default_call_mutable () in
+ let continue__= ref true in
+ let script_name_is_set = ref false in
+ while !continue__ do
+ match Pbrt.Decoder.key d with
+ | None -> (
+ ); continue__ := false
+ | Some (1, Pbrt.Bytes) -> begin
+ v.script_name <- Pbrt.Decoder.string d; script_name_is_set := true;
+ end
+ | Some (1, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(call), field(1)" pk
+ | Some (2, Pbrt.Bytes) -> begin
+ v.tag_value <- Some (Pbrt.Decoder.string d);
+ end
+ | Some (2, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(call), field(2)" pk
+ | Some (3, Pbrt.Bytes) -> begin
+ v.arg_value <- Some (Pbrt.Decoder.string d);
+ end
+ | Some (3, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(call), field(3)" pk
+ | Some (4, Pbrt.Bytes) -> begin
+ v.reply <- Some (decode_pb_status (Pbrt.Decoder.nested d));
+ end
+ | Some (4, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(call), field(4)" pk
+ | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
+ done;
+ begin if not !script_name_is_set then Pbrt.Decoder.missing_field "script_name" end;
+ ({
+ script_name = v.script_name;
+ tag_value = v.tag_value;
+ arg_value = v.arg_value;
+ reply = v.reply;
+ } : call)
+
+let rec decode_pb_commit d =
+ let v = default_commit_mutable () in
+ let continue__= ref true in
+ let background_is_set = ref false in
+ let atomic_is_set = ref false in
+ let dry_run_is_set = ref false in
+ let session_id_is_set = ref false in
+ while !continue__ do
+ match Pbrt.Decoder.key d with
+ | None -> (
+ v.calls <- List.rev v.calls;
+ ); continue__ := false
+ | Some (1, Pbrt.Bytes) -> begin
+ v.session_id <- Pbrt.Decoder.string d; session_id_is_set := true;
+ end
+ | Some (1, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(commit), field(1)" pk
+ | Some (4, Pbrt.Varint) -> begin
+ v.dry_run <- Pbrt.Decoder.bool d; dry_run_is_set := true;
+ end
+ | Some (4, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(commit), field(4)" pk
+ | Some (5, Pbrt.Varint) -> begin
+ v.atomic <- Pbrt.Decoder.bool d; atomic_is_set := true;
+ end
+ | Some (5, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(commit), field(5)" pk
+ | Some (6, Pbrt.Varint) -> begin
+ v.background <- Pbrt.Decoder.bool d; background_is_set := true;
+ end
+ | Some (6, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(commit), field(6)" pk
+ | Some (7, Pbrt.Bytes) -> begin
+ v.init <- Some (decode_pb_status (Pbrt.Decoder.nested d));
+ end
+ | Some (7, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(commit), field(7)" pk
+ | Some (8, Pbrt.Bytes) -> begin
+ v.calls <- (decode_pb_call (Pbrt.Decoder.nested d)) :: v.calls;
+ end
+ | Some (8, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(commit), field(8)" pk
+ | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
+ done;
+ begin if not !background_is_set then Pbrt.Decoder.missing_field "background" end;
+ begin if not !atomic_is_set then Pbrt.Decoder.missing_field "atomic" end;
+ begin if not !dry_run_is_set then Pbrt.Decoder.missing_field "dry_run" end;
+ begin if not !session_id_is_set then Pbrt.Decoder.missing_field "session_id" end;
+ ({
+ session_id = v.session_id;
+ dry_run = v.dry_run;
+ atomic = v.atomic;
+ background = v.background;
+ init = v.init;
+ calls = v.calls;
+ } : commit)
diff --git a/src/vycall_pbt.mli b/src/vycall_pbt.mli
new file mode 100644
index 0000000..f389302
--- /dev/null
+++ b/src/vycall_pbt.mli
@@ -0,0 +1,95 @@
+
+(** Code for vycall.proto *)
+
+(* generated from "data/vycall.proto", do not edit *)
+
+
+
+(** {2 Types} *)
+
+type status = {
+ success : bool;
+ out : string;
+}
+
+type call = {
+ script_name : string;
+ tag_value : string option;
+ arg_value : string option;
+ reply : status option;
+}
+
+type commit = {
+ session_id : string;
+ dry_run : bool;
+ atomic : bool;
+ background : bool;
+ init : status option;
+ calls : call list;
+}
+
+
+(** {2 Basic values} *)
+
+val default_status :
+ ?success:bool ->
+ ?out:string ->
+ unit ->
+ status
+(** [default_status ()] is the default value for type [status] *)
+
+val default_call :
+ ?script_name:string ->
+ ?tag_value:string option ->
+ ?arg_value:string option ->
+ ?reply:status option ->
+ unit ->
+ call
+(** [default_call ()] is the default value for type [call] *)
+
+val default_commit :
+ ?session_id:string ->
+ ?dry_run:bool ->
+ ?atomic:bool ->
+ ?background:bool ->
+ ?init:status option ->
+ ?calls:call list ->
+ unit ->
+ commit
+(** [default_commit ()] is the default value for type [commit] *)
+
+
+(** {2 Formatters} *)
+
+val pp_status : Format.formatter -> status -> unit
+(** [pp_status v] formats v *)
+
+val pp_call : Format.formatter -> call -> unit
+(** [pp_call v] formats v *)
+
+val pp_commit : Format.formatter -> commit -> unit
+(** [pp_commit v] formats v *)
+
+
+(** {2 Protobuf Encoding} *)
+
+val encode_pb_status : status -> Pbrt.Encoder.t -> unit
+(** [encode_pb_status v encoder] encodes [v] with the given [encoder] *)
+
+val encode_pb_call : call -> Pbrt.Encoder.t -> unit
+(** [encode_pb_call v encoder] encodes [v] with the given [encoder] *)
+
+val encode_pb_commit : commit -> Pbrt.Encoder.t -> unit
+(** [encode_pb_commit v encoder] encodes [v] with the given [encoder] *)
+
+
+(** {2 Protobuf Decoding} *)
+
+val decode_pb_status : Pbrt.Decoder.t -> status
+(** [decode_pb_status decoder] decodes a [status] binary value from [decoder] *)
+
+val decode_pb_call : Pbrt.Decoder.t -> call
+(** [decode_pb_call decoder] decodes a [call] binary value from [decoder] *)
+
+val decode_pb_commit : Pbrt.Decoder.t -> commit
+(** [decode_pb_commit decoder] decodes a [commit] binary value from [decoder] *)
diff --git a/src/vycli.ml b/src/vycli.ml
index f793ae0..75e92b5 100644
--- a/src/vycli.ml
+++ b/src/vycli.ml
@@ -1,8 +1,8 @@
-open Client.Vyconf_client
+open Vyconfd_client.Vyconf_client
open Vyconf_connect.Vyconf_pbt
type op_t =
- | OpStatus
+ | OpPrompt
| OpSetupSession
| OpTeardownSession
| OpShowConfig
@@ -35,7 +35,7 @@ let args = [
("--exists", Arg.Unit (fun () -> op := Some OpExists), "Check if specified path exists");
("--list-children", Arg.Unit (fun () -> op := Some OpListChildren), "List children of the node at the specified path");
("--show-config", Arg.Unit (fun () -> op := Some OpShowConfig), "Show the configuration at the specified path");
- ("--status", Arg.Unit (fun () -> op := Some OpStatus), "Send a status/keepalive message");
+ ("--prompt", Arg.Unit (fun () -> op := Some OpPrompt), "Send a status/keepalive message");
("--validate", Arg.Unit (fun () -> op := Some OpValidate), "Validate path");
("--reload-reftree", Arg.Unit (fun () -> op := Some OpReloadReftree), "Reload reference tree");
]
@@ -53,14 +53,14 @@ let output_format_of_string s =
| _ -> failwith (Printf.sprintf "Unknown output format %s, should be plain or json" s)
let main socket op path out_format config_format =
- let%lwt client = Client.Vyconf_client.create ~token:!token socket out_format config_format in
+ let%lwt client = create ~token:!token socket out_format config_format in
let%lwt result = match op with
| None -> Error "Operation required" |> Lwt.return
| Some o ->
begin
match o with
- | OpStatus ->
- let%lwt resp = get_status client in
+ | OpPrompt ->
+ let%lwt resp = prompt client in
begin
match resp.status with
| Success -> Ok "" |> Lwt.return
diff --git a/src/vyconf_client.ml b/src/vyconf_client.ml
index 5437428..c4811c5 100644
--- a/src/vyconf_client.ml
+++ b/src/vyconf_client.ml
@@ -48,8 +48,8 @@ let do_request client req =
let%lwt resp = Vyconf_connect.Message.read client.ic in
decode_pb_response (Pbrt.Decoder.of_bytes resp) |> Lwt.return
-let get_status client =
- let req = Status in
+let prompt client =
+ let req = Prompt in
let%lwt resp = do_request client req in
Lwt.return resp
@@ -118,6 +118,32 @@ let validate client path =
| Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return
| _ -> Error (Option.value resp.error ~default:"") |> Lwt.return
+let set client path =
+ let req = Set {path=path;} in
+ let%lwt resp = do_request client req in
+ match resp.status with
+ | Success -> Lwt.return (Ok "")
+ | Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return
+ | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return
+
+let delete client path =
+ let req = Delete {path=path;} in
+ let%lwt resp = do_request client req in
+ match resp.status with
+ | Success -> Lwt.return (Ok "")
+ | Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return
+ | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return
+
+let commit client =
+ let req =
+ Commit {confirm=None; confirm_timeout=None; comment=None; dry_run=None}
+ in
+ let%lwt resp = do_request client req in
+ match resp.status with
+ | Success -> Ok (Option.value resp.output ~default:"") |> Lwt.return
+ | Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return
+ | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return
+
let reload_reftree ?(on_behalf_of=None) client =
let id = on_behalf_of |> (function None -> None | Some x -> (Some (Int32.of_int x))) in
let req = Reload_reftree {on_behalf_of=id} in
diff --git a/src/vyconf_client.mli b/src/vyconf_client.mli
index 6d74412..9c25c60 100644
--- a/src/vyconf_client.mli
+++ b/src/vyconf_client.mli
@@ -1,31 +1,12 @@
type t
-type status =
- | Success
- | Fail
- | Invalid_path
- | Invalid_value
- | Commit_in_progress
- | Configuration_locked
- | Internal_error
- | Permission_denied
- | Path_already_exists
-
-type response = {
- status : status;
- output : string option;
- error : string option;
- warning : string option;
-}
-
-
val create : ?token:(string option) -> string -> Vyconf_connect.Vyconf_pbt.request_output_format -> Vyconf_connect.Vyconf_pbt.request_config_format -> t Lwt.t
val get_token : t -> (string, string) result Lwt.t
val shutdown : t -> t Lwt.t
-val get_status : t -> response Lwt.t
+val prompt : t -> Vyconf_connect.Vyconf_pbt.response Lwt.t
val setup_session : ?on_behalf_of:(int option) -> t -> string -> (t, string) result Lwt.t
@@ -43,4 +24,11 @@ val show_config : t -> string list -> (string, string) result Lwt.t
val validate : t -> string list -> (string, string) result Lwt.t
+val set : t -> string list -> (string, string) result Lwt.t
+
+val delete : t -> string list -> (string, string) result Lwt.t
+
+val commit : t -> (string, string) result Lwt.t
+
+
val reload_reftree : ?on_behalf_of:(int option) -> t -> (string, string) result Lwt.t
diff --git a/src/vyconf_config.ml b/src/vyconf_config.ml
index bef607f..5fbd716 100644
--- a/src/vyconf_config.ml
+++ b/src/vyconf_config.ml
@@ -6,9 +6,12 @@ type t = {
program_dir: string;
config_dir: string;
reftree_dir: string;
+ session_dir: string;
primary_config: string;
fallback_config: string;
reference_tree: string;
+ running_cache: string;
+ session_cache: string;
socket: string;
pid_file: string;
log_file: string option;
@@ -24,9 +27,12 @@ let empty_config = {
program_dir = "";
config_dir = "";
reftree_dir = "";
+ session_dir = "";
primary_config = "";
fallback_config = "";
reference_tree = "";
+ running_cache = "";
+ session_cache = "";
socket = "";
pid_file = "";
log_file = None;
@@ -63,10 +69,13 @@ let load filename =
let conf = {conf with data_dir = mandatory_field conf_toml "appliance" "data_dir"} in
let conf = {conf with config_dir = mandatory_field conf_toml "appliance" "config_dir"} in
let conf = {conf with reftree_dir = mandatory_field conf_toml "appliance" "reftree_dir"} in
+ let conf = {conf with session_dir = mandatory_field conf_toml "appliance" "session_dir"} in
let conf = {conf with program_dir = mandatory_field conf_toml "appliance" "program_dir"} in
let conf = {conf with primary_config = mandatory_field conf_toml "appliance" "primary_config"} in
let conf = {conf with fallback_config = mandatory_field conf_toml "appliance" "fallback_config"} in
let conf = {conf with reference_tree = mandatory_field conf_toml "appliance" "reference_tree"} in
+ let conf = {conf with running_cache = mandatory_field conf_toml "appliance" "running_cache"} in
+ let conf = {conf with session_cache = mandatory_field conf_toml "appliance" "session_cache"} in
(* Optional fields *)
let conf = {conf with pid_file = optional_field defaults.pid_file conf_toml "vyconf" "pid_file"} in
let conf = {conf with socket = optional_field defaults.socket conf_toml "vyconf" "socket"} in
diff --git a/src/vyconf_config.mli b/src/vyconf_config.mli
index dad574c..9b6b283 100644
--- a/src/vyconf_config.mli
+++ b/src/vyconf_config.mli
@@ -4,9 +4,12 @@ type t = {
program_dir: string;
config_dir: string;
reftree_dir: string;
+ session_dir: string;
primary_config: string;
fallback_config: string;
reference_tree: string;
+ running_cache: string;
+ session_cache: string;
socket: string;
pid_file: string;
log_file: string option;
diff --git a/src/vyconf_pbt.ml b/src/vyconf_pbt.ml
index 9d2845d..5518e27 100644
--- a/src/vyconf_pbt.ml
+++ b/src/vyconf_pbt.ml
@@ -8,7 +8,7 @@ type request_output_format =
| Out_plain
| Out_json
-type request_status = unit
+type request_prompt = unit
type request_setup_session = {
client_application : string option;
@@ -26,13 +26,20 @@ type request_validate = {
type request_set = {
path : string list;
- ephemeral : bool option;
}
type request_delete = {
path : string list;
}
+type request_discard = {
+ dummy : int32 option;
+}
+
+type request_session_changed = {
+ dummy : int32 option;
+}
+
type request_rename = {
edit_level : string list;
from : string;
@@ -54,6 +61,7 @@ type request_commit = {
confirm : bool option;
confirm_timeout : int32 option;
comment : string option;
+ dry_run : bool option;
}
type request_rollback = {
@@ -118,7 +126,7 @@ type request_reload_reftree = {
}
type request =
- | Status
+ | Prompt
| Setup_session of request_setup_session
| Set of request_set
| Delete of request_delete
@@ -141,13 +149,16 @@ type request =
| Validate of request_validate
| Teardown of request_teardown
| Reload_reftree of request_reload_reftree
+ | Load of request_load
+ | Discard of request_discard
+ | Session_changed of request_session_changed
type request_envelope = {
token : string option;
request : request;
}
-type status =
+type errnum =
| Success
| Fail
| Invalid_path
@@ -159,7 +170,7 @@ type status =
| Path_already_exists
type response = {
- status : status;
+ status : errnum;
output : string option;
error : string option;
warning : string option;
@@ -169,7 +180,7 @@ let rec default_request_config_format () = (Curly:request_config_format)
let rec default_request_output_format () = (Out_plain:request_output_format)
-let rec default_request_status = ()
+let rec default_request_prompt = ()
let rec default_request_setup_session
?client_application:((client_application:string option) = None)
@@ -195,10 +206,8 @@ let rec default_request_validate
let rec default_request_set
?path:((path:string list) = [])
- ?ephemeral:((ephemeral:bool option) = None)
() : request_set = {
path;
- ephemeral;
}
let rec default_request_delete
@@ -207,6 +216,18 @@ let rec default_request_delete
path;
}
+let rec default_request_discard
+ ?dummy:((dummy:int32 option) = None)
+ () : request_discard = {
+ dummy;
+}
+
+let rec default_request_session_changed
+ ?dummy:((dummy:int32 option) = None)
+ () : request_session_changed = {
+ dummy;
+}
+
let rec default_request_rename
?edit_level:((edit_level:string list) = [])
?from:((from:string) = "")
@@ -239,10 +260,12 @@ let rec default_request_commit
?confirm:((confirm:bool option) = None)
?confirm_timeout:((confirm_timeout:int32 option) = None)
?comment:((comment:string option) = None)
+ ?dry_run:((dry_run:bool option) = None)
() : request_commit = {
confirm;
confirm_timeout;
comment;
+ dry_run;
}
let rec default_request_rollback
@@ -339,7 +362,7 @@ let rec default_request_reload_reftree
on_behalf_of;
}
-let rec default_request (): request = Status
+let rec default_request (): request = Prompt
let rec default_request_envelope
?token:((token:string option) = None)
@@ -349,10 +372,10 @@ let rec default_request_envelope
request;
}
-let rec default_status () = (Success:status)
+let rec default_errnum () = (Success:errnum)
let rec default_response
- ?status:((status:status) = default_status ())
+ ?status:((status:errnum) = default_errnum ())
?output:((output:string option) = None)
?error:((error:string option) = None)
?warning:((warning:string option) = None)
@@ -393,12 +416,10 @@ let default_request_validate_mutable () : request_validate_mutable = {
type request_set_mutable = {
mutable path : string list;
- mutable ephemeral : bool option;
}
let default_request_set_mutable () : request_set_mutable = {
path = [];
- ephemeral = None;
}
type request_delete_mutable = {
@@ -409,6 +430,22 @@ let default_request_delete_mutable () : request_delete_mutable = {
path = [];
}
+type request_discard_mutable = {
+ mutable dummy : int32 option;
+}
+
+let default_request_discard_mutable () : request_discard_mutable = {
+ dummy = None;
+}
+
+type request_session_changed_mutable = {
+ mutable dummy : int32 option;
+}
+
+let default_request_session_changed_mutable () : request_session_changed_mutable = {
+ dummy = None;
+}
+
type request_rename_mutable = {
mutable edit_level : string list;
mutable from : string;
@@ -447,12 +484,14 @@ type request_commit_mutable = {
mutable confirm : bool option;
mutable confirm_timeout : int32 option;
mutable comment : string option;
+ mutable dry_run : bool option;
}
let default_request_commit_mutable () : request_commit_mutable = {
confirm = None;
confirm_timeout = None;
comment = None;
+ dry_run = None;
}
type request_rollback_mutable = {
@@ -580,14 +619,14 @@ let default_request_envelope_mutable () : request_envelope_mutable = {
}
type response_mutable = {
- mutable status : status;
+ mutable status : errnum;
mutable output : string option;
mutable error : string option;
mutable warning : string option;
}
let default_response_mutable () : response_mutable = {
- status = default_status ();
+ status = default_errnum ();
output = None;
error = None;
warning = None;
@@ -607,7 +646,7 @@ let rec pp_request_output_format fmt (v:request_output_format) =
| Out_plain -> Format.fprintf fmt "Out_plain"
| Out_json -> Format.fprintf fmt "Out_json"
-let rec pp_request_status fmt (v:request_status) =
+let rec pp_request_prompt fmt (v:request_prompt) =
let pp_i fmt () =
Pbrt.Pp.pp_unit fmt ()
in
@@ -636,7 +675,6 @@ let rec pp_request_validate fmt (v:request_validate) =
let rec pp_request_set fmt (v:request_set) =
let pp_i fmt () =
Pbrt.Pp.pp_record_field ~first:true "path" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.path;
- Pbrt.Pp.pp_record_field ~first:false "ephemeral" (Pbrt.Pp.pp_option Pbrt.Pp.pp_bool) fmt v.ephemeral;
in
Pbrt.Pp.pp_brk pp_i fmt ()
@@ -646,6 +684,18 @@ let rec pp_request_delete fmt (v:request_delete) =
in
Pbrt.Pp.pp_brk pp_i fmt ()
+let rec pp_request_discard fmt (v:request_discard) =
+ let pp_i fmt () =
+ Pbrt.Pp.pp_record_field ~first:true "dummy" (Pbrt.Pp.pp_option Pbrt.Pp.pp_int32) fmt v.dummy;
+ in
+ Pbrt.Pp.pp_brk pp_i fmt ()
+
+let rec pp_request_session_changed fmt (v:request_session_changed) =
+ let pp_i fmt () =
+ Pbrt.Pp.pp_record_field ~first:true "dummy" (Pbrt.Pp.pp_option Pbrt.Pp.pp_int32) fmt v.dummy;
+ in
+ Pbrt.Pp.pp_brk pp_i fmt ()
+
let rec pp_request_rename fmt (v:request_rename) =
let pp_i fmt () =
Pbrt.Pp.pp_record_field ~first:true "edit_level" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.edit_level;
@@ -674,6 +724,7 @@ let rec pp_request_commit fmt (v:request_commit) =
Pbrt.Pp.pp_record_field ~first:true "confirm" (Pbrt.Pp.pp_option Pbrt.Pp.pp_bool) fmt v.confirm;
Pbrt.Pp.pp_record_field ~first:false "confirm_timeout" (Pbrt.Pp.pp_option Pbrt.Pp.pp_int32) fmt v.confirm_timeout;
Pbrt.Pp.pp_record_field ~first:false "comment" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.comment;
+ Pbrt.Pp.pp_record_field ~first:false "dry_run" (Pbrt.Pp.pp_option Pbrt.Pp.pp_bool) fmt v.dry_run;
in
Pbrt.Pp.pp_brk pp_i fmt ()
@@ -772,7 +823,7 @@ let rec pp_request_reload_reftree fmt (v:request_reload_reftree) =
let rec pp_request fmt (v:request) =
match v with
- | Status -> Format.fprintf fmt "Status"
+ | Prompt -> Format.fprintf fmt "Prompt"
| Setup_session x -> Format.fprintf fmt "@[<hv2>Setup_session(@,%a)@]" pp_request_setup_session x
| Set x -> Format.fprintf fmt "@[<hv2>Set(@,%a)@]" pp_request_set x
| Delete x -> Format.fprintf fmt "@[<hv2>Delete(@,%a)@]" pp_request_delete x
@@ -795,6 +846,9 @@ let rec pp_request fmt (v:request) =
| Validate x -> Format.fprintf fmt "@[<hv2>Validate(@,%a)@]" pp_request_validate x
| Teardown x -> Format.fprintf fmt "@[<hv2>Teardown(@,%a)@]" pp_request_teardown x
| Reload_reftree x -> Format.fprintf fmt "@[<hv2>Reload_reftree(@,%a)@]" pp_request_reload_reftree x
+ | Load x -> Format.fprintf fmt "@[<hv2>Load(@,%a)@]" pp_request_load x
+ | Discard x -> Format.fprintf fmt "@[<hv2>Discard(@,%a)@]" pp_request_discard x
+ | Session_changed x -> Format.fprintf fmt "@[<hv2>Session_changed(@,%a)@]" pp_request_session_changed x
let rec pp_request_envelope fmt (v:request_envelope) =
let pp_i fmt () =
@@ -803,7 +857,7 @@ let rec pp_request_envelope fmt (v:request_envelope) =
in
Pbrt.Pp.pp_brk pp_i fmt ()
-let rec pp_status fmt (v:status) =
+let rec pp_errnum fmt (v:errnum) =
match v with
| Success -> Format.fprintf fmt "Success"
| Fail -> Format.fprintf fmt "Fail"
@@ -817,7 +871,7 @@ let rec pp_status fmt (v:status) =
let rec pp_response fmt (v:response) =
let pp_i fmt () =
- Pbrt.Pp.pp_record_field ~first:true "status" pp_status fmt v.status;
+ Pbrt.Pp.pp_record_field ~first:true "status" pp_errnum fmt v.status;
Pbrt.Pp.pp_record_field ~first:false "output" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.output;
Pbrt.Pp.pp_record_field ~first:false "error" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.error;
Pbrt.Pp.pp_record_field ~first:false "warning" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.warning;
@@ -838,7 +892,7 @@ let rec encode_pb_request_output_format (v:request_output_format) encoder =
| Out_plain -> Pbrt.Encoder.int_as_varint (0) encoder
| Out_json -> Pbrt.Encoder.int_as_varint 1 encoder
-let rec encode_pb_request_status (v:request_status) encoder =
+let rec encode_pb_request_prompt (v:request_prompt) encoder =
()
let rec encode_pb_request_setup_session (v:request_setup_session) encoder =
@@ -883,12 +937,6 @@ let rec encode_pb_request_set (v:request_set) encoder =
Pbrt.Encoder.string x encoder;
Pbrt.Encoder.key 1 Pbrt.Bytes encoder;
) v.path encoder;
- begin match v.ephemeral with
- | Some x ->
- Pbrt.Encoder.bool x encoder;
- Pbrt.Encoder.key 3 Pbrt.Varint encoder;
- | None -> ();
- end;
()
let rec encode_pb_request_delete (v:request_delete) encoder =
@@ -898,6 +946,24 @@ let rec encode_pb_request_delete (v:request_delete) encoder =
) v.path encoder;
()
+let rec encode_pb_request_discard (v:request_discard) encoder =
+ begin match v.dummy with
+ | Some x ->
+ Pbrt.Encoder.int32_as_varint x encoder;
+ Pbrt.Encoder.key 1 Pbrt.Varint encoder;
+ | None -> ();
+ end;
+ ()
+
+let rec encode_pb_request_session_changed (v:request_session_changed) encoder =
+ begin match v.dummy with
+ | Some x ->
+ Pbrt.Encoder.int32_as_varint x encoder;
+ Pbrt.Encoder.key 1 Pbrt.Varint encoder;
+ | None -> ();
+ end;
+ ()
+
let rec encode_pb_request_rename (v:request_rename) encoder =
Pbrt.List_util.rev_iter_with (fun x encoder ->
Pbrt.Encoder.string x encoder;
@@ -948,6 +1014,12 @@ let rec encode_pb_request_commit (v:request_commit) encoder =
Pbrt.Encoder.key 3 Pbrt.Bytes encoder;
| None -> ();
end;
+ begin match v.dry_run with
+ | Some x ->
+ Pbrt.Encoder.bool x encoder;
+ Pbrt.Encoder.key 4 Pbrt.Varint encoder;
+ | None -> ();
+ end;
()
let rec encode_pb_request_rollback (v:request_rollback) encoder =
@@ -1084,7 +1156,7 @@ let rec encode_pb_request_reload_reftree (v:request_reload_reftree) encoder =
let rec encode_pb_request (v:request) encoder =
begin match v with
- | Status ->
+ | Prompt ->
Pbrt.Encoder.key 1 Pbrt.Bytes encoder;
Pbrt.Encoder.empty_nested encoder
| Setup_session x ->
@@ -1153,6 +1225,15 @@ let rec encode_pb_request (v:request) encoder =
| Reload_reftree x ->
Pbrt.Encoder.nested encode_pb_request_reload_reftree x encoder;
Pbrt.Encoder.key 23 Pbrt.Bytes encoder;
+ | Load x ->
+ Pbrt.Encoder.nested encode_pb_request_load x encoder;
+ Pbrt.Encoder.key 24 Pbrt.Bytes encoder;
+ | Discard x ->
+ Pbrt.Encoder.nested encode_pb_request_discard x encoder;
+ Pbrt.Encoder.key 25 Pbrt.Bytes encoder;
+ | Session_changed x ->
+ Pbrt.Encoder.nested encode_pb_request_session_changed x encoder;
+ Pbrt.Encoder.key 26 Pbrt.Bytes encoder;
end
let rec encode_pb_request_envelope (v:request_envelope) encoder =
@@ -1166,7 +1247,7 @@ let rec encode_pb_request_envelope (v:request_envelope) encoder =
Pbrt.Encoder.key 2 Pbrt.Bytes encoder;
()
-let rec encode_pb_status (v:status) encoder =
+let rec encode_pb_errnum (v:errnum) encoder =
match v with
| Success -> Pbrt.Encoder.int_as_varint (0) encoder
| Fail -> Pbrt.Encoder.int_as_varint 1 encoder
@@ -1179,7 +1260,7 @@ let rec encode_pb_status (v:status) encoder =
| Path_already_exists -> Pbrt.Encoder.int_as_varint 8 encoder
let rec encode_pb_response (v:response) encoder =
- encode_pb_status v.status encoder;
+ encode_pb_errnum v.status encoder;
Pbrt.Encoder.key 1 Pbrt.Varint encoder;
begin match v.output with
| Some x ->
@@ -1217,11 +1298,11 @@ let rec decode_pb_request_output_format d =
| 1 -> (Out_json:request_output_format)
| _ -> Pbrt.Decoder.malformed_variant "request_output_format"
-let rec decode_pb_request_status d =
+let rec decode_pb_request_prompt d =
match Pbrt.Decoder.key d with
| None -> ();
| Some (_, pk) ->
- Pbrt.Decoder.unexpected_payload "Unexpected fields in empty message(request_status)" pk
+ Pbrt.Decoder.unexpected_payload "Unexpected fields in empty message(request_prompt)" pk
let rec decode_pb_request_setup_session d =
let v = default_request_setup_session_mutable () in
@@ -1303,16 +1384,10 @@ let rec decode_pb_request_set d =
end
| Some (1, pk) ->
Pbrt.Decoder.unexpected_payload "Message(request_set), field(1)" pk
- | Some (3, Pbrt.Varint) -> begin
- v.ephemeral <- Some (Pbrt.Decoder.bool d);
- end
- | Some (3, pk) ->
- Pbrt.Decoder.unexpected_payload "Message(request_set), field(3)" pk
| Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
done;
({
path = v.path;
- ephemeral = v.ephemeral;
} : request_set)
let rec decode_pb_request_delete d =
@@ -1334,6 +1409,42 @@ let rec decode_pb_request_delete d =
path = v.path;
} : request_delete)
+let rec decode_pb_request_discard d =
+ let v = default_request_discard_mutable () in
+ let continue__= ref true in
+ while !continue__ do
+ match Pbrt.Decoder.key d with
+ | None -> (
+ ); continue__ := false
+ | Some (1, Pbrt.Varint) -> begin
+ v.dummy <- Some (Pbrt.Decoder.int32_as_varint d);
+ end
+ | Some (1, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(request_discard), field(1)" pk
+ | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
+ done;
+ ({
+ dummy = v.dummy;
+ } : request_discard)
+
+let rec decode_pb_request_session_changed d =
+ let v = default_request_session_changed_mutable () in
+ let continue__= ref true in
+ while !continue__ do
+ match Pbrt.Decoder.key d with
+ | None -> (
+ ); continue__ := false
+ | Some (1, Pbrt.Varint) -> begin
+ v.dummy <- Some (Pbrt.Decoder.int32_as_varint d);
+ end
+ | Some (1, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(request_session_changed), field(1)" pk
+ | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
+ done;
+ ({
+ dummy = v.dummy;
+ } : request_session_changed)
+
let rec decode_pb_request_rename d =
let v = default_request_rename_mutable () in
let continue__= ref true in
@@ -1453,12 +1564,18 @@ let rec decode_pb_request_commit d =
end
| Some (3, pk) ->
Pbrt.Decoder.unexpected_payload "Message(request_commit), field(3)" pk
+ | Some (4, Pbrt.Varint) -> begin
+ v.dry_run <- Some (Pbrt.Decoder.bool d);
+ end
+ | Some (4, pk) ->
+ Pbrt.Decoder.unexpected_payload "Message(request_commit), field(4)" pk
| Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind
done;
({
confirm = v.confirm;
confirm_timeout = v.confirm_timeout;
comment = v.comment;
+ dry_run = v.dry_run;
} : request_commit)
let rec decode_pb_request_rollback d =
@@ -1767,7 +1884,7 @@ let rec decode_pb_request d =
| None -> Pbrt.Decoder.malformed_variant "request"
| Some (1, _) -> begin
Pbrt.Decoder.empty_nested d ;
- (Status : request)
+ (Prompt : request)
end
| Some (2, _) -> (Setup_session (decode_pb_request_setup_session (Pbrt.Decoder.nested d)) : request)
| Some (3, _) -> (Set (decode_pb_request_set (Pbrt.Decoder.nested d)) : request)
@@ -1797,6 +1914,9 @@ let rec decode_pb_request d =
| Some (21, _) -> (Validate (decode_pb_request_validate (Pbrt.Decoder.nested d)) : request)
| Some (22, _) -> (Teardown (decode_pb_request_teardown (Pbrt.Decoder.nested d)) : request)
| Some (23, _) -> (Reload_reftree (decode_pb_request_reload_reftree (Pbrt.Decoder.nested d)) : request)
+ | Some (24, _) -> (Load (decode_pb_request_load (Pbrt.Decoder.nested d)) : request)
+ | Some (25, _) -> (Discard (decode_pb_request_discard (Pbrt.Decoder.nested d)) : request)
+ | Some (26, _) -> (Session_changed (decode_pb_request_session_changed (Pbrt.Decoder.nested d)) : request)
| Some (n, payload_kind) -> (
Pbrt.Decoder.skip d payload_kind;
loop ()
@@ -1832,18 +1952,18 @@ let rec decode_pb_request_envelope d =
request = v.request;
} : request_envelope)
-let rec decode_pb_status d =
+let rec decode_pb_errnum d =
match Pbrt.Decoder.int_as_varint d with
- | 0 -> (Success:status)
- | 1 -> (Fail:status)
- | 2 -> (Invalid_path:status)
- | 3 -> (Invalid_value:status)
- | 4 -> (Commit_in_progress:status)
- | 5 -> (Configuration_locked:status)
- | 6 -> (Internal_error:status)
- | 7 -> (Permission_denied:status)
- | 8 -> (Path_already_exists:status)
- | _ -> Pbrt.Decoder.malformed_variant "status"
+ | 0 -> (Success:errnum)
+ | 1 -> (Fail:errnum)
+ | 2 -> (Invalid_path:errnum)
+ | 3 -> (Invalid_value:errnum)
+ | 4 -> (Commit_in_progress:errnum)
+ | 5 -> (Configuration_locked:errnum)
+ | 6 -> (Internal_error:errnum)
+ | 7 -> (Permission_denied:errnum)
+ | 8 -> (Path_already_exists:errnum)
+ | _ -> Pbrt.Decoder.malformed_variant "errnum"
let rec decode_pb_response d =
let v = default_response_mutable () in
@@ -1854,7 +1974,7 @@ let rec decode_pb_response d =
| None -> (
); continue__ := false
| Some (1, Pbrt.Varint) -> begin
- v.status <- decode_pb_status d; status_is_set := true;
+ v.status <- decode_pb_errnum d; status_is_set := true;
end
| Some (1, pk) ->
Pbrt.Decoder.unexpected_payload "Message(response), field(1)" pk
diff --git a/src/vyconf_pbt.mli b/src/vyconf_pbt.mli
index 56cf4ea..5f768f8 100644
--- a/src/vyconf_pbt.mli
+++ b/src/vyconf_pbt.mli
@@ -15,7 +15,7 @@ type request_output_format =
| Out_plain
| Out_json
-type request_status = unit
+type request_prompt = unit
type request_setup_session = {
client_application : string option;
@@ -33,13 +33,20 @@ type request_validate = {
type request_set = {
path : string list;
- ephemeral : bool option;
}
type request_delete = {
path : string list;
}
+type request_discard = {
+ dummy : int32 option;
+}
+
+type request_session_changed = {
+ dummy : int32 option;
+}
+
type request_rename = {
edit_level : string list;
from : string;
@@ -61,6 +68,7 @@ type request_commit = {
confirm : bool option;
confirm_timeout : int32 option;
comment : string option;
+ dry_run : bool option;
}
type request_rollback = {
@@ -125,7 +133,7 @@ type request_reload_reftree = {
}
type request =
- | Status
+ | Prompt
| Setup_session of request_setup_session
| Set of request_set
| Delete of request_delete
@@ -148,13 +156,16 @@ type request =
| Validate of request_validate
| Teardown of request_teardown
| Reload_reftree of request_reload_reftree
+ | Load of request_load
+ | Discard of request_discard
+ | Session_changed of request_session_changed
type request_envelope = {
token : string option;
request : request;
}
-type status =
+type errnum =
| Success
| Fail
| Invalid_path
@@ -166,7 +177,7 @@ type status =
| Path_already_exists
type response = {
- status : status;
+ status : errnum;
output : string option;
error : string option;
warning : string option;
@@ -181,8 +192,8 @@ val default_request_config_format : unit -> request_config_format
val default_request_output_format : unit -> request_output_format
(** [default_request_output_format ()] is the default value for type [request_output_format] *)
-val default_request_status : unit
-(** [default_request_status ()] is the default value for type [request_status] *)
+val default_request_prompt : unit
+(** [default_request_prompt ()] is the default value for type [request_prompt] *)
val default_request_setup_session :
?client_application:string option ->
@@ -206,7 +217,6 @@ val default_request_validate :
val default_request_set :
?path:string list ->
- ?ephemeral:bool option ->
unit ->
request_set
(** [default_request_set ()] is the default value for type [request_set] *)
@@ -217,6 +227,18 @@ val default_request_delete :
request_delete
(** [default_request_delete ()] is the default value for type [request_delete] *)
+val default_request_discard :
+ ?dummy:int32 option ->
+ unit ->
+ request_discard
+(** [default_request_discard ()] is the default value for type [request_discard] *)
+
+val default_request_session_changed :
+ ?dummy:int32 option ->
+ unit ->
+ request_session_changed
+(** [default_request_session_changed ()] is the default value for type [request_session_changed] *)
+
val default_request_rename :
?edit_level:string list ->
?from:string ->
@@ -244,6 +266,7 @@ val default_request_commit :
?confirm:bool option ->
?confirm_timeout:int32 option ->
?comment:string option ->
+ ?dry_run:bool option ->
unit ->
request_commit
(** [default_request_commit ()] is the default value for type [request_commit] *)
@@ -345,11 +368,11 @@ val default_request_envelope :
request_envelope
(** [default_request_envelope ()] is the default value for type [request_envelope] *)
-val default_status : unit -> status
-(** [default_status ()] is the default value for type [status] *)
+val default_errnum : unit -> errnum
+(** [default_errnum ()] is the default value for type [errnum] *)
val default_response :
- ?status:status ->
+ ?status:errnum ->
?output:string option ->
?error:string option ->
?warning:string option ->
@@ -366,8 +389,8 @@ val pp_request_config_format : Format.formatter -> request_config_format -> unit
val pp_request_output_format : Format.formatter -> request_output_format -> unit
(** [pp_request_output_format v] formats v *)
-val pp_request_status : Format.formatter -> request_status -> unit
-(** [pp_request_status v] formats v *)
+val pp_request_prompt : Format.formatter -> request_prompt -> unit
+(** [pp_request_prompt v] formats v *)
val pp_request_setup_session : Format.formatter -> request_setup_session -> unit
(** [pp_request_setup_session v] formats v *)
@@ -384,6 +407,12 @@ val pp_request_set : Format.formatter -> request_set -> unit
val pp_request_delete : Format.formatter -> request_delete -> unit
(** [pp_request_delete v] formats v *)
+val pp_request_discard : Format.formatter -> request_discard -> unit
+(** [pp_request_discard v] formats v *)
+
+val pp_request_session_changed : Format.formatter -> request_session_changed -> unit
+(** [pp_request_session_changed v] formats v *)
+
val pp_request_rename : Format.formatter -> request_rename -> unit
(** [pp_request_rename v] formats v *)
@@ -444,8 +473,8 @@ val pp_request : Format.formatter -> request -> unit
val pp_request_envelope : Format.formatter -> request_envelope -> unit
(** [pp_request_envelope v] formats v *)
-val pp_status : Format.formatter -> status -> unit
-(** [pp_status v] formats v *)
+val pp_errnum : Format.formatter -> errnum -> unit
+(** [pp_errnum v] formats v *)
val pp_response : Format.formatter -> response -> unit
(** [pp_response v] formats v *)
@@ -459,8 +488,8 @@ val encode_pb_request_config_format : request_config_format -> Pbrt.Encoder.t ->
val encode_pb_request_output_format : request_output_format -> Pbrt.Encoder.t -> unit
(** [encode_pb_request_output_format v encoder] encodes [v] with the given [encoder] *)
-val encode_pb_request_status : request_status -> Pbrt.Encoder.t -> unit
-(** [encode_pb_request_status v encoder] encodes [v] with the given [encoder] *)
+val encode_pb_request_prompt : request_prompt -> Pbrt.Encoder.t -> unit
+(** [encode_pb_request_prompt v encoder] encodes [v] with the given [encoder] *)
val encode_pb_request_setup_session : request_setup_session -> Pbrt.Encoder.t -> unit
(** [encode_pb_request_setup_session v encoder] encodes [v] with the given [encoder] *)
@@ -477,6 +506,12 @@ val encode_pb_request_set : request_set -> Pbrt.Encoder.t -> unit
val encode_pb_request_delete : request_delete -> Pbrt.Encoder.t -> unit
(** [encode_pb_request_delete v encoder] encodes [v] with the given [encoder] *)
+val encode_pb_request_discard : request_discard -> Pbrt.Encoder.t -> unit
+(** [encode_pb_request_discard v encoder] encodes [v] with the given [encoder] *)
+
+val encode_pb_request_session_changed : request_session_changed -> Pbrt.Encoder.t -> unit
+(** [encode_pb_request_session_changed v encoder] encodes [v] with the given [encoder] *)
+
val encode_pb_request_rename : request_rename -> Pbrt.Encoder.t -> unit
(** [encode_pb_request_rename v encoder] encodes [v] with the given [encoder] *)
@@ -537,8 +572,8 @@ val encode_pb_request : request -> Pbrt.Encoder.t -> unit
val encode_pb_request_envelope : request_envelope -> Pbrt.Encoder.t -> unit
(** [encode_pb_request_envelope v encoder] encodes [v] with the given [encoder] *)
-val encode_pb_status : status -> Pbrt.Encoder.t -> unit
-(** [encode_pb_status v encoder] encodes [v] with the given [encoder] *)
+val encode_pb_errnum : errnum -> Pbrt.Encoder.t -> unit
+(** [encode_pb_errnum v encoder] encodes [v] with the given [encoder] *)
val encode_pb_response : response -> Pbrt.Encoder.t -> unit
(** [encode_pb_response v encoder] encodes [v] with the given [encoder] *)
@@ -552,8 +587,8 @@ val decode_pb_request_config_format : Pbrt.Decoder.t -> request_config_format
val decode_pb_request_output_format : Pbrt.Decoder.t -> request_output_format
(** [decode_pb_request_output_format decoder] decodes a [request_output_format] binary value from [decoder] *)
-val decode_pb_request_status : Pbrt.Decoder.t -> request_status
-(** [decode_pb_request_status decoder] decodes a [request_status] binary value from [decoder] *)
+val decode_pb_request_prompt : Pbrt.Decoder.t -> request_prompt
+(** [decode_pb_request_prompt decoder] decodes a [request_prompt] binary value from [decoder] *)
val decode_pb_request_setup_session : Pbrt.Decoder.t -> request_setup_session
(** [decode_pb_request_setup_session decoder] decodes a [request_setup_session] binary value from [decoder] *)
@@ -570,6 +605,12 @@ val decode_pb_request_set : Pbrt.Decoder.t -> request_set
val decode_pb_request_delete : Pbrt.Decoder.t -> request_delete
(** [decode_pb_request_delete decoder] decodes a [request_delete] binary value from [decoder] *)
+val decode_pb_request_discard : Pbrt.Decoder.t -> request_discard
+(** [decode_pb_request_discard decoder] decodes a [request_discard] binary value from [decoder] *)
+
+val decode_pb_request_session_changed : Pbrt.Decoder.t -> request_session_changed
+(** [decode_pb_request_session_changed decoder] decodes a [request_session_changed] binary value from [decoder] *)
+
val decode_pb_request_rename : Pbrt.Decoder.t -> request_rename
(** [decode_pb_request_rename decoder] decodes a [request_rename] binary value from [decoder] *)
@@ -630,8 +671,8 @@ val decode_pb_request : Pbrt.Decoder.t -> request
val decode_pb_request_envelope : Pbrt.Decoder.t -> request_envelope
(** [decode_pb_request_envelope decoder] decodes a [request_envelope] binary value from [decoder] *)
-val decode_pb_status : Pbrt.Decoder.t -> status
-(** [decode_pb_status decoder] decodes a [status] binary value from [decoder] *)
+val decode_pb_errnum : Pbrt.Decoder.t -> errnum
+(** [decode_pb_errnum decoder] decodes a [errnum] binary value from [decoder] *)
val decode_pb_response : Pbrt.Decoder.t -> response
(** [decode_pb_response decoder] decodes a [response] binary value from [decoder] *)
diff --git a/src/vyconfd.ml b/src/vyconfd.ml
index 004ed6f..885fd20 100644
--- a/src/vyconfd.ml
+++ b/src/vyconfd.ml
@@ -4,11 +4,15 @@ open Vyconf_connect.Vyconf_pbt
open Vyconfd_config.Defaults
open Vyconfd_config.Vyconf_config
-module FP = FilePath
module CT = Vyos1x.Config_tree
+module IC = Vyos1x.Internal.Make(CT)
+module CC = Commitd_client.Commit
+module VC = Commitd_client.Vycall_client
+module FP = FilePath
module Gen = Vyos1x.Generate
module Session = Vyconfd_config.Session
module Directories = Vyconfd_config.Directories
+module Startup = Vyconfd_config.Startup
(* On UNIX, self_init uses /dev/random for seed *)
let () = Random.self_init ()
@@ -91,6 +95,10 @@ let teardown token =
with Not_found ->
{response_tmpl with status=Fail; error=(Some "Session not found")}
+let session_changed world token (_req: request_session_changed) =
+ if Session.session_changed world (find_session token) then response_tmpl
+ else {response_tmpl with status=Fail}
+
let exists world token (req: request_exists) =
if Session.exists world (find_session token) req.path then response_tmpl
else {response_tmpl with status=Fail}
@@ -143,6 +151,82 @@ let validate world token (req: request_validate) =
response_tmpl
with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+let set world token (req: request_set) =
+ try
+ let () = (Lwt_log.debug @@ Printf.sprintf "[%s]\n" (Vyos1x.Util.string_of_list req.path)) |> Lwt.ignore_result in
+ let session = Session.set world (find_session token) req.path in
+ Hashtbl.replace sessions token session;
+ response_tmpl
+ with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
+let delete world token (req: request_delete) =
+ try
+ let () = (Lwt_log.debug @@ Printf.sprintf "[%s]\n" (Vyos1x.Util.string_of_list req.path)) |> Lwt.ignore_result in
+ let session = Session.delete world (find_session token) req.path in
+ Hashtbl.replace sessions token session;
+ response_tmpl
+ with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
+let discard world token (_req: request_discard) =
+ try
+ let session = Session.discard world (find_session token)
+ in
+ Hashtbl.replace sessions token session;
+ response_tmpl
+ with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
+let load world token (req: request_load) =
+ try
+ let session = Session.load world (find_session token) req.location
+ in
+ Hashtbl.replace sessions token session;
+ response_tmpl
+ with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
+let save world token (req: request_save) =
+ try
+ let _ = Session.save world (find_session token) req.location
+ in
+ response_tmpl
+ with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
+let commit world token (req: request_commit) =
+ let s = find_session token in
+ let at = world.Session.running_config in
+ let wt = s.proposed_config in
+ let rt = world.reference_tree in
+ let vc = world.vyconf_config in
+ let () = IC.write_internal at (FP.concat vc.session_dir vc.running_cache) in
+ let () = IC.write_internal wt (FP.concat vc.session_dir vc.session_cache) in
+
+ let req_dry_run = Option.value req.dry_run ~default:false in
+ let commit_data = CC.make_commit_data ~dry_run:req_dry_run rt at wt token in
+ let%lwt received_commit_data = VC.do_commit commit_data in
+ let%lwt result_commit_data =
+ Lwt.return (CC.commit_update received_commit_data)
+ in
+ match result_commit_data.init with
+ | None ->
+ let out = "Empty init" in
+ Lwt.return {response_tmpl with status=Internal_error; error=(Some out)}
+ | Some init_data ->
+ let res, out =
+ init_data.success, init_data.out
+ in
+ match res with
+ | false ->
+ Lwt.return {response_tmpl with status=Internal_error; error=(Some out)}
+ | true ->
+ (* partial commit *)
+ if not req_dry_run then
+ world.Session.running_config <- result_commit_data.config_result;
+ let success, msg_str =
+ result_commit_data.result.success, result_commit_data.result.out
+ in
+ match success with
+ | true -> Lwt.return {response_tmpl with status=Success; output=(Some msg_str)}
+ | false -> Lwt.return {response_tmpl with status=Fail; output=(Some msg_str)}
+
let reload_reftree world (_req: request_reload_reftree) =
let config = world.Session.vyconf_config in
let reftree =
@@ -171,12 +255,15 @@ let rec handle_connection world ic oc () =
with Pbrt.Decoder.Failure e -> Lwt.return (Error (Pbrt.Decoder.error_to_string e))
in
let%lwt resp =
- (match req with
- | Error msg -> {response_tmpl with status=Fail; error=(Some (Printf.sprintf "Decoding error: %s" msg))}
+ match req with
+ | Error msg -> Lwt.return {response_tmpl with status=Fail; error=(Some (Printf.sprintf "Decoding error: %s" msg))}
| Ok req ->
+ match req with
+ | Some t, Commit r -> commit world t r
+ | _ as req ->
begin
- match req with
- | _, Status -> response_tmpl
+ (match req with
+ | _, Prompt -> response_tmpl
| _, Setup_session r -> setup_session world r
| _, Reload_reftree r -> reload_reftree world r
| None, _ -> {response_tmpl with status=Fail; output=(Some "Operation requires session token")}
@@ -189,8 +276,15 @@ let rec handle_connection world ic oc () =
| Some t, List_children r -> list_children world t r
| Some t, Show_config r -> show_config world t r
| Some t, Validate r -> validate world t r
+ | Some t, Set r -> set world t r
+ | Some t, Delete r -> delete world t r
+ | Some t, Discard r -> discard world t r
+ | Some t, Session_changed r -> session_changed world t r
+ | Some t, Load r -> load world t r
+ | Some t, Save r -> save world t r
| _ -> failwith "Unimplemented"
- end) |> Lwt.return
+ ) |> Lwt.return
+ end
in
let%lwt () = send_response oc resp in
handle_connection world ic oc ()
generated by cgit v1.2.3 (git 2.39.1) at 2025-07-13 03:27:43 +0000