1(*
2 * Copyright (C) 2006-2007 XenSource Ltd.
3 * Copyright (C) 2008      Citrix Ltd.
4 * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU Lesser General Public License as published
8 * by the Free Software Foundation; version 2.1 only. with the special
9 * exception on linking described in file LICENSE.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 * GNU Lesser General Public License for more details.
15 *)
16
17type config =
18  {
19    domain_init: bool;
20    activate_access_log: bool;
21    daemonize: bool;
22    reraise_top_level: bool;
23    config_file: string option;
24    pidfile: string option; (* old xenstored compatibility *)
25    tracefile: string option; (* old xenstored compatibility *)
26    restart: bool;
27    live_reload: bool;
28    disable_socket: bool;
29    config_test: bool;
30  }
31
32let get_config_filename config_file =
33  match config_file with
34  | Some name -> name
35  | None      -> Define.default_config_dir ^ "/oxenstored.conf"
36
37let do_argv =
38  let pidfile = ref "" and tracefile = ref "" (* old xenstored compatibility *)
39  and domain_init = ref true
40  and activate_access_log = ref true
41  and daemonize = ref true
42  and reraise_top_level = ref false
43  and config_file = ref ""
44  and restart = ref false
45  and live_reload = ref false
46  and disable_socket = ref false
47  and config_test = ref false
48  and help = ref false
49  in
50
51  let speclist =
52    [ ("--no-domain-init", Arg.Unit (fun () -> domain_init := false),
53       "to state that xenstored should not initialise dom0");
54      ("--config-file", Arg.Set_string config_file,
55       "set an alternative location for the configuration file");
56      ("--no-fork", Arg.Unit (fun () -> daemonize := false),
57       "to request that the daemon does not fork");
58      ("--reraise-top-level", Arg.Unit (fun () -> reraise_top_level := true),
59       "reraise exceptions caught at the top level");
60      ("--no-access-log", Arg.Unit (fun () -> activate_access_log := false),
61       "do not create a xenstore-access.log file");
62      ("--pid-file", Arg.Set_string pidfile, ""); (* for compatibility *)
63      ("-T", Arg.Set_string tracefile, ""); (* for compatibility *)
64      ("--restart", Arg.Set restart, "Read database on starting");
65      ("--live", Arg.Set live_reload, "Read live dump on startup");
66      ("--config-test", Arg.Set config_test, "Test validity of config file");
67      ("--disable-socket", Arg.Unit (fun () -> disable_socket := true), "Disable socket");
68      ("--help", Arg.Set help, "Display this list of options")
69    ] in
70  let usage_msg = "usage : xenstored [--config-file <filename>] [--no-domain-init] [--help] [--no-fork] [--reraise-top-level] [--restart] [--disable-socket]" in
71  Arg.parse speclist (fun _ -> ()) usage_msg;
72  let () =
73    if !help then begin
74      if !live_reload then
75        (*
76          Transform --live --help into --config-test for backward compat with
77          running code during live update.
78          Caller will validate config and exit
79        *)
80        config_test := true
81      else begin
82        Arg.usage_string speclist usage_msg |> print_endline;
83        exit 0
84      end
85    end
86  in
87  {
88    domain_init = !domain_init;
89    activate_access_log = !activate_access_log;
90    daemonize = !daemonize;
91    reraise_top_level = !reraise_top_level;
92    config_file = if !config_file <> "" then Some !config_file else None;
93    pidfile = if !pidfile <> "" then Some !pidfile else None;
94    tracefile = if !tracefile <> "" then Some !tracefile else None;
95    restart = !restart;
96    live_reload = !live_reload;
97    disable_socket = !disable_socket;
98    config_test = !config_test;
99  }
100