Skip to content

Commit bc0140f

Browse files
djs55djs55
committed
Merge pull request #44 from robhoes/network-cli
Initial version of a CLI for networkd
2 parents 965422f + 0b9e2ed commit bc0140f

File tree

6 files changed

+615
-92
lines changed

6 files changed

+615
-92
lines changed

‎_oasis‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -44,4 +44,9 @@ Test test_networkd
4444
Command: $network_test
4545
WorkingDirectory: .
4646

47+
Executable cli
48+
CompiledObject: best
49+
Path: cli
50+
MainIs: network_cli.ml
51+
BuildDepends: cmdliner, stdext, network-libs, xcp, xcp.network
4752

‎_tags‎

Lines changed: 20 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
# OASIS_START
2-
# DO NOT EDIT (digest: 25ce055fb4cc4259cfd4fd1e986a20f1)
2+
# DO NOT EDIT (digest: 69abe13a880191e9d4ddc9d091092ce0)
33
# Ignore VCS directories, you can use the same kind of rule outside
44
# OASIS_START/STOP if you want to exclude directories that contains
55
# useless stuff for the build process
@@ -87,5 +87,24 @@
8787
<test/*.ml{,i}>: pkg_xcp-inventory
8888
<test/*.ml{,i}>: pkg_xcp.network
8989
<test/*.ml{,i}>: use_networklibs
90+
# Executable cli
91+
<cli/network_cli.{native,byte}>: pkg_cmdliner
92+
<cli/network_cli.{native,byte}>: pkg_forkexec
93+
<cli/network_cli.{native,byte}>: pkg_rpclib
94+
<cli/network_cli.{native,byte}>: pkg_stdext
95+
<cli/network_cli.{native,byte}>: pkg_threads
96+
<cli/network_cli.{native,byte}>: pkg_xcp
97+
<cli/network_cli.{native,byte}>: pkg_xcp-inventory
98+
<cli/network_cli.{native,byte}>: pkg_xcp.network
99+
<cli/network_cli.{native,byte}>: use_networklibs
100+
<cli/*.ml{,i}>: pkg_cmdliner
101+
<cli/*.ml{,i}>: pkg_forkexec
102+
<cli/*.ml{,i}>: pkg_rpclib
103+
<cli/*.ml{,i}>: pkg_stdext
104+
<cli/*.ml{,i}>: pkg_threads
105+
<cli/*.ml{,i}>: pkg_xcp
106+
<cli/*.ml{,i}>: pkg_xcp-inventory
107+
<cli/*.ml{,i}>: pkg_xcp.network
108+
<cli/*.ml{,i}>: use_networklibs
90109
# OASIS_STOP
91110

‎cli/network_cli.ml‎

Lines changed: 354 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,354 @@
1+
open Network_interface
2+
open Network_client
3+
open Cmdliner
4+
open Xstringext
5+
6+
let dbg = "cli"
7+
8+
let (|>) x f = f x
9+
10+
(* Interface commands *)
11+
12+
let iface_arg =
13+
let doc = "Interface name" in
14+
Arg.(required & pos 0 (some string) None & info [] ~docv:"INTERFACE" ~doc)
15+
16+
let list_iface () =
17+
let all = Client.Interface.get_all dbg () in
18+
List.iter print_endline all
19+
20+
let list_iface_cmd =
21+
let doc = "List all interfaces" in
22+
let man = [] in
23+
Term.(pure list_iface $ pure ()),
24+
Term.info "list-iface" ~doc ~man
25+
26+
let get_mac iface =
27+
try
28+
let mac = Client.Interface.get_mac dbg iface in
29+
`Ok (print_endline mac)
30+
with _ ->
31+
`Error (false, iface ^ " is not an interface")
32+
33+
let get_mac_cmd =
34+
let doc = "Get the MAC address of an interface" in
35+
let man = [] in
36+
Term.(ret (pure get_mac $ iface_arg)),
37+
Term.info "get-mac" ~doc ~man
38+
39+
let is_up iface =
40+
try
41+
let up = Client.Interface.is_up dbg iface in
42+
`Ok (print_endline (if up then "up" else "not up"))
43+
with _ ->
44+
`Error (false, iface ^ " is not an interface")
45+
46+
let is_up_cmd =
47+
let doc = "Check whether an interface is up or down" in
48+
let man = [] in
49+
Term.(ret (pure is_up $ iface_arg)),
50+
Term.info "is-up" ~doc ~man
51+
52+
let get_ipv4_addr iface =
53+
try
54+
let addrs = Client.Interface.get_ipv4_addr dbg iface in
55+
List.iter (fun (addr, prefix) ->
56+
Printf.printf "%s/%d\n" (Unix.string_of_inet_addr addr) prefix
57+
) addrs;
58+
`Ok ()
59+
with _ ->
60+
`Error (false, iface ^ " is not an interface")
61+
62+
let get_ipv4_addr_cmd =
63+
let doc = "Get IPv4 addresses (CIDRs) of an interface" in
64+
let man = [] in
65+
Term.(ret (pure get_ipv4_addr $ iface_arg)),
66+
Term.info "get-ipv4-addr" ~doc ~man
67+
68+
let set_ipv4_addr iface conf =
69+
try
70+
let conf' =
71+
if conf = "none" then
72+
None4
73+
else if conf = "dhcp" then
74+
DHCP4
75+
else
76+
let i = String.index conf '/' in
77+
let n = String.length conf in
78+
let addr = Unix.inet_addr_of_string (String.sub conf 0 i) in
79+
let prefix = String.sub conf (i + 1) (n - i - 1) |> int_of_string in
80+
Static4 [addr, prefix]
81+
in
82+
Client.Interface.set_ipv4_conf dbg iface conf';
83+
`Ok ()
84+
with _ ->
85+
`Error (false, "something went wrong")
86+
87+
let set_ipv4_addr_cmd =
88+
let doc = "Interface name (none|dhcp|<cidr>)" in
89+
let conf_arg = Arg.(required & pos 1 (some string) None & info [] ~docv:"IPV4-CONF" ~doc) in
90+
let doc = "Set IPv4 configuration of an interface" in
91+
let man = [] in
92+
Term.(ret (pure set_ipv4_addr $ iface_arg $ conf_arg)),
93+
Term.info "set-ipv4-addr" ~doc ~man
94+
95+
let get_ipv4_gateway iface =
96+
try
97+
let addr = Client.Interface.get_ipv4_gateway dbg iface in
98+
(match addr with
99+
| Some addr -> Printf.printf "%s\n" (Unix.string_of_inet_addr addr)
100+
| None -> ()
101+
);
102+
`Ok ()
103+
with _ ->
104+
`Error (false, iface ^ " is not an interface")
105+
106+
let get_ipv4_gateway_cmd =
107+
let doc = "If there is an IPv4 default route through the interface, get the gateway address" in
108+
let man = [] in
109+
Term.(ret (pure get_ipv4_gateway $ iface_arg)),
110+
Term.info "get-ipv4-gateway" ~doc ~man
111+
112+
let set_ipv4_gateway iface addr =
113+
try
114+
let addr' = Unix.inet_addr_of_string addr in
115+
Client.Interface.set_ipv4_gateway dbg iface addr';
116+
`Ok ()
117+
with _ ->
118+
`Error (false, "something went wrong")
119+
120+
let set_ipv4_gateway_cmd =
121+
let doc = "Gateway IPv4 address" in
122+
let addr_arg = Arg.(required & pos 1 (some string) None & info [] ~docv:"IPV4-GATEWAY" ~doc) in
123+
let doc = "Set IPv4 gateway for an interface" in
124+
let man = [] in
125+
Term.(ret (pure set_ipv4_gateway $ iface_arg $ addr_arg)),
126+
Term.info "set-ipv4-gateway" ~doc ~man
127+
128+
let get_ipv6_addr iface =
129+
try
130+
let addrs = Client.Interface.get_ipv6_addr dbg iface in
131+
List.iter (fun (addr, prefix) ->
132+
Printf.printf "%s/%d\n" (Unix.string_of_inet_addr addr) prefix
133+
) addrs;
134+
`Ok ()
135+
with _ ->
136+
`Error (false, iface ^ " is not an interface")
137+
138+
let get_ipv6_addr_cmd =
139+
let doc = "Get IPv6 addresses (CIDRs) of an interface" in
140+
let man = [] in
141+
Term.(ret (pure get_ipv6_addr $ iface_arg)),
142+
Term.info "get-ipv6-addr" ~doc ~man
143+
144+
let set_ipv6_addr iface conf =
145+
try
146+
let conf' =
147+
if conf = "none" then
148+
None6
149+
else if conf = "linklocal" then
150+
Linklocal6
151+
else if conf = "dhcp" then
152+
DHCP6
153+
else if conf = "autoconf" then
154+
Autoconf6
155+
else
156+
let i = String.index conf '/' in
157+
let n = String.length conf in
158+
let addr = Unix.inet_addr_of_string (String.sub conf 0 i) in
159+
let prefix = String.sub conf (i + 1) (n - i - 1) |> int_of_string in
160+
Static6 [addr, prefix]
161+
in
162+
Client.Interface.set_ipv6_conf dbg iface conf';
163+
`Ok ()
164+
with _ ->
165+
`Error (false, "something went wrong")
166+
167+
let set_ipv6_addr_cmd =
168+
let doc = "Interface name (none|linklocal|dhcp|autoconf|<cidr>)" in
169+
let conf_arg = Arg.(required & pos 1 (some string) None & info [] ~docv:"IPV6-CONF" ~doc) in
170+
let doc = "Set IPv6 configuration of an interface" in
171+
let man = [] in
172+
Term.(ret (pure set_ipv6_addr $ iface_arg $ conf_arg)),
173+
Term.info "set-ipv6-addr" ~doc ~man
174+
175+
let get_ipv6_gateway iface =
176+
try
177+
let addr = Client.Interface.get_ipv6_gateway dbg iface in
178+
(match addr with
179+
| Some addr -> Printf.printf "%s\n" (Unix.string_of_inet_addr addr)
180+
| None -> ()
181+
);
182+
`Ok ()
183+
with _ ->
184+
`Error (false, iface ^ " is not an interface")
185+
186+
let get_ipv6_gateway_cmd =
187+
let doc = "If there is an IPv6 default route through the interface, get the gateway address" in
188+
let man = [] in
189+
Term.(ret (pure get_ipv6_gateway $ iface_arg)),
190+
Term.info "get-ipv6-gateway" ~doc ~man
191+
192+
let set_ipv6_gateway iface addr =
193+
try
194+
let addr' = Unix.inet_addr_of_string addr in
195+
Client.Interface.set_ipv6_gateway dbg iface addr';
196+
`Ok ()
197+
with _ ->
198+
`Error (false, "something went wrong")
199+
200+
let set_ipv6_gateway_cmd =
201+
let doc = "Gateway IPv6 address" in
202+
let addr_arg = Arg.(required & pos 1 (some string) None & info [] ~docv:"IPV6-GATEWAY" ~doc) in
203+
let doc = "Set IPv6 gateway for an interface" in
204+
let man = [] in
205+
Term.(ret (pure set_ipv6_gateway $ iface_arg $ addr_arg)),
206+
Term.info "set-ipv6-gateway" ~doc ~man
207+
208+
let get_dns () =
209+
let nameservers, domains = Client.Interface.get_dns dbg "" in
210+
Printf.printf "nameservers: %s\n" (String.concat ", " (List.map Unix.string_of_inet_addr nameservers));
211+
Printf.printf "domains: %s\n" (String.concat ", " domains);
212+
`Ok ()
213+
214+
let get_dns_cmd =
215+
let doc = "Get DNS nameservers and domains" in
216+
let man = [] in
217+
Term.(ret (pure get_dns $ pure ())),
218+
Term.info "get-dns" ~doc ~man
219+
220+
let set_dns iface nameservers domains =
221+
try
222+
let ns = match nameservers with
223+
| Some x -> List.map Unix.inet_addr_of_string (String.split ',' x)
224+
| None -> []
225+
in
226+
let d = match domains with
227+
| Some x -> String.split ',' x
228+
| None -> []
229+
in
230+
Client.Interface.set_dns dbg iface ns d;
231+
`Ok ()
232+
with _ ->
233+
`Error (false, "something went wrong")
234+
235+
let set_dns_cmd =
236+
let doc = "Comma-separated list of nameservers" in
237+
let nameservers_arg = Arg.(value & opt (some string) None & info ["nameservers"] ~docv:"NAMESERVERS" ~doc) in
238+
let doc = "Comma-separated list of domains" in
239+
let domains_arg = Arg.(value & opt (some string) None & info ["domains"] ~docv:"DOMAINS" ~doc) in
240+
let doc = "Set DNS nameservers and domains" in
241+
let man = [] in
242+
Term.(ret (pure set_dns $ iface_arg $ nameservers_arg $ domains_arg)),
243+
Term.info "set-dns" ~doc ~man
244+
245+
let get_mtu iface =
246+
try
247+
let mtu = Client.Interface.get_mtu dbg iface in
248+
Printf.printf "%d\n" mtu;
249+
`Ok ()
250+
with _ ->
251+
`Error (false, iface ^ " is not an interface")
252+
253+
let get_mtu_cmd =
254+
let doc = "Get MTU" in
255+
let man = [] in
256+
Term.(ret (pure get_mtu $ iface_arg)),
257+
Term.info "get-mtu" ~doc ~man
258+
259+
let set_mtu iface mtu =
260+
try
261+
Client.Interface.set_mtu dbg iface mtu;
262+
`Ok ()
263+
with _ ->
264+
`Error (false, iface ^ " is not an interface")
265+
266+
let set_mtu_cmd =
267+
let doc = "The MTU" in
268+
let mtu_arg = Arg.(required & pos 1 (some int) None & info [] ~docv:"MTU" ~doc) in
269+
let doc = "Get MTU" in
270+
let man = [] in
271+
Term.(ret (pure set_mtu $ iface_arg $ mtu_arg)),
272+
Term.info "set-mtu" ~doc ~man
273+
274+
let get_persistence iface =
275+
try
276+
let persistent = Client.Interface.is_persistent dbg iface in
277+
Printf.printf "%s\n" (if persistent then "persistent" else "not persistent");
278+
`Ok ()
279+
with _ ->
280+
`Error (false, iface ^ " is not an interface")
281+
282+
let get_persistence_cmd =
283+
let doc = "Get persistence" in
284+
let man = [] in
285+
Term.(ret (pure get_persistence $ iface_arg)),
286+
Term.info "get-persistence" ~doc ~man
287+
288+
let set_persistence iface persistence =
289+
try
290+
if persistence = "on" then
291+
`Ok (Client.Interface.set_persistent dbg iface true)
292+
else if persistence = "off" then
293+
`Ok (Client.Interface.set_persistent dbg iface false)
294+
else
295+
`Error (false, "'on' or 'off' please")
296+
with _ ->
297+
`Error (false, iface ^ " is not an interface")
298+
299+
let set_persistence_cmd =
300+
let doc = "Persistence (on|off)" in
301+
let persistence_arg = Arg.(required & pos 1 (some string) None & info [] ~docv:"PERSISTENCE" ~doc) in
302+
let doc = "Set persistence" in
303+
let man = [] in
304+
Term.(ret (pure set_persistence $ iface_arg $ persistence_arg)),
305+
Term.info "set-persistence" ~doc ~man
306+
307+
(* Bridge commands *)
308+
309+
let list_br () =
310+
let all = Client.Bridge.get_all dbg () in
311+
List.iter print_endline all
312+
313+
let list_br_cmd =
314+
let doc = "List all bridges" in
315+
let man = [] in
316+
Term.(pure list_br $ pure ()),
317+
Term.info "list-br" ~doc ~man
318+
319+
let read_config path =
320+
let config_json = Unixext.string_of_file path in
321+
config_json |> Jsonrpc.of_string |> config_t_of_rpc
322+
323+
let config path =
324+
let config = read_config path in
325+
Client.Bridge.make_config dbg ~config:config.bridge_config ();
326+
Client.Interface.make_config dbg ~config:config.interface_config ();
327+
`Ok ()
328+
329+
let config_cmd =
330+
let doc = "Path to JSON config file" in
331+
let config_arg = Arg.(required & pos 0 (some file) None & info [] ~docv:"CONFIG-FILE" ~doc) in
332+
let doc = "Set network configuration based on a config file" in
333+
let man = [] in
334+
Term.(ret (pure config $ config_arg)),
335+
Term.info "config" ~doc ~man
336+
337+
let default_cmd =
338+
let doc = "CLI for xcp-networkd" in
339+
let man = [] in
340+
Term.(ret (pure (`Help (`Pager, None)))),
341+
Term.info "network-cli" ~version:"0.1" ~doc ~man
342+
343+
let cmds = [
344+
list_iface_cmd; get_mac_cmd; is_up_cmd;
345+
get_ipv4_addr_cmd; set_ipv4_addr_cmd; get_ipv4_gateway_cmd; set_ipv4_gateway_cmd;
346+
get_ipv6_addr_cmd; set_ipv6_addr_cmd; get_ipv6_gateway_cmd; set_ipv6_gateway_cmd;
347+
get_dns_cmd; set_dns_cmd; get_mtu_cmd; set_mtu_cmd;
348+
get_persistence_cmd; set_persistence_cmd;
349+
list_br_cmd;
350+
config_cmd]
351+
352+
let _ =
353+
match Term.eval_choice default_cmd cmds with
354+
| `Error _ -> exit 1 | _ -> exit 0

0 commit comments

Comments
 (0)