T7292: add commit request client operations

3 files changed, 59 insertions, 0 deletions

diff --git a/src/vyconf_client.ml b/src/vyconf_client.ml
index 5437428..1f00f29 100644
--- a/src/vyconf_client.ml
+++ b/src/vyconf_client.ml
@@ -118,6 +118,30 @@ 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;} 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..5fd4df4 100644
--- a/src/vyconf_client.mli
+++ b/src/vyconf_client.mli
@@ -43,4 +43,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/vyconfd.ml b/src/vyconfd.ml
index 95915b3..76f7205 100644
--- a/src/vyconfd.ml
+++ b/src/vyconfd.ml
@@ -144,6 +144,31 @@ 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 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 reload_reftree world (_req: request_reload_reftree) =
     let config = world.Session.vyconf_config in
     let reftree =
@@ -190,6 +215,9 @@ 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, Commit r -> commit world t r
                     | _ -> failwith "Unimplemented"
                 end) |> Lwt.return
         in