Implement config reading functions and a minimal command line client for using them.

Yes, I hate oversized commits too, but this is hard to avoid sometimes.

Adjustments to the Session functions logic required to make it work:
 Do not try to validate the path. The validation function is geared towards
  validating _set_ paths, so when path lacks a value, it doesn't work right.
  We assume that the path has been through set at some point, so if a path
  currently exists in the config tree, it is also a valid path that can be used for
  Reference_tree.is_leaf etc.

6 files changed, 143 insertions, 25 deletions

diff --git a/src/session.ml b/src/session.ml
index 90ab5c8..a502629 100644
--- a/src/session.ml
+++ b/src/session.ml
@@ -77,27 +77,41 @@ let delete w s path =
     {s with proposed_config=config; changeset=(op :: s.changeset)}
 
 let get_value w s path =
-    let path, _ = RT.validate_path D.(w.dirs.validators) w.reference_tree path in
-    if RT.is_leaf w.reference_tree path then
-        if not ((RT.is_multi w.reference_tree path) || (RT.is_valueless w.reference_tree path))
-        then CT.get_value s.proposed_config path
-        else raise (Session_error "This node can have more than one value")
-    else raise (Session_error "Cannot get a value of a non-leaf node")
+    if not (Vytree.exists s.proposed_config path) then
+        raise (Session_error ("Path does not exist"))
+    else if not (RT.is_leaf w.reference_tree path) then
+        raise (Session_error "Cannot get a value of a non-leaf node")
+    else if (RT.is_multi w.reference_tree path) then
+        raise (Session_error "This node can have more than one value")
+    else if (RT.is_valueless w.reference_tree path) then
+        raise (Session_error "This node can have more than one value")
+    else CT.get_value s.proposed_config path
 
 let get_values w s path =
-    let path, _ = RT.validate_path D.(w.dirs.validators) w.reference_tree path in
-    if RT.is_leaf w.reference_tree path then
-        if RT.is_multi w.reference_tree path
-        then CT.get_values s.proposed_config path
-        else raise (Session_error "This node can have only one value")
-    else raise (Session_error "Cannot get a value of a non-leaf node")
+    if not (Vytree.exists s.proposed_config path) then
+        raise (Session_error ("Path does not exist"))
+    else if not (RT.is_leaf w.reference_tree path) then
+        raise (Session_error "Cannot get a value of a non-leaf node")
+    else if not (RT.is_multi w.reference_tree path) then
+        raise (Session_error "This node can have only one value")
+    else  CT.get_values s.proposed_config path
 
 let list_children w s path =
-    let path, _ = RT.validate_path D.(w.dirs.validators) w.reference_tree path in
-    if not (RT.is_leaf w.reference_tree path)
-    then Vytree.children_of_path s.proposed_config path
-    else raise (Session_error "Cannot list children of a leaf node")
+    if not (Vytree.exists s.proposed_config path) then
+        raise (Session_error ("Path does not exist"))
+    else if (RT.is_leaf w.reference_tree path) then
+        raise (Session_error "Cannot list children of a leaf node")
+    else Vytree.children_of_path s.proposed_config path
 
 let exists w s path =
-    let path, _ = RT.validate_path D.(w.dirs.validators) w.reference_tree path in
     Vytree.exists s.proposed_config path
+
+let show_config w s path fmt =
+    let open Vyconf_types in
+    if not (Vytree.exists s.proposed_config path) then
+        raise (Session_error ("Path does not exist")) 
+    else
+        let node = Vytree.get s.proposed_config path in
+        match fmt with
+        | Curly -> CT.render node
+        | Json -> CT.to_yojson node |> Yojson.Safe.pretty_to_string
diff --git a/src/session.mli b/src/session.mli
index 0ec844b..299f2ca 100644
--- a/src/session.mli
+++ b/src/session.mli
@@ -35,3 +35,5 @@ val exists : world -> session_data -> string list -> bool
 val list_children : world -> session_data -> string list -> string list
 
 val string_of_op : cfg_op -> string
