Skip to content

Commit

Permalink
Mac: handle large DNS result sets
Browse files Browse the repository at this point in the history
This incorporates

mirage/ocaml-osx-dnssd#14

backported to the opam-1.2 branch.

Signed-off-by: David Scott <[email protected]>
  • Loading branch information
djs55 committed Apr 5, 2019
1 parent ee5dd64 commit 7e995c2
Show file tree
Hide file tree
Showing 9 changed files with 37 additions and 82 deletions.
File renamed without changes.
File renamed without changes.
1 change: 1 addition & 0 deletions repo/darwin/packages/dev/dnssd.0.6.0/url
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
git: "git://github.com/djs55/ocaml-osx-dnssd#big-results-opam-1.2-v2"
2 changes: 0 additions & 2 deletions repo/darwin/packages/upstream/dnssd.0.5.0/url

This file was deleted.

1 change: 1 addition & 0 deletions repo/win32/packages/dev/dnssd.0.6.0
19 changes: 0 additions & 19 deletions repo/win32/packages/upstream/dnssd.0.5.0/descr

This file was deleted.

32 changes: 0 additions & 32 deletions repo/win32/packages/upstream/dnssd.0.5.0/opam

This file was deleted.

2 changes: 0 additions & 2 deletions repo/win32/packages/upstream/dnssd.0.5.0/url

This file was deleted.

62 changes: 35 additions & 27 deletions src/hostnet/host.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1136,33 +1136,41 @@ module Dns = struct
let query_one name ty =
let query = Dnssd.LowLevel.query (Dns.Name.to_string name) ty in
let socket = Dnssd.LowLevel.socket query in
let t, u = Lwt.task () in
match Uwt.Poll.start socket [ Uwt.Poll.Readable ]
~cb:(fun _poll events ->
match events with
| Error error ->
Log.err (fun f -> f "Uwt.Poll callback failed with %s" (Uwt.strerror error))
| Ok events ->
List.iter (fun event ->
if event = Uwt.Poll.Readable then Lwt.wakeup_later u ()
) events
) with
| Error error ->
Log.err (fun f -> f "Uwt.Poll.start failed with %s" (Uwt.strerror error));
Lwt.return (Ok [])
| Ok poll ->
t >>= fun () ->
let result = Uwt.Poll.close poll in
if not (Uwt.Int_result.is_ok result) then begin
let error = Uwt.Int_result.to_error result in
Log.err (fun f -> f "Uwt.Poll.close failed with %s" (Uwt.strerror error));
Lwt.return (Ok [])
end else begin
Uwt_preemptive.detach
(fun () ->
Dnssd.LowLevel.response query
) ()
end in
let one () =
let t, u = Lwt.task () in
match Uwt.Poll.start socket [ Uwt.Poll.Readable ]
~cb:(fun _poll events ->
match events with
| Error error ->
Log.err (fun f -> f "Uwt.Poll callback failed with %s" (Uwt.strerror error))
| Ok events ->
List.iter (fun event ->
if event = Uwt.Poll.Readable then Lwt.wakeup_later u ()
) events
) with
| Error error ->
Log.err (fun f -> f "Uwt.Poll.start failed with %s" (Uwt.strerror error));
Lwt.return (Ok ([], false))
| Ok poll ->
t >>= fun () ->
let result = Uwt.Poll.close poll in
if not (Uwt.Int_result.is_ok result) then begin
let error = Uwt.Int_result.to_error result in
Log.err (fun f -> f "Uwt.Poll.close failed with %s" (Uwt.strerror error));
Lwt.return (Ok ([], false))
end else begin
Uwt_preemptive.detach
(fun () ->
Dnssd.LowLevel.response query
) ()
end in
let rec loop acc =
one ()
>>= function
| Error e -> Lwt.return (Error e)
| Ok (rrs, true) -> loop (acc @ rrs)
| Ok (rrs, false) -> Lwt.return (Ok (acc @ rrs)) in
loop [] in

let query requested_name ty =
(* The DNSServiceRef API will return CNAMEs first, without resolving to
Expand Down

0 comments on commit 7e995c2

Please sign in to comment.