From bed066dbf1b6cf9d606c0f1f827cce30f4dcc430 Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Thu, 20 Mar 2025 21:26:37 -0500 Subject: T7272: simplify library dependencies for implementation of commit op --- src/commit.ml | 20 -------------------- 1 file changed, 20 deletions(-) (limited to 'src/commit.ml') diff --git a/src/commit.ml b/src/commit.ml index a2b9f6e..a0d9d35 100644 --- a/src/commit.ml +++ b/src/commit.ml @@ -2,7 +2,6 @@ module VT = Vyos1x.Vytree module CT = Vyos1x.Config_tree module CD = Vyos1x.Config_diff module RT = Vyos1x.Reference_tree -module FP = FilePath type tree_source = DELETE | ADD @@ -175,22 +174,3 @@ let commit_store c_data = | false -> acc ^ "\n" ^ r.out in List.fold_left func "" c_data.node_list in print_endline out - -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 - in - let sprint_node_data acc s = - acc ^ "\n" ^ (node_data_to_yojson s |> Yojson.Safe.to_string) - in - let del_out = List.fold_left sprint_node_data "" del_list in - let add_out = List.fold_left sprint_node_data "" add_list in - del_out ^ "\n" ^ add_out -- cgit v1.2.3 From 56b05dc3b8d04de25489b4510ba25efc584ebc7a Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Sun, 30 Mar 2025 15:30:39 -0500 Subject: T7272: add commit processing of commitd response --- data/vycall.proto | 6 ---- data/vyconf.proto | 1 - src/commit.ml | 80 +++++++++++++++++++++++++++++++++++++++++++++------ src/commit.mli | 13 +++++++-- src/session.ml | 17 +++++++++++ src/session.mli | 2 ++ src/vycall_client.ml | 11 ++----- src/vycall_client.mli | 2 +- src/vycall_pbt.ml | 36 ----------------------- src/vycall_pbt.mli | 4 --- src/vyconf_pbt.ml | 18 ------------ src/vyconf_pbt.mli | 2 -- 12 files changed, 105 insertions(+), 87 deletions(-) (limited to 'src/commit.ml') diff --git a/data/vycall.proto b/data/vycall.proto index e0af67b..0037aa7 100644 --- a/data/vycall.proto +++ b/data/vycall.proto @@ -12,12 +12,6 @@ message Call { message Commit { required string session_id = 1; - // optional explicit load; - // otherwise, session configs are loaded from cached internal - // representation, specified by session id value - optional string named_active = 2; - optional string named_proposed = 3; - // required bool dry_run = 4; required bool atomic = 5; required bool background = 6; diff --git a/data/vyconf.proto b/data/vyconf.proto index a09d84a..09ee685 100644 --- a/data/vyconf.proto +++ b/data/vyconf.proto @@ -28,7 +28,6 @@ message Request { message Set { repeated string Path = 1; - optional bool Ephemeral = 3; } message Delete { diff --git a/src/commit.ml b/src/commit.ml index a0d9d35..acfecfe 100644 --- a/src/commit.ml +++ b/src/commit.ml @@ -3,6 +3,8 @@ 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 @@ -32,29 +34,31 @@ let default_node_data = { arg_value = None; path = []; source = ADD; - reply = Some { success = false; out = ""; }; + reply = None; } type commit_data = { session_id: string; - named_active : string option; - named_proposed : string option; 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 = ""; - named_active = None; - named_proposed = None; dry_run = false; atomic = false; background = false; - init = Some { success = false; out = ""; }; + init = None; node_list = []; + config_diff = CT.default; + config_result = CT.default; + result = { success = true; out = ""; }; } let lex_order c1 c2 = @@ -154,8 +158,7 @@ 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 DELETE in @@ -174,3 +177,64 @@ let commit_store c_data = | false -> acc ^ "\n" ^ r.out in List.fold_left func "" c_data.node_list in print_endline out + +(* 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 -> raise (Commit_error "commitd failure: no init status provided") + | Some _ -> + let func acc_data nd = + match nd.reply with + | None -> raise (Commit_error "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 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; + 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 index 696f595..12ad084 100644 --- a/src/commit.mli +++ b/src/commit.mli @@ -17,21 +17,28 @@ type node_data = { type commit_data = { session_id: string; - named_active : string option; - named_proposed : string option; 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 calculate_priority_lists : Vyos1x.Reference_tree.t -> Vyos1x.Config_tree.t -> Vyos1x.Config_tree.t -> node_data list * node_data list +val make_commit_data : 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 val commit_store : commit_data -> unit diff --git a/src/session.ml b/src/session.ml index 567f999..9e78be3 100644 --- a/src/session.ml +++ b/src/session.ml @@ -1,6 +1,8 @@ module CT = Vyos1x.Config_tree module VT = Vyos1x.Vytree module RT = Vyos1x.Reference_tree +module CC = Commitd_client.Commit +module VC = Commitd_client.Vycall_client module D = Directories exception Session_error of string @@ -88,6 +90,21 @@ let delete w s path = let config = apply_cfg_op op s.proposed_config in {s with proposed_config=config; changeset=(op :: s.changeset)} +let commit w s t = + let at = w.running_config in + let wt = s.proposed_config in + let rt = w.reference_tree in + let commit_data = CC.make_commit_data rt at wt t in + let received_commit_data = VC.do_commit commit_data in + let result_commit_data = + try + CC.commit_update received_commit_data + with CC.Commit_error e -> + raise (Session_error (Printf.sprintf "Commit internal error: %s" e)) + in + w.running_config <- result_commit_data.config_result; + result_commit_data.result.success, result_commit_data.result.out + 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..507b33e 100644 --- a/src/session.mli +++ b/src/session.mli @@ -32,6 +32,8 @@ val set : world -> session_data -> string list -> session_data val delete : world -> session_data -> string list -> session_data +val commit : world -> session_data -> string -> bool * string + val get_value : world -> session_data -> string list -> string val get_values : world -> session_data -> string list -> string list diff --git a/src/vycall_client.ml b/src/vycall_client.ml index f146543..140fe2a 100644 --- a/src/vycall_client.ml +++ b/src/vycall_client.ml @@ -31,8 +31,6 @@ let call_to_node_data ((c: call), (nd: node_data)) = let commit_data_to_commit_proto cd = { session_id = cd.session_id; - named_active = cd.named_active; - named_proposed = cd.named_proposed; dry_run = cd.dry_run; atomic = cd.atomic; background = cd.background; @@ -86,15 +84,12 @@ let create sockfile = let oc = Lwt_io.of_fd ~mode:Lwt_io.Output sock in Lwt.return { ic=ic; oc=oc; } -let update session_data = - Lwt.return (commit_store session_data) - -let do_commit session_data = - let session = commit_data_to_commit_proto session_data in +let do_commit commit_data = + let session = commit_data_to_commit_proto commit_data in let run () = 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 - update (commit_proto_to_commit_data resp session_data) + Lwt.return (commit_proto_to_commit_data resp commit_data) in Lwt_main.run @@ run () diff --git a/src/vycall_client.mli b/src/vycall_client.mli index 0fdb6d7..758a32f 100644 --- a/src/vycall_client.mli +++ b/src/vycall_client.mli @@ -1 +1 @@ -val do_commit : Commit.commit_data -> unit +val do_commit : Commit.commit_data -> Commit.commit_data diff --git a/src/vycall_pbt.ml b/src/vycall_pbt.ml index 8cccb0a..715c453 100644 --- a/src/vycall_pbt.ml +++ b/src/vycall_pbt.ml @@ -14,8 +14,6 @@ type call = { type commit = { session_id : string; - named_active : string option; - named_proposed : string option; dry_run : bool; atomic : bool; background : bool; @@ -45,8 +43,6 @@ let rec default_call let rec default_commit ?session_id:((session_id:string) = "") - ?named_active:((named_active:string option) = None) - ?named_proposed:((named_proposed:string option) = None) ?dry_run:((dry_run:bool) = false) ?atomic:((atomic:bool) = false) ?background:((background:bool) = false) @@ -54,8 +50,6 @@ let rec default_commit ?calls:((calls:call list) = []) () : commit = { session_id; - named_active; - named_proposed; dry_run; atomic; background; @@ -89,8 +83,6 @@ let default_call_mutable () : call_mutable = { type commit_mutable = { mutable session_id : string; - mutable named_active : string option; - mutable named_proposed : string option; mutable dry_run : bool; mutable atomic : bool; mutable background : bool; @@ -100,8 +92,6 @@ type commit_mutable = { let default_commit_mutable () : commit_mutable = { session_id = ""; - named_active = None; - named_proposed = None; dry_run = false; atomic = false; background = false; @@ -132,8 +122,6 @@ let rec pp_call fmt (v:call) = 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 "named_active" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.named_active; - Pbrt.Pp.pp_record_field ~first:false "named_proposed" (Pbrt.Pp.pp_option Pbrt.Pp.pp_string) fmt v.named_proposed; 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; @@ -179,18 +167,6 @@ let rec encode_pb_call (v:call) encoder = let rec encode_pb_commit (v:commit) encoder = Pbrt.Encoder.string v.session_id encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; - begin match v.named_active with - | Some x -> - Pbrt.Encoder.string x encoder; - Pbrt.Encoder.key 2 Pbrt.Bytes encoder; - | None -> (); - end; - begin match v.named_proposed with - | Some x -> - Pbrt.Encoder.string x encoder; - Pbrt.Encoder.key 3 Pbrt.Bytes encoder; - | None -> (); - end; Pbrt.Encoder.bool v.dry_run encoder; Pbrt.Encoder.key 4 Pbrt.Varint encoder; Pbrt.Encoder.bool v.atomic encoder; @@ -296,16 +272,6 @@ let rec decode_pb_commit d = end | Some (1, pk) -> Pbrt.Decoder.unexpected_payload "Message(commit), field(1)" pk - | Some (2, Pbrt.Bytes) -> begin - v.named_active <- Some (Pbrt.Decoder.string d); - end - | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(commit), field(2)" pk - | Some (3, Pbrt.Bytes) -> begin - v.named_proposed <- Some (Pbrt.Decoder.string d); - end - | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(commit), field(3)" pk | Some (4, Pbrt.Varint) -> begin v.dry_run <- Pbrt.Decoder.bool d; dry_run_is_set := true; end @@ -339,8 +305,6 @@ let rec decode_pb_commit d = begin if not !session_id_is_set then Pbrt.Decoder.missing_field "session_id" end; ({ session_id = v.session_id; - named_active = v.named_active; - named_proposed = v.named_proposed; dry_run = v.dry_run; atomic = v.atomic; background = v.background; diff --git a/src/vycall_pbt.mli b/src/vycall_pbt.mli index 5c8bd20..f389302 100644 --- a/src/vycall_pbt.mli +++ b/src/vycall_pbt.mli @@ -21,8 +21,6 @@ type call = { type commit = { session_id : string; - named_active : string option; - named_proposed : string option; dry_run : bool; atomic : bool; background : bool; @@ -51,8 +49,6 @@ val default_call : val default_commit : ?session_id:string -> - ?named_active:string option -> - ?named_proposed:string option -> ?dry_run:bool -> ?atomic:bool -> ?background:bool -> diff --git a/src/vyconf_pbt.ml b/src/vyconf_pbt.ml index 9d2845d..5692f77 100644 --- a/src/vyconf_pbt.ml +++ b/src/vyconf_pbt.ml @@ -26,7 +26,6 @@ type request_validate = { type request_set = { path : string list; - ephemeral : bool option; } type request_delete = { @@ -195,10 +194,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 @@ -393,12 +390,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 = { @@ -636,7 +631,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 () @@ -883,12 +877,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 = @@ -1303,16 +1291,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 = diff --git a/src/vyconf_pbt.mli b/src/vyconf_pbt.mli index 56cf4ea..7371d18 100644 --- a/src/vyconf_pbt.mli +++ b/src/vyconf_pbt.mli @@ -33,7 +33,6 @@ type request_validate = { type request_set = { path : string list; - ephemeral : bool option; } type request_delete = { @@ -206,7 +205,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] *) -- cgit v1.2.3 From ab010dbe993afc990fafa4525e1a94670ca7f5a4 Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Sun, 30 Mar 2025 22:29:35 -0500 Subject: T7272: call both Lwt connections under a single Lwt.main Call both the vyconfd server and the vyos-commitd client under the top-level Lwt.main loop. --- src/commit.ml | 13 ++++++++++-- src/session.ml | 17 --------------- src/session.mli | 2 -- src/vycall_client.ml | 12 +++++------ src/vycall_client.mli | 2 +- src/vyconfd.ml | 57 +++++++++++++++++++++++++++++++++++++++------------ 6 files changed, 61 insertions(+), 42 deletions(-) (limited to 'src/commit.ml') diff --git a/src/commit.ml b/src/commit.ml index acfecfe..ba740b5 100644 --- a/src/commit.ml +++ b/src/commit.ml @@ -61,6 +61,9 @@ let default_commit_data = { 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 @@ -222,11 +225,17 @@ let config_result_update c_data n_data = let commit_update c_data = match c_data.init with - | None -> raise (Commit_error "commitd failure: no init status provided") + | 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 -> raise (Commit_error "commitd failure: no reply status provided") + | 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 diff --git a/src/session.ml b/src/session.ml index 9e78be3..567f999 100644 --- a/src/session.ml +++ b/src/session.ml @@ -1,8 +1,6 @@ module CT = Vyos1x.Config_tree module VT = Vyos1x.Vytree module RT = Vyos1x.Reference_tree -module CC = Commitd_client.Commit -module VC = Commitd_client.Vycall_client module D = Directories exception Session_error of string @@ -90,21 +88,6 @@ let delete w s path = let config = apply_cfg_op op s.proposed_config in {s with proposed_config=config; changeset=(op :: s.changeset)} -let commit w s t = - let at = w.running_config in - let wt = s.proposed_config in - let rt = w.reference_tree in - let commit_data = CC.make_commit_data rt at wt t in - let received_commit_data = VC.do_commit commit_data in - let result_commit_data = - try - CC.commit_update received_commit_data - with CC.Commit_error e -> - raise (Session_error (Printf.sprintf "Commit internal error: %s" e)) - in - w.running_config <- result_commit_data.config_result; - result_commit_data.result.success, result_commit_data.result.out - 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 507b33e..2166a80 100644 --- a/src/session.mli +++ b/src/session.mli @@ -32,8 +32,6 @@ val set : world -> session_data -> string list -> session_data val delete : world -> session_data -> string list -> session_data -val commit : world -> session_data -> string -> bool * string - val get_value : world -> session_data -> string list -> string val get_values : world -> session_data -> string list -> string list diff --git a/src/vycall_client.ml b/src/vycall_client.ml index 140fe2a..11bbe3f 100644 --- a/src/vycall_client.ml +++ b/src/vycall_client.ml @@ -86,10 +86,8 @@ let create sockfile = let do_commit commit_data = let session = commit_data_to_commit_proto commit_data in - let run () = - 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) - in Lwt_main.run @@ run () + 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 index 758a32f..fe19231 100644 --- a/src/vycall_client.mli +++ b/src/vycall_client.mli @@ -1 +1 @@ -val do_commit : Commit.commit_data -> Commit.commit_data +val do_commit : Commit.commit_data -> Commit.commit_data Lwt.t diff --git a/src/vyconfd.ml b/src/vyconfd.ml index 76f7205..d3e4216 100644 --- a/src/vyconfd.ml +++ b/src/vyconfd.ml @@ -4,8 +4,11 @@ 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 @@ -161,13 +164,38 @@ let delete world token (req: request_delete) = with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} let commit world token (_req: request_commit) = - try - let success, msg_str = Session.commit world (find_session token) token in - match success with - | true -> {response_tmpl with status=Success; output=(Some msg_str)} - | false -> {response_tmpl with status=Fail; output=(Some msg_str)} - with Session.Session_error msg -> - {response_tmpl with status=Internal_error; error=(Some msg)} + 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 commit_data = CC.make_commit_data 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 -> + 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 @@ -197,11 +225,14 @@ 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 + (match req with | _, Status -> response_tmpl | _, Setup_session r -> setup_session world r | _, Reload_reftree r -> reload_reftree world r @@ -217,9 +248,9 @@ let rec handle_connection world ic oc () = | 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, Commit r -> commit world t r | _ -> failwith "Unimplemented" - end) |> Lwt.return + ) |> Lwt.return + end in let%lwt () = send_response oc resp in handle_connection world ic oc () -- cgit v1.2.3