Add functionality for socket communication.

The Message module contains read and write functions that take care of
the wire protocol, which sends a 4 byte length header before every message.
They take a bytes buffer and don't care about its contents.

The Vyconf_client module has high level functions for interfacing with vyconfd.

Functions for creating a socket and creating a server loop are in Startup.

The rest is, for now at least, right in vyconfd.

Notes:
Message.read/write probably should be wrapped in Lwt_io.atomic
We need to find out if it's safe to reuse Pbrt.Encoder.t or we really
should create it every time.

7 files changed, 144 insertions, 1 deletions

diff --git a/src/message.ml b/src/message.ml
new file mode 100644
index 0000000..24803fe
--- /dev/null
+++ b/src/message.ml
@@ -0,0 +1,23 @@
+(** The wire protocol of VyConf.
+
+    Messages are preceded by a length header, four bytes in network order.
+ *)
+
+
+let read ic =
+    let header = Bytes.create 4 in
+    let%lwt () = Lwt_io.read_into_exactly ic header 0 4 in
+    let length = EndianBytes.BigEndian.get_int32 header 0 |> Int32.to_int in
+    if length < 0 then failwith (Printf.sprintf "Bad message length: %d" length) else
+    let buffer = Bytes.create length in
+    let%lwt () = Lwt_io.read_into_exactly ic buffer 0 length in
+    Lwt.return buffer
+
+let write oc msg =
+    let length = Bytes.length msg in
+    let length' = Int32.of_int length in
+    if length' < 0l then failwith (Printf.sprintf "Bad message length: %d" length) else
+    let header = Bytes.create 4 in
+    let () = EndianBytes.BigEndian.set_int32 header 0 length' in
+    let%lwt () = Lwt_io.write_from_exactly oc header 0 4 in
+    Lwt_io.write_from_exactly oc msg 0 length
diff --git a/src/message.mli b/src/message.mli
new file mode 100644
index 0000000..ec44c56
--- /dev/null
+++ b/src/message.mli
@@ -0,0 +1,3 @@
+val read : Lwt_io.input_channel -> bytes Lwt.t
+
+val write : Lwt_io.output_channel -> bytes -> unit Lwt.t
diff --git a/src/startup.ml b/src/startup.ml
index d4b5ef2..1c25bed 100644
--- a/src/startup.ml
+++ b/src/startup.ml
@@ -43,3 +43,19 @@ let check_dirs dirs =
     | Ok _ -> ()
     | Error err -> panic err
 
+(** Bind to a UNIX socket *)
+let create_socket sockfile =
+    let open Lwt_unix in
+    let backlog = 10 in
+    let%lwt sock = socket PF_UNIX SOCK_STREAM 0 |> Lwt.return in
+    (* XXX: replace with just bind after Lwt 3.0.0 release *)
+    let%lwt () = Lwt_unix.Versioned.bind_2 sock @@ ADDR_UNIX(sockfile) in
+    listen sock backlog;
+    Lwt.return sock
+
+(** Create the server loop function *)
+let create_server accept_connection sock =
+    let open Lwt in
+    let rec serve () =
+        Lwt_unix.accept sock >>= accept_connection >>= serve
+    in serve
diff --git a/src/startup.mli b/src/startup.mli
index 329024e..988e028 100644
--- a/src/startup.mli
+++ b/src/startup.mli
@@ -5,3 +5,9 @@ val setup_logger : bool -> string option -> Lwt_log.template -> unit Lwt.t
 val load_config : string -> Vyconf_config.t
 
 val check_dirs : Directories.t -> unit
