diff options
| -rw-r--r-- | src/directories.ml | 14 | ||||
| -rw-r--r-- | src/directories.mli | 2 | ||||
| -rw-r--r-- | src/vyconfd.ml | 29 |
3 files changed, 25 insertions, 20 deletions
diff --git a/src/directories.ml b/src/directories.ml index 625b2e3..3b7156f 100644 --- a/src/directories.ml +++ b/src/directories.ml @@ -17,14 +17,16 @@ let relative_dirs = { interface_definitions = "interfaces"; } -let make conf = +let concat = List.fold_left F.concat "" + +let make basepath conf = let open Vyconf_config in { - components = F.concat conf.program_dir relative_dirs.components; - validators = F.concat conf.program_dir relative_dirs.validators; - migrators = F.concat conf.program_dir relative_dirs.migrators; - component_definitions = F.concat conf.data_dir relative_dirs.component_definitions; - interface_definitions = F.concat conf.data_dir relative_dirs.interface_definitions + components = concat [basepath; conf.program_dir; relative_dirs.components]; + validators = concat [basepath; conf.program_dir; relative_dirs.validators]; + migrators = concat [basepath; conf.program_dir; relative_dirs.migrators]; + component_definitions = concat [basepath; conf.data_dir; relative_dirs.component_definitions]; + interface_definitions = concat [basepath; conf.data_dir; relative_dirs.interface_definitions] } (** Check if required directories exist diff --git a/src/directories.mli b/src/directories.mli index 623d6f1..9a7a376 100644 --- a/src/directories.mli +++ b/src/directories.mli @@ -6,6 +6,6 @@ type t = { interface_definitions: string; } -val make : Vyconf_config.t -> t +val make : string -> Vyconf_config.t -> t val test : t -> (unit, string) result diff --git a/src/vyconfd.ml b/src/vyconfd.ml index d8fa7c5..c2ca6f7 100644 --- a/src/vyconfd.ml +++ b/src/vyconfd.ml @@ -3,6 +3,8 @@ open Defaults open Vyconf_config open Vyconf_pb +module FP = FilePath + (* On UNIX, self_init uses /dev/random for seed *) let () = Random.self_init () @@ -11,6 +13,7 @@ let () = Lwt_log.add_rule "*" Lwt_log.Info (* Default VyConf configuration *) let daemonize = ref true let config_file = ref defaults.config_file +let basepath = ref "/" let log_file = ref None (* Global data *) @@ -22,14 +25,13 @@ let conf_mode_lock : string option ref = ref None (* Command line arguments *) let args = [ - ("--no-daemon", Arg.Unit (fun () -> daemonize := false), - "Do not daemonize"); - ("--config", Arg.String (fun s -> config_file := s), - (Printf.sprintf "<string> Configuration file, default is %s" defaults.config_file)); - ("--log-file", Arg.String (fun s -> log_file := Some s), - "<string> Log file"); - ("--version", Arg.Unit (fun () -> print_endline @@ Version.version_info (); exit 0), "Print version and exit") - ] + ("--no-daemon", Arg.Unit (fun () -> daemonize := false), "Do not daemonize"); + ("--config", Arg.String (fun s -> config_file := s), + (Printf.sprintf "<string> Configuration file, default is %s" defaults.config_file)); + ("--log-file", Arg.String (fun s -> log_file := Some s), "<string> Log file"); + ("--base-path", Arg.String (fun s -> basepath := s), "<string> Appliance base path"); + ("--version", Arg.Unit (fun () -> print_endline @@ Version.version_info (); exit 0), "Print version and exit") + ] let usage = "Usage: " ^ Sys.argv.(0) ^ " [options]" let response_tmpl = {status=Success; output=None; error=None; warning=None} @@ -116,11 +118,12 @@ let accept_connection world conn = Lwt.on_failure (handle_connection world ic oc ()) (fun e -> Lwt_log.ign_error (Printexc.to_string e)); Lwt_log.info "New connection" >>= return -let main_loop world () = +let main_loop basepath world () = let open Session in - let%lwt () = Startup.setup_logger !daemonize !log_file world.vyconf_config.log_template in + let log_file = BatOption.bind !log_file (fun s -> Some (FP.concat basepath s)) in + let%lwt () = Startup.setup_logger !daemonize log_file world.vyconf_config.log_template in let%lwt () = Lwt_log.notice @@ Printf.sprintf "Starting VyConf for %s" world.vyconf_config.app_name in - let%lwt sock = Startup.create_socket world.vyconf_config.socket in + let%lwt sock = Startup.create_socket (FP.concat basepath world.vyconf_config.socket) in let%lwt serve = Startup.create_server (accept_connection world) sock () in serve () @@ -142,8 +145,8 @@ let () = let () = Arg.parse args (fun f -> ()) usage in let config = Startup.load_config !config_file in let () = Lwt_log.load_rules ("* -> " ^ config.log_level) in - let dirs = Directories.make config in + let dirs = Directories.make !basepath config in Startup.check_dirs dirs; let world = make_world config dirs in - Lwt_main.run @@ main_loop world () + Lwt_main.run @@ main_loop !basepath world () |