anil.recoil.org
forked from
gazagnaire.org/ocaml-mdns
mDNS/DNS-SD service discovery for OCaml (RFC 6762/6763)
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: MIT
4 ---------------------------------------------------------------------------*)
5
6(** mdns-query - mDNS service discovery CLI tool *)
7
8let pp_domain ppf name = Fmt.pf ppf "%s" (Domain_name.to_string name)
9
10let pp_response ppf (r : Mdns.response) =
11 List.iter
12 (fun (service, instance) ->
13 Fmt.pf ppf "@[<h>PTR %a -> %a@]@." pp_domain service pp_domain instance)
14 r.ptrs;
15 List.iter
16 (fun (instance, port, target) ->
17 Fmt.pf ppf "@[<h>SRV %a -> %a:%d@]@." pp_domain instance pp_domain target
18 port)
19 r.srvs;
20 List.iter
21 (fun (instance, txts) ->
22 Fmt.pf ppf "@[<h>TXT %a -> %a@]@." pp_domain instance
23 Fmt.(list ~sep:(any " ") string)
24 txts)
25 r.txts;
26 List.iter
27 (fun (name, ip) ->
28 Fmt.pf ppf "@[<h>A %a -> %a@]@." pp_domain name Ipaddr.V4.pp ip)
29 r.addrs;
30 List.iter
31 (fun (name, ip) ->
32 Fmt.pf ppf "@[<h>AAAA %a -> %a@]@." pp_domain name Ipaddr.V6.pp ip)
33 r.addrs6
34
35let is_empty (r : Mdns.response) =
36 r.ptrs = [] && r.srvs = [] && r.txts = [] && r.addrs = [] && r.addrs6 = []
37
38let run service timeout quiet =
39 Eio_main.run @@ fun env ->
40 Eio.Switch.run @@ fun sw ->
41 let net = Eio.Stdenv.net env in
42 let clock = Eio.Stdenv.clock env in
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;
50 let responses = Mdns.query ~sw ~net ~clock ~timeout name in
51 let merged = Mdns.merge responses in
52 if is_empty merged then begin
53 if not quiet then Fmt.pr "No responses received.@.";
54 exit 1
55 end
56 else begin
57 if not quiet then Fmt.pr "Results:@.";
58 pp_response Fmt.stdout merged
59 end
60
61(* Cmdliner interface *)
62open Cmdliner
63
64let service =
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
69 Arg.(required & pos 0 (some string) None & info [] ~docv:"SERVICE" ~doc)
70
71let timeout =
72 let doc = "Timeout in seconds to wait for responses." in
73 Arg.(value & opt float 3.0 & info [ "t"; "timeout" ] ~docv:"SECONDS" ~doc)
74
75let quiet =
76 let doc = "Suppress informational messages; only print results." in
77 Arg.(value & flag & info [ "q"; "quiet" ] ~doc)
78
79let cmd =
80 let doc = "Query mDNS services on the local network" in
81 let man =
82 [
83 `S Manpage.s_description;
84 `P
85 "$(tname) sends an mDNS query for the specified service type and \
86 displays all responses received within the timeout period.";
87 `P "Exit status is 0 if at least one response was received, 1 otherwise.";
88 `S Manpage.s_examples;
89 `P "Query for HomeKit accessories:";
90 `Pre " $(tname) _hap._tcp.local";
91 `P "Query for Matter devices:";
92 `Pre " $(tname) _matter._tcp.local";
93 `P "Query for HTTP servers with longer timeout:";
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)";
99 ]
100 in
101 let info = Cmd.info "mdns-query" ~version:"%%VERSION%%" ~doc ~man in
102 Cmd.v info Term.(const run $ service $ timeout $ quiet)
103
104let () = exit (Cmd.eval cmd)