unikernel/duniverse/mirage-tcpip/src/stack-unix/dune

@@ -0,0 +1,50 @@
+(library
+ (name icmpv4_socket)
+ (public_name tcpip.icmpv4-socket)
+ (modules icmpv4_socket)
+ (wrapped false)
+ (instrumentation
+  (backend bisect_ppx))
+ (libraries lwt.unix ipaddr.unix cstruct-lwt tcpip.icmpv4 tcpip.ipv4
+   tcpip.ipv6))
+
+(library
+ (name udpv4v6_socket)
+ (public_name tcpip.udpv4v6-socket)
+ (modules udpv4v6_socket)
+ (wrapped false)
+ (instrumentation
+  (backend bisect_ppx))
+ (libraries lwt.unix ipaddr.unix cstruct-lwt fmt logs))
+
+(library
+ (name tcp_socket_options)
+ (public_name tcpip.tcp_socket_options)
+ (modules tcp_socket_options)
+ (foreign_stubs
+  (language c)
+  (names tcp_socket_options_stubs)
+  (flags :standard))
+ (wrapped false)
+ (instrumentation
+  (backend bisect_ppx))
+ (libraries lwt.unix duration))
+
+(library
+ (name tcpv4v6_socket)
+ (public_name tcpip.tcpv4v6-socket)
+ (modules tcp_socket tcpv4v6_socket)
+ (wrapped false)
+ (instrumentation
+  (backend bisect_ppx))
+ (libraries lwt.unix ipaddr.unix cstruct-lwt fmt tcpip tcp_socket_options logs))
+
+(library
+ (name tcpip_stack_socket)
+ (public_name tcpip.stack-socket)
+ (modules tcpip_stack_socket ipv4_socket ipv6_socket ipv4v6_socket)
+ (wrapped false)
+ (instrumentation
+  (backend bisect_ppx))
+ (libraries lwt.unix cstruct-lwt ipaddr.unix logs tcpip.ipv4 tcpip.ipv6
+  tcpip.tcpv4v6-socket tcpip.udpv4v6-socket))

unikernel/duniverse/mirage-tcpip/src/stack-unix/icmpv4_socket.ml

