Source file mirage_runtime_network.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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
open Cmdliner

let pf = Format.fprintf
let str = Format.asprintf

let pp_group ppf = function
  | None -> pf ppf "the unikernel"
  | Some s -> pf ppf "the %s group" s

let runtime_arg ?(group = "") ~docs ?docv ~doc ~default c name =
  let prefix = if group = "" then group else group ^ "-" in
  let doc = Arg.info ~docs ?docv ~doc [ prefix ^ name ] in
  Arg.(value & opt c default doc)

let interface ?group ?(docs = Mirage_runtime.s_net) default =
  let doc = str "The network interface listened by %a." pp_group group in
  runtime_arg ~doc ~default ?group ~docs ~docv:"INTERFACE" Arg.string
    "interface"

module Conv = struct
  let conv of_string to_string : _ Cmdliner.Arg.conv =
    let pp ppf v = Format.pp_print_string ppf (to_string v) in
    Cmdliner.Arg.conv (of_string, pp)

  let ipv4_address = conv Ipaddr.V4.of_string Ipaddr.V4.to_string
  let ipv4 = conv Ipaddr.V4.Prefix.of_string Ipaddr.V4.Prefix.to_string
  let ipv6_address = conv Ipaddr.V6.of_string Ipaddr.V6.to_string
  let ipv6 = conv Ipaddr.V6.Prefix.of_string Ipaddr.V6.Prefix.to_string
  let ip_address = conv Ipaddr.of_string Ipaddr.to_string
end

open Conv

module V4 = struct
  let network ?group ?(docs = Mirage_runtime.s_net) default =
    let doc =
      str
        "The network of %a specified as an IP address and netmask, e.g. \
         192.168.0.1/16 ."
        pp_group group
    in
    runtime_arg ~doc ~docs ~docv:"PREFIX" ~default ?group ipv4 "ipv4"

  let gateway ?group ?(docs = Mirage_runtime.s_net) default =
    let doc = str "The gateway of %a." pp_group group in
    runtime_arg ~doc ~docs ~docv:"IP" ~default ?group
      Arg.(some ipv4_address)
      "ipv4-gateway"
end

module V6 = struct
  let network ?group ?(docs = Mirage_runtime.s_net) default =
    let doc =
      str "The network of %a specified as IPv6 address and prefix length."
        pp_group group
    in
    runtime_arg ~doc ~docs ~docv:"PREFIX" ~default ?group Arg.(some ipv6) "ipv6"

  let gateway ?group ?(docs = Mirage_runtime.s_net) default =
    let doc = str "The gateway of %a." pp_group group in
    runtime_arg ~doc ~docs ~docv:"IP" ~default ?group
      Arg.(some ipv6_address)
      "ipv6-gateway"

  let accept_router_advertisements ?group ?(docs = Mirage_runtime.s_net) () =
    let doc = str "Accept router advertisements for %a." pp_group group in
    runtime_arg ~doc ~docs ?group ~default:true Arg.bool
      "accept-router-advertisements"
end

let ipv4_only ?group ?(docs = Mirage_runtime.s_net) () =
  let doc = str "Only use IPv4 for %a." pp_group group in
  runtime_arg ~doc ~docs ?group ~default:false Arg.bool "ipv4-only"

let ipv6_only ?group ?(docs = Mirage_runtime.s_net) () =
  let doc = str "Only use IPv6 for %a." pp_group group in
  runtime_arg ~doc ~docs ?group ~default:false Arg.bool "ipv6-only"

let resolver ?group ?(docs = Mirage_runtime.s_net) ?default () =
  let doc = str "DNS resolver (default to anycast.censurfridns.dk)" in
  runtime_arg ~doc ~docv:"IP" ~docs ?group ~default
    Arg.(some (list string))
    "resolver"

let dns_servers ?group ?(docs = Mirage_runtime.s_dns) default =
  let doc = str "DNS servers (default to anycast.censurfridns.dk)" in
  runtime_arg ~doc ~docv:"DNS-SERVER" ~docs ?group ~default
    Arg.(some (list string))
    "dns_servers"

let dns_timeout ?group ?(docs = Mirage_runtime.s_dns) default =
  let doc = str "DNS timeout (in nanoseconds)" in
  runtime_arg ~doc ~docv:"DNS-TIMEOUT" ~docs ?group ~default
    Arg.(some int64)
    "dns_timeout"

let dns_cache_size ?group ?(docs = Mirage_runtime.s_dns) default =
  let doc = str "DNS cache size" in
  runtime_arg ~doc ~docv:"DNS-CACHE-SIZE" ~docs ?group ~default
    Arg.(some int)
    "dns_cache_size"