+
+val show_config : world -> session_data -> string list -> Vyconf_types.request_config_format -> string
diff --git a/src/vycli.ml b/src/vycli.ml
new file mode 100644
index 0000000..c2f95e7
--- /dev/null
+++ b/src/vycli.ml
@@ -0,0 +1,88 @@
+open Vyconf_client
+open Vyconf_types
+
+type op_t =
+    | OpStatus
+    | OpSetupSession
+    | OpTeardownSession
+    | OpShowConfig
+    | OpExists
+    | OpGetValue
+    | OpGetValues
+    | OpListChildren
+
+let token : string option ref = ref None
+let conf_format_opt = ref "curly"
+let out_format_opt = ref "plain"
+let socket = ref ""
+let path_opt = ref ""
+let op = ref None
+
+(* Command line arguments *)
+let usage = "Usage: " ^ Sys.argv.(0) ^ " [options]"
+
+let args = [
+    ("--config-format", Arg.String (fun s -> conf_format_opt := s), "<curly|json>  Configuration output format, default is curly");
+    ("--out-format", Arg.String (fun s -> out_format_opt := s), "<plain|json>  Operational mode output format, default is plain");
+    ("--token", Arg.String (fun s -> token := Some s), "<string>  Session token");
+    ("--socket", Arg.String (fun s -> socket := s), "<string>  Socket file path");
+    ("--setup-session", Arg.Unit (fun () -> op := Some OpSetupSession), "Setup a configuration session");
+    ("--path", Arg.String (fun s -> path_opt := s), "<string> Configuration path");
+    ("--get-value", Arg.Unit (fun () -> op := Some OpGetValue), "Get value at the specified path");
+    ("--get-values", Arg.Unit (fun () -> op := Some OpGetValues), "Get values at the specified path");
+    ("--exists", Arg.Unit (fun () -> op := Some OpExists), "Check if specified path exists");
+    ("--list-children", Arg.Unit (fun () -> op := Some OpListChildren), "List children of the node at the specified path");
+    ("--show-config", Arg.Unit (fun () -> op := Some OpShowConfig), "Show the configuration at the specified path");
+    ("--status", Arg.Unit (fun () -> op := Some OpStatus), "Send a status/keepalive message");
+   ]
+
+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 main socket op path out_format config_format =
+    let%lwt client = Vyconf_client.create ~token:!token socket out_format config_format in
+    let%lwt result = match op with
+    | None -> Error "Operation required" |> Lwt.return
+    | Some o ->
+        begin
+            match o with
+            | OpStatus ->
+                let%lwt resp = get_status client in
+                begin
+                    match resp.status with
+                    | Success -> Ok "" |> Lwt.return
+                    | _ -> Error (BatOption.default "" resp.error) |> Lwt.return
+                end
+            | OpSetupSession ->
+                let%lwt resp = setup_session client "vycli" in
+                begin
+                    match resp with
+                    | Ok c -> get_token c
+                    | Error e -> Error e |> Lwt.return
+                end
+            | OpExists -> exists client path
+            | OpGetValue -> get_value client path
+            | OpGetValues -> get_values client path
+            | OpListChildren -> list_children client path
+            | OpShowConfig -> show_config client path
+            | _ -> Error "Unimplemented" |> Lwt.return
+        end
+    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 e in Lwt.return 1
+
+let _ =
+    let () = Arg.parse args (fun f -> ()) usage in
+    let path = String.trim !path_opt |> Pcre.split ~pat:"\\s+" in
+    let out_format = output_format_of_string !out_format_opt in
+    let config_format = config_format_of_string !conf_format_opt in
+    let result = Lwt_main.run (main !socket !op path out_format config_format) in exit result
diff --git a/src/vyconf_client.ml b/src/vyconf_client.ml
index a9e7637..db7d9c1 100644
--- a/src/vyconf_client.ml
+++ b/src/vyconf_client.ml
@@ -47,7 +47,6 @@ let do_request client req =
     let msg = Pbrt.Encoder.to_bytes enc in
     let%lwt () = Message.write client.oc msg in
     let%lwt resp = Message.read client.ic in
-    let%lwt () = Printf.printf "Decoding" |> (fun () -> Lwt.return_unit) in
     decode_response (Pbrt.Decoder.of_bytes resp) |> Lwt.return
 
 let get_status client =