@@ -0,0 +1,109 @@
+open Lwt.Infix
+
+type ipaddr = Ipaddr.V4.t
+
+type t = {
+  mutable listening_sockets : Lwt_unix.file_descr list
+}
+
+type error = [ `Ip of string ]
+let pp_error ppf (`Ip s) = Fmt.string ppf s
+
+let is_win32 = Sys.os_type = "Win32"
+
+let ipproto_icmp = 1 (* according to BSD /etc/protocols *)
+let port = 0 (* port isn't meaningful in this context *)
+
+let safe_close fd =
+  Lwt.catch
+    (fun () -> Lwt_unix.close fd)
+    (function
+      | Unix.Unix_error (Unix.EBADF, _, _) -> Lwt.return_unit
+      | e -> Lwt.fail e)
+
+let connect () = Lwt.return { listening_sockets = [] }
+let disconnect t = Lwt_list.iter_p safe_close t.listening_sockets
+
+let pp_sockaddr fmt sa =
+  let open Lwt_unix in
+  match sa with
+  | ADDR_UNIX s -> Format.fprintf fmt "%s" s
+  | ADDR_INET (ip, port) -> Format.fprintf fmt "%s, %d" (Unix.string_of_inet_addr ip) port
+
+let src = Logs.Src.create "icmpv4_socket" ~doc:"Mirage ICMPv4 (Sockets Edition)"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+let sendto' fd buf flags dst =
+  if is_win32 then begin
+     (* Lwt on Win32 doesn't support Lwt_bytes.sendto *)
+     let bytes = Bytes.make (Cstruct.length buf) '\000' in
+     Cstruct.blit_to_bytes buf 0 bytes 0 (Cstruct.length buf);
+     Lwt_unix.sendto fd bytes 0 (Bytes.length bytes) flags dst
+  end else Lwt_cstruct.sendto fd buf flags dst
+
+let recvfrom' fd buf flags =
+  if is_win32 then begin
+    (* Lwt on Win32 doesn't support Lwt_bytes.recvfrom *)
+    let bytes = Bytes.make (Cstruct.length buf) '\000' in
+    Lwt_unix.recvfrom fd bytes 0 (Bytes.length bytes) flags
+    >>= fun (n, sockaddr) ->
+    Cstruct.blit_from_bytes bytes 0 buf 0 n;
+    Lwt.return (n, sockaddr)
+  end else Lwt_cstruct.recvfrom fd buf flags
+
+let write _t ?src:_ ~dst ?ttl:_ttl buf =
+  let open Lwt_unix in
+  let flags = [] in
+  let ipproto_icmp = 1 in (* according to BSD /etc/protocols *)
+  let port = 0 in (* port isn't meaningful in this context *)
+  let fd = socket PF_INET SOCK_RAW ipproto_icmp in
+  let in_addr = Unix.inet_addr_of_string (Ipaddr.V4.to_string dst) in
+  let sockaddr = ADDR_INET (in_addr, port) in
+  Lwt.catch (fun () ->
+    sendto' fd buf flags sockaddr >>= fun sent ->
+      if (sent <> (Cstruct.length buf)) then
+        Log.debug (fun f -> f "short write: %d received vs %d expected" sent (Cstruct.length buf));
+    Lwt_unix.close fd |> Lwt_result.ok
+  ) (fun exn -> Lwt.return @@ Error (`Ip (Printexc.to_string exn)))
+
+let input t ~src ~dst:_ buf =
+  (* some default logic -- respond to echo requests with echo replies *)
+  match Icmpv4_packet.Unmarshal.of_cstruct buf with
+  | Error s ->
+    Log.debug (fun f -> f "Error decomposing an ICMP packet: %s" s);
+    Lwt.return_unit
+  | Ok (icmp, payload) ->
+    let open Icmpv4_packet in
+    match icmp.ty, icmp.subheader with
+    | Icmpv4_wire.Echo_request, Id_and_seq (id, seq) ->
+      let response =
+          { ty = Icmpv4_wire.Echo_reply;
+            code = 0x00;
+            subheader = Id_and_seq (id, seq); } in
+      (* TODO: if `listen` were allowed to report problems,
+       * it would be sensible not to discard the value returned here,
+       * but as it is we can only return () *)
+      write t ~dst:src (Marshal.make_cstruct response ~payload) >>= fun _ -> Lwt.return_unit
+    | _, _ -> Lwt.return_unit
+
+let listen t addr fn =
+  let fd = Lwt_unix.socket PF_INET SOCK_RAW ipproto_icmp in
+  t.listening_sockets <- fd :: t.listening_sockets;
+  let sa = Lwt_unix.ADDR_INET (Unix.inet_addr_of_string (Ipaddr.V4.to_string addr), port) in
+  Lwt_unix.bind fd sa >>= fun () ->
+  Log.debug (fun f -> f "Bound ICMP file descriptor to %a" pp_sockaddr sa);
+  let rec loop () =
+    let receive_buffer = Cstruct.create 4096 in
+    recvfrom' fd receive_buffer [] >>= fun (len, _sockaddr) ->
+    (* trim the buffer to the amount of data actually received *)
+    let receive_buffer = Cstruct.sub receive_buffer 0 len in
+    (* On macOS the IP length field is set to a very large value (16384) which
+       probably reflects some kernel datastructure size rather than the real
+       on-the-wire size. This confuses our IPv4 parser so we correct the size
+       here. *)
+    let len = Ipv4_wire.get_len receive_buffer in
+    Ipv4_wire.set_len receive_buffer (min len (Cstruct.length receive_buffer));
+    Lwt.async (fun () -> fn receive_buffer);
+    loop ()
+  in
+  loop ()

unikernel/duniverse/mirage-tcpip/src/stack-unix/icmpv4_socket.mli

@@ -0,0 +1,13 @@
+include Icmpv4.S
+
+val connect : unit -> t Lwt.t
+
+val listen : t -> ipaddr -> (Cstruct.t -> unit Lwt.t) -> unit Lwt.t
+(** [listen t addr fn] attempts to create an unprivileged listener on IP address [addr].
+
+    When a packet is received, the callback [fn] will be called in a fresh background
+    thread. The callback will be provided a buffer containing an IP datagram with an
+    ICMP payload inside.
+
+    The thread returned by [listen] blocks until the stack is disconnected.
+*)

unikernel/duniverse/mirage-tcpip/src/stack-unix/ipv4_socket.ml

@@ -0,0 +1,39 @@
+(*
+ * Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.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 t = unit
+type error = Tcpip.Ip.error
+type ipaddr = Ipaddr.V4.t
+type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
+type prefix = Ipaddr.V4.Prefix.t
+
+let pp_error = Tcpip.Ip.pp_error
+let pp_ipaddr = Ipaddr.V4.pp
+let pp_prefix = Ipaddr.V4.Prefix.pp
+
+let mtu _ ~dst:_ = 1500 - Ipv4_wire.sizeof_ipv4
+
+let disconnect _ = Lwt.return_unit
+let connect _ = Lwt.return_unit
+
+let input _ ~tcp:_ ~udp:_ ~default:_ _ = Lwt.return_unit
+let write _ ?fragment:_ ?ttl:_ ?src:_ _ _ ?size:_ _ _ =
+  Lwt.fail (Failure "Not implemented")
+
+let get_ip _ = [Ipaddr.V4.any]
+let configured_ips _ = [Ipaddr.V4.Prefix.global]
+let src _ ~dst:_ = raise (Failure "Not implemented")
+let pseudoheader _ ?src:_ _ _ _ = raise (Failure "Not implemented")

unikernel/duniverse/mirage-tcpip/src/stack-unix/ipv4v6_socket.ml

@@ -0,0 +1,41 @@
+(*
+ * Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.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 t = unit
+type error = Tcpip.Ip.error
+type ipaddr = Ipaddr.t
+type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
+type prefix = Ipaddr.Prefix.t
+
+let pp_error = Tcpip.Ip.pp_error
+let pp_ipaddr = Ipaddr.pp
+let pp_prefix = Ipaddr.Prefix.pp
+
+let mtu _ ~dst = match dst with
+  | Ipaddr.V4 _ -> 1500 - Ipv4_wire.sizeof_ipv4
+  | Ipaddr.V6 _ -> 1500 - Ipv6_wire.sizeof_ipv6
+
+let disconnect _ = Lwt.return_unit
+let connect _ = Lwt.return_unit
+
+let input _ ~tcp:_ ~udp:_ ~default:_ _ = Lwt.return_unit
+let write _ ?fragment:_ ?ttl:_ ?src:_ _ _ ?size:_ _ _ =
+  Lwt.fail (Failure "Not implemented")
+
+let get_ip _ = [Ipaddr.V6 Ipaddr.V6.unspecified]
+let configured_ips _ = [Ipaddr.Prefix.of_string_exn "::/0"]
+let src _ ~dst:_ = raise (Failure "Not implemented")
+let pseudoheader _ ?src:_ _ _ _ = raise (Failure "Not implemented")

unikernel/duniverse/mirage-tcpip/src/stack-unix/ipv6_socket.ml

@@ -0,0 +1,40 @@
+(*
+ * Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2014 Nicolas Ojeda Bar <n.oje.bar@gmail.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.
+ *)
+
+type t = unit
+type error = Tcpip.Ip.error
+type ipaddr = Ipaddr.V6.t
+type callback = src:ipaddr -> dst:ipaddr -> Cstruct.t -> unit Lwt.t
+type prefix = Ipaddr.V6.Prefix.t
+
+let pp_error = Tcpip.Ip.pp_error
+let pp_ipaddr = Ipaddr.V6.pp
+let pp_prefix = Ipaddr.V6.Prefix.pp
+
+let mtu _ ~dst:_ = 1500 - Ipv6_wire.sizeof_ipv6
+
+let disconnect () = Lwt.return_unit
+let connect () = Lwt.return_unit
+
+let input _ ~tcp:_ ~udp:_ ~default:_ _ = Lwt.return_unit
+let write _ ?fragment:_ ?ttl:_ ?src:_ _ _ ?size:_ _ _ =
+  Lwt.fail (Failure "Not implemented")
+
+let get_ip _ = [Ipaddr.V6.unspecified]
+let configured_ips _ = [Ipaddr.V6.Prefix.of_string_exn "::/0"]
+let src _ ~dst:_ = raise (Failure "Not implemented")
+let pseudoheader _ ?src:_ _ _ _ = raise (Failure "Not implemented")

unikernel/duniverse/mirage-tcpip/src/stack-unix/tcp_socket.ml

@@ -0,0 +1,76 @@
+open Lwt
+
+type error = [ Tcpip.Tcp.error | `Exn of exn ]
+type write_error = [ Tcpip.Tcp.write_error | `Exn of exn ]
+
+let pp_error ppf = function
+  | #Tcpip.Tcp.error as e -> Tcpip.Tcp.pp_error ppf e
+  | `Exn e -> Fmt.exn ppf e
+
+let pp_write_error ppf = function
+  | #Tcpip.Tcp.write_error as e -> Tcpip.Tcp.pp_write_error ppf e
+  | `Exn e -> Fmt.exn ppf e
+
+let ignore_canceled = function
+  | Lwt.Canceled -> Lwt.return_unit
+  | exn -> raise exn
+
+let disconnect _ =
+  return_unit
+
+let read fd =
+  let buflen = 65536 in
+  let buf = Cstruct.create buflen in
+  Lwt.catch (fun () ->
+      Lwt_cstruct.read fd buf
+      >>= function
+      | 0 -> return (Ok `Eof)
+      | n when n = buflen -> return (Ok (`Data buf))
+      | n -> return @@ Ok (`Data (Cstruct.sub buf 0 n))
+    )
+    (fun exn -> return (Error (`Exn exn)))
+
+let rec write fd buf =
+  Lwt.catch
+    (fun () ->
+      Lwt_cstruct.write fd buf
+      >>= function
+      | n when n = Cstruct.length buf -> return @@ Ok ()
+      | 0 -> return @@ Error `Closed
+      | n -> write fd (Cstruct.sub buf n (Cstruct.length buf - n))
+    ) (function
+      | Unix.Unix_error(Unix.EPIPE, _, _) -> return @@ Error `Closed
+      | e -> return (Error (`Exn e)))
+
+let writev fd bufs =
+  Lwt_list.fold_left_s
+    (fun res buf ->
+       match res with
+       | Error _ as e -> return e
+       | Ok () -> write fd buf
+    ) (Ok ()) bufs
+
+(* TODO make nodelay a flow option *)
+let write_nodelay fd buf =
+  write fd buf
+
+(* TODO make nodelay a flow option *)
+let writev_nodelay fd bufs =
+  writev fd bufs
+
+let close fd =
+  Lwt.catch
+    (fun () -> Lwt_unix.close fd)
+    (function
+      | Unix.Unix_error (Unix.EBADF, _, _) -> Lwt.return_unit
+      | e -> Lwt.fail e)
+
+let shutdown fd mode =
+  let cmd = match mode with
+    | `read -> Lwt_unix.SHUTDOWN_RECEIVE
+    | `write -> Lwt_unix.SHUTDOWN_SEND
+    | `read_write -> Lwt_unix.SHUTDOWN_ALL
+  in
+  Lwt.return (Lwt_unix.shutdown fd cmd)
+
+let input _t ~src:_ ~dst:_ _buf = Lwt.return_unit

unikernel/duniverse/mirage-tcpip/src/stack-unix/tcp_socket_options.ml

@@ -0,0 +1,24 @@
+(*
+ * Copyright (c) 2017 Docker 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.
+ *)
+
+external tcp_set_keepalive_params: Unix.file_descr -> int -> int -> int -> unit = "caml_tcp_set_keepalive_params"
+
+let enable_keepalive ~fd ~after ~interval ~probes =
+  let fd' = Lwt_unix.unix_file_descr fd in
+  let after = Duration.to_ms after in
+  let interval = Duration.to_ms interval in
+  tcp_set_keepalive_params fd' after interval probes;
+  Lwt_unix.setsockopt fd Lwt_unix.SO_KEEPALIVE true

unikernel/duniverse/mirage-tcpip/src/stack-unix/tcp_socket_options_stubs.c

@@ -0,0 +1,88 @@
+/*
+ * Copyright (c) 2017 Docker 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.
+ */
+
+#include <stdio.h>
+#include <stdint.h>
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/fail.h>
+#include <caml/bigarray.h>
+#include <caml/unixsupport.h>
+
+#ifdef _WIN32
+#ifdef _MSC_VER
+/* https://docs.microsoft.com/en-us/windows/win32/winsock/sio-keepalive-vals */
+#include <Mstcpip.h>
+#endif
+#else
+#include <sys/time.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/tcp.h>
+#include <netinet/in.h>
+#endif
+
+/* Round up to the next second */
+#define SECONDS_OF_MILLISECONDS(x) ( (x + 999) / 1000 )
+
+CAMLprim value
+caml_tcp_set_keepalive_params(value v_fd, value v_time, value v_interval, value v_probe)
+{
+  CAMLparam4(v_fd, v_time, v_interval, v_probe);
+#ifdef _WIN32
+  SOCKET s = Socket_val(v_fd);
+  DWORD dwBytesRet=0;
+  struct tcp_keepalive alive;
+  alive.onoff = TRUE;
+  alive.keepalivetime = Int_val(v_time); /* ms */
+  alive.keepaliveinterval = Int_val(v_interval); /* ms */
+  if (WSAIoctl(s, SIO_KEEPALIVE_VALS, &alive, sizeof(alive),
+    NULL, 0, &dwBytesRet, NULL, NULL) == SOCKET_ERROR) {
+    win32_maperr(WSAGetLastError());
+  }
+#elif DARWIN
+  int s = Int_val(v_fd);
+  int optval = SECONDS_OF_MILLISECONDS(Int_val(v_time));
+  if(setsockopt(s, IPPROTO_TCP, TCP_KEEPALIVE, &optval, sizeof optval) < 0) {
+    uerror("setsockopt", Nothing);
+  }
+  optval = SECONDS_OF_MILLISECONDS(Int_val(v_interval));
+  if(setsockopt(s, IPPROTO_TCP, TCP_KEEPINTVL, &optval, sizeof optval) < 0) {
+    uerror("setsockopt", Nothing);
+  }
+  optval = Int_val(v_probe);
+  if(setsockopt(s, IPPROTO_TCP, TCP_KEEPCNT, &optval, sizeof optval) < 0) {
+    uerror("setsockopt", Nothing);
+  }
+#elif LINUX
+  int s = Int_val(v_fd);
+  int optval = SECONDS_OF_MILLISECONDS(Int_val(v_time));
+  if(setsockopt(s, SOL_TCP, TCP_KEEPIDLE, &optval, optlen) < 0) {
+    uerror("setsockopt", Nothing);
+  }
+  optval = SECONDS_OF_MILLISECONDS(Int_val(v_interval));
+  if(setsockopt(s, SOL_TCP, TCP_KEEPINTVL, &optval, sizeof optval) < 0) {
+    uerror("setsockopt", Nothing);
+  }
+  optval = Int_val(v_probe);
+  if(setsockopt(s, SOL_TCP, TCP_KEEPCNT, &optval, sizeof optval) < 0) {
+    uerror("setsockopt", Nothing);
+  }
+#else
+  fprintf(stderr, "Warning: setting TCP keep-alive parameters not supported on this platform\n");
+#endif
+  CAMLreturn(Val_unit);
+}

unikernel/duniverse/mirage-tcpip/src/stack-unix/tcpip_stack_socket.ml

@@ -0,0 +1,51 @@
+(*
+ * Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.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 "tcpip-stack-socket" ~doc:"Platform's native TCP/IP stack"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+module V4V6 = struct
+  module TCP = Tcpv4v6_socket
+  module UDP = Udpv4v6_socket
+  module IP  = Ipv4v6_socket
+
+  type t = {
+    udp : UDP.t;
+    tcp : TCP.t;
+    stop : unit Lwt.u;
+    switched_off : unit Lwt.t;
+  }
+
+  let udp { udp; _ } = udp
+  let tcp { tcp; _ } = tcp
+  let ip _ = ()
+
+  let listen t = t.switched_off
+
+  let connect udp tcp =
+    Log.info (fun f -> f "Dual IPv4 and IPv6 socket stack: connect");
+    let switched_off, stop = Lwt.wait () in
+    UDP.set_switched_off udp switched_off;
+    TCP.set_switched_off tcp switched_off;
+    Lwt.return { tcp; udp; stop; switched_off }
+
+  let disconnect t =
+    TCP.disconnect t.tcp >>= fun () ->
+    UDP.disconnect t.udp >|= fun () ->
+    Lwt.wakeup_later t.stop ()
+end

unikernel/duniverse/mirage-tcpip/src/stack-unix/tcpip_stack_socket.mli

@@ -0,0 +1,23 @@
+(*
+ * Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.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.
+ *)
+
+module V4V6 : sig
+  include Tcpip.Stack.V4V6
+    with module UDP = Udpv4v6_socket
+     and module TCP = Tcpv4v6_socket
+     and module IP  = Ipv4v6_socket
+  val connect : Udpv4v6_socket.t -> Tcpv4v6_socket.t -> t Lwt.t
+end

unikernel/duniverse/mirage-tcpip/src/stack-unix/tcpv4v6_socket.ml

@@ -0,0 +1,196 @@
+(*
+ * Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2014 Nicolas Ojeda Bar <n.oje.bar@gmail.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.
+ *)
+
+let src = Logs.Src.create "tcpv4v6-socket" ~doc:"TCP socket v4v6 (platform native)"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+open Lwt.Infix
+
+type ipaddr = Ipaddr.t
+type flow = Lwt_unix.file_descr
+
+type t = {
+  interface: [ `Any | `Ip of Unix.inet_addr * Unix.inet_addr | `V4_only of Unix.inet_addr | `V6_only of Unix.inet_addr ];    (* source ip to bind to *)
+  mutable active_connections : Lwt_unix.file_descr list;
+  listen_sockets : (int, Lwt_unix.file_descr list) Hashtbl.t;
+  mutable switched_off : unit Lwt.t;
+}
+
+let set_switched_off t switched_off =
+  t.switched_off <- Lwt.pick [ switched_off; t.switched_off ]
+
+let any_v6 = Ipaddr_unix.V6.to_inet_addr Ipaddr.V6.unspecified
+
+include Tcp_socket
+
+let connect ~ipv4_only ~ipv6_only ipv4 ipv6 =
+  let interface =
+    let v4 = Ipaddr.V4.Prefix.address ipv4 in
+    let v4_unix = Ipaddr_unix.V4.to_inet_addr v4 in
+    if ipv4_only then
+      `V4_only v4_unix
+    else if ipv6_only then
+      `V6_only (match ipv6 with
+          | None ->  any_v6
+          | Some x -> Ipaddr_unix.V6.to_inet_addr (Ipaddr.V6.Prefix.address x))
+    else
+      match ipv6, Ipaddr.V4.(compare v4 any) with
+      | None, 0 -> `Any
+      | None, _ -> `Ip (v4_unix, any_v6)
+      | Some x, v4_any ->
+        let v6 = Ipaddr.V6.Prefix.address x in
+        if Ipaddr.V6.(compare v6 unspecified = 0) && v4_any = 0 then
+          `Any
+        else
+          `Ip (v4_unix, Ipaddr_unix.V6.to_inet_addr v6)
+  in
+  Lwt.return {interface; active_connections = []; listen_sockets = Hashtbl.create 7; switched_off = fst (Lwt.wait ())}
+
+let disconnect t =
+  Lwt_list.iter_p close t.active_connections >>= fun () ->
+  Lwt_list.iter_p close
+    (Hashtbl.fold (fun _ fd acc -> fd @ acc) t.listen_sockets []) >>= fun () ->
+  Lwt.cancel t.switched_off ; Lwt.return_unit
+
+let dst fd =
+  match Lwt_unix.getpeername fd with
+  | Unix.ADDR_UNIX _ ->
+    raise (Failure "unexpected: got a unix instead of tcp sock")
+  | Unix.ADDR_INET (ia,port) ->
+    let ip = Ipaddr_unix.of_inet_addr ia in
+    let ip = match Ipaddr.to_v4 ip with
+      | None -> ip
+      | Some v4 -> Ipaddr.V4 v4
+    in
+    ip, port
+
+let src fd =
+  match Lwt_unix.getsockname fd with
+  | Unix.ADDR_UNIX _ ->
+    raise (Failure "unexpected: got a unix instead of tcp sock")
+  | Unix.ADDR_INET (ia,port) ->
+    let ip = Ipaddr_unix.of_inet_addr ia in
+    let ip = match Ipaddr.to_v4 ip with
+      | None -> ip
+      | Some v4 -> Ipaddr.V4 v4
+    in
+    ip, port
+
+let create_connection ?keepalive t (dst,dst_port) =
+  match
+    match dst, t.interface with
+    | Ipaddr.V4 _, (`Any | `Ip _ | `V4_only _) -> Ok (Lwt_unix.PF_INET, fst)
+    | Ipaddr.V6 _, (`Any | `Ip _ | `V6_only _) -> Ok (Lwt_unix.PF_INET6, snd)
+    | Ipaddr.V4 _, `V6_only _ ->
+      Error (`Msg "Attempted to connect to an IPv4 host, but stack is IPv6 only")
+    | Ipaddr.V6 _, `V4_only _ ->
+      Error (`Msg "Attempted to connect to an IPv6 host, but stack is IPv4 only")
+  with
+  | Error (`Msg m) -> Lwt.return (Error (`Exn (Invalid_argument m)))
+  | Ok (family, proj) ->
+    let fd = Lwt_unix.(socket family SOCK_STREAM 0) in
+    Lwt.catch (fun () ->
+        (match t.interface with
+         | `Any -> Lwt.return_unit
+         | `Ip p -> Lwt_unix.bind fd (Lwt_unix.ADDR_INET (proj p, 0))
+         | `V4_only ip -> Lwt_unix.bind fd (Lwt_unix.ADDR_INET (ip, 0))
+         | `V6_only ip -> Lwt_unix.bind fd (Lwt_unix.ADDR_INET (ip, 0))) >>= fun () ->
+        Lwt_unix.connect fd
+          (Lwt_unix.ADDR_INET ((Ipaddr_unix.to_inet_addr dst), dst_port))
+        >>= fun () ->
+        ( match keepalive with
+          | None -> ()
+          | Some { Tcpip.Tcp.Keepalive.after; interval; probes } ->
+            Tcp_socket_options.enable_keepalive ~fd ~after ~interval ~probes );
+        t.active_connections <- fd :: t.active_connections;
+        Lwt.return (Ok fd))
+      (fun exn ->
+         close fd >>= fun () ->
+         Lwt.return (Error (`Exn exn)))
+
+let unlisten t ~port =
+  match Hashtbl.find_opt t.listen_sockets port with
+  | None -> ()
+  | Some fds ->
+    Hashtbl.remove t.listen_sockets port;
+    try List.iter (fun fd -> Unix.close (Lwt_unix.unix_file_descr fd)) fds with _ -> ()
+
+let listen t ~port ?keepalive callback =
+  if port < 0 || port > 65535 then
+    raise (Invalid_argument (Printf.sprintf "invalid port number (%d)" port));
+  unlisten t ~port;
+  let fds =
+    match t.interface with
+    | `Any ->
+      let fd = Lwt_unix.(socket PF_INET6 SOCK_STREAM 0) in
+      Lwt_unix.(setsockopt fd SO_REUSEADDR true);
+      Lwt_unix.(setsockopt fd IPV6_ONLY false);
+      [ (fd, Lwt_unix.ADDR_INET (any_v6, port)) ]
+    | `Ip (v4, v6) ->
+      let fd = Lwt_unix.(socket PF_INET SOCK_STREAM 0) in
+      Lwt_unix.(setsockopt fd SO_REUSEADDR true);
+      let fd' = Lwt_unix.(socket PF_INET6 SOCK_STREAM 0) in
+      Lwt_unix.(setsockopt fd' SO_REUSEADDR true);
+      Lwt_unix.(setsockopt fd' IPV6_ONLY true);
+      [ (fd, Lwt_unix.ADDR_INET (v4, port)) ; (fd', Lwt_unix.ADDR_INET (v6, port)) ]
+    | `V4_only ip ->
+      let fd = Lwt_unix.(socket PF_INET SOCK_STREAM 0) in
+      Lwt_unix.setsockopt fd Lwt_unix.SO_REUSEADDR true;
+      [ (fd, Lwt_unix.ADDR_INET (ip, port)) ]
+    | `V6_only ip ->
+      let fd = Lwt_unix.(socket PF_INET6 SOCK_STREAM 0) in
+      Lwt_unix.(setsockopt fd SO_REUSEADDR true);
+      Lwt_unix.(setsockopt fd IPV6_ONLY true);
+      [ (fd, Lwt_unix.ADDR_INET (ip, port)) ]
+  in
+  List.iter (fun (fd, addr) ->
+      Unix.bind (Lwt_unix.unix_file_descr fd) addr;
+      Hashtbl.replace t.listen_sockets port (List.map fst fds);
+      Lwt_unix.listen fd 10;
+      (* FIXME: we should not ignore the result *)
+      Lwt.async (fun () ->
+          (* TODO cancellation *)
+          let rec loop () =
+            if not (Lwt.is_sleeping t.switched_off) then raise Lwt.Canceled ;
+            Lwt.catch (fun () ->
+                Lwt_unix.accept fd >|= fun (afd, _) ->
+                t.active_connections <- afd :: t.active_connections;
+                (match keepalive with
+                 | None -> ()
+                 | Some { Tcpip.Tcp.Keepalive.after; interval; probes } ->
+                   Tcp_socket_options.enable_keepalive ~fd:afd ~after ~interval ~probes);
+                Lwt.async
+                  (fun () ->
+                     Lwt.catch
+                       (fun () -> callback afd)
+                       (fun exn ->
+                          Log.warn (fun m -> m "tcp error on port %u in callback %s" port (Printexc.to_string exn)) ;
+                          close afd));
+                `Continue)
+              (function
+                | Unix.Unix_error (Unix.EBADF, _, _) ->
+                  (match Hashtbl.find_opt t.listen_sockets port with
+                   | None -> ()
+                   | Some _ -> Log.warn (fun m -> m "tcp error bad file descriptor in accept on port %u" port)) ;
+                  Lwt.return `Stop
+                | exn ->
+                  Log.warn (fun m -> m "tcp error on port %u in accept: %s" port (Printexc.to_string exn)) ;
+                  Lwt.return `Continue) >>= function
+            | `Continue -> loop ()
+            | `Stop -> Lwt.return_unit
+          in
+          Lwt.catch loop ignore_canceled >>= fun () -> close fd)) fds

unikernel/duniverse/mirage-tcpip/src/stack-unix/tcpv4v6_socket.mli

@@ -0,0 +1,26 @@
+(*
+ * Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2014 Nicolas Ojeda Bar <n.oje.bar@gmail.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.
+ *)
+
+include Tcpip.Tcp.S
+  with type ipaddr = Ipaddr.t
+   and type flow = Lwt_unix.file_descr
+   and type error = [ Tcpip.Tcp.error | `Exn of exn ]
+   and type write_error = [ Tcpip.Tcp.write_error | `Exn of exn ]
+
+val connect : ipv4_only:bool -> ipv6_only:bool -> Ipaddr.V4.Prefix.t -> Ipaddr.V6.Prefix.t option -> t Lwt.t
+
+val set_switched_off : t -> unit Lwt.t -> unit

unikernel/duniverse/mirage-tcpip/src/stack-unix/udpv4v6_socket.ml

@@ -0,0 +1,213 @@
+(*
+ * Copyright (c) 2014 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2014 Nicolas Ojeda Bar <n.oje.bar@gmail.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.
+ *)
+
+let src = Logs.Src.create "udpv4v6-socket" ~doc:"UDP socket v4v6 (platform native)"
+module Log = (val Logs.src_log src : Logs.LOG)
+
+open Lwt.Infix
+
+type ipaddr = Ipaddr.t
+type callback = src:ipaddr -> dst:ipaddr -> src_port:int -> Cstruct.t -> unit Lwt.t
+
+let any_v6 = Ipaddr_unix.V6.to_inet_addr Ipaddr.V6.unspecified
+
+type t = {
+  interface: [ `Any | `Ip of Unix.inet_addr * Unix.inet_addr | `V4_only of Unix.inet_addr | `V6_only of Unix.inet_addr ]; (* source ip to bind to *)
+  listen_fds: (int, Lwt_unix.file_descr * Lwt_unix.file_descr option) Hashtbl.t; (* UDP fds bound to a particular port *)
+  mutable switched_off : unit Lwt.t;
+}
+
+let set_switched_off t switched_off =
+  t.switched_off <- Lwt.pick [ switched_off; t.switched_off ]
+
+let ignore_canceled = function
+  | Lwt.Canceled -> Lwt.return_unit
+  | exn -> raise exn
+
+let get_udpv4v6_listening_fd ?(preserve = true) ?(v4_or_v6 = `Both) {listen_fds;interface;_} port =
+  try
+    Lwt.return
+      (match Hashtbl.find listen_fds port with
+       | (fd, None) -> false, [ fd ]
+       | (fd, Some fd') -> false, [ fd ; fd' ])
+  with Not_found ->
+    (match interface with
+     | `Any ->
+       let fd = Lwt_unix.(socket PF_INET6 SOCK_DGRAM 0) in
+       Lwt_unix.(setsockopt fd IPV6_ONLY false);
+       Lwt_unix.bind fd (Lwt_unix.ADDR_INET (any_v6, port)) >|= fun () ->
+       ((fd, None), [ fd ])
+     | `Ip (v4, v6) ->
+       (match v4_or_v6 with
+        | `Both ->
+          let fd = Lwt_unix.(socket PF_INET SOCK_DGRAM 0) in
+          Lwt_unix.bind fd (Lwt_unix.ADDR_INET (v4, port)) >>= fun () ->
+          let fd' = Lwt_unix.(socket PF_INET6 SOCK_DGRAM 0) in
+          Lwt_unix.(setsockopt fd' IPV6_ONLY true);
+          Lwt_unix.bind fd' (Lwt_unix.ADDR_INET (v6, port)) >|= fun () ->
+          ((fd, Some fd'), [ fd ; fd' ])
+        | `V4 ->
+          let fd = Lwt_unix.(socket PF_INET SOCK_DGRAM 0) in
+          Lwt_unix.bind fd (Lwt_unix.ADDR_INET (v4, port)) >|= fun () ->
+          ((fd, None), [ fd ])
+        | `V6 ->
+          let fd = Lwt_unix.(socket PF_INET6 SOCK_DGRAM 0) in
+          Lwt_unix.(setsockopt fd IPV6_ONLY true);
+          Lwt_unix.bind fd (Lwt_unix.ADDR_INET (v6, port)) >|= fun () ->
+          ((fd, None), [ fd ]))
+     | `V4_only ip ->
+       let fd = Lwt_unix.(socket PF_INET SOCK_DGRAM 0) in
+       Lwt_unix.bind fd (Lwt_unix.ADDR_INET (ip, port)) >|= fun () ->
+       ((fd, None), [ fd ])
+     | `V6_only ip ->
+       let fd = Lwt_unix.(socket PF_INET6 SOCK_DGRAM 0) in
+       Lwt_unix.bind fd (Lwt_unix.ADDR_INET (ip, port)) >|= fun () ->
+       ((fd, None), [ fd ])) >|= fun (fds, r) ->
+    if preserve then Hashtbl.add listen_fds port fds;
+    true, r
+
+
+type error = [`Sendto_failed | `Different_ip_version]
+
+let pp_error ppf = function
+  | `Sendto_failed -> Fmt.pf ppf "sendto failed to write any bytes"
+  | `Different_ip_version ->
+    Fmt.string ppf "attempting to send to a destination with a different IP protocol version"
+
+let close fd =
+  Lwt.catch
+    (fun () -> Lwt_unix.close fd)
+    (function
+      | Unix.Unix_error (Unix.EBADF, _, _) -> Lwt.return_unit
+      | e -> Lwt.fail e)
+
+let connect ~ipv4_only ~ipv6_only ipv4 ipv6 =
+  let v4 = Ipaddr.V4.Prefix.address ipv4 in
+  let v4_unix = Ipaddr_unix.V4.to_inet_addr v4 in
+  let interface =
+    if ipv4_only then
+      `V4_only v4_unix
+    else if ipv6_only then
+      `V6_only (
+        match ipv6 with
+        | None -> any_v6
+        | Some x -> Ipaddr_unix.V6.to_inet_addr (Ipaddr.V6.Prefix.address x))
+    else
+      match ipv6, Ipaddr.V4.(compare v4 any) with
+      | None, 0 -> `Any
+      | None, _ -> `Ip (v4_unix, any_v6)
+      | Some x, v4_any ->
+        let v6 = Ipaddr.V6.Prefix.address x in
+        if Ipaddr.V6.(compare v6 unspecified = 0) && v4_any = 0 then
+          `Any
+        else
+          `Ip (v4_unix, Ipaddr_unix.V6.to_inet_addr v6)
+  in
+  let listen_fds = Hashtbl.create 7 in
+  Lwt.return { interface; listen_fds; switched_off = fst (Lwt.wait ()) }
+
+let disconnect t =
+  Hashtbl.fold (fun _ (fd, fd') r ->
+      r >>= fun () ->
+      close fd >>= fun () ->
+      match fd' with None -> Lwt.return_unit | Some fd -> close fd)
+    t.listen_fds Lwt.return_unit >>= fun () ->
+  Lwt.cancel t.switched_off ; Lwt.return_unit
+
+let input _t ~src:_ ~dst:_ _buf = Lwt.return_unit
+
+let write ?src:_ ?src_port ?ttl:_ttl ~dst ~dst_port t buf =
+  let open Lwt_unix in
+  let rec write_to_fd fd buf =
+    Lwt.catch (fun () ->
+        let dst = match t.interface with `Any -> Ipaddr.(V6 (to_v6 dst)) | _ -> dst in
+        Lwt_cstruct.sendto fd buf [] (ADDR_INET ((Ipaddr_unix.to_inet_addr dst), dst_port))
+        >>= function
+        | n when n = Cstruct.length buf -> Lwt.return (Ok ())
+        | 0 -> Lwt.return (Error `Sendto_failed)
+        | n -> write_to_fd fd (Cstruct.sub buf n (Cstruct.length buf - n))) (* keep trying *)
+      (fun _exn -> Lwt.return (Error `Sendto_failed))
+  in
+  let v4_or_v6 = match dst with Ipaddr.V4 _ -> `V4 | Ipaddr.V6 _ -> `V6 in
+  match t.interface, v4_or_v6 with
+  | `Any, _ | `Ip _, _ | `V4_only _, `V4 | `V6_only _, `V6 ->
+    let p = match src_port with None -> 0 | Some x -> x in
+    get_udpv4v6_listening_fd ~preserve:false ~v4_or_v6 t p >>= fun (created, fds) ->
+    ((match fds, v4_or_v6 with
+      | [ fd ], _ -> Lwt.return (Ok fd)
+      | [ v4 ; _v6 ], `V4 -> Lwt.return (Ok v4)
+      | [ _v4; v6 ], `V6 -> Lwt.return (Ok v6)
+      | _ -> Lwt.return (Error `Different_ip_version)) >>= function
+       | Error _ as e -> Lwt.return e
+       | Ok fd ->
+         write_to_fd fd buf >>= fun r ->
+         (if created then close fd else Lwt.return_unit) >|= fun () ->
+         r)
+  | _ -> Lwt.return (Error `Different_ip_version)
+
+let unlisten t ~port =
+  try
+    let fd, fd' = Hashtbl.find t.listen_fds port in
+    Hashtbl.remove t.listen_fds port;
+    (match fd' with None -> () | Some fd' -> Unix.close (Lwt_unix.unix_file_descr fd'));
+    Unix.close (Lwt_unix.unix_file_descr fd)
+  with _ -> ()
+
+let listen t ~port callback =
+  if port < 0 || port > 65535 then
+    raise (Invalid_argument (Printf.sprintf "invalid port number (%d)" port))
+  else
+    (* FIXME: we should not ignore the result *)
+    Lwt.async (fun () ->
+        get_udpv4v6_listening_fd t port >|= fun (_, fds) ->
+        List.iter (fun fd ->
+            Lwt.async (fun () ->
+                let buf = Cstruct.create 4096 in
+                let rec loop () =
+                  if not (Lwt.is_sleeping t.switched_off) then raise Lwt.Canceled ;
+                  Lwt.catch (fun () ->
+                      Lwt_cstruct.recvfrom fd buf [] >>= fun (len, sa) ->
+                      if len = 0 then
+                        Lwt.return `Stop
+                      else
+                        (match sa with
+                         | Lwt_unix.ADDR_INET (addr, src_port) ->
+                           let src = Ipaddr_unix.of_inet_addr addr in
+                           let src =
+                             match Ipaddr.to_v4 src with
+                             | None -> src
+                             | Some v4 -> Ipaddr.V4 v4
+                           in
+                           let dst = Ipaddr.(V6 V6.unspecified) in (* TODO *)
+                           let buf = Cstruct.sub_copy buf 0 len in
+                           callback ~src ~dst ~src_port buf
+                         | _ -> Lwt.return_unit) >|= fun () ->
+                        `Continue)
+                    (function
+                      | Unix.Unix_error (Unix.EBADF, _, _) ->
+                        (match Hashtbl.find_opt t.listen_fds port with
+                         | None -> ()
+                         | Some _ ->
+                           Log.info (fun m -> m "udp error bad file descriptor in accept on port %u" port)) ;
+                        Lwt.return `Stop
+                      | exn ->
+                        Log.warn (fun m -> m "udp exception on port %u in recvfrom: %s" port (Printexc.to_string exn)) ;
+                        Lwt.return `Continue) >>= function
+                  | `Continue -> loop ()
+                  | `Stop -> Lwt.return_unit
+                in
+                Lwt.catch loop ignore_canceled >>= fun () -> close fd)) fds)