Merge branch 'dunify-with-variants' of https://github.com/avsm/mirage…

…-tcpip into avsm-dunify-with-variants

CHANGES.md

@@ -1,3 +1,11 @@
+### dev
+
+* Use Dune 1.7 virtual libraries to cleanup the stub compilation
+  of checksums. (@avsm).
+
+* Include a pure OCaml implementation of checksumming for easier JavaScript
+  compilationm (#383 by @copy)
+
 ### v3.7.0 (2019-02-02)
 
 * Use `Lwt_dllist` instead of `Lwt_sequence`, due to the latter being deprecated

Makefile

@@ -1,12 +1,15 @@
 
-.PHONY: build clean test
+.PHONY: build clean test doc install uninstall
 
 build:
 	dune build
 
 test:
 	dune runtest
 
+doc:
+	dune build @doc
+
 install:
 	dune install
 

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/arpv4/dune

@@ -0,0 +1,6 @@
+(library
+ (name        tcpip_arpv4)
+ (public_name tcpip.arpv4)
+ (libraries   mirage-protocols-lwt logs ipaddr macaddr cstruct rresult tcpip.ethif duration fmt mirage-clock-lwt mirage-time-lwt)
+ (preprocess (pps ppx_cstruct))
+ (wrapped false))

src/config/discover.ml

@@ -1,9 +1,4 @@
-open Base
-open Stdio
-module C = Configurator
-
-let write_sexp fn sexp =
-  Out_channel.write_all fn ~data:(Sexp.to_string sexp)
+module C = Configurator.V1
 
 let () =
   (* Extend the pkg-config path rather than overwriting it.
@@ -13,7 +8,7 @@ let () =
   let combined = prepend ^ onto in
   if not(String.equal combined "") then Unix.putenv "PKG_CONFIG_PATH" combined;
 
-  C.main ~name:"mirage-xen-ocaml" (fun c ->
+  C.main ~name:"mirage-tcpip" (fun c ->
     let default : C.Pkg_config.package_conf =
       { libs   = []
       ; cflags = []
@@ -22,8 +17,11 @@ let () =
     let conf =
       match C.Pkg_config.get c with
       | None -> default
-      | Some pc ->
-        Option.value (C.Pkg_config.query pc ~package:"mirage-xen-ocaml") ~default
+      | Some pc -> begin
+        match C.Pkg_config.query pc ~package:"mirage-xen-ocaml" with
+        | None -> default
+        | Some v -> v
+      end
     in
 
-    write_sexp "c_flags_xen.sexp" (sexp_of_list sexp_of_string conf.cflags))
+    C.Flags.write_sexp "c_flags_xen.sexp" conf.cflags)

src/config/dune

@@ -1,3 +1,3 @@
 (executable
  (name discover)
- (libraries base stdio configurator))
+ (libraries dune.configurator))

src/ethif/dune

@@ -0,0 +1,7 @@
+(library
+ (name        tcpip_ethif)
+ (public_name tcpip.ethif)
+ (libraries   mirage-net-lwt mirage-protocols-lwt rresult logs mirage-profile)
+ (preprocess (pps ppx_cstruct))
+ (wrapped false))
+

src/icmp/dune

@@ -1,7 +1,6 @@
 (library
- (name tcpip_icmpv4)
+ (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/stack-unix/dune

@@ -49,6 +49,16 @@
  (public_name tcpip.stack-socket)
  (modules tcpip_stack_socket ipv4_socket ipv6_socket)
  (wrapped false)
- (libraries lwt.unix cstruct-lwt ipaddr.unix io-page-unix logs
-   tcpip.tcpv4-socket tcpip.udpv4-socket tcpip.ipv4 tcpip.ipv6 tcpip.icmpv4
-   mirage-protocols-lwt mirage-stack-lwt))
+ (libraries
+   lwt.unix
+    cstruct-lwt
+    ipaddr.unix
+    io-page-unix
+    logs
+    tcpip.tcpv4-socket
+    tcpip.udpv4-socket
+    tcpip.ipv4
+    tcpip.ipv6
+    tcpip.icmpv4
+    mirage-protocols-lwt
+    mirage-stack-lwt))

src/tcp/dune

@@ -1,8 +1,8 @@
 (library
- (name tcp)
+ (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)
+(library 
+ (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)
+ (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))

tcpip.opam

@@ -19,8 +19,7 @@ build: [
 ]
 
 depends: [
-  "dune"     {build & >= "1.0"}
-  "configurator" {build}
+  "dune"     {build & >= "1.7"}
   "ocaml" {>= "4.03.0"}
   "rresult" {>= "0.5.0"}
   "cstruct" {>= "3.0.2"}

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
+    tcpip.ethif tcpip.arpv4 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)))