From 5d7927e392e70436aaca1f8261e5d4ab8e4ec8f8 Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Wed, 23 Oct 2024 18:50:46 -0500 Subject: T6718: update build system, drop batteries, and adjust for lib changes Update as needed for use with contemporary vyos1x-config: . update build system to use dune . drop use of batteries . update for protoc breaking changes in versions >= 3.0 . remove files now in vyos1x-config (config_tree et. al.; parsing) --- src/startup.ml | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) (limited to 'src/startup.ml') diff --git a/src/startup.ml b/src/startup.ml index cea5f02..4cf109c 100644 --- a/src/startup.ml +++ b/src/startup.ml @@ -75,11 +75,21 @@ let create_server accept_connection sock = let load_config file = try let chan = open_in file in - let config = Curly_parser.config Curly_lexer.token (Lexing.from_channel chan) in + let s = really_input_string chan (in_channel_length chan) in + let config = Vyos1x.Parser.from_string s in Ok config with | Sys_error msg -> Error msg - | Curly_parser.Error -> Error "Parse error" + | Vyos1x.Util.Syntax_error (opt, msg) -> + begin + match opt with + | None -> + let out = Printf.sprintf "Parse error: %s\n" msg + in Error out + | Some (line, pos) -> + let out = Printf.sprintf "Parse error: %s line %d pos %d\n" msg line pos + in Error out + end (** Load the appliance configuration file or the fallback config *) let load_config_failsafe main fallback = @@ -99,7 +109,7 @@ let load_config_failsafe main fallback = (* Load interface definitions from a directory into a reference tree *) let load_interface_definitions dir = - let open Reference_tree in + let open Vyos1x.Reference_tree in let relative_paths = FileUtil.ls dir in let absolute_paths = try Ok (List.map Util.absolute_path relative_paths) -- cgit v1.2.3 From 037c3ce961e1fec94b1d50b069b69c6636ac0393 Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Wed, 23 Oct 2024 18:50:46 -0500 Subject: T6718: reorganize layout for dune build of libs/executables --- src/dune | 28 +++++++++++++++++++++++++--- src/message.ml | 9 +++++++-- src/session.ml | 6 +++--- src/session.mli | 2 +- src/startup.ml | 6 +++--- src/startup.mli | 4 ++-- src/util.ml | 38 -------------------------------------- src/util.mli | 9 --------- src/vyconf_client.ml | 8 ++++---- src/vyconf_client.mli | 2 +- src/vyconfd.ml | 27 +++++++++++++++------------ vyconf.opam | 6 +++--- 12 files changed, 64 insertions(+), 81 deletions(-) delete mode 100644 src/util.ml delete mode 100644 src/util.mli (limited to 'src/startup.ml') diff --git a/src/dune b/src/dune index ff86052..a259da4 100644 --- a/src/dune +++ b/src/dune @@ -1,5 +1,27 @@ (library - (name vyconf) - (public_name vyconf) - (libraries vyos1x-config lwt lwt.unix lwt_log lwt_ppx ocaml-protoc toml sha yojson ppx_deriving.show ppx_deriving_yojson) + (name vyconf_connect) + (public_name vyconf.vyconf-connect) + (modules vyconf_types vyconf_pb message) + (libraries lwt lwt.unix lwt_log lwt_ppx ocaml-protoc fileutils ppx_deriving_yojson) + (preprocess (pps lwt_ppx ppx_deriving_yojson))) + +(library + (name vyconfd_config) + (modules vyconf_config session directories defaults) + (libraries vyos1x-config vyconf_connect toml sha ppx_deriving.show) + (preprocess (pps ppx_deriving.show ppx_deriving_yojson))) + +(library + (name client) + (public_name vyconf.vyconf-client) + (modules vyconf_client) + (libraries vyos1x-config vyconf_connect lwt lwt.unix lwt_log lwt_ppx ocaml-protoc toml sha + yojson ppx_deriving.show ppx_deriving_yojson) (preprocess (pps lwt_ppx ppx_deriving.show ppx_deriving_yojson))) + +(executable + (name vyconfd) + (public_name vyconfd) + (modules vyconfd startup version util) + (libraries vyos1x-config vyconfd_config vyconf_connect) + (preprocess (pps lwt_ppx))) diff --git a/src/message.ml b/src/message.ml index 3629f0d..d4cc374 100644 --- a/src/message.ml +++ b/src/message.ml @@ -3,6 +3,11 @@ Messages are preceded by a length header, four bytes in network order. *) +(** Makes a hex dump of a byte string *) +let hexdump b = + let dump = ref "" in + Bytes.iter (fun c -> dump := Char.code c |> Printf.sprintf "%s %02x" !dump) b; + !dump let read ic = let header = Bytes.create 4 in @@ -12,14 +17,14 @@ let read ic = 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_log.debug (Util.hexdump buffer |> Printf.sprintf "Read mesage: %s") |> Lwt.ignore_result; + Lwt_log.debug (hexdump buffer |> Printf.sprintf "Read mesage: %s") |> Lwt.ignore_result; Lwt.return buffer let write oc msg = let length = Bytes.length msg in let length' = Int32.of_int length in Lwt_log.debug (Printf.sprintf "Write length: %d\n" length) |> Lwt.ignore_result; - Lwt_log.debug (Util.hexdump msg |> Printf.sprintf "Write message: %s") |> Lwt.ignore_result; + Lwt_log.debug (hexdump msg |> Printf.sprintf "Write message: %s") |> Lwt.ignore_result; 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 diff --git a/src/session.ml b/src/session.ml index 7624bb0..1a422f7 100644 --- a/src/session.ml +++ b/src/session.ml @@ -37,12 +37,12 @@ let make world client_app user = { let string_of_op op = match op with | CfgSet (path, value, _) -> - let path_str = Util.string_of_list path in + let path_str = Vyos1x.Util.string_of_list path in (match value with | None -> Printf.sprintf "set %s" path_str | Some v -> Printf.sprintf "set %s \"%s\"" path_str v) | CfgDelete (path, value) -> - let path_str = Util.string_of_list path in + let path_str = Vyos1x.Util.string_of_list path in (match value with | None -> Printf.sprintf "delete %s" path_str | Some v -> Printf.sprintf "delete %s \"%s\"" path_str v) @@ -110,7 +110,7 @@ let exists _w s path = VT.exists s.proposed_config path let show_config _w s path fmt = - let open Vyconf_types in + let open Vyconf_connect.Vyconf_types in if (path <> []) && not (VT.exists s.proposed_config path) then raise (Session_error ("Path does not exist")) else diff --git a/src/session.mli b/src/session.mli index f59ea7b..9670edd 100644 --- a/src/session.mli +++ b/src/session.mli @@ -40,4 +40,4 @@ 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 +val show_config : world -> session_data -> string list -> Vyconf_connect.Vyconf_types.request_config_format -> string diff --git a/src/startup.ml b/src/startup.ml index 4cf109c..b3a967e 100644 --- a/src/startup.ml +++ b/src/startup.ml @@ -33,7 +33,7 @@ let setup_logger daemonize log_file template = (** Load the config file or panic if it fails *) let load_daemon_config path = - let result = Vyconf_config.load path in + let result = Vyconfd_config.Vyconf_config.load path in match result with | Ok cfg -> cfg | Error err -> @@ -41,7 +41,7 @@ let load_daemon_config path = (** Check if appliance directories exist and panic if they don't *) let check_dirs dirs = - let res = Directories.test dirs in + let res = Vyconfd_config.Directories.test dirs in match res with | Ok _ -> () | Error err -> panic err @@ -112,7 +112,7 @@ let load_interface_definitions dir = let open Vyos1x.Reference_tree in let relative_paths = FileUtil.ls dir in let absolute_paths = - try Ok (List.map Util.absolute_path relative_paths) + try Ok (List.map Vyos1x.Util.absolute_path relative_paths) with Sys_error no_dir_msg -> Error no_dir_msg in let load_aux tree file = diff --git a/src/startup.mli b/src/startup.mli index abe731f..77c35ac 100644 --- a/src/startup.mli +++ b/src/startup.mli @@ -2,9 +2,9 @@ val panic : string -> 'a val setup_logger : bool -> string option -> Lwt_log.template -> unit Lwt.t -val load_daemon_config : string -> Vyconf_config.t +val load_daemon_config : string -> Vyconfd_config.Vyconf_config.t -val check_dirs : Directories.t -> unit +val check_dirs : Vyconfd_config.Directories.t -> unit val create_socket : string -> Lwt_unix.file_descr Lwt.t diff --git a/src/util.ml b/src/util.ml deleted file mode 100644 index ec988e9..0000000 --- a/src/util.ml +++ /dev/null @@ -1,38 +0,0 @@ -(** The unavoidable module for functions that don't fit anywhere else *) - -(** Find a child node in xml-lite *) -let find_xml_child name xml = - let find_aux e = - match e with - | Xml.Element (name', _, _) when name' = name -> true - | _ -> false - in - match xml with - | Xml.Element (_, _, children) -> Vyos1x.Vylist.find find_aux children - | Xml.PCData _ -> None - -(** Convert a list of strings to a string of unquoted, space separated words *) -let string_of_list ss = - let rec aux xs acc = - match xs with - | [] -> acc - | x :: xs' -> aux xs' (Printf.sprintf "%s %s" acc x) - in - match ss with - | [] -> "" - | x :: xs -> Printf.sprintf "%s%s" x (aux xs "") - -(** Convert a list of strings to JSON *) -let json_of_list ss = - let ss = List.map (fun x -> `String x) ss in - Yojson.Safe.to_string (`List ss) - -(** Convert a relative path to an absolute path based on the current working directory *) -let absolute_path relative_path = - FilePath.make_absolute (Sys.getcwd ()) relative_path - -(** Makes a hex dump of a byte string *) -let hexdump b = - let dump = ref "" in - Bytes.iter (fun c -> dump := Char.code c |> Printf.sprintf "%s %02x" !dump) b; - !dump diff --git a/src/util.mli b/src/util.mli deleted file mode 100644 index 4c11d9e..0000000 --- a/src/util.mli +++ /dev/null @@ -1,9 +0,0 @@ -val find_xml_child : string -> Xml.xml -> Xml.xml option - -val string_of_list : string list -> string - -val json_of_list : string list -> string - -val absolute_path : FilePath.filename -> FilePath.filename - -val hexdump : bytes -> string diff --git a/src/vyconf_client.ml b/src/vyconf_client.ml index 63ff121..bc4002c 100644 --- a/src/vyconf_client.ml +++ b/src/vyconf_client.ml @@ -1,5 +1,5 @@ -include Vyconf_pb -include Vyconf_types +include Vyconf_connect.Vyconf_pb +include Vyconf_connect.Vyconf_types type t = { sock: Lwt_unix.file_descr; @@ -45,8 +45,8 @@ let do_request client req = let enc = Pbrt.Encoder.create () in let () = encode_request_envelope {token=client.session; 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 + let%lwt () = Vyconf_connect.Message.write client.oc msg in + let%lwt resp = Vyconf_connect.Message.read client.ic in decode_response (Pbrt.Decoder.of_bytes resp) |> Lwt.return let get_status client = diff --git a/src/vyconf_client.mli b/src/vyconf_client.mli index 8eaada8..8621130 100644 --- a/src/vyconf_client.mli +++ b/src/vyconf_client.mli @@ -19,7 +19,7 @@ type response = { } -val create : ?token:(string option) -> string -> Vyconf_types.request_output_format -> Vyconf_types.request_config_format -> t Lwt.t +val create : ?token:(string option) -> string -> Vyconf_connect.Vyconf_types.request_output_format -> Vyconf_connect.Vyconf_types.request_config_format -> t Lwt.t val get_token : t -> (string, string) result Lwt.t diff --git a/src/vyconfd.ml b/src/vyconfd.ml index f3816d4..59425ee 100644 --- a/src/vyconfd.ml +++ b/src/vyconfd.ml @@ -1,11 +1,14 @@ open Lwt -open Defaults -open Vyconf_config -open Vyconf_pb -open Vyconf_types + +open Vyconf_connect.Vyconf_types +open Vyconf_connect.Vyconf_pb +open Vyconfd_config.Defaults module FP = FilePath module CT = Vyos1x.Config_tree +module Gen = Vyos1x.Generate +module Session = Vyconfd_config.Session +module Directories = Vyconfd_config.Directories (* On UNIX, self_init uses /dev/random for seed *) let () = Random.self_init () @@ -94,7 +97,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 () = (Lwt_log.debug @@ Printf.sprintf "[%s]\n" (Vyos1x.Util.string_of_list req.path)) |> Lwt.ignore_result in let value = Session.get_value world (find_session token) req.path in let fmt = Option.value req.output_format ~default:Out_plain in let value_str = @@ -110,8 +113,8 @@ let get_values world token (req: request_get_values) = let fmt = Option.value req.output_format ~default:Out_plain in let values_str = (match fmt with - | Out_plain -> Util.string_of_list @@ List.map (Printf.sprintf "\'%s\'") values - | Out_json -> Util.json_of_list values) + | Out_plain -> Vyos1x.Util.string_of_list @@ List.map (Printf.sprintf "\'%s\'") values + | Out_json -> Vyos1x.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)} @@ -121,8 +124,8 @@ let list_children world token (req: request_list_children) = let fmt = Option.value req.output_format ~default:Out_plain in let children_str = (match fmt with - | Out_plain -> Util.string_of_list @@ List.map (Printf.sprintf "\'%s\'") children - | Out_json -> Util.json_of_list children) + | Out_plain -> Vyos1x.Util.string_of_list @@ List.map (Printf.sprintf "\'%s\'") children + | Out_json -> Vyos1x.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)} @@ -137,12 +140,12 @@ let send_response oc resp = 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 + let%lwt () = Vyconf_connect.Message.write oc resp_msg in Lwt.return () let rec handle_connection world ic oc fd () = try%lwt - let%lwt req_msg = Message.read ic in + let%lwt req_msg = Vyconf_connect.Message.read ic in let%lwt req = try let envelope = decode_request_envelope (Pbrt.Decoder.of_bytes req_msg) in @@ -196,7 +199,7 @@ let main_loop basepath world () = let load_interface_definitions dir = (* let open Session in *) - let reftree = Startup.load_interface_definitions dir in + let reftree = Gen.load_interface_definitions dir in match reftree with | Ok r -> r | Error s -> Startup.panic s diff --git a/vyconf.opam b/vyconf.opam index 68e8d45..b947e39 100644 --- a/vyconf.opam +++ b/vyconf.opam @@ -1,12 +1,13 @@ opam-version: "2.0" name: "vyconf" version: "0.1" +synopsis: "VyOS 2.x config file control library" +description: "An appliance configuration framework" maintainer: "Daniil Baturin " authors: "VyOS maintainers and contributors " homepage: "https://github.com/vyos/vyconf" bug-reports: "https://phabricator.vyos.net" -license: "LGPL with OCaml linking exception" -description: "An appliance configuration framework" +license: "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception" dev-repo: "git+https://github.com/vyos/vyconf/" build: [ ["dune" "subst"] {pinned} @@ -29,4 +30,3 @@ depends: [ "sha" {build} "pcre" {build} ] -available: ocaml-version >= "4.14.2" -- cgit v1.2.3 From 085b22f7be84944a27e565be4227dc55720bec47 Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Wed, 23 Oct 2024 18:50:46 -0500 Subject: T6718: read reference tree json file on startup --- data/examples/vyconfd.conf | 1 + src/startup.ml | 7 +++++++ src/startup.mli | 2 ++ src/vyconf_config.ml | 3 +++ src/vyconf_config.mli | 1 + src/vyconfd.ml | 12 +++++++++--- 6 files changed, 23 insertions(+), 3 deletions(-) (limited to 'src/startup.ml') diff --git a/data/examples/vyconfd.conf b/data/examples/vyconfd.conf index db9e493..68b0531 100644 --- a/data/examples/vyconfd.conf +++ b/data/examples/vyconfd.conf @@ -9,6 +9,7 @@ config_dir = "/etc/testappliance" # paths relative to config_dir primary_config = "config.boot" fallback_config = "config.failsafe" +reference_tree = "reftree.cache" [vyconf] diff --git a/src/startup.ml b/src/startup.ml index b3a967e..7418a81 100644 --- a/src/startup.ml +++ b/src/startup.ml @@ -124,3 +124,10 @@ let load_interface_definitions dir = | Error msg -> Error msg end with Bad_interface_definition msg -> Error msg +module I = Vyos1x.Internal.Make(Vyos1x.Reference_tree) + +let read_reference_tree file = + try + let reftree = I.read_internal file in + Ok reftree + with Sys_error msg -> Error msg diff --git a/src/startup.mli b/src/startup.mli index 77c35ac..ab0e0f2 100644 --- a/src/startup.mli +++ b/src/startup.mli @@ -17,3 +17,5 @@ val load_config : string -> (Vyos1x.Config_tree.t, string) result val load_config_failsafe : string -> string -> Vyos1x.Config_tree.t val load_interface_definitions : string -> (Vyos1x.Reference_tree.t, string) result + +val read_reference_tree : string -> (Vyos1x.Reference_tree.t, string) result diff --git a/src/vyconf_config.ml b/src/vyconf_config.ml index 07ab3ef..2640c9b 100644 --- a/src/vyconf_config.ml +++ b/src/vyconf_config.ml @@ -7,6 +7,7 @@ type t = { config_dir: string; primary_config: string; fallback_config: string; + reference_tree: string; socket: string; pid_file: string; log_file: string option; @@ -23,6 +24,7 @@ let empty_config = { config_dir = ""; primary_config = ""; fallback_config = ""; + reference_tree = ""; socket = ""; pid_file = ""; log_file = None; @@ -61,6 +63,7 @@ let load filename = let conf = {conf with program_dir = mandatory_field conf_toml "appliance" "program_dir"} in let conf = {conf with primary_config = mandatory_field conf_toml "appliance" "primary_config"} in let conf = {conf with fallback_config = mandatory_field conf_toml "appliance" "fallback_config"} in + let conf = {conf with reference_tree = mandatory_field conf_toml "appliance" "reference_tree"} in (* Optional fields *) let conf = {conf with pid_file = optional_field defaults.pid_file conf_toml "vyconf" "pid_file"} in let conf = {conf with socket = optional_field defaults.socket conf_toml "vyconf" "socket"} in diff --git a/src/vyconf_config.mli b/src/vyconf_config.mli index ed30b35..1cfeffa 100644 --- a/src/vyconf_config.mli +++ b/src/vyconf_config.mli @@ -5,6 +5,7 @@ type t = { config_dir: string; primary_config: string; fallback_config: string; + reference_tree: string; socket: string; pid_file: string; log_file: string option; diff --git a/src/vyconfd.ml b/src/vyconfd.ml index 729be73..af7c309 100644 --- a/src/vyconfd.ml +++ b/src/vyconfd.ml @@ -2,6 +2,7 @@ open Lwt open Vyconf_connect.Vyconf_pbt open Vyconfd_config.Defaults +open Vyconfd_config.Vyconf_config module FP = FilePath module CT = Vyos1x.Config_tree @@ -197,16 +198,21 @@ let main_loop basepath world () = serve () let load_interface_definitions dir = -(* let open Session in *) let reftree = Gen.load_interface_definitions dir in match reftree with | Ok r -> r | Error s -> Startup.panic s +let read_reference_tree file = + let reftree = Startup.read_reference_tree file in + match reftree with + | Ok r -> r + | Error s -> Startup.panic s + let make_world config dirs = - let open Directories in let open Session in - let reftree = load_interface_definitions dirs.interface_definitions in + (* the reference_tree json file is generated at vyos-1x build time *) + let reftree = read_reference_tree (FP.concat config.config_dir config.reference_tree) in let running_config = CT.make "root" in {running_config=running_config; reference_tree=reftree; vyconf_config=config; dirs=dirs} -- cgit v1.2.3 From a2781efcf74f4ffedd35ca48a742b215351487ac Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Wed, 23 Oct 2024 18:50:46 -0500 Subject: T6718: restrict directory existence check to validators dir --- src/directories.ml | 13 ++++++++++--- src/directories.mli | 2 ++ src/startup.ml | 6 ++++++ src/startup.mli | 2 ++ src/vyconfd.ml | 2 +- 5 files changed, 21 insertions(+), 4 deletions(-) (limited to 'src/startup.ml') diff --git a/src/directories.ml b/src/directories.ml index 3b7156f..c28f055 100644 --- a/src/directories.ml +++ b/src/directories.ml @@ -33,12 +33,19 @@ let make basepath conf = We do not try to check if they are readable at this point, it's just to fail early if they don't even exist and we shouldn't bother trying *) + +let check_dir d = + if FU.test FU.Is_dir d then () + else raise (Failure (Printf.sprintf "%s does not exist or is not a directory" d)) + let test dirs = - let check_dir d = - if FU.test FU.Is_dir d then () - else raise (Failure (Printf.sprintf "%s does not exist or is not a directory" d)) in let l = [dirs.components; dirs.validators; dirs.migrators; dirs.component_definitions; dirs.interface_definitions] in try List.iter check_dir l; Ok () with Failure msg -> Error msg + +let test_validators_dir dirs = + try + check_dir dirs.validators; Ok () + with Failure msg -> Error msg diff --git a/src/directories.mli b/src/directories.mli index 9a7a376..fb01f16 100644 --- a/src/directories.mli +++ b/src/directories.mli @@ -9,3 +9,5 @@ type t = { val make : string -> Vyconf_config.t -> t val test : t -> (unit, string) result + +val test_validators_dir : t -> (unit, string) result diff --git a/src/startup.ml b/src/startup.ml index 7418a81..beb125e 100644 --- a/src/startup.ml +++ b/src/startup.ml @@ -46,6 +46,12 @@ let check_dirs dirs = | Ok _ -> () | Error err -> panic err +let check_validators_dir dirs = + let res = Vyconfd_config.Directories.test_validators_dir dirs in + match res with + | Ok _ -> () + | Error err -> panic err + let delete_socket_if_exists sockfile = try let _ = Unix.stat sockfile in diff --git a/src/startup.mli b/src/startup.mli index ab0e0f2..84fb99e 100644 --- a/src/startup.mli +++ b/src/startup.mli @@ -6,6 +6,8 @@ val load_daemon_config : string -> Vyconfd_config.Vyconf_config.t val check_dirs : Vyconfd_config.Directories.t -> unit +val check_validators_dir : Vyconfd_config.Directories.t -> unit + val create_socket : string -> Lwt_unix.file_descr Lwt.t val create_server : diff --git a/src/vyconfd.ml b/src/vyconfd.ml index af7c309..7c66aa0 100644 --- a/src/vyconfd.ml +++ b/src/vyconfd.ml @@ -221,7 +221,7 @@ let () = let vc = Startup.load_daemon_config !config_file in let () = Lwt_log.load_rules ("* -> " ^ vc.log_level) in let dirs = Directories.make !basepath vc in - Startup.check_dirs dirs; + Startup.check_validators_dir dirs; let world = make_world vc dirs in let config = Startup.load_config_failsafe (FP.concat vc.config_dir vc.primary_config) -- cgit v1.2.3 From 73652e2bfc8a785e9b3dc447e0a0ced4716549e3 Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Wed, 23 Oct 2024 18:50:46 -0500 Subject: T6718: set perms on socket for group write access --- src/startup.ml | 1 + 1 file changed, 1 insertion(+) (limited to 'src/startup.ml') diff --git a/src/startup.ml b/src/startup.ml index beb125e..db0d719 100644 --- a/src/startup.ml +++ b/src/startup.ml @@ -67,6 +67,7 @@ let create_socket sockfile = let backlog = 10 in let%lwt sock = socket PF_UNIX SOCK_STREAM 0 |> Lwt.return in let%lwt () = Lwt_unix.bind sock @@ ADDR_UNIX(sockfile) in + let%lwt () = Lwt_unix.chmod sockfile 0o775 in listen sock backlog; Lwt.return sock -- cgit v1.2.3