From 28efcd85149bb284b7835c360dd2cfeab2f92aa2 Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Sun, 17 Aug 2025 13:43:58 -0500 Subject: T7728: dynamically generate proposed config from changeset data --- src/session.ml | 132 ++++++++++++++++++++++++++++++++++---------------------- src/session.mli | 8 ++-- src/vyconfd.ml | 11 ++++- 3 files changed, 96 insertions(+), 55 deletions(-) (limited to 'src') diff --git a/src/session.ml b/src/session.ml index 31bd411..f8bc843 100644 --- a/src/session.ml +++ b/src/session.ml @@ -58,17 +58,32 @@ let set_modified s = if s.modified = true then s else {s with modified = true} -let apply_cfg_op op config = +let apply_cfg_op w op config = + let config = match op with | CfgSet (path, value, value_behaviour) -> - CT.set config path value value_behaviour + begin + try + CT.set config path value value_behaviour |> + (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 | CT.Duplicate_value -> config + end | CfgDelete (path, value) -> - CT.delete config path value + begin + try + CT.delete config path value |> + (fun c -> CT.prune_delete c path) + with + | VT.Nonexistent_path | CT.No_such_value -> config + end + in config -let rec apply_changes changeset config = +let rec apply_changes w changeset config = match changeset with | [] -> config - | c :: cs -> apply_changes cs (apply_cfg_op c config) + | c :: cs -> apply_changes w cs (apply_cfg_op w c config) let validate w _s path = try @@ -81,46 +96,55 @@ let validate_tree w t = | "" -> () | _ -> raise (Session_error out) -let split_path w _s path = +let split_path w path = RT.split_path w.reference_tree path -let set w s path = - let _ = validate w s path in - let path, value = split_path w s path in +let get_proposed_config w s = + let c = w.running_config in + apply_changes w (List.rev s.changeset) c + +let update_set w changeset path = + let path, value = split_path w path in 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 = - 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 | CT.Duplicate_value -> s.proposed_config + (op :: changeset) + +let update_delete w changeset path = + let path, value = split_path w path in + let op = CfgDelete (path, value) in + (op :: changeset) +let get_changeset w lt rt = + let diff = CD.diff_tree [] lt rt in + let add_tree = CT.get_subtree diff ["add"] in + let del_tree = CT.get_subtree diff ["del"] in + let add_changeset = + List.fold_left (update_set w) [] (CT.value_paths_of_tree add_tree) + in + let del_changeset = + List.fold_left (update_delete w) [] (CT.value_paths_of_tree del_tree) in - {s with proposed_config=config; changeset=(op :: s.changeset)} + add_changeset @ del_changeset + +let set w s path = + let _ = validate w s path in + let changeset' = update_set w s.changeset path in + { s with changeset = changeset' } let delete w s path = - let path, value = split_path w s path in - let op = CfgDelete (path, value) in - let config = - try - apply_cfg_op op s.proposed_config |> - (fun c -> CT.prune_delete c path) - with - | VT.Nonexistent_path | CT.No_such_value -> s.proposed_config - in - {s with proposed_config=config; changeset=(op :: s.changeset)} + let changeset' = update_delete w s.changeset path in + { s with changeset = changeset' } -let discard w s = - {s with proposed_config=w.running_config} +let discard _w s = + { s with changeset = []; } 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 c = get_proposed_config w s in + let diff = CD.diff_tree [] w.running_config c 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) @@ -138,7 +162,8 @@ let load w s file cached = 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;} + validate_tree w config; + { s with changeset = get_changeset w w.running_config config; } let merge w s file destructive = let ct = Vyos1x.Config_file.load_config file in @@ -146,9 +171,10 @@ let merge w s file destructive = | Error e -> raise (Session_error (Printf.sprintf "Error loading config: %s" e)) | Ok config -> let () = validate_tree w config in - let merged = CD.tree_merge ~destructive:destructive s.proposed_config config + let proposed = get_proposed_config w s in + let merged = CD.tree_merge ~destructive:destructive proposed config in - {s with proposed_config=merged;} + { s with changeset = get_changeset w w.running_config merged; } let save w s file = let ct = w.running_config in @@ -157,9 +183,8 @@ let save w s file = | Error e -> raise (Session_error (Printf.sprintf "Error saving config: %s" e)) | Ok () -> s -let prepare_commit ?(dry_run=false) w s id = +let prepare_commit ?(dry_run=false) w config id = let at = w.running_config in - let wt = s.proposed_config in let rt = w.reference_tree in let vc = w.vyconf_config in let () = @@ -170,15 +195,15 @@ let prepare_commit ?(dry_run=false) w s id = in let () = try - IC.write_internal wt (FP.concat vc.session_dir vc.session_cache) + IC.write_internal config (FP.concat vc.session_dir vc.session_cache) with Vyos1x.Internal.Write_error msg -> raise (Session_error msg) in - CC.make_commit_data ~dry_run:dry_run rt at wt id + CC.make_commit_data ~dry_run:dry_run rt at config id let get_config w s id = let at = w.running_config in - let wt = s.proposed_config in + let wt = get_proposed_config w s in let vc = w.vyconf_config in let running_cache = Printf.sprintf "%s_%s" vc.running_cache id in let session_cache = Printf.sprintf "%s_%s" vc.session_cache id in @@ -207,7 +232,8 @@ let cleanup_config w id = remove_file (FP.concat vc.session_dir session_cache) let get_value w s path = - if not (VT.exists s.proposed_config path) then + let c = get_proposed_config w s in + if not (VT.exists c path) then raise (Session_error ("Config path does not exist")) else let refpath = RT.refpath w.reference_tree path in if not (RT.is_leaf w.reference_tree refpath) then @@ -216,39 +242,43 @@ let get_value w s path = raise (Session_error "This node can have more than one value") else if (RT.is_valueless w.reference_tree refpath) then raise (Session_error "This node can have more than one value") - else CT.get_value s.proposed_config path + else CT.get_value c path let get_values w s path = - if not (VT.exists s.proposed_config path) then + let c = get_proposed_config w s in + if not (VT.exists c path) then raise (Session_error ("Config path does not exist")) else let refpath = RT.refpath w.reference_tree path in if not (RT.is_leaf w.reference_tree refpath) then raise (Session_error "Cannot get a value of a non-leaf node") else if not (RT.is_multi w.reference_tree refpath) then raise (Session_error "This node can have only one value") - else CT.get_values s.proposed_config path + else CT.get_values c path let list_children w s path = - if not (VT.exists s.proposed_config path) then + let c = get_proposed_config w s in + if not (VT.exists c path) then raise (Session_error ("Config path does not exist")) else let refpath = RT.refpath w.reference_tree path in if (RT.is_leaf w.reference_tree refpath) then raise (Session_error "Cannot list children of a leaf node") - else VT.children_of_path s.proposed_config path + else VT.children_of_path c path -let exists _w s path = - VT.exists s.proposed_config path +let exists w s path = + let c = get_proposed_config w s in + VT.exists c path -let show_config _w s path fmt = +let show_config w s path fmt = let open Vyconf_connect.Vyconf_pbt in - if (path <> []) && not (VT.exists s.proposed_config path) then + let c = get_proposed_config w s in + if (path <> []) && not (VT.exists c path) then raise (Session_error ("Path does not exist")) else - let node = s.proposed_config in + let node = c in match fmt with | Curly -> CT.render_at_level node path | Json -> let node = - (match path with [] -> s.proposed_config | - _ as ps -> VT.get s.proposed_config ps) in + (match path with [] -> c | + _ as ps -> VT.get c ps) in CT.to_yojson node |> Yojson.Safe.pretty_to_string diff --git a/src/session.mli b/src/session.mli index 1a9b79f..abe5165 100644 --- a/src/session.mli +++ b/src/session.mli @@ -25,14 +25,16 @@ val make : world -> string -> string -> int32 -> session_data val set_modified : session_data -> session_data -val apply_changes : cfg_op list -> Vyos1x.Config_tree.t -> Vyos1x.Config_tree.t - val validate : world -> session_data -> string list -> unit +val get_changeset : world -> Vyos1x.Config_tree.t -> Vyos1x.Config_tree.t -> cfg_op list + val set : world -> session_data -> string list -> session_data val delete : world -> session_data -> string list -> session_data +val get_proposed_config : world -> session_data -> Vyos1x.Config_tree.t + val discard : world -> session_data -> session_data val session_changed : world -> session_data -> bool @@ -53,7 +55,7 @@ val list_children : world -> session_data -> string list -> string list val string_of_op : cfg_op -> string -val prepare_commit : ?dry_run:bool -> world -> session_data -> string -> Commitd_client.Commit.commit_data +val prepare_commit : ?dry_run:bool -> world -> Vyos1x.Config_tree.t -> string -> Commitd_client.Commit.commit_data val get_config : world -> session_data -> string -> string diff --git a/src/vyconfd.ml b/src/vyconfd.ml index a0be019..f1b1694 100644 --- a/src/vyconfd.ml +++ b/src/vyconfd.ml @@ -240,9 +240,10 @@ let save world token (req: request_save) = let commit world token (req: request_commit) = let s = find_session token in + let proposed_config = Session.get_proposed_config world s in let req_dry_run = Option.value req.dry_run ~default:false in - let commit_data = Session.prepare_commit ~dry_run:req_dry_run world s token + let commit_data = Session.prepare_commit ~dry_run:req_dry_run world proposed_config token in let%lwt received_commit_data = VC.do_commit commit_data in let%lwt result_commit_data = @@ -263,6 +264,14 @@ let commit world token (req: request_commit) = (* partial commit *) if not req_dry_run then world.Session.running_config <- result_commit_data.config_result; + let session = + { s with changeset = + Session.get_changeset + world + world.Session.running_config + proposed_config } + in Hashtbl.replace sessions token session; + let success, msg_str = result_commit_data.result.success, result_commit_data.result.out in -- cgit v1.2.3 From b46b74b48f7db04a46d0ba7caa512dc70b5fcccd Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Mon, 18 Aug 2025 22:38:10 -0500 Subject: T7734: distinguish childless non-leaf nodes in set operation --- src/session.ml | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/session.ml b/src/session.ml index f8bc843..5efc9f5 100644 --- a/src/session.ml +++ b/src/session.ml @@ -53,20 +53,26 @@ let string_of_op op = | None -> Printf.sprintf "delete %s" path_str | Some v -> Printf.sprintf "delete %s \"%s\"" path_str v) - let set_modified s = if s.modified = true then s else {s with modified = true} let apply_cfg_op w op config = - let config = + let result = match op with | CfgSet (path, value, value_behaviour) -> begin + let rt = w.reference_tree in + let refp = RT.refpath rt path in try - CT.set config path value value_behaviour |> - (fun c -> RT.set_tag_data w.reference_tree c path) |> - (fun c -> RT.set_leaf_data w.reference_tree c path) + let c = + match (RT.is_leaf rt refp) with + | true -> + CT.set config path value value_behaviour + | false -> + CT.create_node config path + in + RT.set_tag_data rt c path with | CT.Useless_set | CT.Duplicate_value -> config end @@ -78,7 +84,7 @@ let apply_cfg_op w op config = with | VT.Nonexistent_path | CT.No_such_value -> config end - in config + in result let rec apply_changes w changeset config = match changeset with -- cgit v1.2.3