diff --git a/repo/darwin/packages/upstream/dnssd.0.5.0/descr b/repo/darwin/packages/dev/dnssd.0.6.0/descr similarity index 100% rename from repo/darwin/packages/upstream/dnssd.0.5.0/descr rename to repo/darwin/packages/dev/dnssd.0.6.0/descr diff --git a/repo/darwin/packages/upstream/dnssd.0.5.0/opam b/repo/darwin/packages/dev/dnssd.0.6.0/opam similarity index 100% rename from repo/darwin/packages/upstream/dnssd.0.5.0/opam rename to repo/darwin/packages/dev/dnssd.0.6.0/opam diff --git a/repo/darwin/packages/dev/dnssd.0.6.0/url b/repo/darwin/packages/dev/dnssd.0.6.0/url new file mode 100644 index 000000000..f821f4fa6 --- /dev/null +++ b/repo/darwin/packages/dev/dnssd.0.6.0/url @@ -0,0 +1 @@ +git: "git://github.com/djs55/ocaml-osx-dnssd#big-results-opam-1.2-v2" diff --git a/repo/darwin/packages/upstream/dnssd.0.5.0/url b/repo/darwin/packages/upstream/dnssd.0.5.0/url deleted file mode 100644 index 5f1db26d3..000000000 --- a/repo/darwin/packages/upstream/dnssd.0.5.0/url +++ /dev/null @@ -1,2 +0,0 @@ -archive: "https://github.com/mirage/ocaml-osx-dnssd/releases/download/v0.5.0/dnssd-0.5.0.tbz" -checksum: "8208d2ee22d572ea42da2a1e258c5d5a" \ No newline at end of file diff --git a/repo/win32/packages/dev/dnssd.0.6.0 b/repo/win32/packages/dev/dnssd.0.6.0 new file mode 120000 index 000000000..23ca574a6 --- /dev/null +++ b/repo/win32/packages/dev/dnssd.0.6.0 @@ -0,0 +1 @@ +../../../darwin/packages/dev/dnssd.0.6.0 \ No newline at end of file diff --git a/repo/win32/packages/upstream/dnssd.0.5.0/descr b/repo/win32/packages/upstream/dnssd.0.5.0/descr deleted file mode 100644 index 82ad97bb3..000000000 --- a/repo/win32/packages/upstream/dnssd.0.5.0/descr +++ /dev/null @@ -1,19 +0,0 @@ -DNS Service Discovery for macOS - -This library contains bindings to the functions in `dns_sd.h`, which -are used to perform generic DNS queries using the macOS resolver. -This is the best way to ensure that the query results match the -results obtained by other apps on OSX. - -## Usage example - -In a toplevel: - -```ocaml -Dnssd.query "dave.recoil.org" Dns.Packet.Q_A;; -- : (Dns.Packet.rr list, Dnssd.error) result = -Ok - [{Dns.Packet.name = ; cls = Dns.Packet.RR_IN; flush = false; ttl = 187l; rdata = Dns.Packet.A }; - {Dns.Packet.name = ; cls = Dns.Packet.RR_IN; flush = false; ttl = 187l; rdata = Dns.Packet.CNAME }; - {Dns.Packet.name = ; cls = Dns.Packet.RR_IN; flush = false; ttl = 187l; rdata = Dns.Packet.CNAME }] -``` \ No newline at end of file diff --git a/repo/win32/packages/upstream/dnssd.0.5.0/opam b/repo/win32/packages/upstream/dnssd.0.5.0/opam deleted file mode 100644 index 0c07c4ede..000000000 --- a/repo/win32/packages/upstream/dnssd.0.5.0/opam +++ /dev/null @@ -1,32 +0,0 @@ -opam-version: "1.2" -maintainer: "dave@recoil.org" -authors: ["David Scott" "Thomas Gazagnaire"] -license: "ISC" -homepage: "https://github.com/mirage/ocaml-osx-dnssd" -dev-repo: "https://github.com/mirage/ocaml-osx-dnssd.git" -bug-reports: "https://github.com/mirage/ocaml-osx-dnssd/issues" -doc: "https://mirage.github.io/ocaml-osx-dnssd/" -tags: [ - "org:mirage" -] - -build: [ - ["jbuilder" "subst" "-p" name] {pinned} - ["jbuilder" "build" "-j" jobs] -] - -build-test: [ - [ "jbuilder" "runtest" ] -] - -depends: [ - "dns" - "lwt" - "logs" - "fmt" - "cstruct" {>= "2.3.0"} - "jbuilder" {build & >= "1.0+beta10"} - "alcotest" {test} -] - -available: [ocaml-version >= "4.03.0"] diff --git a/repo/win32/packages/upstream/dnssd.0.5.0/url b/repo/win32/packages/upstream/dnssd.0.5.0/url deleted file mode 100644 index 5f1db26d3..000000000 --- a/repo/win32/packages/upstream/dnssd.0.5.0/url +++ /dev/null @@ -1,2 +0,0 @@ -archive: "https://github.com/mirage/ocaml-osx-dnssd/releases/download/v0.5.0/dnssd-0.5.0.tbz" -checksum: "8208d2ee22d572ea42da2a1e258c5d5a" \ No newline at end of file diff --git a/src/hostnet/host.ml b/src/hostnet/host.ml index 908f79082..5fc0e9681 100644 --- a/src/hostnet/host.ml +++ b/src/hostnet/host.ml @@ -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