Source file mnet_happy_eyeballs_cli.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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
let error_msgf fmt = Fmt.kstr (fun msg -> Error (`Msg msg)) fmt

open Cmdliner

let s_happy_eyeballs = "HAPPY EYEBALLS"

let timeout =
  let is_digit = function '0' .. '9' -> true | _ -> false in
  let parser str =
    let len =
      let len = ref 0 in
      while !len < String.length str && is_digit str.[!len] do
        incr len
      done;
      !len
    in
    let meter = String.sub str len (String.length str - len) in
    let value = String.sub str 0 len in
    match meter with
    | "ns" -> Ok (Int64.of_string value)
    | "us" -> Ok (Duration.of_us (int_of_string value))
    | "ms" -> Ok (Duration.of_ms (int_of_string value))
    | "sec" | "s" -> Ok (Duration.of_sec (int_of_string value))
    | "min" | "m" -> Ok (Duration.of_min (int_of_string value))
    | "hour" | "h" -> Ok (Duration.of_hour (int_of_string value))
    | _ -> error_msgf "Invalid time: %S" str
  in
  let parser str =
    try parser str with _exn -> error_msgf "Invalid time: %S" str
  in
  Arg.conv ~docv:"TIME" (parser, Duration.pp)

let aaaa_timeout =
  let doc = "The timeout applied to the IPv6 resolution." in
  let open Arg in
  value
  & opt timeout (Duration.of_ms 50)
  & info [ "aaaa-timeout" ] ~doc ~docv:"TIME" ~docs:s_happy_eyeballs

let connect_delay =
  let doc =
    "Time to repeat another connection attempt if the others don't respond."
  in
  let open Arg in
  value
  & opt timeout (Duration.of_ms 50)
  & info [ "connect-delay" ] ~doc ~docv:"TIME" ~docs:s_happy_eyeballs

let connect_timeout =
  let doc = "The timeout applied top $(b,connect())." in
  let open Arg in
  value
  & opt timeout (Duration.of_sec 10)
  & info [ "connect-timeout" ] ~doc ~docv:"TIME" ~docs:s_happy_eyeballs

let resolve_timeout =
  let doc = "The timeout applied to the domain-name resolution." in
  let open Arg in
  value
  & opt timeout (Duration.of_sec 1)
  & info [ "resolve-timeout" ] ~doc ~docv:"TIME" ~docs:s_happy_eyeballs

let resolve_retries =
  let doc = "The number $(i,N) of attempts to make a connection." in
  let open Arg in
  value
  & opt int 3
  & info [ "resolve-retries" ] ~doc ~docv:"NUMBER" ~docs:s_happy_eyeballs

type setup = {
    aaaa_timeout: int64
  ; connect_delay: int64
  ; connect_timeout: int64
  ; resolve_timeout: int64
  ; resolve_retries: int
}

let setup aaaa_timeout connect_delay connect_timeout resolve_timeout
    resolve_retries =
  {
    aaaa_timeout
  ; connect_delay
  ; connect_timeout
  ; resolve_timeout
  ; resolve_retries
  }

let setup =
  let open Term in
  const setup
  $ aaaa_timeout
  $ connect_delay
  $ connect_timeout
  $ resolve_timeout
  $ resolve_retries