diff options
| -rw-r--r-- | _oasis | 14 | ||||
| -rw-r--r-- | _tags | 11 | ||||
| -rw-r--r-- | myocamlbuild.ml | 8 | ||||
| -rw-r--r-- | setup.ml | 306 | ||||
| -rw-r--r-- | src/message.ml | 23 | ||||
| -rw-r--r-- | src/message.mli | 3 | ||||
| -rw-r--r-- | src/startup.ml | 16 | ||||
| -rw-r--r-- | src/startup.mli | 6 | ||||
| -rw-r--r-- | src/vyconf_client.ml | 41 | ||||
| -rw-r--r-- | src/vyconf_client.mli | 26 | ||||
| -rw-r--r-- | src/vyconfd.ml | 30 |
11 files changed, 474 insertions, 10 deletions
@@ -85,11 +85,23 @@ Library "startup" FindlibParent: vyconf BuildDepends: fileutils, lwt, lwt.log +Library "message" + Path: src + Modules: Message + FindlibParent: vyconf + BuildDepends: lwt, lwt.log, lwt.unix, lwt.ppx, ocplib-endian + +Library "vyconf_client" + Path: src + Modules: Vyconf_client + FindlibParent: vyconf + BuildDepends: lwt, lwt.log, lwt.unix, lwt.ppx, ocplib-endian + Executable "vyconfd" Path: src MainIs: vyconfd.ml CompiledObject: best - BuildDepends: ppx_deriving.runtime, ppx_deriving_yojson.runtime, lwt, lwt.unix, lwt.ppx, toml, fileutils, vyconf + BuildDepends: ppx_deriving.runtime, ppx_deriving_yojson.runtime, lwt, lwt.unix, lwt.ppx, toml, fileutils, ocaml-protoc, ocplib-endian, vyconf Executable "vytree_test" Path: test @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 0757c9ec9f5d35df060616ca6806b8dd) +# DO NOT EDIT (digest: 961843de21a9e59181cb630343a7c107) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -35,7 +35,6 @@ true: annot, bin_annot <src/*.ml{,i,y}>: pkg_xml-light # Library vyconf_pb "src/vyconf_pb.cmxs": use_vyconf_pb -<src/*.ml{,i,y}>: pkg_ocaml-protoc # Library session "src/session.cmxs": use_session # Library vyconf_config @@ -45,12 +44,18 @@ true: annot, bin_annot "src/directories.cmxs": use_directories # Library startup "src/startup.cmxs": use_startup +# Library message +"src/message.cmxs": use_message +# Library vyconf_client +"src/vyconf_client.cmxs": use_vyconf_client <src/*.ml{,i,y}>: pkg_lwt.log # Executable vyconfd <src/vyconfd.{native,byte}>: pkg_fileutils <src/vyconfd.{native,byte}>: pkg_lwt <src/vyconfd.{native,byte}>: pkg_lwt.ppx <src/vyconfd.{native,byte}>: pkg_lwt.unix +<src/vyconfd.{native,byte}>: pkg_ocaml-protoc +<src/vyconfd.{native,byte}>: pkg_ocplib-endian <src/vyconfd.{native,byte}>: pkg_ppx_deriving.runtime <src/vyconfd.{native,byte}>: pkg_ppx_deriving_yojson.runtime <src/vyconfd.{native,byte}>: pkg_toml @@ -59,6 +64,8 @@ true: annot, bin_annot <src/*.ml{,i,y}>: pkg_lwt <src/*.ml{,i,y}>: pkg_lwt.ppx <src/*.ml{,i,y}>: pkg_lwt.unix +<src/*.ml{,i,y}>: pkg_ocaml-protoc +<src/*.ml{,i,y}>: pkg_ocplib-endian <src/*.ml{,i,y}>: pkg_ppx_deriving.runtime <src/*.ml{,i,y}>: pkg_ppx_deriving_yojson.runtime <src/*.ml{,i,y}>: pkg_toml diff --git a/myocamlbuild.ml b/myocamlbuild.ml index 2012409..f0a0c8d 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -1,5 +1,5 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: 8452cc385560a63fa70df22ac20ce33d) *) +(* DO NOT EDIT (digest: dda8b70cfde7f0c3aceab1a7fa9b6f8e) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) @@ -899,7 +899,9 @@ let package_default = ("session", ["src"], []); ("vyconf_config", ["src"], []); ("directories", ["src"], []); - ("startup", ["src"], []) + ("startup", ["src"], []); + ("message", ["src"], []); + ("vyconf_client", ["src"], []) ]; lib_c = []; flags = []; @@ -911,6 +913,6 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; -# 915 "myocamlbuild.ml" +# 917 "myocamlbuild.ml" (* OASIS_STOP *) Ocamlbuild_plugin.dispatch dispatch_default;; @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.4.8 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 84b1c61979038af9d47810eec03f5beb) *) +(* DO NOT EDIT (digest: 602702c2b3e29065636a02e0e82ba6a6) *) (* Regenerated by OASIS v0.4.8 Visit http://oasis.forge.ocamlcore.org for more information and @@ -9109,6 +9109,304 @@ let setup_t = lib_findlib_directory = None; lib_findlib_containers = [] }); + Library + ({ + cs_name = "message"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = [(OASISExpr.EBool true, true)]; + bs_install = [(OASISExpr.EBool true, true)]; + bs_path = "src"; + bs_compiled_object = Best; + bs_build_depends = + [ + FindlibPackage ("lwt", None); + FindlibPackage ("lwt.log", None); + FindlibPackage ("lwt.unix", None); + FindlibPackage ("lwt.ppx", None); + FindlibPackage ("ocplib-endian", None) + ]; + bs_build_tools = [ExternalTool "ocamlbuild"]; + bs_interface_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${capitalize_file module}.mli" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${uncapitalize_file module}.mli" + } + ]; + bs_implementation_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${capitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${uncapitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${capitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${uncapitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${capitalize_file module}.mly" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${uncapitalize_file module}.mly" + } + ]; + bs_c_sources = []; + bs_data_files = []; + bs_findlib_extra_files = []; + bs_ccopt = [(OASISExpr.EBool true, [])]; + bs_cclib = [(OASISExpr.EBool true, [])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + { + lib_modules = ["Message"]; + lib_pack = false; + lib_internal_modules = []; + lib_findlib_parent = Some "vyconf"; + lib_findlib_name = None; + lib_findlib_directory = None; + lib_findlib_containers = [] + }); + Library + ({ + cs_name = "vyconf_client"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = [(OASISExpr.EBool true, true)]; + bs_install = [(OASISExpr.EBool true, true)]; + bs_path = "src"; + bs_compiled_object = Best; + bs_build_depends = + [ + FindlibPackage ("lwt", None); + FindlibPackage ("lwt.log", None); + FindlibPackage ("lwt.unix", None); + FindlibPackage ("lwt.ppx", None); + FindlibPackage ("ocplib-endian", None) + ]; + bs_build_tools = [ExternalTool "ocamlbuild"]; + bs_interface_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${capitalize_file module}.mli" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mli" + ]; + origin = "${uncapitalize_file module}.mli" + } + ]; + bs_implementation_patterns = + [ + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${capitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".ml" + ]; + origin = "${uncapitalize_file module}.ml" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${capitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mll" + ]; + origin = "${uncapitalize_file module}.mll" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("capitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${capitalize_file module}.mly" + }; + { + OASISSourcePatterns.Templater.atoms = + [ + OASISSourcePatterns.Templater.Text ""; + OASISSourcePatterns.Templater.Expr + (OASISSourcePatterns.Templater.Call + ("uncapitalize_file", + OASISSourcePatterns.Templater.Ident + "module")); + OASISSourcePatterns.Templater.Text ".mly" + ]; + origin = "${uncapitalize_file module}.mly" + } + ]; + bs_c_sources = []; + bs_data_files = []; + bs_findlib_extra_files = []; + bs_ccopt = [(OASISExpr.EBool true, [])]; + bs_cclib = [(OASISExpr.EBool true, [])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + { + lib_modules = ["Vyconf_client"]; + lib_pack = false; + lib_internal_modules = []; + lib_findlib_parent = Some "vyconf"; + lib_findlib_name = None; + lib_findlib_directory = None; + lib_findlib_containers = [] + }); Executable ({ cs_name = "vyconfd"; @@ -9130,6 +9428,8 @@ let setup_t = FindlibPackage ("lwt.ppx", None); FindlibPackage ("toml", None); FindlibPackage ("fileutils", None); + FindlibPackage ("ocaml-protoc", None); + FindlibPackage ("ocplib-endian", None); InternalLibrary "vyconf" ]; bs_build_tools = [ExternalTool "ocamlbuild"]; @@ -11036,7 +11336,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.8"; - oasis_digest = Some "\027{n\2259\249cpP<\136\011\130\144}u"; + oasis_digest = Some "\164\128uZ\195\226\174r\220\161\232Msu\141\165"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -11044,7 +11344,7 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 11048 "setup.ml" +# 11348 "setup.ml" let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t open BaseCompat.Compat_0_4 (* OASIS_STOP *) 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 |