Merge pull request #63 from avsm/master

Support Async 112.24.00

.travis.yml

@@ -6,4 +6,4 @@ env:
   - PACKAGE="dns" OCAML_VERSION=4.01 POST_INSTALL_HOOK="./.travis-ci-post.sh"
   - PACKAGE="dns" OCAML_VERSION=4.02 DEPOPTS="tcpip" POST_INSTALL_HOOK="./.travis-ci-post.sh"
   - PACKAGE="dns" OCAML_VERSION=4.02 DEPOPTS="async"
-  - PACKAGE="dns" OCAML_VERSION=4.01 DEPOPTS="async"
+  - PACKAGE="dns" OCAML_VERSION=4.01 DEPOPTS="tcpip lwt" REVDEPS=true

CHANGES

@@ -1,5 +1,10 @@
 0.14.1 (2015-03-29):
-* Reduce namespace pollution in `name.ml` to avoid breaking with Cstruct 1.6.0+
+* Reduce namespace pollution in `name.ml` to avoid breaking with Cstruct 1.6.0+.
+* Add a `Dns_server.compose` function to make it easier to build resolution pipelines (#58).
+* Add a `Dns_server_mirage` functor (#55).
+* Add `Dns_resolver.resolve_pkt` to support custom query packets (#49).
+* Split out the experimental Async_resolver into a `Async_kernel` and Unix libraries.
+  This introduces the `dns.async-unix` library.
 
 0.14.0 (2015-01-29):
 * Renamed `Packet.QM` to `Packet.Q_Normal` and `QU` to `Q_mDNS_Unicast` for

_oasis

@@ -25,7 +25,7 @@ Flag mirage
   Default: false
 
 Flag async
-  Description: build the Async library
+  Description: build the Async_kernel library
   Default: false
 
 Library dns
@@ -73,9 +73,19 @@ Library "dns-async"
   Build$: flag(async)
   Install$: flag(async)
   Findlibname: async
-  Modules: Async_dns_resolver, Async_dns_resolver_unix
-  BuildDepends: async, ipaddr, dns, core.syntax, threads
-  XMetaRequires: async, ipaddr, dns, threads
+  Modules: Async_dns_resolver
+  BuildDepends: async_kernel, ipaddr, dns, core.syntax
+  XMetaRequires: async_kernel, ipaddr, dns
+  FindlibParent: dns
+
+Library "dns-async-unix"
+  Path: async
+  Build$: flag(async)
+  Install$: flag(async)
+  Findlibname: async-unix
+  Modules: Async_dns_resolver_unix
+  BuildDepends: async, dns.async, threads
+  XMetaRequires: async, dns.async, threads
   FindlibParent: dns
 
 Document dns
@@ -129,7 +139,7 @@ Executable async_resolver
   Custom:             true
   CompiledObject:     best
   Install:            false
-  BuildDepends:       async, dns.async
+  BuildDepends:       async, dns.async-unix
 
 Executable test
   Path:               lib_test/ounit

_tags

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: eefda97a7a038bffab19720f0d34747f)
+# DO NOT EDIT (digest: e1b56de685fe4f22bf8fe52edcc12561)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
@@ -58,7 +58,10 @@ true: annot, bin_annot
 "lwt/dns-lwt.cmxs": use_dns-lwt
 # Library dns-async
 "async/dns-async.cmxs": use_dns-async
+# Library dns-async-unix
+"async/dns-async-unix.cmxs": use_dns-async-unix
 <async/*.ml{,i,y}>: pkg_async
+<async/*.ml{,i,y}>: pkg_async_kernel
 <async/*.ml{,i,y}>: pkg_base64
 <async/*.ml{,i,y}>: pkg_bytes
 <async/*.ml{,i,y}>: pkg_core.syntax
@@ -69,6 +72,7 @@ true: annot, bin_annot
 <async/*.ml{,i,y}>: pkg_re.str
 <async/*.ml{,i,y}>: pkg_threads
 <async/*.ml{,i,y}>: use_dns
+<async/*.ml{,i,y}>: use_dns-async
 # Executable lwt_server
 <lib_test/unix/lwt_server.{native,byte}>: pkg_base64
 <lib_test/unix/lwt_server.{native,byte}>: pkg_bytes
@@ -154,6 +158,7 @@ true: annot, bin_annot
 <lwt/mldig.{native,byte}>: custom
 # Executable async_resolver
 <lib_test/async/test_async_dns_resolver_unix.{native,byte}>: pkg_async
+<lib_test/async/test_async_dns_resolver_unix.{native,byte}>: pkg_async_kernel
 <lib_test/async/test_async_dns_resolver_unix.{native,byte}>: pkg_base64
 <lib_test/async/test_async_dns_resolver_unix.{native,byte}>: pkg_bytes
 <lib_test/async/test_async_dns_resolver_unix.{native,byte}>: pkg_core.syntax
@@ -165,7 +170,9 @@ true: annot, bin_annot
 <lib_test/async/test_async_dns_resolver_unix.{native,byte}>: pkg_threads
 <lib_test/async/test_async_dns_resolver_unix.{native,byte}>: use_dns
 <lib_test/async/test_async_dns_resolver_unix.{native,byte}>: use_dns-async
+<lib_test/async/test_async_dns_resolver_unix.{native,byte}>: use_dns-async-unix
 <lib_test/async/*.ml{,i,y}>: pkg_async
+<lib_test/async/*.ml{,i,y}>: pkg_async_kernel
 <lib_test/async/*.ml{,i,y}>: pkg_base64
 <lib_test/async/*.ml{,i,y}>: pkg_bytes
 <lib_test/async/*.ml{,i,y}>: pkg_core.syntax
@@ -177,6 +184,7 @@ true: annot, bin_annot
 <lib_test/async/*.ml{,i,y}>: pkg_threads
 <lib_test/async/*.ml{,i,y}>: use_dns
 <lib_test/async/*.ml{,i,y}>: use_dns-async
+<lib_test/async/*.ml{,i,y}>: use_dns-async-unix
 <lib_test/async/test_async_dns_resolver_unix.{native,byte}>: custom
 # Executable test
 <lib_test/ounit/test.{native,byte}>: pkg_base64
@@ -204,3 +212,4 @@ true: annot, bin_annot
 <lib_test/ounit/test.{native,byte}>: custom
 # OASIS_STOP
 <lib_test/*>: not_hygienic
+true: annot, principal, bin_annot, debug, short_paths

async/async_dns_resolver.ml

@@ -14,15 +14,15 @@
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
 
-open Core.Std
-open Async.Std
+open Core_kernel.Std
+open Async_kernel.Std
 open Dns.Name
 open Dns.Operators
 open Dns.Protocol
 
 module DP = Dns.Packet
 
-type result = Answer of DP.t | Error of exn
+type result = Answer of DP.t | Err of exn
 
 type commfn = {
   txfn    : Dns.Buf.t -> unit Deferred.t;
@@ -31,11 +31,15 @@ type commfn = {
   cleanfn : unit -> unit Deferred.t;
 }
 
+(*
+TODO: move to a Unix module, since library should not write to stdout
+    
 let stdout_writer () = Lazy.force Writer.stdout
 let stderr_writer () = Lazy.force Writer.stderr
 
 let message s = Writer.write (stdout_writer ()) s
 let warn s = Writer.write (stderr_writer ()) (Printf.sprintf "WARN: %s\n%!" s)
+*)
 
 let nchoose_split l = 
   let fold_f (rs, ts) cur =
@@ -51,7 +55,6 @@ let rec send_req txfn timerfn q =
   | count -> begin
       txfn q >>= fun _ ->
       timerfn () >>= fun () ->
-      message (Printf.sprintf "retry query for %d times\n" (4 - count));
       send_req txfn timerfn q (count - 1)
     end
 
@@ -61,11 +64,11 @@ let send_pkt client ({ txfn; rxfn; timerfn; cleanfn }) pkt =
   let resl = List.map cqpl ~f:(fun (ctxt, q) ->
     Deferred.any [
       ((send_req txfn timerfn q 4) >>= fun () -> 
-        return (Error (R.timeout ctxt)));
+        return (Err (R.timeout ctxt)));
       (try_with (fun () -> rxfn (R.parse ctxt))
         >>| function
         | Ok r -> (Answer r)
-        | Error exn -> (Error exn))
+        | Error exn -> (Err exn))
       ]) in
   let rec select errors = function
     | [] -> raise (Dns_resolve_error errors)
@@ -75,7 +78,7 @@ let send_pkt client ({ txfn; rxfn; timerfn; cleanfn }) pkt =
       let rec find_answer errors = function
         | [] -> select errors ts
         | (Answer a) ::  _ -> return a
-        | (Error e) :: r -> find_answer (e :: errors) r
+        | (Err e) :: r -> find_answer (e :: errors) r
       in
       find_answer errors rs
   in select [] resl

async/async_dns_resolver.mli

@@ -16,8 +16,8 @@
 
 (** Async DNS resolution logic *)
 
-open Core.Std
-open Async.Std
+open Core_kernel.Std
+open Async_kernel.Std
 
 type commfn = {
   txfn : Dns.Buf.t -> unit Deferred.t;

async/dns-async-unix.mldylib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: dfd0b74f03e1d5f5a34dfbbfbe0c8b52)
+Async_dns_resolver_unix
+# OASIS_STOP

async/dns-async-unix.mllib

@@ -0,0 +1,4 @@
+# OASIS_START
+# DO NOT EDIT (digest: dfd0b74f03e1d5f5a34dfbbfbe0c8b52)
+Async_dns_resolver_unix
+# OASIS_STOP

async/dns-async.mldylib

@@ -1,5 +1,4 @@
 # OASIS_START
-# DO NOT EDIT (digest: f6052db6eaa57c98b4758ec47a2b1ac9)
+# DO NOT EDIT (digest: 8d0e492b3c94872c9c7378af17139846)
 Async_dns_resolver
-Async_dns_resolver_unix
 # OASIS_STOP

async/dns-async.mllib

@@ -1,5 +1,4 @@
 # OASIS_START
-# DO NOT EDIT (digest: f6052db6eaa57c98b4758ec47a2b1ac9)
+# DO NOT EDIT (digest: 8d0e492b3c94872c9c7378af17139846)
 Async_dns_resolver
-Async_dns_resolver_unix
 # OASIS_STOP

lib/META

@@ -1,5 +1,5 @@
 # OASIS_START
-# DO NOT EDIT (digest: e0be643d87d2a0fcf73bffac1d91f89b)
+# DO NOT EDIT (digest: abf7e81e524e741f99f94433b9f8d8d1)
 version = "0.14.1"
 description = "DNS client and server implementation"
 requires = "cstruct re re.str ipaddr base64 bytes"
@@ -41,10 +41,21 @@ package "lwt" (
  exists_if = "dns-lwt.cma"
 )
 
+package "async-unix" (
+ version = "0.14.1"
+ description = "DNS client and server implementation"
+ requires = "async dns.async threads"
+ archive(byte) = "dns-async-unix.cma"
+ archive(byte, plugin) = "dns-async-unix.cma"
+ archive(native) = "dns-async-unix.cmxa"
+ archive(native, plugin) = "dns-async-unix.cmxs"
+ exists_if = "dns-async-unix.cma"
+)
+
 package "async" (
  version = "0.14.1"
  description = "DNS client and server implementation"
- requires = "async ipaddr dns threads"
+ requires = "async_kernel ipaddr dns"
  archive(byte) = "dns-async.cma"
  archive(byte, plugin) = "dns-async.cma"
  archive(native) = "dns-async.cmxa"

lwt/dns_server.ml

@@ -20,6 +20,7 @@ open Printf
 
 module DR = Dns.RR
 module DP = Dns.Packet
+module DQ = Dns.Query
 
 type ip_endpoint = Ipaddr.t * int
 
@@ -32,6 +33,17 @@ end
 
 type 'a processor = (module PROCESSOR with type context = 'a)
 
+let compose process backup ~src ~dst packet =
+  process ~src ~dst packet
+  >>= fun result ->
+  match result with
+  | Some a ->
+      let open DQ in
+      (match a.rcode with
+      | DP.NoError -> return result
+      | _ -> backup ~src ~dst packet)
+  | None -> backup ~src ~dst packet
+
 let process_query buf len obuf src dst processor =
   let module Processor = (val processor : PROCESSOR) in
   match Processor.parse (Dns.Buf.sub buf 0 len) with

lwt/dns_server.mli

@@ -33,6 +33,9 @@ end
 
 type 'a processor = (module PROCESSOR with type context = 'a)
 
+(** [compose process backup_process] is [process] unless it returns 
+	an {!rcode} other than {!NoError} in which case it becomes [backup_process]. *)
+val compose: Dns.Packet.t process -> Dns.Packet.t process -> Dns.Packet.t process
 
 (** [process_query ibuf ibuflen obuf src dst processor] *)
 val process_query: Dns.Buf.t -> int -> Dns.Buf.t -> ip_endpoint -> ip_endpoint -> 

myocamlbuild.ml

@@ -1,5 +1,5 @@
 (* OASIS_START *)
-(* DO NOT EDIT (digest: c0bc55b8a1eef376ad5f495bdd68cf50) *)
+(* DO NOT EDIT (digest: b6e55431cd19c75684fcc40b9cb75077) *)
 module OASISGettext = struct
 (* # 22 "src/oasis/OASISGettext.ml" *)
 
@@ -613,7 +613,8 @@ let package_default =
           ("dns-lwt-core", ["lwt"], []);
           ("dns-lwt-mirage", ["mirage"], []);
           ("dns-lwt", ["lwt"], []);
-          ("dns-async", ["async"], [])
+          ("dns-async", ["async"], []);
+          ("dns-async-unix", ["async"], [])
        ];
      lib_c = [];
      flags = [];
@@ -633,6 +634,6 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
 
 let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
 
-# 637 "myocamlbuild.ml"
+# 638 "myocamlbuild.ml"
 (* OASIS_STOP *)
 Ocamlbuild_plugin.dispatch dispatch_default;;

opam

@@ -41,6 +41,6 @@ depopts: [
 ]
 conflicts: [
   "mirage-types" {<"1.2.0"}
-  "async" {<"109.21.00"}
+  "async" {<"112.24.00"}
 ]
 ocaml-version: [>= "4.00.0"]