[WIP] Dunify with variants

CHANGES.md

@@ -1,3 +1,8 @@
+### dev
+
+* Port from Jbuilder to Dune and use virtual libraries to cleanup the stub compilation
+  of checksums. (@avsm).
+
 ### v3.7.0 (2019-02-02)
 
 * Use `Lwt_dllist` instead of `Lwt_sequence`, due to the latter being deprecated
@@ -21,6 +26,8 @@
 * Use `Ipaddr.pp` instead of `Ipaddr.pp_hum` due to upstream
   interface changes (#385 @hannesm).
 
+* Use `Ipaddr.pp` instead of `Ipaddr.pp_hum` due to upstream interface changes (@avsm).
+
 ### v3.5.1 (2018-11-16)
 
 * socket stack (tcp/udp): catch exception in recv_from and accept (#376 @hannesm)

dune-project

@@ -1,2 +1,2 @@
-(lang dune 1.0)
+(lang dune 1.7)
 (name tcpip)

examples/ping/dune

@@ -1,3 +1,3 @@
 (executables
  (names ping)
- (libraries cmdliner logs logs.fmt tcpip.icmpv4-socket))
+ (libraries cmdliner logs logs.fmt tcpip.icmpv4-socket tcpip-checksum.unix))

examples/ping/ping.ml

@@ -51,7 +51,6 @@ let send_echo_requests ~stack ~payload ~dst () =
 (* Return a thread and a receiver callback. The thread is woken up when we have
    received [count] packets *)
 let make_receiver ~count ~payload () =
-  let open Lwt.Infix in
   let finished_t, finished_u = Lwt.task () in
   let callback buf =
     Log.debug (fun f -> f "Received IP %a" Cstruct.hexdump_pp buf);
@@ -70,7 +69,7 @@ let make_receiver ~count ~payload () =
           | Next_hop_mtu _ | Pointer _ | Address _ | Unused ->
             Log.err (fun f -> f "received an ICMP message which wasn't an echo-request or reply");
             Lwt.return_unit
-          | Id_and_seq (id, seq) ->
+          | Id_and_seq (_id, seq) ->
             if reply.code <> 0
             then Log.err (fun f -> f "received an ICMP ECHO_REQUEST with reply.code=%d" reply.code);
             if not(Cstruct.equal payload received_payload)

src/icmp/dune

@@ -1,7 +1,6 @@
 (library
  (name tcpip_icmpv4)
  (public_name tcpip.icmpv4)
- (libraries mirage-protocols-lwt rresult logs tcpip mirage-profile tcpip.udp)
- (preprocess
-  (pps ppx_cstruct))
+ (libraries   mirage-protocols-lwt rresult logs tcpip-checksum mirage-profile tcpip.udp)
+ (preprocess (pps ppx_cstruct))
  (wrapped false))

src/ipv4/dune

@@ -1,8 +1,7 @@
 (library
- (name tcpip_ipv4)
+ (name        tcpip_ipv4)
  (public_name tcpip.ipv4)
- (libraries logs io-page mirage-protocols-lwt ipaddr cstruct rresult tcpip
-   ethernet tcpip.udp mirage-random mirage-clock randomconv lru)
- (preprocess
-  (pps ppx_cstruct))
+ (libraries   logs io-page mirage-protocols-lwt ipaddr cstruct rresult
+                tcpip-checksum ethernet tcpip.udp mirage-random mirage-clock randomconv lru)
+ (preprocess (pps ppx_cstruct))
  (wrapped false))

src/ipv6/dune

@@ -1,9 +1,7 @@
 (library
  (name tcpip_ipv6)
  (public_name tcpip.ipv6)
- (libraries logs io-page mirage-protocols-lwt mirage-time-lwt
-   mirage-clock-lwt duration ipaddr cstruct rresult mirage-random tcpip
-   randomconv ethernet)
- (preprocess
-  (pps ppx_cstruct))
+ (libraries   logs io-page mirage-protocols-lwt mirage-time-lwt mirage-clock-lwt duration ipaddr cstruct rresult
+                mirage-random tcpip-checksum randomconv ethernet)
+ (preprocess (pps ppx_cstruct))
  (wrapped false))

src/tcp/dune

@@ -1,8 +1,8 @@
 (library
  (name tcp)
  (public_name tcpip.tcp)
- (libraries logs mirage-protocols-lwt ipaddr cstruct lwt-dllist rresult
-   mirage-profile io-page tcpip duration randomconv fmt mirage-time-lwt
-   mirage-clock mirage-random)
- (preprocess
-  (pps ppx_cstruct)))
+ (libraries   logs mirage-protocols-lwt ipaddr cstruct 
+                rresult mirage-profile io-page tcpip-checksum duration
+                randomconv fmt mirage-time-lwt mirage-clock
+                mirage-random lwt-dllist)
+ (preprocess (pps ppx_cstruct)))

