forked from
gazagnaire.org/ocaml-mdns
mDNS/DNS-SD service discovery for OCaml (RFC 6762/6763)
Improve CLI design following cmdliner best practices
mdns-query:
- Add --quiet flag for scripting
- Exit 1 when no results found
- Better error handling for invalid service names
- Improved documentation
matter:
- Replace --all/--commissionable flags with --filter enum (orthogonality)
- Consolidate on/off/toggle into single 'control' subcommand
- Make --passcode a required flag (not positional - more explicit)
- Add --port with default 5540 (predictability)
- Add --quiet flag
- Proper exit codes on errors
- Improved help text and examples
+30
-15
+30
-15
bin/mdns_query.ml
+30
-15
bin/mdns_query.ml
···
8
8
let pp_domain ppf name = Fmt.pf ppf "%s" (Domain_name.to_string name)
9
9
10
10
let pp_response ppf (r : Mdns.response) =
11
-
(* PTR records: service instances *)
12
11
List.iter
13
12
(fun (service, instance) ->
14
13
Fmt.pf ppf "@[<h>PTR %a -> %a@]@." pp_domain service pp_domain instance)
15
14
r.ptrs;
16
-
(* SRV records: port and target *)
17
15
List.iter
18
16
(fun (instance, port, target) ->
19
17
Fmt.pf ppf "@[<h>SRV %a -> %a:%d@]@." pp_domain instance pp_domain target
20
18
port)
21
19
r.srvs;
22
-
(* TXT records *)
23
20
List.iter
24
21
(fun (instance, txts) ->
25
22
Fmt.pf ppf "@[<h>TXT %a -> %a@]@." pp_domain instance
26
23
Fmt.(list ~sep:(any " ") string)
27
24
txts)
28
25
r.txts;
29
-
(* A records *)
30
26
List.iter
31
27
(fun (name, ip) ->
32
28
Fmt.pf ppf "@[<h>A %a -> %a@]@." pp_domain name Ipaddr.V4.pp ip)
33
29
r.addrs;
34
-
(* AAAA records *)
35
30
List.iter
36
31
(fun (name, ip) ->
37
32
Fmt.pf ppf "@[<h>AAAA %a -> %a@]@." pp_domain name Ipaddr.V6.pp ip)
38
33
r.addrs6
39
34
40
-
let run service timeout =
35
+
let is_empty (r : Mdns.response) =
36
+
r.ptrs = [] && r.srvs = [] && r.txts = [] && r.addrs = [] && r.addrs6 = []
37
+
38
+
let run service timeout quiet =
41
39
Eio_main.run @@ fun env ->
42
40
Eio.Switch.run @@ fun sw ->
43
41
let net = Eio.Stdenv.net env in
44
42
let clock = Eio.Stdenv.clock env in
45
-
let name = Domain_name.of_string_exn service in
46
-
Fmt.pr "Querying %s (timeout: %.1fs)...@.@." service timeout;
43
+
let name =
44
+
try Domain_name.of_string_exn service
45
+
with Invalid_argument msg ->
46
+
Fmt.epr "Error: invalid service name %S: %s@." service msg;
47
+
exit 1
48
+
in
49
+
if not quiet then Fmt.pr "Querying %s (timeout: %.1fs)...@.@." service timeout;
47
50
let responses = Mdns.query ~sw ~net ~clock ~timeout name in
48
51
let merged = Mdns.merge responses in
49
-
if
50
-
merged.ptrs = [] && merged.srvs = [] && merged.txts = []
51
-
&& merged.addrs = [] && merged.addrs6 = []
52
-
then Fmt.pr "No responses received.@."
52
+
if is_empty merged then begin
53
+
if not quiet then Fmt.pr "No responses received.@.";
54
+
exit 1
55
+
end
53
56
else begin
54
-
Fmt.pr "Results:@.";
57
+
if not quiet then Fmt.pr "Results:@.";
55
58
pp_response Fmt.stdout merged
56
59
end
57
60
···
59
62
open Cmdliner
60
63
61
64
let service =
62
-
let doc = "Service type to query (e.g., _http._tcp.local, _hap._tcp.local)" in
65
+
let doc =
66
+
"Service type to query. Use DNS-SD format: $(b,_service._proto.local) \
67
+
(e.g., $(b,_http._tcp.local), $(b,_hap._tcp.local))."
68
+
in
63
69
Arg.(required & pos 0 (some string) None & info [] ~docv:"SERVICE" ~doc)
64
70
65
71
let timeout =
66
72
let doc = "Timeout in seconds to wait for responses." in
67
73
Arg.(value & opt float 3.0 & info [ "t"; "timeout" ] ~docv:"SECONDS" ~doc)
68
74
75
+
let quiet =
76
+
let doc = "Suppress informational messages; only print results." in
77
+
Arg.(value & flag & info [ "q"; "quiet" ] ~doc)
78
+
69
79
let cmd =
70
80
let doc = "Query mDNS services on the local network" in
71
81
let man =
···
74
84
`P
75
85
"$(tname) sends an mDNS query for the specified service type and \
76
86
displays all responses received within the timeout period.";
87
+
`P "Exit status is 0 if at least one response was received, 1 otherwise.";
77
88
`S Manpage.s_examples;
78
89
`P "Query for HomeKit accessories:";
79
90
`Pre " $(tname) _hap._tcp.local";
···
81
92
`Pre " $(tname) _matter._tcp.local";
82
93
`P "Query for HTTP servers with longer timeout:";
83
94
`Pre " $(tname) -t 5 _http._tcp.local";
95
+
`P "Quiet mode for scripting:";
96
+
`Pre " $(tname) -q _hap._tcp.local";
97
+
`S Manpage.s_see_also;
98
+
`P "$(b,dns-sd)(1), RFC 6762 (mDNS), RFC 6763 (DNS-SD)";
84
99
]
85
100
in
86
101
let info = Cmd.info "mdns-query" ~version:"%%VERSION%%" ~doc ~man in
87
-
Cmd.v info Term.(const run $ service $ timeout)
102
+
Cmd.v info Term.(const run $ service $ timeout $ quiet)
88
103
89
104
let () = exit (Cmd.eval cmd)