unikernel/duniverse/mirage-flow/.gitignore

@@ -0,0 +1,6 @@
+_build
+*~
+\.\#*
+\#*#
+*.merlin
+*.install

unikernel/duniverse/mirage-flow/CHANGES.md

@@ -0,0 +1,98 @@
+### v5.0.0 (2025-02-05)
+
+- Remove functor over Mirage_clock.MCLOCK, use mirage-mtime instead
+  (#53 @hannesm)
+
+### v4.0.2 (2024-02-08)
+
+- revert < coercion, shutdown is again
+  ``shutdown : flow -> [ `read | `write | `read_write ] -> unit Lwt.t``
+  (@reynir @hannesm)
+
+### v4.0.1 (2024-02-08)
+
+- move Mirage_flow.stats and pp_stats to Mirage_flow_combinators (#51 @hannesm)
+- improve documentation of expected semantics (when write promise is resolved,
+  what is done to the underlying flow - addresses #4 @samoht),
+  (#51 @reynir @dinosaure @hannesm)
+- add < coercion to shutdown:
+  ``shutdown : flow -> [< `read | `write | `read_write ] -> unit Lwt.t``
+  (requested #50 @reynir, #52 @hannesm)
+
+### v4.0.0 (2023-12-19)
+
+- Redefine `close` semantics, which no longer is a `` shutdown `read_write ``
+  (#49 @hannesm)
+- Add ``shutdown : flow -> [ `read | `write | `read_write ] -> unit Lwt.t``
+  (@djs55 @hannesm #16 #18 #48)
+- Remove SHUTDOWNABLE signature (@djs55 #17, rebased into #48)
+
+### v3.0.0 (2021-11-14)
+
+- Remove Mirage_flow_lwt module (#47 @hannesm)
+- Require fmt 0.8.7, cstruct 6.0.0 and avoid deprecated functions (#47 @hannesm)
+- Compatibility with alcotest 1.4 (eta expansion of Alcotest.fail) (#47 @hannesm)
+- Mirage_flow_combinators.forward has an additional unit argument to avoid
+  unerasable optional argument warning (#47 @hannesm)
+
+### v2.0.1 (2019-11-04)
+
+* provide deprecated Mirage_flow_lwt for smooth transition (#45 @hannesm)
+
+### v2.0.0 (2019-10-23)
+
+* mirage-flow uses Lwt.t and Cstruct.t directly (#43 @hannesm)
+* mirage-flow-lwt was removed, combinators are now in mirage-flow-combinators (#43 @hannesm)
+* raise lower OCaml bound to 4.06.0 (#43 @hannesm)
+
+### v1.6.0 (2019-04-24)
+
+* remove uses of `Result` (#40 @hannesm)
+* port opam metadata to 2.0 format (#41 @hannesm)
+* port build to dune from jbuilder (#41 @hannesm)
+
+### v1.5.0 (2018-07-09)
+
+* remove Result module, work with `-safe-string` and require cstruct >=3.2.0
+
+### v1.4.0 (2017-06-23)
+
+* mirage-flow-unix: add `Mirage_flow_unix.Fd` to wrap `Lwt_unix.file_descr` into
+  a MirageOS flow (#34, #36, @samoht)
+* mirage-flow-lwt: add first class flow values of type `Mirage_flow_lwt.t`
+  (#35, @samoht)
+
+### v1.3.0 (2017-06-12)
+
+* Port to Jbuilder (#32 @djs55)
+
+### v1.2.0 (2016-12-21)
+
+* Import `V1.FLOW` from `mirage-types` into `Mirage_flow.S` (@samoht)
+* Import `V1_LWT.FLOW` from `mirage-types-lwt` into `Mirage_flow_lwt.S` (@samoht)
+* Rename the existing `Mirage_flow` into `Mirage_flow_lwt` (@samoht)
+* Rename `Lwt_io_flow` into `Mirage_flow_unix` (@samoht)
+
+### v1.1.0 (2016-01-27)
+
+* Add a new top-level interface `module Mirage_flow`. Existing `module Fflow`
+  is still present.
+* Add `Mirage_flow.copy` to copy all the data in a flow to another
+* Add `Mirage_flow.proxy` to copy data bidirectionally between two flows
+
+### v1.0.3 (2015-07-29)
+
+* Support lwt 2.5.0
+
+### v1.0.2 (2015-06-30)
+
+* Add explicit dependency to OUnit
+
+### v1.0.1 (2015-04-28)
+
+* Add `Fflow.error_message` to satisfay `mirage-types.2.3.0`
+
+### v1.0.0 (2015-02-26)
+
+* Add `Fflow` (functional flows)
+* Add `Lwt_io_flow` to convert between Mirage and Lwt flows

unikernel/duniverse/mirage-flow/LICENSE.md

@@ -0,0 +1,11 @@
+Permission to use, copy, modify, and distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

unikernel/duniverse/mirage-flow/Makefile

@@ -0,0 +1,10 @@
+.PHONY: build clean test
+
+build:
+	dune build
+
+test:
+	dune runtest
+
+clean:
+	dune clean

unikernel/duniverse/mirage-flow/README.md

@@ -0,0 +1,27 @@
+## mirag-flow -- Flow implementations and combinators for MirageOS
+
+This repo contains generic operations over Mirage `FLOW` implementations.
+
+Please consult [the API documentation](https://mirage.github.io/mirage-flow/index.html).
+
+### Example usage
+
+In a top-level like utop:
+```ocaml
+# #require "mirage-flow";;
+# #require "mirage-clock-unix";;
+# #require "lwt.syntax";;
+
+# let a = Mirage_flow.Fun.(make ~input:(input_string "hellooooo") ());;
+val a : Mirage_flow.Fun.flow = <abstr>
+
+# let buffer = String.make 20 ' ';;
+val buffer : bytes = "                    "
+# let b = Mirage_flow.Fun.(make ~output:(output_string buffer) ());;
+val b : Mirage_flow.Fun.flow = <abstr>
+
+# lwt results = Mirage_flow.copy (module Clock) (module Mirage_flow.Fun) a (module Mirage_flow.Fun) b ();;
+val results : [ `Error of [ `Msg of bytes ] | `Ok of Mirage_flow.CopyStats.t ] =  `Ok {Mirage_flow.CopyStats.read_bytes = 9L; read_ops = 1L; write_bytes = 9L; write_ops = 1L; duration = 6.9141387939453125e-06}
+# buffer;;
+- : bytes = "hellooooo           "
+```

unikernel/duniverse/mirage-flow/combinators/dune

@@ -0,0 +1,5 @@
+(library
+ (name mirage_flow_combinators)
+ (public_name mirage-flow-combinators)
+ (libraries lwt cstruct mirage-flow mirage-mtime logs)
+ (wrapped false))

unikernel/duniverse/mirage-flow/combinators/mirage_flow_combinators.ml

@@ -0,0 +1,430 @@
+(*
+ * Copyright (c) 2011-present Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2013-present Thomas Gazagnaire <thomas@gazagnaire.org>
+ * Copyright (C) 2016-present David Scott <dave.scott@docker.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+
+let src = Logs.Src.create "mirage-flow-combinators"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+type stats = {
+  read_bytes: int64;
+  read_ops: int64;
+  write_bytes: int64;
+  write_ops: int64;
+  duration: int64;
+}
+
+let kib = 1024L
+let ( ** ) = Int64.mul
+let mib = kib ** 1024L
+let gib = mib ** 1024L
+let tib = gib ** 1024L
+
+let suffix = [
+  kib, "KiB";
+  mib, "MiB";
+  gib, "GiB";
+  tib, "TiB";
+]
+
+let add_suffix x =
+  List.fold_left (fun acc (y, label) ->
+      if Int64.div x y > 0L
+      then Printf.sprintf "%.1f %s" Int64.((to_float x) /. (to_float y)) label
+      else acc
+    ) (Printf.sprintf "%Ld bytes" x) suffix
+
+let pp_stats ppf s =
+  Fmt.pf ppf "%s bytes at %s/nanosec and %Lu IOPS/nanosec"
+    (add_suffix s.read_bytes)
+    (add_suffix Int64.(div s.read_bytes s.duration))
+    (Int64.div s.read_ops s.duration)
+
+module type CONCRETE =  Mirage_flow.S
+  with type error = [ `Msg of string ]
+   and type write_error = [ Mirage_flow.write_error | `Msg of string ]
+
+module Concrete (S: Mirage_flow.S) = struct
+  type error = [`Msg of string]
+  type write_error = [ Mirage_flow.write_error | `Msg of string]
+  type flow = S.flow
+
+  let pp_error ppf = function
+    | `Msg s -> Fmt.string ppf s
+
+  let pp_write_error ppf = function
+    | #error as e -> pp_error ppf e
+    | `Closed     -> Mirage_flow.pp_write_error ppf `Closed
+
+  let lift_read = function
+    | Ok x    -> Ok x
+    | Error e -> Error (`Msg (Fmt.str "%a" S.pp_error e))
+
+  let lift_write = function
+    | Ok ()         -> Ok ()
+    | Error `Closed -> Error `Closed
+    | Error e       -> Error (`Msg (Fmt.str "%a" S.pp_write_error e))
+
+  let read t = S.read t >|= lift_read
+  let write t b = S.write t b >|= lift_write
+  let writev t bs = S.writev t bs >|= lift_write
+  let shutdown t m = S.shutdown t m
+  let close t = S.close t
+end
+
+type time = int64
+
+type 'a stats_lwt = {
+  read_bytes: int64 ref;
+  read_ops: int64 ref;
+  write_bytes: int64 ref;
+  write_ops: int64 ref;
+  finish: time option ref;
+  start: time;
+  time: unit -> time;
+  t: (unit, 'a) result Lwt.t;
+}
+
+let stats_lwt t =
+  let duration : int64 = match !(t.finish) with
+    | None -> Int64.sub (t.time ()) t.start
+    | Some x -> Int64.sub x t.start
+  in {
+    read_bytes  = !(t.read_bytes);
+    read_ops    = !(t.read_ops);
+    write_bytes = !(t.write_bytes);
+    write_ops   = !(t.write_ops);
+    duration;
+  }
+
+module Copy (A: Mirage_flow.S) (B: Mirage_flow.S) =
+struct
+
+  type error = [`A of A.error | `B of B.write_error]
+
+  let pp_error ppf = function
+    | `A e -> A.pp_error ppf e
+    | `B e -> B.pp_write_error ppf e
+
+  let start (a: A.flow) (b: B.flow) =
+    let read_bytes = ref 0L in
+    let read_ops = ref 0L in
+    let write_bytes = ref 0L in
+    let write_ops = ref 0L in
+    let finish = ref None in
+    let start = Mirage_mtime.elapsed_ns () in
+    let rec loop () =
+      A.read a >>= function
+      | Error e ->
+        finish := Some (Mirage_mtime.elapsed_ns ());
+        Lwt.return (Error (`A e))
+      | Ok `Eof ->
+        finish := Some (Mirage_mtime.elapsed_ns ());
+        Lwt.return (Ok ())
+      | Ok (`Data buffer) ->
+        read_ops := Int64.succ !read_ops;
+        read_bytes := Int64.(add !read_bytes (of_int @@ Cstruct.length buffer));
+        B.write b buffer
+        >>= function
+        | Ok () ->
+          write_ops := Int64.succ !write_ops;
+          write_bytes := Int64.(add !write_bytes (of_int @@ Cstruct.length buffer));
+          loop ()
+        | Error e ->
+          finish := Some (Mirage_mtime.elapsed_ns ());
+          Lwt.return (Error (`B e))
+    in
+    {
+      read_bytes;
+      read_ops;
+      write_bytes;
+      write_ops;
+      finish;
+      start;
+      time = (fun () -> Mirage_mtime.elapsed_ns ());
+      t = loop ();
+    }
+
+  let wait t = t.t
+
+  let copy ~src:a ~dst:b =
+    let t = start a b in
+    wait t >|= function
+    | Ok ()   -> Ok (stats_lwt t)
+    | Error e -> Error e
+
+end
+
+module Proxy (A: Mirage_flow.S) (B: Mirage_flow.S) =
+struct
+
+  module A_to_B = Copy(A)(B)
+  module B_to_A = Copy(B)(A)
+
+  type error = [
+    | `A of A_to_B.error
+    | `B of B_to_A.error
+    | `A_and_B of A_to_B.error * B_to_A.error
+  ]
+
+  let pp_error ppf = function
+    | `A_and_B (e1, e2) ->
+      Fmt.pf ppf "flow proxy a: %a; flow proxy b: %a"
+        A_to_B.pp_error e1 B_to_A.pp_error e2
+    | `A e -> Fmt.pf ppf "flow proxy a: %a" A_to_B.pp_error e
+    | `B e -> Fmt.pf ppf "flow proxy b: %a" B_to_A.pp_error e
+
+  let proxy a b =
+    let a2b =
+      let t = A_to_B.start a b in
+      A_to_B.wait t >>= fun result ->
+      A.shutdown a `read >>= fun () ->
+      B.shutdown b `write >|= fun () ->
+      let stats = stats_lwt t in
+      match result with
+      | Ok ()   -> Ok stats
+      | Error e -> Error e
+    in
+    let b2a =
+      let t = B_to_A.start b a in
+      B_to_A.wait t >>= fun result ->
+      B.shutdown b `read >>= fun () ->
+      A.shutdown a `write >|= fun () ->
+      let stats = stats_lwt t in
+      match result with
+      | Ok ()   -> Ok stats
+      | Error e -> Error e
+    in
+    a2b >>= fun a_stats ->
+    b2a >|= fun b_stats ->
+    match a_stats, b_stats with
+    | Ok a_stats, Ok b_stats -> Ok (a_stats, b_stats)
+    | Error e1  , Error e2   -> Error (`A_and_B (e1, e2))
+    | Error e1  ,  _         -> Error (`A e1)
+    | _         , Error e2   -> Error (`B e2)
+
+end
+
+module F = struct
+
+  let (>>=) = Lwt.bind
+
+  type refill = Cstruct.t -> int -> int -> int Lwt.t
+
+  type error
+  let pp_error ppf (_:error) =
+    Fmt.string ppf "Mirage_flow_combinators.F.error"
+  type write_error = Mirage_flow.write_error
+  let pp_write_error = Mirage_flow.pp_write_error
+
+  let seq f1 f2 buf off len =
+    f1 buf off len >>= function
+    | 0 -> f2 buf off len
+    | n -> Lwt.return n
+
+  let zero _buf _off _len = Lwt.return 0
+
+  let rec iter fn = function
+    | []   -> zero
+    | h::t -> seq (fn h) (iter fn t)
+
+  type flow = {
+    close: unit -> unit Lwt.t;
+    input: refill;
+    output: refill;
+    mutable buf: Cstruct.t;
+    mutable ic_closed: bool;
+    mutable oc_closed: bool;
+  }
+
+  let default_buffer_size = 4096
+
+  let make ?(close=fun () -> Lwt.return_unit) ?input ?output () =
+    let buf = Cstruct.create default_buffer_size in
+    let ic_closed = input = None in
+    let oc_closed = output = None in
+    let input = match input with None -> zero | Some x -> x in
+    let output = match output with None -> zero | Some x -> x in
+    { close; input; output; buf; ic_closed; oc_closed; }
+
+  let input_fn len blit str =
+    let str_off = ref 0 in
+    let str_len = len str in
+    fun buf off len ->
+      if !str_off >= str_len then Lwt.return 0
+      else (
+        let len = min (str_len - !str_off) len in
+        blit str !str_off buf off len;
+        str_off := !str_off + len;
+        Lwt.return len
+      )
+
+  let output_fn len blit str =
+    let str_off = ref 0 in
+    let str_len = len str in
+    fun buf off len ->
+      if !str_off >= str_len then Lwt.return 0
+      else (
+        let len = min (str_len - !str_off) len in
+        blit buf off str !str_off len;
+        str_off := !str_off + len;
+        Lwt.return len
+      )
+
+  let mk fn_i fn_o ?input ?output () =
+    let input = match input with None -> None | Some x -> Some (fn_i x) in
+    let output = match output with None -> None | Some x -> Some (fn_o x) in
+    make ?input ?output ()
+
+  let input_string = input_fn String.length Cstruct.blit_from_string
+  let output_bytes = output_fn Bytes.length Cstruct.blit_to_bytes
+  let string = mk input_string output_bytes
+
+  let input_cstruct = input_fn Cstruct.length Cstruct.blit
+  let output_cstruct = output_fn Cstruct.length Cstruct.blit
+  let cstruct = mk input_cstruct output_cstruct
+
+  let input_strings = iter input_string
+  let output_bytess = iter output_bytes
+  let strings = mk input_strings output_bytess
+
+  let input_cstructs = iter input_cstruct
+  let output_cstructs = iter output_cstruct
+  let cstructs = mk input_cstructs output_cstructs
+
+  let refill ch =
+    if Cstruct.length ch.buf = 0 then (
+      let buf = Cstruct.create default_buffer_size in
+      ch.buf <- buf
+    )
+
+  let read ch =
+    if ch.ic_closed then Lwt.return @@ Ok `Eof
+    else (
+      refill ch;
+      ch.input ch.buf 0 default_buffer_size >>= fun n ->
+      if n = 0 then (
+        ch.ic_closed <- true;
+        Lwt.return (Ok `Eof);
+      ) else (
+        let ret = Cstruct.sub ch.buf 0 n in
+        let buf = Cstruct.shift ch.buf n in
+        ch.buf <- buf;
+        Lwt.return (Ok (`Data ret))
+      )
+    )
+
+  let write ch buf =
+    if ch.oc_closed then Lwt.return @@ Error `Closed
+    else (
+      let len = Cstruct.length buf in
+      let rec aux off =
+        if off = len then Lwt.return (Ok ())
+        else (
+          ch.output buf off (len - off) >>= fun n ->
+          if n = 0 then (
+            ch.oc_closed <- true;
+            Lwt.return @@ Error `Closed
+          ) else aux (off+n)
+        )
+      in
+      aux 0
+    )
+
+  let writev ch bufs =
+    if ch.oc_closed then Lwt.return @@ Error `Closed
+    else
+      let rec aux = function
+        | []   -> Lwt.return (Ok ())
+        | h::t ->
+          write ch h >>= function
+          | Error e -> Lwt.return (Error e)
+          | Ok ()   -> aux t
+      in
+      aux bufs
+
+  let shutdown ch mode =
+    (match mode with
+     | `read -> ch.ic_closed <- true
+     | `write -> ch.oc_closed <- true
+     | `read_write ->
+       ch.ic_closed <- true;
+       ch.oc_closed <- true);
+    Lwt.return_unit
+
+  let close ch =
+    ch.ic_closed <- true;
+    ch.oc_closed <- true;
+    ch.close ()
+
+end
+
+type error = [`Msg of string]
+type write_error = [ Mirage_flow.write_error | error ]
+let pp_error ppf (`Msg s) = Fmt.string ppf s
+
+let pp_write_error ppf = function
+  | #Mirage_flow.write_error as e -> Mirage_flow.pp_write_error ppf e
+  | #error as e                   -> pp_error ppf e
+
+type flow =
+  | Flow: string * (module CONCRETE with type flow = 'a) * 'a -> flow
+
+type t = flow
+
+let create (type a) (module M: Mirage_flow.S with type flow = a) t name =
+  let m = (module Concrete(M): CONCRETE with type flow = a) in
+  Flow (name, m , t)
+
+let read (Flow (_, (module F), flow)) = F.read flow
+let write (Flow (_, (module F), flow)) b = F.write flow b
+let writev (Flow (_, (module F), flow)) b = F.writev flow b
+let close (Flow (_, (module F), flow)) = F.close flow
+let shutdown (Flow (_, (module F), flow)) m = F.shutdown flow m
+let pp ppf (Flow (name, _, _)) = Fmt.string ppf name
+
+let forward ?(verbose=false) ~src ~dst () =
+  let rec loop () =
+    read src >>= function
+    | Ok `Eof ->
+      Log.err (fun l -> l "forward[%a => %a] EOF" pp src pp dst);
+      Lwt.return_unit
+    | Error e ->
+      Log.err (fun l -> l "forward[%a => %a] %a" pp src pp dst pp_error e);
+      Lwt.return_unit
+    | Ok (`Data buf) ->
+      Log.debug (fun l ->
+          let payload =
+            if verbose then Fmt.str "[%S]" @@ Cstruct.to_string buf
+            else Fmt.str "%d bytes" (Cstruct.length buf)
+          in
+          l "forward[%a => %a] %s" pp src pp dst payload);
+      write dst buf >>= function
+      | Ok ()   -> loop ()
+      | Error e ->
+        Log.err (fun l -> l "forward[%a => %a] %a"
+                    pp src pp dst pp_write_error e);
+        Lwt.return_unit
+  in
+  loop ()
+
+let proxy ?verbose f1 f2 =
+  Lwt.join [
+    forward ?verbose ~src:f1 ~dst:f2 ();
+    forward ?verbose ~src:f2 ~dst:f1 ();
+  ]

unikernel/duniverse/mirage-flow/combinators/mirage_flow_combinators.mli

@@ -0,0 +1,170 @@
+(*
+ * Copyright (C) 2016-present David Scott <dave.scott@docker.com>
+ * Copyright (c) 2011-present Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2013-present Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** {1 Flow-related devices using lwt}
+
+    This module define flow-related devices for MirageOS, using lwt for I/O.
+
+    {e Release v5.0.0 } *)
+
+(** {1 Copy stats} *)
+
+type stats = {
+  read_bytes: int64;
+  read_ops: int64;
+  write_bytes: int64;
+  write_ops: int64;
+  duration: int64;
+}
+(** The type for I/O statistics from a copy operation. *)
+
+val pp_stats: stats Fmt.t
+(** [pp_stats] is the pretty-printer for flow stats. *)
+
+(** [CONCRETE] expose the private row as [`Msg str] errors, using
+    [pp_error] and [pp_write_error]. *)
+module type CONCRETE =  Mirage_flow.S
+  with type error = [ `Msg of string ]
+   and type write_error = [ Mirage_flow.write_error | `Msg of string ]
+
+(** Functor to transform a {{!S}flow} signature using private rows for
+    errors into concrete error types. *)
+module Concrete (S: Mirage_flow.S): CONCRETE with type flow = S.flow
+
+module Copy (A: Mirage_flow.S) (B: Mirage_flow.S): sig
+
+  type error = [`A of A.error | `B of B.write_error]
+  (** The type for copy errors. *)
+
+  val pp_error: error Fmt.t
+  (** [pp_error] pretty-prints errors. *)
+
+  val copy: src:A.flow -> dst:B.flow -> (stats, error) result Lwt.t
+  (** [copy source destination] copies data from [source] to
+      [destination] using the clock to compute a transfer rate. On
+      successful completion, some statistics are returned. On failure we
+      return a printable error. *)
+
+end
+
+module Proxy (A: Mirage_flow.S) (B: Mirage_flow.S):
+sig
+
+  type error
+  (** The type for proxy errors. *)
+
+  val pp_error: error Fmt.t
+  (** [pp_error] pretty-prints errors. *)
+
+  val proxy: A.flow -> B.flow ->
+    ((stats * stats), error) result Lwt.t
+  (** [proxy a b] proxies data between [a] and [b] until both
+      sides close. If either direction encounters an error then so
+      will [proxy]. If both directions succeed, then return I/O
+      statistics. *)
+
+end
+
+module F: sig
+
+  (** In-memory, function-based flows. *)
+
+  include Mirage_flow.S
+
+  type refill = Cstruct.t -> int -> int -> int Lwt.t
+  (** The type for refill functions. *)
+
+  val make:
+    ?close:(unit -> unit Lwt.t) ->
+    ?input:refill ->
+    ?output:refill ->
+    unit -> flow
+  (** [make ~close ~input ~output ()] is a flow using [input] to
+      refill its internal input buffer when needed and [output] to
+      refill its external output buffer. It is using [close] to
+      eventually clean-up other resources on close. *)
+
+  (** {1 String flows} *)
+
+  val input_string: string -> refill
+  (** [input_string buf] is the refill function reading its inputs
+      from the string [buf]. *)
+
+  val output_bytes: bytes -> refill
+  (** [output_bytes buf] is the refill function writing its outputs in
+      the buffer [buf]. *)
+
+  val string: ?input:string -> ?output:bytes -> unit -> flow
+  (** The flow built using {!input_string} and {!output_bytes}. *)
+
+  val input_strings: string list -> refill
+  (** [input_strings bufs] is the refill function reading its inputs
+      from the list of buffers [bufs]. Empty strings are ignored. *)
+
+  val output_bytess: bytes list -> refill
+  (** [output_bytess buf] is the refill function writing its outputs in
+      the list of buffers [buf]. Empty strings are ignored. *)
+
+  val strings: ?input:string list -> ?output:bytes list -> unit -> flow
+  (** The flow built using {!input_strings} and {!output_bytess}. *)
+
+  (** {1 Cstruct buffers flows} *)
+
+  val input_cstruct: Cstruct.t -> refill
+  (** Same as {!input_string} but for {!Cstruct.t} buffers. *)
+
+  val output_cstruct: Cstruct.t -> refill
+  (** Same as {!output_string} buf for {!Cstruct.t} buffers. *)
+
+  val cstruct: ?input:Cstruct.t -> ?output:Cstruct.t -> unit -> flow
+  (** Same as {!string} but for {!Cstruct.t} buffers. *)
+
+  val input_cstructs: Cstruct.t list -> refill
+  (** Same as {!input_strings} but for {!Cstruct.t} buffers. *)
+
+  val output_cstructs: Cstruct.t list -> refill
+  (** Same as {!output_strings} but for {!Cstruct.t} buffers. *)
+
+  val cstructs: ?input:Cstruct.t list -> ?output:Cstruct.t list -> unit -> flow
+  (** Same as {!strings} but for {!Cstruct.t} buffers. *)
+
+end
+
+type t
+(** The type for first-class flows. *)
+
+include Mirage_flow.S with type flow = t
+
+val create: (module Mirage_flow.S with type flow = 'a) -> 'a -> string -> t
+(** [create (module M) t name] is the flow representing [t] using the
+    function defined in [M]. *)
+
+val pp: t Fmt.t
+(** [pp] is the pretty-printer for IO flows. *)
+
+val forward: ?verbose:bool -> src:t -> dst:t -> unit -> unit Lwt.t
+(** [forward ?verbose ~src ~dst ()] forwards writes from [src] to
+    [dst]. Block until either [src] or [dst] is closed. If [verbose]
+    is set (by default it is not), show the full flow contents in the debug
+    messages. *)
+
+val proxy: ?verbose:bool -> t -> t -> unit Lwt.t
+(** [proxy ?verbose x y] is the same as [forward x y <*> forward y
+    x]. Block until both flows are closed. If [verbose] is set (by
+    default it is not), show the full flow contents in the debug
+    messages. *)

unikernel/duniverse/mirage-flow/dune-project

@@ -0,0 +1,3 @@
+(lang dune 1.0)
+(name mirage-flow)
+(version v5.0.0)

unikernel/duniverse/mirage-flow/mirage-flow-combinators.opam

@@ -0,0 +1,31 @@
+version: "5.0.0"
+opam-version: "2.0"
+maintainer: "thomas@gazagnaire.org"
+authors: ["Thomas Gazagnaire" "Dave Scott"]
+license: "ISC"
+tags: "org:mirage"
+homepage: "https://github.com/mirage/mirage-flow"
+doc: "https://mirage.github.io/mirage-flow/"
+bug-reports: "https://github.com/mirage/mirage-flow/issues"
+depends: [
+  "ocaml" {>= "4.08.0"}
+  "dune" {>= "1.0"}
+  "fmt" {>= "0.8.7"}
+  "lwt" {>= "4.0.0"}
+  "logs"
+  "cstruct" {>= "6.0.0"}
+  "mirage-mtime" {>= "4.0.0"}
+  "mirage-flow" {= version}
+]
+build: [
+  ["dune" "subst"] {dev}
+  ["dune" "build" "-p" name "-j" jobs]
+]
+dev-repo: "git+https://github.com/mirage/mirage-flow.git"
+synopsis: "Flow implementations and combinators for MirageOS specialized to lwt"
+description: """
+This repo contains generic operations over Mirage `FLOW` implementations.
+
+Please consult [the API documentation](https://mirage.github.io/mirage-flow/index.html).
+"""
+x-maintenance-intent: ["(latest)"]

unikernel/duniverse/mirage-flow/mirage-flow-unix.opam

@@ -0,0 +1,33 @@
+version: "5.0.0"
+opam-version: "2.0"
+maintainer: "thomas@gazagnaire.org"
+authors: ["Thomas Gazagnaire" "Dave Scott"]
+license: "ISC"
+tags: "org:mirage"
+homepage: "https://github.com/mirage/mirage-flow"
+doc: "https://mirage.github.io/mirage-flow/"
+bug-reports: "https://github.com/mirage/mirage-flow/issues"
+depends: [
+  "ocaml" {>= "4.08.0"}
+  "dune" {>= "1.0"}
+  "fmt" {>= "0.8.7"}
+  "logs"
+  "mirage-flow" {= version}
+  "lwt" {>= "4.0.0"}
+  "cstruct" {>= "6.0.0"}
+  "alcotest" {with-test}
+  "mirage-flow-combinators" {with-test & = version}
+]
+build: [
+  ["dune" "subst"] {dev}
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
+]
+dev-repo: "git+https://github.com/mirage/mirage-flow.git"
+synopsis: "Flow implementations and combinators for MirageOS on Unix"
+description: """
+This repo contains generic operations over Mirage `FLOW` implementations.
+
+Please consult [the API documentation](https://mirage.github.io/mirage-flow/index.html).
+"""
+x-maintenance-intent: ["(latest)"]

unikernel/duniverse/mirage-flow/mirage-flow.opam

@@ -0,0 +1,28 @@
+version: "5.0.0"
+opam-version: "2.0"
+maintainer: "thomas@gazagnaire.org"
+authors: ["Thomas Gazagnaire" "Dave Scott"]
+license: "ISC"
+tags: "org:mirage"
+homepage: "https://github.com/mirage/mirage-flow"
+doc: "https://mirage.github.io/mirage-flow/"
+bug-reports: "https://github.com/mirage/mirage-flow/issues"
+depends: [
+  "ocaml" {>= "4.08.0"}
+  "dune" {>= "1.0"}
+  "cstruct" {>= "4.0.0"}
+  "fmt"
+  "lwt" {>= "4.0.0"}
+]
+build: [
+  ["dune" "subst"] {dev}
+  ["dune" "build" "-p" name "-j" jobs]
+]
+dev-repo: "git+https://github.com/mirage/mirage-flow.git"
+synopsis: "Flow implementations and combinators for MirageOS"
+description: """
+This repo contains generic operations over Mirage `FLOW` implementations.
+
+Please consult [the API documentation](https://mirage.github.io/mirage-flow/index.html).
+"""
+x-maintenance-intent: ["(latest)"]

unikernel/duniverse/mirage-flow/src/dune

@@ -0,0 +1,4 @@
+(library
+ (name mirage_flow)
+ (public_name mirage-flow)
+ (libraries fmt lwt cstruct))

unikernel/duniverse/mirage-flow/src/mirage_flow.ml

@@ -0,0 +1,41 @@
+(*
+ * Copyright (C) 2016-present David Scott <dave.scott@docker.com>
+ * Copyright (c) 2011-present Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2013-present Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+type write_error = [ `Closed ]
+
+let pp_write_error ppf = function
+  | `Closed -> Fmt.pf ppf "attempted to write to a closed flow"
+
+type 'a or_eof = [`Data of 'a | `Eof ]
+
+let pp_or_eof d ppf = function
+  | `Data a -> d ppf a
+  | `Eof    -> Fmt.string ppf "End-of-file"
+
+module type S = sig
+  type error
+  val pp_error: error Fmt.t
+  type nonrec write_error = private [> write_error ]
+  val pp_write_error: write_error Fmt.t
+  type flow
+  val read: flow -> (Cstruct.t or_eof, error) result Lwt.t
+  val write: flow -> Cstruct.t -> (unit, write_error) result Lwt.t
+  val writev: flow -> Cstruct.t list -> (unit, write_error) result Lwt.t
+  val shutdown : flow -> [ `read | `write | `read_write ] -> unit Lwt.t
+  val close: flow -> unit Lwt.t
+end

unikernel/duniverse/mirage-flow/src/mirage_flow.mli

@@ -0,0 +1,119 @@
+(*
+ * Copyright (c) 2011-2015 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2013-2015 Thomas Gazagnaire <thomas@gazagnaire.org>
+ * Copyright (c) 2013      Citrix Systems Inc
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** {1 Flow-related signatures}
+
+    This module defines the flow signature for MirageOS.
+
+    {e Release v5.0.0 } *)
+
+type write_error = [ `Closed ]
+(** The type for generic write errors on flows. *)
+
+val pp_write_error: write_error Fmt.t
+(** [pp_write_error] is the pretty-printer for write errors. *)
+
+type 'a or_eof = [`Data of 'a | `Eof ]
+(** The type for read results on flows. *)
+
+val pp_or_eof: 'a Fmt.t -> 'a or_eof Fmt.t
+(** [pp_or_eof] is the pretty-printer for {!or_eof} values. *)
+
+(** Abstract flow signature. *)
+module type S = sig
+
+  type error
+  (** The type for flow errors. *)
+
+  val pp_error: error Fmt.t
+  (** [pp_error] is the pretty-printer for errors. *)
+
+  type nonrec write_error = private [> write_error ]
+  (** The type for write errors. *)
+
+  val pp_write_error: write_error Fmt.t
+  (** [pp_write_error] is the pretty-printer for write errors. *)
+
+  type flow
+  (** The type for flows. A flow represents the state of a single reliable
+      stream that is connected to an endpoint. *)
+
+  val read: flow -> (Cstruct.t or_eof, error) result Lwt.t
+  (** [read flow] blocks until some data is available and returns a fresh buffer
+      containing it.
+
+      The returned buffer will be of a size convenient to the flow
+      implementation, but will always have at least 1 byte.
+
+      When [read] returns [`Eof] or an error, [close] (or [shutdown]) should be
+      called on the [flow] by the client. Once [read] returned [`Eof] or an
+      error, no subsequent [read] call will be successful. *)
+
+  val write: flow -> Cstruct.t -> (unit, write_error) result Lwt.t
+  (** [write flow buffer] writes a buffer to the flow. There is no indication
+      when the buffer has actually been sent and, therefore, it must not be
+      reused. The contents may be transmitted in separate packets, depending on
+      the underlying transport. The result [Ok ()] indicates success,
+      [Error `Closed] indicates that the connection is now closed and therefore
+      the data could not be written. Other errors are possible.
+
+      The promise is resolved when the buffer has been accepted by the
+      implementation (if a partial write occured, [write] will wait until the
+      remainder of the buffer has been accepted by the implementation).
+
+      If [write] returns an error, [close] (or [shutdown]) should be called on
+      the [flow] by the client. Once [write] returned an error, no subsequent
+      [write] or [writev] call will be successful. *)
+
+  val writev: flow -> Cstruct.t list -> (unit, write_error) result Lwt.t
+  (** [writev flow buffers] writes a sequence of buffers to the flow. There is
+      no indication when the buffers have actually been sent and, therefore,
+      they must not be reused. The result [Ok ()] indicates success,
+      [Error `Closed] indicates that the connection is now closed and therefore
+      the data could not be written. Other errors are possible.
+
+      The promise is resolved when the buffers have been accepted by the
+      implementation (if a partial write occured, [writev] will wait until all
+      buffers have been accepted by the implementation).
+
+      If [writev] returns an error, [close] (or [shutdown]) should be called on
+      the [flow] by the client. Once [writev] returned an error, no subsequent
+      [writev] or [write] call will be successful. *)
+
+  val shutdown : flow -> [ `read | `write | `read_write ] -> unit Lwt.t
+  (** [shutdown flow mode] shuts down the [flow] for the specific [mode]:
+      A flow which is [shutdown `read] (or [`read_write]) will never be [read]
+      again (subsequent calls will return [`Eof]); a flow which is
+      [shutdown `write] (or [`read_write]) flushes all pending writes and
+      signals the remote endpoint there won't be any future [write] or [writev]
+      calls (subsequent calls will return [`Closed]). E.g. in TCP, the
+      signalling is done by sending a segment with the FIN flag.
+
+      If this [flow] is layered upon another [flow'] (e.g. TLS over TCP),
+      and the internal state after [shutdown] is [`Closed], [close] on the
+      underlying [flow'] is executed. *)
+
+  val close: flow -> unit Lwt.t
+  (** [close flow] terminates the [flow] and frees all associated data. Any
+      subsequent [read] or [write] will return an error. A subsequent [close]
+      will not do anything (esp. not raising an exception), but it may log an
+      error.
+
+      If this [flow] is layered upon another [flow'] (e.g. TLS over TCP),
+      [close] on the underlying [flow'] is executed. *)
+end

unikernel/duniverse/mirage-flow/test/dune

@@ -0,0 +1,4 @@
+(test
+ (name test)
+ (package mirage-flow-unix)
+ (libraries mirage-flow-combinators mirage-flow-unix alcotest))

unikernel/duniverse/mirage-flow/test/test.ml

@@ -0,0 +1,229 @@
+(*
+ * Copyright (c) 2015 Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+open Mirage_flow_combinators
+
+let pp_buf ppf buf = Fmt.string ppf (Cstruct.to_string buf)
+let eq_buf b1 b2 = Cstruct.to_string b1 = Cstruct.to_string b2
+
+let cstruct = Alcotest.testable pp_buf eq_buf
+let fail fmt = Fmt.kstr (fun s -> Alcotest.fail s) fmt
+
+let check_buffer = Alcotest.(check cstruct)
+let check_buffers = Alcotest.(check @@ list cstruct)
+
+let check_ok_buffer msg buf = function
+  | Ok (`Data b) -> check_buffer msg buf b
+  | Ok `Eof      -> fail "%s: eof" msg
+  | Error e      -> fail "%s: error=%a" msg F.pp_error e
+
+let check_ok_unit msg = function
+  | Ok ()   -> ()
+  | Error e -> fail "%s: error=%a" msg F.pp_error e
+
+let check_ok_write msg = function
+  | Ok ()   -> ()
+  | Error e -> fail "%s: error=%a" msg F.pp_write_error e
+
+let check_closed msg = function
+  | Ok ()         -> fail "%s: not closed" msg
+  | Error `Closed -> ()
+  | Error e       -> fail "%s: error=%a" msg F.pp_write_error e
+
+let check_eof msg = function
+  | Ok `Eof -> ()
+  | Ok _    -> fail "%s: ok" msg
+  | Error e -> fail "%s: error=%a" msg F.pp_error e
+
+let cs str = Cstruct.of_string str
+let cb str = Cstruct.of_bytes str
+
+let css = List.map cs
+let cbs = List.map cb
+
+let filter x =
+  let zero = Cstruct.of_string "" in
+  List.filter ((<>) zero) x
+
+let input_string () =
+  let input = "xxxxxxxxxx" in
+  let ic = F.string ~input () in
+  F.read ic >>= fun x1 ->
+  F.read ic >>= fun x2 ->
+  F.write ic (cs "hihi") >>= fun r ->
+  check_ok_buffer "read 1" (cs input) x1;
+  check_eof "read 2" x2;
+  check_closed "write"  r;
+  Lwt.return_unit
+
+let output_string () =
+  let output = Bytes.of_string "xxxxxxxxxx" in
+  let oc = F.string ~output () in
+  F.write oc (cs  "hell") >>= fun x1 ->
+  F.write oc (cs   "o! ") >>= fun x2 ->
+  F.write oc (cs "world") >>= fun x3 ->
+  F.read oc >>= fun r ->
+  check_buffer "result" (cb output) (cs "hello! wor");
+  check_ok_write "write 1" x1;
+  check_ok_write "write 2" x2;
+  check_closed   "write 3" x3;
+  check_eof      "read"    r;
+  Lwt.return_unit
+
+let input_strings () =
+  let input = [ ""; "123"; "45"; "6789"; "0" ] in
+  let ic = F.strings ~input () in
+  F.read ic >>= fun x1 ->
+  F.read ic >>= fun x2 ->
+  F.read ic >>= fun x3 ->
+  F.read ic >>= fun x4 ->
+  F.read ic >>= fun y ->
+  F.read ic >>= fun z ->
+  F.write ic (cs "hihi") >>= fun w ->
+  check_ok_buffer "read 1" (cs  "123") x1;
+  check_ok_buffer "read 2" (cs   "45") x2;
+  check_ok_buffer "read 3" (cs "6789") x3;
+  check_ok_buffer "read 4" (cs    "0") x4;
+  check_eof       "read 5" y;
+  check_eof       "read 6" z;
+  check_closed    "write"  w;
+  Lwt.return_unit
+
+let output_strings () =
+  let output = List.map Bytes.of_string ["xxx"; ""; "xx"; "xxx"; ] in
+  let oc = F.strings ~output () in
+  F.write oc (cs  "hell") >>= fun x1 ->
+  F.write oc (cs   "o! ") >>= fun x2 ->
+  F.write oc (cs "world") >>= fun x3 ->
+  F.read oc >>= fun r ->
+  check_buffers "result" (filter (cbs output)) (css ["hel"; "lo"; "! w"]);
+  check_ok_write "write 1" x1;
+  check_ok_write "write 2" x2;
+  check_closed   "write 3" x3;
+  check_eof     "read"    r;
+  Lwt.return_unit
+
+let input_cstruct () =
+  let input = Cstruct.of_string "xxxxxxxxxx" in
+  let ic = F.cstruct ~input () in
+  F.read ic >>= fun x1 ->
+  F.read ic >>= fun x2 ->
+  F.write ic (cs "hihi") >>= fun r ->
+  check_ok_buffer "read 1" input x1;
+  check_eof       "read 2" x2;
+  check_closed    "write"  r;
+  Lwt.return_unit
+
+let output_cstruct () =
+  let output = Cstruct.of_string "xxxxxxxxxx" in
+  let oc = F.cstruct ~output () in
+  F.write oc (cs  "hell") >>= fun x1 ->
+  F.write oc (cs   "o! ") >>= fun x2 ->
+  F.write oc (cs "world") >>= fun x3 ->
+  F.read oc >>= fun r ->
+  check_buffer  "result" output (cs "hello! wor");
+  check_ok_write "write 1" x1;
+  check_ok_write "write 2" x2;
+  check_closed   "write 3" x3;
+  check_eof     "read"    r;
+  Lwt.return_unit
+
+let input_cstructs () =
+  let inputs = List.map cs [ "123"; "45"; ""; "6789"; "0" ] in
+  let ic = F.cstructs ~input:inputs () in
+  F.read ic >>= fun x1 ->
+  F.read ic >>= fun x2 ->
+  F.read ic >>= fun x3 ->
+  F.read ic >>= fun x4 ->
+  F.read ic >>= fun y ->
+  F.read ic >>= fun z ->
+  F.write ic (cs "hihi") >>= fun w ->
+  check_ok_buffer "read 1" (cs  "123") x1;
+  check_ok_buffer "read 2" (cs   "45") x2;
+  check_ok_buffer "read 3" (cs "6789") x3;
+  check_ok_buffer "read 4" (cs    "0") x4;
+  check_eof       "read 5 "y;
+  check_eof       "read 6" z;
+  check_closed    "read 7" w;
+  Lwt.return_unit
+
+let output_cstructs () =
+  let output = List.map cs [ ""; "xxx"; "xx"; "xxx" ] in
+  let oc = F.cstructs ~output () in
+  F.write oc (cs  "hell") >>= fun x1 ->
+  F.write oc (cs   "o! ") >>= fun x2 ->
+  F.write oc (cs "world") >>= fun x3 ->
+  F.read oc >>= fun r ->
+  check_buffers "result" (filter output) (css ["hel"; "lo"; "! w"]);
+  check_ok_write "write 1" x1;
+  check_ok_write "write 2" x2;
+  check_closed   "write 3" x3;
+  check_eof     "read"    r;
+  Lwt.return_unit
+
+module Lwt_io_flow = Mirage_flow_unix.Make(F)
+
+let input_lwt_io () =
+  let ic = F.strings ~input:["1"; "234"; "56"; "78\n90"] () in
+  let lic = Lwt_io_flow.ic ic in
+  Lwt_io.read_line lic >>= fun l ->
+  check_buffer "result" (cs "12345678") (cs l);
+  Lwt.return_unit
+
+let output_lwt_io () =
+  let output = css ["xxxx";"xxxx"; "xxxxxx"] in
+  let oc = F.cstructs ~output () in
+  let loc = Lwt_io_flow.oc oc in
+  Lwt_io.write_line loc "Hello world!" >>= fun () ->
+  Lwt_io.flush loc >>= fun () ->
+  check_buffers "result" (css ["Hell"; "o wo"; "rld!\nx"]) output;
+  Lwt.return_unit
+
+let run f () = Lwt_main.run (f ())
+
+let string = [
+  "input" , `Quick, run input_string;
+  "output", `Quick, run output_string;
+]
+
+let strings = [
+  "input" , `Quick, run input_strings;
+  "output", `Quick, run output_strings;
+]
+
+let cstruct = [
+  "input" , `Quick, run input_cstruct;
+  "output", `Quick, run output_cstruct;
+]
+
+let cstructs = [
+  "input" , `Quick, run input_cstructs;
+  "output", `Quick, run output_cstructs;
+]
+
+let lwt_io = [
+  "input" , `Quick, run input_lwt_io;
+  "output", `Quick, run output_lwt_io;
+]
+let () =
+  Alcotest.run "mirage-flow" [
+    "string"  , string;
+    "strings" , strings;
+    "cstruct" , cstruct;
+    "cstructs", cstructs;
+    "lwt-io"  , lwt_io;
+  ]

unikernel/duniverse/mirage-flow/unix/dune

@@ -0,0 +1,5 @@
+(library
+ (name mirage_flow_unix)
+ (public_name mirage-flow-unix)
+ (libraries mirage-flow lwt.unix logs)
+ (wrapped false))

unikernel/duniverse/mirage-flow/unix/mirage_flow_unix.ml

@@ -0,0 +1,139 @@
+(*
+ * Copyright (c) 2015-present Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Lwt.Infix
+
+let src = Logs.Src.create "mirage-flow-unix"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+module Make (F: Mirage_flow.S) = struct
+
+  let reader t =
+    let frag = ref (Cstruct.create 0) in
+    let rec aux buf ofs len =
+      if len = 0
+      then Lwt.return 0
+      else
+        let available = Cstruct.length !frag in
+        if available = 0 then begin
+          F.read t >>= function
+          | Ok (`Data b) ->
+            frag := b;
+            aux buf ofs len
+          | Ok `Eof -> Lwt.return 0
+          | Error e ->
+            Lwt.fail_with @@ Fmt.str "Lwt_io_flow.reader: %a" F.pp_error e
+        end else begin
+          let n = min available len in
+          Cstruct.blit !frag 0 (Cstruct.of_bigarray buf) ofs n;
+          frag := Cstruct.shift !frag n;
+          Lwt.return n
+        end in
+    aux
+
+  let writer t buf ofs len =
+    let b = Cstruct.sub (Cstruct.of_bigarray buf) ofs len in
+    F.write t b >>= function
+    | Ok ()          -> Lwt.return len
+    | Error `Closed  -> Lwt.return 0
+    | Error e        ->
+      Lwt.fail_with @@ Fmt.str "Lwt_io_flow.writer: %a" F.pp_write_error e
+
+  let ic ?(buffer_size=1024) ?(close=true) t =
+    let close () = if close then F.close t else Lwt.return_unit in
+    let buffer = Lwt_bytes.create buffer_size in
+    Lwt_io.make ~buffer ~mode:Lwt_io.input ~close (reader t)
+
+  let oc ?(buffer_size=1024) ?(close=false) t =
+    let close () = if close then F.close t else Lwt.return_unit in
+    let buffer = Lwt_bytes.create buffer_size in
+    Lwt_io.make ~buffer ~mode:Lwt_io.output ~close (writer t)
+
+end
+
+module Fd = struct
+
+  type error = [`Msg of string]
+  type write_error = [ Mirage_flow.write_error | error ]
+
+  let pp_error ppf (`Msg s) = Fmt.string ppf s
+
+  let pp_write_error ppf = function
+    | #Mirage_flow.write_error as e -> Mirage_flow.pp_write_error ppf e
+    | #error as e                   -> pp_error ppf e
+
+  type flow = Lwt_unix.file_descr
+
+  let err e =  Lwt.return (Error (`Msg (Printexc.to_string e)))
+
+  let failf fmt = Fmt.kstr Lwt.fail_with fmt
+
+  let pp_fd ppf (t:Lwt_unix.file_descr) =
+    Fmt.int ppf (Obj.magic (Lwt_unix.unix_file_descr t): int)
+
+  let rec really_write fd buf off len =
+    match len with
+    | 0   -> Lwt.return_unit
+    | len ->
+       Log.debug (fun l -> l "really_write %a off=%d len=%d" pp_fd fd off len);
+       Lwt_unix.write fd buf off len >>= fun n ->
+       if n = 0 then Lwt.fail_with "write 0"
+       else really_write fd buf (off+n) (len-n)
+
+  let write_all fd buf = really_write fd buf 0 (Bytes.length buf)
+
+  let read_all fd =
+    Log.debug (fun l -> l "read_all %a" pp_fd fd);
+    let len = 16 * 1024 in
+    let buf = Bytes.create len in
+    let rec loop acc =
+      Lwt_unix.read fd buf 0 len >>= fun n ->
+      if n = 0 then failf "read %a: 0" pp_fd fd
+      else
+        let acc = Bytes.sub buf 0 n :: acc in
+        if n <= len then Lwt.return (List.rev acc)
+        else loop acc
+    in
+    loop [] >|= fun bufs ->
+    Bytes.concat (Bytes.create 0) bufs
+
+  let read t =
+    Lwt.catch (fun () ->
+        read_all t >|= fun buf -> Ok (`Data (Cstruct.of_bytes buf))
+      ) (function Failure _ -> Lwt.return (Ok `Eof) | e -> err e)
+
+  let write t b =
+    Lwt.catch (fun () ->
+        write_all t (Cstruct.to_bytes b) >|= fun () -> Ok ()
+      ) (fun e  -> err e)
+
+  let close t = Lwt_unix.close t
+
+  let shutdown t mode =
+    let cmd = Lwt_unix.(match mode with
+        | `read -> SHUTDOWN_RECEIVE
+        | `write -> SHUTDOWN_SEND
+        | `read_write -> SHUTDOWN_ALL)
+    in
+    Lwt.return (Lwt_unix.shutdown t cmd)
+
+  let writev t bs =
+    Lwt.catch (fun () ->
+        Lwt_list.iter_s (fun b -> write_all t (Cstruct.to_bytes b)) bs
+        >|= fun () -> Ok ()
+      ) (fun e -> err e)
+
+end

unikernel/duniverse/mirage-flow/unix/mirage_flow_unix.mli

@@ -0,0 +1,33 @@
+(*
+ * Copyright (c) 2015-present Thomas Gazagnaire <thomas@gazagnaire.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Conversion from mirage flows to Lwt_io channels. *)
+
+module Make (F: Mirage_flow.S): sig
+
+  val ic: ?buffer_size:int -> ?close:bool -> F.flow -> Lwt_io.input_channel
+  (** Build an [Lwt_io] input channel from a mirage flow. If [close]
+      is omitted, the mirage flow will be closed when the input
+      channel is closed. *)
+
+  val oc: ?buffer_size:int -> ?close:bool -> F.flow -> Lwt_io.output_channel
+  (** Build an [Lwt_io] output channel from a mirage flow. If [close]
+      is omitted, the mirage flow will {e not} be closed when the
+      output channel is closed. *)
+
+end
+
+module Fd: Mirage_flow.S with type flow = Lwt_unix.file_descr