diff options
Diffstat (limited to 'src/commit.ml')
| -rw-r--r-- | src/commit.ml | 174 |
1 files changed, 132 insertions, 42 deletions
diff --git a/src/commit.ml b/src/commit.ml index 3c593fd..19c9844 100644 --- a/src/commit.ml +++ b/src/commit.ml @@ -2,25 +2,68 @@ module VT = Vyos1x.Vytree module CT = Vyos1x.Config_tree module CD = Vyos1x.Config_diff module RT = Vyos1x.Reference_tree -module FP = FilePath -type commit_data = { - script: string option; +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; -} [@@deriving yojson] + source: tree_source; + reply: status option; +} [@@deriving to_yojson] -let default_commit_data = { - script = None; +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 @@ -33,7 +76,7 @@ let lex_order c1 c2 = | _ as a -> a module CI = struct - type t = commit_data + type t = node_data let compare a b = match compare a.priority b.priority with | 0 -> lex_order a b @@ -41,24 +84,21 @@ module CI = struct end module CS = Set.Make(CI) -let owner_args_from_data p s = - match s with - | None -> None, None - | Some o -> +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 Some owner, None + 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 Some owner, arg_value + in owner, arg_value let add_tag_instance cd cs tv = CS.add { cd with tag_value = Some tv; } cs -let get_commit_data rt ct (path, cs') t = +let get_node_data rt ct src (path, cs') t = if Vyos1x.Util.is_empty path then (path, cs') else @@ -78,14 +118,16 @@ let get_commit_data rt ct (path, cs') t = | Some s -> int_of_string s in let owner = RT.get_owner rt rt_path in - if owner = None then (path, cs') - else - let (own, arg) = owner_args_from_data rpath owner in - let c_data = { default_commit_data with - script = own; + 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; } + path = rpath; + source = src; } in let tag_values = match RT.is_tag rt rt_path with @@ -98,8 +140,8 @@ let get_commit_data rt ct (path, cs') t = | _ -> List.fold_left (add_tag_instance c_data) cs' tag_values in (path, cs) -let get_commit_set rt ct = - snd (VT.fold_tree_with_path (get_commit_data rt ct) ([], CS.empty) ct) +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 @@ -119,30 +161,78 @@ let legacy_order del_t a b = in CS.fold shift a (a, b) -let calculate_priority_lists rt at wt = - let diff = CD.diff_tree [] at wt in +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 in - let cs_add' = get_commit_set rt add_tree 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 -let show_commit_data at wt = - let vc = - Startup.load_daemon_config Defaults.defaults.config_file in - let rt_opt = - Startup.read_reference_tree (FP.concat vc.reftree_dir vc.reference_tree) - in - match rt_opt with - | Error msg -> msg - | Ok rt -> - let del_list, add_list = - calculate_priority_lists rt at wt +(* 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 - let sprint_commit_data acc s = - acc ^ "\n" ^ (commit_data_to_yojson s |> Yojson.Safe.to_string) + { 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 - let del_out = List.fold_left sprint_commit_data "" del_list in - let add_out = List.fold_left sprint_commit_data "" add_list in - del_out ^ "\n" ^ add_out + { 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; } |