No alloc

.merlin

@@ -1,8 +1,8 @@
 PKG async async_kernel
 PKG re ipaddr uri base64 hashcons cstruct result cstruct.ppx
 PKG lwt mirage-profile cmdliner re.str lwt.uni uri.services ipaddr.unix
-PKG io-page duration mirage-time-lwt mirage-stack-lwt mirage-kv-lwt
-PKG oUnit pcap-format mirage-protocols mirage-kv io-page.unix
+PKG duration mirage-time-lwt mirage-stack-lwt mirage-kv-lwt
+PKG oUnit pcap-format mirage-protocols mirage-kv
 
 S lib
 S lib_test

_tags

@@ -9,7 +9,7 @@ true : package(re re.str ipaddr uri base64 hashcons cstruct result)
 "lwt": include
 <lwt/*.{ml,mli}>: package(lwt mirage-profile)
 <lwt/dig_unix.*>: package(cmdliner lwt.unix uri.services ipaddr.unix lwt)
-<mirage/*.{ml,mli}>: package(io-page lwt duration mirage-time-lwt)
+<mirage/*.{ml,mli}>: package(lwt duration mirage-time-lwt)
 <mirage/*.{ml,mli}>: package(mirage-stack-lwt mirage-kv-lwt)
 
 <async/*.{ml,mli}>: package(async async_kernel threads), thread
@@ -20,7 +20,7 @@ true : package(re re.str ipaddr uri base64 hashcons cstruct result)
 "async": include
 <lib_test/unix/*>: package(lwt lwt.unix uri.services ipaddr.unix)
 <lib_test/ounit/*>: package(oUnit cstruct.ppx pcap-format lwt mirage-protocols)
-<lib_test/ounit/*>: package(mirage-stack-lwt mirage-time-lwt mirage-kv io-page)
+<lib_test/ounit/*>: package(mirage-stack-lwt mirage-time-lwt mirage-kv)
 <lib_test/ounit/*>: package(mirage-kv-lwt lwt.unix uri.services)
-<lib_test/ounit/*>: package(mirage-profile lwt ipaddr.unix duration io-page.unix)
-<lib_test/async/*>: package(async threads), thread
+<lib_test/ounit/*>: package(mirage-profile lwt ipaddr.unix duration)
+<lib_test/async/*>: package(async threads uri.services), thread

async/async_dns_resolver.ml

@@ -28,8 +28,8 @@ type result = Answer of DP.t | Err of exn
 
 type commfn = {
   log : Log.t option;
-  txfn    : Buf.t -> unit Deferred.t;
-  rxfn    : (Buf.t -> Packet.t option) -> DP.t Deferred.t;
+  txfn    : Cstruct.t -> unit Deferred.t;
+  rxfn    : (Cstruct.t -> Packet.t option) -> DP.t Deferred.t;
   timerfn : unit -> unit Deferred.t;
   cleanfn : unit -> unit Deferred.t;
 }
@@ -50,9 +50,9 @@ let rec send_req txfn timerfn q = function
       send_req txfn timerfn q (count - 1)
     end
 
-let send_pkt client { log; txfn; rxfn; timerfn; cleanfn } pkt =
+let send_pkt ?alloc client { log; txfn; rxfn; timerfn; cleanfn } pkt =
   let module R = (val client: CLIENT ) in
-  let cqpl = R.marshal pkt in
+  let cqpl = R.marshal ?alloc pkt in
   let resl = List.map cqpl ~f:begin fun (ctxt, q) -> Deferred.any [
       ((send_req txfn timerfn q 4) >>| fun () -> (Err (R.timeout ctxt)));
       (try_with (fun () -> rxfn (R.parse ctxt)) >>| function
@@ -78,19 +78,19 @@ let send_pkt client { log; txfn; rxfn; timerfn; cleanfn } pkt =
       find_answer errors rs
   in select [] resl
 
-let resolve ?(dnssec = false) client commfn q_class q_type q_name =
+let resolve ?alloc ?(dnssec = false) client commfn q_class q_type q_name =
   Monitor.try_with_or_error begin fun () ->
     let id = (let module R = (val client: CLIENT ) in R.get_id ()) in
     let q = Dns.Query.create ~id ~dnssec q_class q_type q_name in
-    send_pkt client commfn q
+    send_pkt ?alloc client commfn q
   end >>| fun r ->
   don't_wait_for (commfn.cleanfn ());
   r
 
-let gethostbyname ?(q_class=DP.Q_IN) ?(q_type=DP.Q_A) commfn name =
+let gethostbyname ?alloc ?(q_class=DP.Q_IN) ?(q_type=DP.Q_A) commfn name =
   let open DP in
   let domain = Name.of_string name in
-  resolve (module Dns.Protocol.Client) commfn q_class q_type domain >>|
+  resolve ?alloc (module Dns.Protocol.Client) commfn q_class q_type domain >>|
   Or_error.map ~f:begin fun r ->
     List.fold_right r.answers ~init:[] ~f:begin fun x a ->
       match x.rdata with

async/async_dns_resolver.mli

@@ -24,13 +24,14 @@ open Dns
 
 type commfn = {
   log : Log.t option;
-  txfn : Buf.t -> unit Deferred.t;
-  rxfn : (Buf.t -> Packet.t option) -> Packet.t Deferred.t;
+  txfn : Cstruct.t -> unit Deferred.t;
+  rxfn : (Cstruct.t -> Packet.t option) -> Packet.t Deferred.t;
   timerfn : unit -> unit Deferred.t;
   cleanfn : unit -> unit Deferred.t;
 }
 
 val resolve :
+  ?alloc:(unit -> Cstruct.t) ->
   ?dnssec:bool ->
   (module Protocol.CLIENT) ->
   commfn ->
@@ -39,6 +40,7 @@ val resolve :
   Name.t -> Packet.t Deferred.Or_error.t
 
 val gethostbyname :
+  ?alloc:(unit -> Cstruct.t) ->
   ?q_class:Packet.q_class ->
   ?q_type:Packet.q_type ->
   commfn ->

async/async_dns_resolver_unix.ml

@@ -38,7 +38,7 @@ let cleanfn ?log sock () =
 
 let connect_to_resolver ?log ?(timeout=Time_ns.Span.of_int_sec 1) ?(port=53) addr =
   let sock = Socket.create (Socket.Type.udp) in
-  let addr = sockaddr addr port in
+  let addr = sockaddr addr ~port in
   Monitor.try_with_or_error
     (fun () -> Socket.connect_interruptible sock addr ~interrupt:(Clock_ns.after timeout)) >>= begin function
     | Error e ->
@@ -48,13 +48,13 @@ let connect_to_resolver ?log ?(timeout=Time_ns.Span.of_int_sec 1) ?(port=53) add
     | Ok (`Ok ac_sock) ->
       let txfn buf =
         let w = Writer.create (Socket.fd ac_sock) in
-        Writer.write_bigstring ~pos:0 ~len:(Buf.length buf) w buf;
+        Writer.write_bigstring ~pos:buf.Cstruct.off ~len:buf.Cstruct.len w buf.Cstruct.buffer;
         Writer.flushed w
       in
       let rec rxfn f =
         let r = Reader.create (Socket.fd ac_sock) in
         let handle_chunk (iobuf : ([ `Read | `Who_can_write of Core_kernel.Perms.me ], Iobuf.seek) Iobuf.t) =
-          match f @@ Iobuf.Consume.To_bigstring.subo (iobuf :> ([ `Read ], Iobuf.seek) Iobuf.t) with
+          match f @@ Cstruct.of_bigarray (Iobuf.Consume.To_bigstring.subo (iobuf :> ([ `Read ], Iobuf.seek) Iobuf.t)) with
           | None ->
             Option.iter log ~f:(fun log -> Log.error log "Received wrong data, retrying");
             return `Continue

doc/api.odocl

@@ -9,7 +9,6 @@ Zone
 Zone_lexer
 Zone_parser
 Resolvconf
-Buf
 Protocol
 Probe
 

lib/dns.mlpack

@@ -9,7 +9,6 @@ Zone
 Zone_lexer
 Zone_parser
 Resolvconf
-Buf
 Protocol
 Dig
 Probe

lib/packet.ml

@@ -1459,7 +1459,6 @@ let to_string d =
     (d.additionals ||> rr_to_string |> String.concat ",")
 
 let parse buf =
-  let buf = Cstruct.of_bigarray buf in
   let names = Hashtbl.create 32 in
   let parsen f base n buf typ =
     let rec aux acc n base buf =
@@ -1489,12 +1488,12 @@ let parse buf =
   (* eprintf "RX: %s\n%!" (to_string dns); *)
   dns
 
-let marshal txbuf dns =
+let marshal ?(alloc = fun () -> Cstruct.create 4096) dns =
+  let txbuf = alloc () in
   let marshaln f names base buf values =
     List.fold_left f (names, base, buf) values
   in
 
-  let txbuf = Cstruct.of_bigarray txbuf in
   set_h_id txbuf dns.id;
   set_h_detail txbuf (marshal_detail dns.detail);
   set_h_qdcount txbuf (List.length dns.questions);
@@ -1510,7 +1509,7 @@ let marshal txbuf dns =
   let names,base,buf = marshaln marshal_rr names base buf dns.authorities in
   let _,_,buf = marshaln marshal_rr names base buf dns.additionals in
 
-  let txbuf = Buf.sub txbuf.Cstruct.buffer 0 Cstruct.(len txbuf - len buf) in
+  let txbuf = Cstruct.(sub txbuf 0 (len txbuf - len buf)) in
   (* Cstruct.hexdump txbuf;   *)
   (* eprintf "TX: %s\n%!" (txbuf |> parse (Hashtbl.create 8) |> to_string); *)
   txbuf

lib/packet.mli

@@ -356,10 +356,10 @@ type t = {
 }
 
 val to_string : t -> string
-val parse : Buf.t -> t
+val parse : Cstruct.t -> t
 
 (** The marshalling entry point, given a {! dns} structure.
 
     @return the marshalled packet
 *)
-val marshal : Buf.t -> t -> Buf.t
+val marshal : ?alloc:(unit -> Cstruct.t) -> t -> Cstruct.t

lib/protocol.ml

@@ -22,8 +22,8 @@ module type CLIENT = sig
 
   val get_id : unit -> int
 
-  val marshal : ?alloc:(unit -> Buf.t) -> Packet.t -> (context * Buf.t) list
-  val parse : context -> Buf.t -> Packet.t option
+  val marshal : ?alloc:(unit -> Cstruct.t) -> Packet.t -> (context * Cstruct.t) list
+  val parse : context -> Cstruct.t -> Packet.t option
 
   val timeout : context -> exn
 end
@@ -37,7 +37,7 @@ module Client : CLIENT = struct
     Random.int (1 lsl 16)
 
   let marshal ?alloc q =
-    [q.Packet.id, Packet.marshal (Buf.create ?alloc 4096) q]
+    [q.Packet.id, Packet.marshal ?alloc q]
 
   let parse id buf =
     let pkt = Packet.parse buf in
@@ -51,8 +51,8 @@ module type SERVER = sig
 
   val query_of_context : context -> Packet.t
 
-  val parse   : Buf.t -> context option
-  val marshal : Buf.t -> context -> Packet.t -> Buf.t option
+  val parse   : Cstruct.t -> context option
+  val marshal : ?alloc:(unit -> Cstruct.t) -> context -> Packet.t -> Cstruct.t option
 
 end
 
@@ -70,6 +70,6 @@ module Server : SERVER with type context = Packet.t = struct
   let query_of_context x = x
 
   let parse buf = contain_exc "parse" (fun () -> Packet.parse buf)
-  let marshal buf _q response =
-    contain_exc "marshal" (fun () -> Packet.marshal buf response)
+  let marshal ?alloc _q response =
+    contain_exc "marshal" (fun () -> Packet.marshal ?alloc response)
 end

lib/protocol.mli

@@ -32,12 +32,12 @@ module type CLIENT = sig
       successful parse or timeout. With this behavior, it is easy to construct
       low-latency but network-environment-aware DNS resolvers.
   *)
-  val marshal : ?alloc:(unit -> Buf.t) -> Packet.t -> (context * Buf.t) list
+  val marshal : ?alloc:(unit -> Cstruct.t) -> Packet.t -> (context * Cstruct.t) list
 
   (** [parse ctxt buf] is the potential packet extracted out of [buf]
       with [ctxt]
   *)
-  val parse : context -> Buf.t -> Packet.t option
+  val parse : context -> Cstruct.t -> Packet.t option
 
   (** [timeout ctxt] is the exception resulting from a context [ctxt] that has
       timed-out
@@ -61,15 +61,15 @@ module type SERVER = sig
       @param buf message buffer
       @return parsed packet and context
   *)
-  val parse   : Buf.t -> context option
+  val parse   : Cstruct.t -> context option
 
   (** DNS wire format marshal function.
-      @param buf output resource
+      @param alloc allocator
       @param _q context
       @param response answer packet
       @return buffer to write
   *)
-  val marshal : Buf.t -> context -> Packet.t -> Buf.t option
+  val marshal : ?alloc:(unit -> Cstruct.t) -> context -> Packet.t -> Cstruct.t option
 end
 
 (** The default DNS server using the standard DNS protocol *)

lib_test/mirage-mdns/unikernel.ml

@@ -28,7 +28,6 @@ module Main (C:CONSOLE) (K:KV_RO) (S:STACKV4) = struct
     let open Mdns_responder in
     let udp = S.udpv4 s in
     let module Responder = Make(struct
-        let alloc () = (Io_page.get 1 :> Dns.Buf.t)
         let write (dest_ip,dest_port) txbuf =
           U.write ~source_port:listening_port ~dest_ip:dest_ip ~dest_port udp (Cstruct.of_bigarray txbuf)
         let sleep t = OS.Time.sleep t

lib_test/ounit/test_dns_server_mirage.ml

@@ -27,8 +27,8 @@ let simulate_query
     detail= {qr=Query; opcode=Standard; aa=false; tc=false; rd=true; ra=false; rcode=NoError};
     questions=[question]; answers=[]; authorities=[]; additionals=[];
   } in
-  let buf = marshal (Dns.Buf.create 512) request |> Cstruct.of_bigarray in
-  let listener_thread = match MockStack.udpv4_listeners stack 53 with
+  let buf = marshal request in
+  let listener_thread = match MockStack.udpv4_listeners stack ~dst_port:53 with
     | None -> assert_failure "missing listener"
     | Some listener -> listener ~src:from_ip ~dst:to_ip ~src_port:from_port buf
   in
@@ -140,7 +140,7 @@ let tests =
           assert_equal ~printer:string_of_int 53 w.src_port;
           assert_ip client_ip w.dst;
           assert_equal ~printer:string_of_int 12345 w.dst_port;
-          let packet = parse (Dns.Buf.of_cstruct w.buf) in
+          let packet = parse w.buf in
           assert_packet ~prefix:"1" ~id:3848 packet
             {qr=Response; opcode=Standard; aa=true; tc=false; rd=true; ra=false; rcode=NoError}
             1 1 2 3;
@@ -170,7 +170,7 @@ let tests =
           assert_equal ~printer:string_of_int 53 w.src_port;
           assert_ip client_ip w.dst;
           assert_equal ~printer:string_of_int 12345 w.dst_port;
-          let packet = parse (Dns.Buf.of_cstruct w.buf) in
+          let packet = parse w.buf in
           assert_packet ~prefix:"2" ~id:19560 packet
             {qr=Response; opcode=Standard; aa=true; tc=false; rd=true; ra=false; rcode=NoError}
             1 1 2 3;