T7374: add executable to replace legacy my_* cli tools

Add framework and initial replacements vy_set, vy_delete, vy_discard,
and the utility vy_session_changed.

4 files changed, 105 insertions, 1 deletions

diff --git a/src/dune b/src/dune
index 63e1167..0c13950 100644
--- a/src/dune
+++ b/src/dune
@@ -49,6 +49,13 @@
  (preprocess (pps lwt_ppx)))
 
 (executable
+ (name vyconf_cli)
+ (public_name vyconf_cli)
+ (modules vyconf_cli)
+ (libraries vyconfd_client)
+ (preprocess (pps lwt_ppx)))
+
+(executable
  (name validate)
  (public_name validate)
  (modules validate)
diff --git a/src/vyconf_cli.ml b/src/vyconf_cli.ml
new file mode 100644
index 0000000..ded03df
--- /dev/null
+++ b/src/vyconf_cli.ml
@@ -0,0 +1,69 @@
+open Vyconfd_client.Vyconf_client
+open Vyconf_connect.Vyconf_pbt
+
+type op_t =
+    | OpSet
+    | OpDelete
+    | OpDiscard
+    | OpShowConfig
+    | OpSessionChanged
+
+let op_of_string s =
+    match s with
+    | "vy_set" -> OpSet
+    | "vy_delete" -> OpDelete
+    | "vy_discard" -> OpDiscard
+    | "vy_show" -> OpShowConfig
+    | "vy_session_changed" -> OpSessionChanged
+    | _ -> failwith (Printf.sprintf "Unknown operation %s" s)
+
+let config_format_of_string s =
+    match s with
+    | "curly" -> Curly
+    | "json" -> Json
+    | _ -> failwith (Printf.sprintf "Unknown config format %s, should be curly or json" s)
+
+let output_format_of_string s =
+    match s with
+    | "plain" -> Out_plain
+    | "json" ->	Out_json
+    | _	-> failwith (Printf.sprintf "Unknown output format %s, should be plain or json" s)
+
+let get_session () =
+    let pid = Int32.of_int (Unix.getppid()) in
+    let socket = "/var/run/vyconfd.sock" in
+    let config_format = config_format_of_string "curly" in
+    let out_format = output_format_of_string "plain" in
+    let%lwt client =
+        create socket out_format config_format
+    in
+    let%lwt resp = session_of_pid client pid in
+    match resp with
+    | Error _ -> setup_session client "vyconf_cli" pid
+    | _ as c -> c |> Lwt.return
+
+let main op path =
+    let%lwt client = get_session () in
+    let%lwt result =
+    match client with
+    | Ok c ->
+        begin
+        match op with
+        | OpSet -> set c path
+        | OpDelete -> delete c path
+        | OpDiscard -> discard c
+        | OpShowConfig -> show_config c path
+        | OpSessionChanged -> session_changed c
+        end
+    | Error e -> Error e |> Lwt.return
+    in
+    match result with
+    | Ok s -> let%lwt () = Lwt_io.write Lwt_io.stdout s in Lwt.return 0
+    | Error e -> let%lwt () = Lwt_io.write Lwt_io.stderr (Printf.sprintf "%s\n" e) in Lwt.return 1
+
+let () =
+    let path_list = Array.to_list (Array.sub Sys.argv 1 (Array.length Sys.argv - 1))
+    in
+    let op_str = FilePath.basename Sys.argv.(0) in
+    let op = op_of_string op_str in
+    let result = Lwt_main.run (main op path_list) in exit result
diff --git a/src/vyconf_client.ml b/src/vyconf_client.ml
index 9971f8f..05b5548 100644
--- a/src/vyconf_client.ml
+++ b/src/vyconf_client.ml
@@ -65,6 +65,13 @@ let setup_session ?(on_behalf_of=None) client client_app pid =
          | None -> Error "setup_session did not return a session token!") |> Lwt.return
     | _ -> Error (Option.value resp.error ~default:"Unknown error") |> Lwt.return
 
+let session_of_pid client pid =
+    let req = Session_of_pid {client_pid=pid} in
+    let%lwt resp = do_request client req in
+    (match resp.output with
+     | Some token -> Ok {client with session=(Some token)}
+     | None -> Error "no such session") |> Lwt.return
+
 let teardown_session ?(on_behalf_of=None) client =
     let id = on_behalf_of |> (function None -> None | Some x -> (Some (Int32.of_int x))) in
     let req = Teardown {on_behalf_of=id} in
@@ -134,6 +141,22 @@ let delete client path =
     | Fail -> Error (Option.value resp.error ~default:"") |> Lwt.return
     | _ -> Error (Option.value resp.error ~default:"") |> Lwt.return
 
+let session_changed client =
+    let req = Session_changed {dummy=None;} 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 discard client =
+    let req = Discard {dummy=None;} 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}
diff --git a/src/vyconf_client.mli b/src/vyconf_client.mli
index 39e955b..762495d 100644
--- a/src/vyconf_client.mli
+++ b/src/vyconf_client.mli
@@ -10,6 +10,8 @@ val prompt : t -> Vyconf_connect.Vyconf_pbt.response Lwt.t
 
 val setup_session : ?on_behalf_of:(int option) -> t -> string -> int32 -> (t, string) result Lwt.t
 
+val session_of_pid : t -> int32 -> (t, string) result Lwt.t
+
 val teardown_session : ?on_behalf_of:(int option) -> t -> (string, string) result Lwt.t
 
 val exists : t -> string list -> (string, string) result Lwt.t
@@ -28,7 +30,10 @@ 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 session_changed : t -> (string, string) result Lwt.t
 
+val discard : t -> (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