Merge pull request #33 from MisterDA/updates

Dependencies update and CI

.github/workflows/main.yml

@@ -0,0 +1,36 @@
+name: Main workflow
+
+on:
+  pull_request:
+  push:
+  schedule:
+    # Prime the caches every Monday
+    - cron: 0 1 * * MON
+
+jobs:
+  build:
+    strategy:
+      fail-fast: false
+      matrix:
+        os:
+          - macos-latest
+          - windows-latest
+        ocaml-compiler:
+          - 4.13.x
+
+    runs-on: ${{ matrix.os }}
+
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v2
+
+      - name: Use OCaml ${{ matrix.ocaml-compiler }}
+        uses: ocaml/setup-ocaml@v2
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-compiler }}
+
+      - run: opam install . --deps-only --with-test
+
+      - run: opam exec -- dune build
+
+      - run: opam exec -- dune runtest

CHANGES.md

@@ -5,6 +5,8 @@
 - add package mirage-vnetif-stack to provide a preassembled ipv4 stack
 - add initial connect test for the vnetif-stack
 - clean up opam dependencies
+- drop mirage protocols and adapt to arp, ipaddr, tcpip interface
+  changes (#33 @MisterDA)
 
 ### v0.5.0 (2019-10-30)
 

examples/iperf_self/iperf_self.ml

@@ -129,7 +129,7 @@ module Main (C : Mirage_types_lwt.CONSOLE) = struct
           S.T.close flow >>= fun () ->
           C.log_s c "Iperf server: Done - closed connection."
       | `Ok data -> begin
-          let l = Cstruct.len data in
+          let l = Cstruct.length data in
           st.bytes <- (Int64.add st.bytes (Int64.of_int l));
           st.packets <- (Int64.add st.packets 1L);
           st.bin_bytes <- (Int64.add st.bin_bytes (Int64.of_int l));

examples/iperf_vnetif/iperf_vnetif.ml

@@ -85,7 +85,7 @@ module Main (C : Mirage_types_lwt.CONSOLE) = struct
     let enough_data, enough_data_waker = Lwt.wait () in
     Lwt.choose [
        V.listen s (fun data -> 
-            let l = Cstruct.len data in
+            let l = Cstruct.length data in
             st.bytes <- (Int64.add st.bytes (Int64.of_int l));
             st.packets <- (Int64.add st.packets 1L);
             st.bin_bytes <- (Int64.add st.bin_bytes (Int64.of_int l));

mirage-vnetif-stack.opam

@@ -16,29 +16,27 @@ build: [
 
 depends: [
   "ocaml" {>= "4.06.0"}
-  "dune"  {>= "1.0"}
+  "dune"  {>= "1.9"}
+  "result" {>= "1.5"}
   "lwt"
   "mirage-time" {>= "2.0.0"}
   "mirage-clock" {>= "3.0.0"}
   "mirage-net" {>= "3.0.0"}
   "mirage-random"
-  "mirage-stack"
   "mirage-vnetif" {= version}
-  "tcpip"
+  "tcpip" {>= "7.0.0"}
   "ethernet"
-  "arp"
-  "cstruct" {>="2.4.0"}
-  "ipaddr" {>= "3.0.0"}
+  "cstruct" {>="6.0.0"}
+  "ipaddr" {>= "5.0.0"}
   "macaddr"
   "mirage-profile"
-  "arp"
-  "arp-mirage"
+  "arp" {>= "3.0.0"}
   "duration"
   "logs"
   "mirage-time-unix" {with-test}
   "mirage-clock-unix" {with-test}
   "mirage-random-test" {with-test}
-  "alcotest" {with-test}
+  "alcotest" {>= "1.5.0" & with-test}
   "alcotest-lwt" {with-test}
 ]
 tags: ["org:mirage"]

mirage-vnetif.opam

@@ -15,10 +15,11 @@ build: [
 
 depends: [
   "ocaml" {>= "4.06.0"}
-  "dune"  {>= "1.0"}
+  "dune"  {>= "1.9"}
+  "result" {>= "1.5"}
   "lwt"
   "mirage-net" {>= "3.0.0"}
-  "cstruct" {>="2.4.0"}
+  "cstruct" {>="6.0.0"}
   "ipaddr" {>= "3.0.0"}
   "macaddr"
   "mirage-profile"

src/vnetif-stack/dune

@@ -4,8 +4,7 @@
  (modules vnetif_stack)
  (wrapped false)
  (libraries cstruct lwt lwt.unix mirage-clock ipaddr macaddr mirage-profile
-   duration result mirage-time mirage-net mirage-random mirage-stack
-   ethernet arp arp-mirage logs mirage-protocols tcpip.stack-direct
-   tcpip.ipv4 tcpip.icmpv4 tcpip.tcp tcpip.udp
+   duration result mirage-time mirage-net mirage-random ethernet arp arp.mirage
+   logs tcpip.stack-direct tcpip.ipv4 tcpip.icmpv4 tcpip.tcp tcpip.udp
    mirage-vnetif
    ))

src/vnetif-stack/vnetif_stack.ml

@@ -22,11 +22,11 @@ sig
   type buffer
   type 'a io
   type id
-  module V4 : Mirage_stack.V4
+  module V4 : Tcpip.Stack.V4
   module Backend : Vnetif.BACKEND
 
   (** Create a new IPv4 stack connected to an existing backend *)
-  val create_stack_ipv4 : ip:(Ipaddr.V4.Prefix.t * Ipaddr.V4.t) ->
+  val create_stack_ipv4 : cidr:Ipaddr.V4.Prefix.t ->
     ?gateway:Ipaddr.V4.t -> ?mtu:int -> ?monitor_fn:(buffer -> unit io) ->
     ?unlock_on_listen:Lwt_mutex.t ->
     backend -> V4.t Lwt.t
@@ -50,11 +50,11 @@ struct
   module T = Tcp.Flow.Make(Ip)(Time)(Mclock)(R)
   module V4 = Tcpip_stack_direct.Make(Time)(R)(V)(E)(A)(Ip)(Icmp)(U)(T)
 
-  let create_stack_ipv4 ~ip ?gateway ?mtu ?monitor_fn ?unlock_on_listen backend =
+  let create_stack_ipv4 ~cidr ?gateway ?mtu ?monitor_fn ?unlock_on_listen backend =
     V.connect ?size_limit:mtu ?monitor_fn ?unlock_on_listen backend >>= fun netif ->
     E.connect netif >>= fun ethif ->
     A.connect ethif >>= fun arp ->
-    Ip.connect ~ip ?gateway ethif arp >>= fun ipv4 ->
+    Ip.connect ~cidr ?gateway ethif arp >>= fun ipv4 ->
     Icmp.connect ipv4 >>= fun icmp ->
     U.connect ipv4 >>= fun udp ->
     T.connect ipv4 >>= fun tcp ->

src/vnetif/basic_backend.ml

@@ -118,7 +118,7 @@ module Make = struct
         Hashtbl.replace t.listeners id fn
 
     let buffer_copy src =
-        let len = Cstruct.len src in
+        let len = Cstruct.length src in
         let dst = Cstruct.create len in
         Cstruct.blit src 0 dst 0 len;
         dst

src/vnetif/vnetif.ml

@@ -95,7 +95,7 @@ module Make (B : BACKEND) = struct
   let listen t ~header_size:_ fn =
     (* Add counters to the listener function *)
     let listener t fn buf =
-      t.stats.rx_bytes <- Int64.add (Int64.of_int (Cstruct.len buf)) (t.stats.rx_bytes);
+      t.stats.rx_bytes <- Int64.add (Int64.of_int (Cstruct.length buf)) (t.stats.rx_bytes);
       t.stats.rx_pkts <- Int32.succ t.stats.rx_pkts;
       fn buf
     in

test/vnetif-stack/dune

@@ -1,10 +1,6 @@
-(executables
-    (names test)
-    (libraries lwt alcotest alcotest-lwt mirage-vnetif mirage-vnetif-stack mirage-random-test mirage-clock-unix mirage-time-unix))
-
-(alias
-    (name runtest)
-    (deps
-        (:< test.exe))
+(test
+    (name test)
+    (package mirage-vnetif-stack)
+    (libraries lwt alcotest alcotest-lwt mirage-vnetif mirage-vnetif-stack mirage-random-test mirage-clock-unix mirage-time-unix)
     (action
-        (run %{<} -v -e --color=always)))
+        (run %{test} -v -e --color=always)))

test/vnetif-stack/test.ml

@@ -21,33 +21,31 @@ module Stack(B: Vnetif.BACKEND) = struct
   include V
 end
 
-let failf fmt = Fmt.kstr Alcotest.fail fmt
-
 let connect_test_lwt _ () =
   let module Backend = Basic_backend.Make in
   let module Stack = Stack(Backend) in
-  let backend = Backend.create ~use_async_readers:true ~yield:Lwt_main.yield () in
+  let backend = Backend.create ~use_async_readers:true ~yield:Lwt.pause () in
 
   let test_msg = "This is a connect test. ABCDEFGHIJKLMNOPQRSTUVWXYZ" in
 
   let or_error name fn t =
     fn t >>= function
-    | Error e -> failf "%s: %s" name (Format.asprintf "%a" Stack.V4.TCPV4.pp_error e)
+    | Error e -> Alcotest.failf "%s: %s" name (Format.asprintf "%a" Stack.V4.TCPV4.pp_error e)
     | Ok t    -> Lwt.return t
   in
 
   let accept client_l flow expected =
     or_error "read" Stack.V4.TCPV4.read flow >>= function
-    | `Eof -> failf "eof while reading from socket"
-    | `Data data -> 
+    | `Eof -> Alcotest.failf "eof while reading from socket"
+    | `Data data ->
         let recv_str = Cstruct.to_string data in
         Alcotest.(check string) "server and client strings matched" expected recv_str;
         Lwt_mutex.unlock client_l;
         Lwt.return_unit
   in
 
-  let client_ip = Ipaddr.V4.Prefix.of_address_string_exn "10.0.0.10/24" in
-  let server_ip = Ipaddr.V4.Prefix.of_address_string_exn "10.0.0.11/24" in
+  let client_cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.10/24" in
+  let server_cidr = Ipaddr.V4.Prefix.of_string_exn "10.0.0.11/24" in
 
   let timeout_in_s = 5 in
 
@@ -60,21 +58,21 @@ let connect_test_lwt _ () =
       Lwt.pick [
           (* Cancellation timer *)
           (Time.sleep_ns (Duration.of_sec timeout_in_s) >>= fun () ->
-          failf "timeout: test timed out after %d seconds" timeout_in_s);
+          Alcotest.failf "timeout: test timed out after %d seconds" timeout_in_s);
 
           (* Server side *)
-          (Stack.create_stack_ipv4 ~ip:server_ip ~unlock_on_listen:listen_l backend >>= fun s1 ->
-          Stack.V4.listen_tcpv4 s1 ~port:80 (fun f -> accept accept_l f test_msg);
+          (Stack.create_stack_ipv4 ~cidr:server_cidr ~unlock_on_listen:listen_l backend >>= fun s1 ->
+          Stack.V4.TCPV4.listen (Stack.V4.tcpv4 s1) ~port:80 (fun f -> accept accept_l f test_msg);
           Stack.V4.listen s1 >>= fun () ->
-          failf "server: listen should never exit");
+          Alcotest.failf "server: listen should never exit");
 
           (* Client side *)
           Lwt_mutex.lock listen_l >>= fun () -> (* wait for server to unlock with call to listen *)
-          Stack.create_stack_ipv4 ~ip:client_ip backend >>= fun s2 ->
-          or_error "connect" (Stack.V4.TCPV4.create_connection (Stack.V4.tcpv4 s2)) (snd server_ip, 80) >>= fun flow -> 
+          Stack.create_stack_ipv4 ~cidr:client_cidr backend >>= fun s2 ->
+          or_error "connect" (Stack.V4.TCPV4.create_connection (Stack.V4.tcpv4 s2)) (Ipaddr.V4.Prefix.address server_cidr, 80) >>= fun flow ->
           Stack.V4.TCPV4.write flow (Cstruct.of_string test_msg) >>= (function
               | Ok () -> Lwt.return_unit
-              | Error e -> failf "write: %s" (Format.asprintf "%a" Stack.V4.TCPV4.pp_write_error e))
+              | Error e -> Alcotest.failf "write: %s" (Format.asprintf "%a" Stack.V4.TCPV4.pp_write_error e))
           >>= fun () ->
           Stack.V4.TCPV4.close flow >>= fun () ->
           Lwt_mutex.lock accept_l (* wait for accept to unlock *)
@@ -84,7 +82,7 @@ let connect_test_lwt _ () =
  )
 
 let () =
-  let rand_seed = 0 in 
+  let rand_seed = 0 in
   Random.init rand_seed;
   Printf.printf "Testing with rand_seed %d\n" rand_seed;