let he_aaaa_timeout ?group ?(docs = Mirage_runtime.s_he) default =
  let doc = str "AAAA timeout (in nanoseconds)" in
  runtime_arg ~doc ~docv:"AAAA-TIMEOUT" ~docs ?group ~default
    Arg.(some int64)
    "he_aaaa_timeout"

let he_connect_delay ?group ?(docs = Mirage_runtime.s_he) default =
  let doc = str "Delay (in nanoseconds) for connection establishment" in
  runtime_arg ~doc ~docv:"CONNECT-DELAY" ~docs ?group ~default
    Arg.(some int64)
    "he_connect_delay"

let he_connect_timeout ?group ?(docs = Mirage_runtime.s_he) default =
  let doc = str "Connection establishment timeout (in nanoseconds)" in
  runtime_arg ~doc ~docv:"CONNECT-TIMEOUT" ~docs ?group ~default
    Arg.(some int64)
    "he_connect_timeout"

let he_resolve_timeout ?group ?(docs = Mirage_runtime.s_he) default =
  let doc = str "DNS resolution timeout (in nanoseconds)" in
  runtime_arg ~doc ~docv:"RESOLVE-TIMEOUT" ~docs ?group ~default
    Arg.(some int64)
    "he_resolve_timeout"

let he_resolve_retries ?group ?(docs = Mirage_runtime.s_he) default =
  let doc = str "Amount of DNS resolution attempts" in
  runtime_arg ~doc ~docv:"RESOLVE-RETRIES" ~docs ?group ~default
    Arg.(some int)
    "he_resolve_retries"

let he_timer_interval ?group ?(docs = Mirage_runtime.s_he) default =
  let doc = str "Interal (in nanoseconds) for execution of the timer" in
  runtime_arg ~doc ~docv:"TIMER-INTERVAL" ~docs ?group ~default
    Arg.(some int64)
    "he_timer_interval"

let ssh_key ?group ?(docs = Mirage_runtime.s_ssh) default =
  let doc = str "Private SSH key (rsa:<seed> or ed25519:<b64-key>)." in
  runtime_arg ~doc ~docs ~docv:"KEY" ?group ~default Arg.(some string) "ssh-key"

let ssh_password ?group ?(docs = Mirage_runtime.s_ssh) default =
  let doc = str "Private SSH password." in
  runtime_arg ~doc ~docs ~docv:"PASSWORD" ?group ~default
    Arg.(some string)
    "ssh-password"

let ssh_authenticator ?group ?(docs = Mirage_runtime.s_ssh) default =
  let doc = str "SSH authenticator." in
  runtime_arg ~doc ~docs ~docv:"SSH-AUTHENTICATOR" ?group ~default
    Arg.(some string)
    "ssh-authenticator"

let tls_authenticator ?group ?(docs = Mirage_runtime.s_tls) default =
  let doc = str "TLS authenticator." in
  runtime_arg ~doc ~docs ~docv:"TLS-AUTHENTICATOR" ?group ~default
    Arg.(some string)
    "tls-authenticator"

let http_headers ?group ?(docs = Mirage_runtime.s_http) default =
  let doc = str "HTTP headers." in
  runtime_arg ~doc ~docs ~docv:"HEADERS" ?group ~default
    Arg.(some (list ~sep:',' (pair ~sep:':' string string)))
    "http-headers"

let syslog ?group ?(docs = Mirage_runtime.s_log) default =
  let doc = str "syslog server IP" in
  runtime_arg ~doc ~docv:"IP" ~docs ?group ~default
    Arg.(some ip_address)
    "syslog"

let syslog_port ?group ?(docs = Mirage_runtime.s_log) default =
  let default = Option.value ~default:514 default in
  let doc = str "syslog server port" in
  runtime_arg ~doc ~docs ~docv:"PORT" ?group ~default Arg.int "syslog-port"

let syslog_truncate ?group ?(docs = Mirage_runtime.s_log) default =
  let doc = str "truncate syslog messages" in
  runtime_arg ~doc ~docs ?group ~default Arg.(some int) "syslog-truncate"

let syslog_keyname ?group ?(docs = Mirage_runtime.s_log) default =
  let doc = str "TLS key name used for syslog" in
  runtime_arg ~doc ~docs ?group ~default Arg.(some string) "syslog-keyname"

let monitor ?group ?(docs = Mirage_runtime.s_log) default =
  let doc = str "monitor server" in
  runtime_arg ~doc ~docv:"IP" ~docs ?group ~default
    Arg.(some ip_address)
    "monitor"

module Arg = Conv