Source file `vif_options.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
let error_msgf fmt = Fmt.kstr (fun msg -> Error (`Msg msg)) fmt
let port = ref 8080
let inet_addr = ref Unix.inet_addr_loopback
let backlog = ref 64
let pid = ref None
let domains = ref None

let setup_config domains' port' inet_addr' backlog' pid' =
  port := port';
  inet_addr := inet_addr';
  backlog := backlog';
  pid := pid';
  domains := domains'

let config_from_globals () =
  let sockaddr = Unix.(ADDR_INET (!inet_addr, !port)) in
  Vif_config.config ?domains:!domains ?pid:!pid ~backlog:!backlog sockaddr

open Cmdliner

let port =
  let doc = "The port used by the HTTP server." in
  let open Arg in
  value & opt int 8080 & info [ "p"; "port" ] ~doc ~docv:"PORT"

let inet_addr =
  let doc = "The address to bind the HTTP server." in
  let parser str =
    try Ok (Unix.inet_addr_of_string str)
    with _ -> error_msgf "Invalid inet-addr: %S" str
  in
  let pp ppf inet_addr = Fmt.string ppf (Unix.string_of_inet_addr inet_addr) in
  let inet_addr = Arg.conv (parser, pp) in
  let open Arg in
  value
  & opt inet_addr Unix.inet_addr_loopback
  & info [ "i"; "inet-addr" ] ~doc ~docv:"INET_ADDR"

let is_not_directory str =
  (Sys.file_exists str && Sys.is_directory str = false)
  || Sys.file_exists str = false

let pid =
  let doc = "Specify a file to record its process-id in." in
  let non_existing_file =
    let parser str =
      match Fpath.of_string str with
      | Ok _ as v when is_not_directory str -> v
      | Ok v -> error_msgf "%a already exists as a directory" Fpath.pp v
      | Error _ as err -> err
    in
    Arg.conv (parser, Fpath.pp)
  in
  let open Arg in
  value
  & opt (some non_existing_file) None
  & info [ "pid-file" ] ~doc ~docv:"PATH"

let domains =
  let doc = "The number of number used by vif." in
  let open Arg in
  value & opt (some int) None & info [ "domains" ] ~doc ~docv:"DOMAINS"

let backlog =
  let doc =
    "The limit of outstanding connections in the socket's listen queue."
  in
  let open Arg in
  value & opt int 64 & info [ "backlog" ] ~doc ~docv:"NUMBER"

let setup_config =
  let open Term in
  const setup_config $ domains $ port $ inet_addr $ backlog $ pid