Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Dependencies update and CI #33

Merged
merged 6 commits into from
Jan 12, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
36 changes: 36 additions & 0 deletions .github/workflows/main.yml
Original file line number Diff line number Diff line change
@@ -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
16 changes: 0 additions & 16 deletions .travis.yml

This file was deleted.

2 changes: 2 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
2 changes: 1 addition & 1 deletion examples/iperf_self/iperf_self.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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));
Expand Down
2 changes: 1 addition & 1 deletion examples/iperf_vnetif/iperf_vnetif.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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));
Expand Down
16 changes: 7 additions & 9 deletions mirage-vnetif-stack.opam
Original file line number Diff line number Diff line change
Expand Up @@ -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"]
Expand Down
5 changes: 3 additions & 2 deletions mirage-vnetif.opam
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
5 changes: 2 additions & 3 deletions src/vnetif-stack/dune
Original file line number Diff line number Diff line change
Expand Up @@ -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
))
8 changes: 4 additions & 4 deletions src/vnetif-stack/vnetif_stack.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 ->
Expand Down
2 changes: 1 addition & 1 deletion src/vnetif/basic_backend.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/vnetif/vnetif.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
14 changes: 5 additions & 9 deletions test/vnetif-stack/dune
Original file line number Diff line number Diff line change
@@ -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)))
30 changes: 14 additions & 16 deletions test/vnetif-stack/test.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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 *)
Expand All @@ -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;

Expand Down