+
+val create_socket : string -> Lwt_unix.file_descr Lwt.t
+
+val create_server :
+    (Lwt_unix.file_descr * Lwt_unix.sockaddr -> unit Lwt.t) ->
+    Lwt_unix.file_descr -> unit -> 'a Lwt.t
diff --git a/src/vyconf_client.ml b/src/vyconf_client.ml
new file mode 100644
index 0000000..7db59ff
--- /dev/null
+++ b/src/vyconf_client.ml
@@ -0,0 +1,41 @@
+include Vyconf_pb
+
+type t = {
+    sock: Lwt_unix.file_descr;
+    ic: Lwt_io.input Lwt_io.channel;
+    oc: Lwt_io.output Lwt_io.channel;
+    enc: Pbrt.Encoder.t;
+    session: string option;
+    conf_mode: bool;
+    closed: bool
+}
+
+let create sockfile =
+    let open Lwt_unix in
+    let sock = socket PF_UNIX SOCK_STREAM 0 in
+    let%lwt () = connect sock (ADDR_UNIX sockfile) in
+    let ic = Lwt_io.of_fd Lwt_io.Input sock in
+    let oc = Lwt_io.of_fd Lwt_io.Output sock in
+    Lwt.return {
+      sock=sock; ic=ic; oc=oc;
+      enc=(Pbrt.Encoder.create ()); closed=false;
+      session=None; conf_mode=false
+    }
+
+let shutdown client =
+    let%lwt () = Lwt_unix.close client.sock in
+    Lwt.return {client with closed=true}
+
+let do_request client req =
+    let enc = Pbrt.Encoder.create () in
+    let () = encode_request req enc in
+    let msg = Pbrt.Encoder.to_bytes enc in
+    let%lwt () = Message.write client.oc msg in
+    let%lwt resp = Message.read client.ic in
+    decode_response (Pbrt.Decoder.of_bytes resp) |> Lwt.return
+    
+
+let get_status client =
+    let req = Status in
+    let%lwt resp = do_request client req in
+    Lwt.return resp
diff --git a/src/vyconf_client.mli b/src/vyconf_client.mli
new file mode 100644
index 0000000..87fffdd
--- /dev/null
+++ b/src/vyconf_client.mli
@@ -0,0 +1,26 @@
+type t
+
+type status =
+  | Success 
+  | Fail 
+  | Invalid_path 
+  | Invalid_value 
+  | Commit_in_progress 
+  | Configuration_locked 
+  | Internal_error 
+  | Permission_denied 
+  | Path_already_exists 
+
+type response = {
+  status : status;
+  output : string option;
+  error : string option;
+  warning : string option;
+}
+
+
+val create : string -> t Lwt.t
+
+val shutdown : t -> t Lwt.t
+
+val get_status : t -> response Lwt.t
diff --git a/src/vyconfd.ml b/src/vyconfd.ml
index 84bc0de..f8dde8c 100644
--- a/src/vyconfd.ml
+++ b/src/vyconfd.ml
@@ -23,10 +23,38 @@ let args = [
     ]
 let usage = "Usage: " ^ Sys.argv.(0) ^ " [options]"
 
+let rec handle_connection ic oc () =
+    let open Vyconf_pb in
+    try%lwt
+        let%lwt req_msg = Message.read ic in
+        let%lwt req = decode_request (Pbrt.Decoder.of_bytes req_msg) |> return in
+        let%lwt resp =
+            (match req with
+            | Status -> {status=Success; output=None; error=None; warning=(Some "None of the other functions are implemented though")}
+            | _ -> failwith "Unimplemented") |> return
+        in
+        let enc = Pbrt.Encoder.create () in
+        let%lwt () = encode_response resp enc |> return in
+        let%lwt resp_msg = Pbrt.Encoder.to_bytes enc |> return in
+        let%lwt () = Message.write oc resp_msg in
+        handle_connection ic oc ()
+    with
+    | Failure e -> Lwt_log.error e >>= handle_connection ic oc
+    | End_of_file -> Lwt_log.info "Connection closed" >>= return
+
+let accept_connection conn =
+    let fd, _ = conn in
+    let ic = Lwt_io.of_fd Lwt_io.Input fd in
+    let oc = Lwt_io.of_fd Lwt_io.Output fd in
+    Lwt.on_failure (handle_connection ic oc ()) (fun e -> Lwt_log.ign_error (Printexc.to_string e));
+    Lwt_log.info "New connection" >>= return
+
 let main_loop config () =
     let%lwt () = Startup.setup_logger !daemonize !log_file config.log_template in
     let%lwt () = Lwt_log.notice @@ Printf.sprintf "Starting VyConf for %s" config.app_name in
-    Lwt.return_unit
+    let%lwt sock = Startup.create_socket config.socket in
+    let%lwt serve = Startup.create_server accept_connection sock () in
+    serve ()
 
 let () = 
   let () = Arg.parse args (fun f -> ()) usage in