@@ -96,4 +95,10 @@ let list_children client path =
     | Success -> unwrap resp.output |> Lwt.return
     | _ -> Error (BatOption.default "" resp.error) |> Lwt.return
 
+let show_config client path =
+    let req = Show_config {path=path; format=(Some client.conf_format)} in
+    let%lwt resp = do_request client req in
+    match resp.status with
+    | Success -> unwrap resp.output |> Lwt.return
+    | _ -> Error (BatOption.default "" resp.error) |> Lwt.return
 
diff --git a/src/vyconf_client.mli b/src/vyconf_client.mli
index 9749102..8eaada8 100644
--- a/src/vyconf_client.mli
+++ b/src/vyconf_client.mli
@@ -37,4 +37,4 @@ val get_values : t -> string list -> (string, string) result Lwt.t
 
 val list_children : t -> string list -> (string, string) result Lwt.t
 
-
+val show_config : t -> string list -> (string, string) result Lwt.t
diff --git a/src/vyconfd.ml b/src/vyconfd.ml
index 81dd2aa..810a355 100644
--- a/src/vyconfd.ml
+++ b/src/vyconfd.ml
@@ -41,13 +41,10 @@ let make_session_token () =
     Sha1.string (string_of_int (Random.bits ())) |> Sha1.to_hex
 
 let setup_session world req =
-    let () = print_endline "Setting up a new session" in
     let token = make_session_token () in
     let user = "unknown user" in
     let client_app = BatOption.default "unknown client" req.client_application in
-    let () = print_endline "Adding session to the list" in
     let () = Hashtbl.add sessions token (Session.make world client_app user) in
-    let () = Printf.printf "New session %s\n" token in
     {response_tmpl with output=(Some token)}
 
 let find_session token = Hashtbl.find sessions token
@@ -96,6 +93,7 @@ let exists world token (req: request_exists) =
 
 let get_value world token (req: request_get_value) =
     try
+        let () = (Lwt_log.debug @@ Printf.sprintf "[%s]\n" (Util.string_of_list req.path)) |> Lwt.ignore_result in
         let value = Session.get_value world (find_session token) req.path in
         let fmt = BatOption.default Out_plain req.output_format in
         let value_str =
@@ -111,7 +109,7 @@ let get_values world token (req: request_get_values) =
         let fmt = BatOption.default Out_plain req.output_format in
         let values_str =
          (match fmt with
-          | Out_plain -> Util.string_of_list values
+          | Out_plain -> Util.string_of_list @@ List.map (Printf.sprintf "\'%s\'") values
           | Out_json -> Util.json_of_list values)
         in {response_tmpl with output=(Some values_str)}
     with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
@@ -122,11 +120,18 @@ let list_children world token (req: request_list_children) =
         let fmt = BatOption.default Out_plain req.output_format in
         let children_str =
           (match fmt with
-          | Out_plain -> Util.string_of_list children
+          | Out_plain -> Util.string_of_list @@ List.map (Printf.sprintf "\'%s\'") children
           | Out_json -> Util.json_of_list children)
          in {response_tmpl with output=(Some children_str)}
     with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
-    
+
+let show_config world token (req: request_show_config) =
+    try
+        let fmt = BatOption.default Curly req.format in
+        let conf_str = Session.show_config world (find_session token) req.path fmt in
+        {response_tmpl with output=(Some conf_str)}
+    with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)}
+
 
 let rec handle_connection world ic oc fd () =
     try%lwt
@@ -150,6 +155,10 @@ let rec handle_connection world ic oc fd () =
                     | Some t, Configure r -> enter_conf_mode r t
                     | Some t, Exit_configure -> exit_conf_mode world t
                     | Some t, Exists r -> exists world t r
+                    | Some t, Get_value r -> get_value world t r
+                    | Some t, Get_values r -> get_values world t r
+                    | Some t, List_children r -> list_children world t r
+                    | Some t, Show_config r -> show_config world t r
                     | _ -> failwith "Unimplemented"
                 end) |> Lwt.return
         in