src/tcpip_checksum/dune

@@ -1,37 +1,6 @@
 (library
- (name tcpip)
- (public_name tcpip)
+ (name        tcpip_checksum)
+ (public_name tcpip-checksum)
  (modules tcpip_checksum)
- (libraries cstruct tcpip.unix)
- (wrapped false))
-
-(library
- (name tcpip_xen)
- (public_name tcpip.xen)
- (libraries tcpip)
- (modules tcpip_xen)
- (c_names checksum_stubs_xen)
- (c_flags
-  (:include c_flags_xen.sexp))
- (wrapped false))
-
-(rule
- (targets c_flags_xen.sexp)
- (deps
-  (:< ../config/discover.exe))
- (action
-  (run %{<} -ocamlc %{ocamlc})))
-
-(rule
- (targets checksum_stubs_xen.c)
- (deps
-  (:< checksum_stubs.c))
- (action
-  (copy# %{<} %{targets})))
-
-(library
- (name tcpip_unix)
- (public_name tcpip.unix)
- (modules tcpip_unix)
- (c_names checksum_stubs)
- (wrapped false))
+ (virtual_modules tcpip_checksum)
+ (libraries   cstruct))

src/tcpip_checksum/ocaml/dune

@@ -0,0 +1,4 @@
+(library
+ (name tcpip_checksum_ocaml)
+ (public_name tcpip-checksum.ocaml)
+ (implements tcpip_checksum))

src/tcpip_checksum/ocaml/tcpip_checksum.ml

@@ -0,0 +1,68 @@
+(*
+ * Copyright (c) 2010-2011 Anil Madhavapeddy <[email protected]>
+ *
+ * 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 rec finalise_checksum cs =
+  assert (cs >= 0);
+  if cs < 0x10000 then
+    lnot cs land 0xffff
+  else
+    finalise_checksum ((cs land 0xffff) + (cs lsr 16))
+
+let ones_complement (buffer: Cstruct.t) =
+  let len = Cstruct.len buffer in
+  let rec do_checksum checksum offset =
+    if offset + 1 < len then (
+      let checksum = checksum + Cstruct.BE.get_uint16 buffer offset in
+      do_checksum checksum (offset + 2)
+    ) else if offset + 1 = len then (
+      let checksum = checksum + (Cstruct.get_uint8 buffer offset lsl 8) in
+      finalise_checksum checksum
+    ) else
+      finalise_checksum checksum
+  in
+  do_checksum 0 0
+
+let ones_complement_list buffers =
+  let rec do_checksum checksum offset len buffer buffers =
+    if offset + 1 < len then (
+      let checksum = checksum + Cstruct.BE.get_uint16 buffer offset in
+      do_checksum checksum (offset + 2) len buffer buffers
+    ) else (
+      let extra_single_byte = offset + 1 = len in
+      match buffers with
+      | [] ->
+        let checksum =
+          checksum +
+          if extra_single_byte then Cstruct.get_uint8 buffer offset lsl 8 else 0
+        in
+        finalise_checksum checksum
+      | next_buffer :: buffers ->
+        let checksum =
+          checksum +
+          if extra_single_byte
+            then Cstruct.get_uint8 next_buffer 0 + (Cstruct.get_uint8 buffer offset lsl 8)
+            else 0
+        in
+        let offset = if extra_single_byte then 1 else 0 in
+        let len = Cstruct.len next_buffer in
+        do_checksum checksum offset len next_buffer buffers
+    )
+  in
+  match buffers with
+  | buffer :: buffers ->
+    let len = Cstruct.len buffer in
+    do_checksum 0 0 len buffer buffers
+  | [] -> finalise_checksum 0

src/tcpip_checksum/unix/dune

@@ -0,0 +1,9 @@
+(library
+ (name tcpip_checksum_unix)
+ (public_name tcpip-checksum.unix)
+ (implements tcpip_checksum)
+ (c_names checksum_stubs))
+
+(copy_files# ../checksum_stubs.c)
+
+

src/tcpip_checksum/tcpip_checksum.ml → src/tcpip_checksum/unix/tcpip_checksum.ml

@@ -1,5 +1,5 @@
 (*
- * Copyright (c) 2010-2011 Anil Madhavapeddy <[email protected]>
+ * Copyright (c) 2010-2018 Anil Madhavapeddy <[email protected]>
  *
  * Permission to use, copy, modify, and distribute this software for any
  * purpose with or without fee is hereby granted, provided that the above
@@ -15,6 +15,7 @@
  *)
 
 (** One's complement checksum, RFC1071 *)
-external ones_complement: Cstruct.t -> int = "caml_tcpip_ones_complement_checksum"
 
+external ones_complement: Cstruct.t -> int = "caml_tcpip_ones_complement_checksum"
 external ones_complement_list: Cstruct.t list -> int = "caml_tcpip_ones_complement_checksum_list"
+

src/tcpip_checksum/xen/dune

@@ -0,0 +1,13 @@
+(library
+ (name tcpip_checksum_xen)
+ (public_name tcpip-checksum.xen)
+ (implements tcpip_checksum)
+ (c_names checksum_stubs)
+ (c_flags (:include c_flags_xen.sexp)))
+
+(rule
+ (targets c_flags_xen.sexp)
+ (deps ../../config/discover.exe)
+ (action (run %{deps})))
+
+(copy_files# ../checksum_stubs.c)

src/tcpip_checksum/xen/tcpip_checksum.ml

@@ -0,0 +1,21 @@
+(*
+ * Copyright (c) 2010-2018 Anil Madhavapeddy <[email protected]>
+ *
+ * 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.
+ *)
+
+(** One's complement checksum, RFC1071 *)
+
+external ones_complement: Cstruct.t -> int = "caml_tcpip_ones_complement_checksum"
+external ones_complement_list: Cstruct.t list -> int = "caml_tcpip_ones_complement_checksum_list"
+

src/udp/dune

@@ -1,7 +1,6 @@
 (library
  (name tcpip_udpv4)
  (public_name tcpip.udp)
- (libraries mirage-protocols-lwt mirage-random rresult logs tcpip randomconv)
- (preprocess
-  (pps ppx_cstruct))
+ (libraries   mirage-protocols-lwt mirage-random rresult logs tcpip-checksum randomconv)
+ (preprocess (pps ppx_cstruct))
  (wrapped false))

test/dune

@@ -1,15 +1,16 @@
 (executables
  (names test)
- (libraries alcotest mirage-random-test lwt.unix io-page-unix tcpip.unix logs
-   logs.fmt mirage-profile mirage-flow mirage-vnetif mirage-clock-unix
-   pcap-format duration mirage-random rresult mirage-protocols-lwt
-   mirage-stack-lwt arp arp-mirage ethernet tcpip.ipv4 tcpip.tcp tcpip.udp
-   tcpip.stack-direct tcpip.icmpv4 tcpip.udpv4-socket tcpip.tcpv4-socket
-   tcpip.icmpv4-socket tcpip.stack-socket tcpip.ipv6))
+ (libraries
+    alcotest mirage-random-test lwt.unix io-page-unix tcpip-checksum.unix
+    logs logs.fmt mirage-profile mirage-flow mirage-vnetif
+    mirage-clock-unix pcap-format duration mirage-random
+    rresult mirage-protocols-lwt mirage-stack-lwt
+    ethernet arp-mirage tcpip.ipv4 tcpip.tcp tcpip.udp
+    tcpip.stack-direct tcpip.icmpv4
+    tcpip.udpv4-socket tcpip.tcpv4-socket tcpip.icmpv4-socket
+    tcpip.stack-socket tcpip.ipv6))
 
 (alias
- (name runtest)
- (deps
-  (:< test.exe))
- (action
-  (run %{<} -q -e --color=always)))
+ (name    runtest)
+ (deps    test.exe)
+ (action (run %{deps} -q -e --color=always)))