diff options
-rw-r--r-- | data/dune | 2 | ||||
-rw-r--r-- | data/vycall.proto | 21 | ||||
-rw-r--r-- | data/vyconf.proto | 21 | ||||
-rw-r--r-- | data/vyconfd.conf | 7 | ||||
-rw-r--r-- | src/adapter/vyos1x_adapter.ml | 2 | ||||
-rw-r--r-- | src/commit.ml | 238 | ||||
-rw-r--r-- | src/commit.mli | 42 | ||||
-rw-r--r-- | src/dune | 49 | ||||
-rw-r--r-- | src/session.ml | 52 | ||||
-rw-r--r-- | src/session.mli | 8 | ||||
-rw-r--r-- | src/startup.ml | 31 | ||||
-rw-r--r-- | src/startup.mli | 8 | ||||
-rw-r--r-- | src/test_commit_data.ml | 30 | ||||
-rw-r--r-- | src/validate.ml | 2 | ||||
-rw-r--r-- | src/vycall_client.ml | 93 | ||||
-rw-r--r-- | src/vycall_client.mli | 1 | ||||
-rw-r--r-- | src/vycall_pbt.ml | 313 | ||||
-rw-r--r-- | src/vycall_pbt.mli | 95 | ||||
-rw-r--r-- | src/vycli.ml | 12 | ||||
-rw-r--r-- | src/vyconf_client.ml | 30 | ||||
-rw-r--r-- | src/vyconf_client.mli | 28 | ||||
-rw-r--r-- | src/vyconf_config.ml | 9 | ||||
-rw-r--r-- | src/vyconf_config.mli | 3 | ||||
-rw-r--r-- | src/vyconf_pbt.ml | 222 | ||||
-rw-r--r-- | src/vyconf_pbt.mli | 87 | ||||
-rw-r--r-- | src/vyconfd.ml | 106 | ||||
-rw-r--r-- | vyconf.opam | 3 |
27 files changed, 1353 insertions, 162 deletions
@@ -1,3 +1,3 @@ (install - (files vyconfd.conf vyconf.proto) + (files vyconfd.conf vyconf.proto vycall.proto) (section share)) diff --git a/data/vycall.proto b/data/vycall.proto new file mode 100644 index 0000000..0037aa7 --- /dev/null +++ b/data/vycall.proto @@ -0,0 +1,21 @@ +message Status { + required bool success = 1; + required string out = 2; +} + +message Call { + required string script_name = 1; + optional string tag_value = 2; + optional string arg_value = 3; + optional Status reply = 4; +} + +message Commit { + required string session_id = 1; + required bool dry_run = 4; + required bool atomic = 5; + required bool background = 6; + + optional Status init = 7; + repeated Call calls = 8; +} diff --git a/data/vyconf.proto b/data/vyconf.proto index a09d84a..815ec68 100644 --- a/data/vyconf.proto +++ b/data/vyconf.proto @@ -9,7 +9,7 @@ message Request { OutJSON = 1; } - message Status { + message Prompt { } message SetupSession { @@ -28,13 +28,20 @@ message Request { message Set { repeated string Path = 1; - optional bool Ephemeral = 3; } message Delete { repeated string Path = 1; } + message Discard { + optional int32 dummy = 1; + } + + message SessionChanged { + optional int32 dummy = 1; + } + message Rename { repeated string EditLevel = 1; required string From = 2; @@ -56,6 +63,7 @@ message Request { optional bool Confirm = 1; optional int32 ConfirmTimeout = 2; optional string Comment = 3; + optional bool DryRun = 4; } message Rollback { @@ -125,7 +133,7 @@ message Request { oneof msg { - Status status = 1; + Prompt prompt = 1; SetupSession setup_session = 2; Set set = 3; Delete delete = 4; @@ -148,6 +156,9 @@ message Request { Validate validate = 21; Teardown teardown = 22; ReloadReftree reload_reftree = 23; + Load load = 24; + Discard discard = 25; + SessionChanged session_changed = 26; } } @@ -156,7 +167,7 @@ message RequestEnvelope { required Request request = 2; } -enum Status { +enum Errnum { SUCCESS = 0; FAIL = 1; INVALID_PATH = 2; @@ -169,7 +180,7 @@ enum Status { } message Response { - required Status status = 1; + required Errnum status = 1; optional string output = 2; optional string error = 3; optional string warning = 4; diff --git a/data/vyconfd.conf b/data/vyconfd.conf index bcde860..d1ae247 100644 --- a/data/vyconfd.conf +++ b/data/vyconfd.conf @@ -6,6 +6,7 @@ data_dir = "/usr/share/vyos/vyconf" program_dir = "/usr/libexec/vyos" config_dir = "/usr/libexec/vyos/vyconf/config" reftree_dir = "/usr/libexec/vyos/vyconf/reftree" +session_dir = "/usr/libexec/vyos/vyconf/session" # paths relative to config_dir primary_config = "config.boot" @@ -14,6 +15,12 @@ fallback_config = "config.failsafe" # paths relative to reftree_dir reference_tree = "reftree.cache" +# paths relative to session_dir +running_cache = "running_cache" +session_cache = "session_cache" + +commitd_socket = "/var/run/vyos-commitd.sock" + [vyconf] socket = "/var/run/vyconfd.sock" 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 @@ -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 () diff --git a/vyconf.opam b/vyconf.opam index b947e39..2ae8127 100644 --- a/vyconf.opam +++ b/vyconf.opam @@ -17,7 +17,7 @@ depends: [ "menhir" {build} "dune" {build & >= "1.4.0"} "ocaml-protoc" {build} - "ounit" {build} + "ounit2" {build} "lwt" {build & >= "4.1.0"} "lwt_ppx" {build} "lwt_log" {build} @@ -29,4 +29,5 @@ depends: [ "toml" {build} "sha" {build} "pcre" {build} + "toml" {build} ] |