end-to-end testing shell scripts

.github/workflows/e2e.yml

@@ -0,0 +1,56 @@
+name: End-to-end interoperability testing
+
+on: [pull_request]
+
+jobs:
+  tests:
+    name: End-to-end test
+
+    strategy:
+      fail-fast: false
+      matrix:
+        ocaml-version: ["4.14.2"]
+        operating-system: [ubuntu-latest]
+
+    runs-on: ${{ matrix.operating-system }}
+
+    steps:
+      - name: Checkout code
+        uses: actions/checkout@v2
+
+      - name: Use OCaml ${{ matrix.ocaml-version }}
+        uses: ocaml/setup-ocaml@v2
+        with:
+          ocaml-compiler: ${{ matrix.ocaml-version }}
+
+      - name: Install openvpn
+        run: sudo apt install -y openvpn
+
+      - name: Install dependencies
+        run: |
+          opam install --deps-only -t .
+          opam install bisect_ppx
+
+      - name: Build
+        run: opam exec -- dune build --instrument-with bisect_ppx @all
+
+      - name: Testing
+        run: |
+          opam exec -- dune runtest --instrument-with bisect_ppx
+          opam exec -- dune exec bench/bench_engine.exe
+          sudo ip tuntap add mode tun e2e-test
+          ( cd test/e2e && sudo ./test-client.sh e2e-test; )
+          ( cd test/e2e && sudo ./test-server.sh e2e-test; )
+          echo '```' > code-coverage-results.md
+          opam exec -- ./coverage.sh >> code-coverage-results.md
+          echo '```' >> code-coverage-results.md
+
+      - name: Add Coverage PR Comment
+        uses: marocchino/sticky-pull-request-comment@v2
+        if: github.event_name == 'pull_request'
+        with:
+          recreate: true
+          path: code-coverage-results.md
+
+      - name: Write to Job Summary
+        run: cat code-coverage-results.md >> $GITHUB_STEP_SUMMARY

app/miragevpn_client_notun.ml

@@ -11,10 +11,6 @@ let ticker () =
   let+ () = Lwt_unix.sleep 1. in
   `Tick
 
-let pinger () =
-  let+ () = Lwt_unix.sleep 1. in
-  `Ping
-
 let resolve (name, ip_version) =
   let happy_eyeballs = Happy_eyeballs_lwt.create () in
   let res = Dns_client_lwt.create happy_eyeballs in
@@ -64,12 +60,12 @@ let event k (tick : [ `Tick ] Lwt.t) client actions ev =
       k tick client (actions @ new_actions)
 
 let mk_ifconfig (ip_config, mtu, _routes) =
-  { ip_config; mtu; ping = pinger (); seq_no = 0 }
+  { ip_config; mtu; ping = Lwt.return `Ping; seq_no = 0 }
 
 let ping_payload =
   Cstruct.of_string "never gonna give you up\nnever gonna let you down\nlalala!"
 
-let ping ({ ip_config; seq_no; mtu = _; ping = _ } as ifconfig) =
+let send_ping ({ ip_config; seq_no; mtu = _; ping = _ } as ifconfig) =
   let ping =
     {
       Icmpv4_packet.code = 0;
@@ -145,7 +141,7 @@ let pong { ip_config; _ } buf =
       m "Received ICMPv4 payload %d bytes" (Cstruct.length buf));
   (id, seq_no)
 
-let rec established_action proto fd incoming ifconfig tick client actions =
+let rec established_action test proto fd incoming ifconfig tick client actions =
   let action, actions =
     match actions with
     | action :: actions -> ((action :> action), actions)
@@ -166,35 +162,40 @@ let rec established_action proto fd incoming ifconfig tick client actions =
       | `Data _ as ev ->
           let incoming = Common.receive proto fd in
           event
-            (established_action proto fd incoming ifconfig)
+            (established_action test proto fd incoming ifconfig)
             tick client actions ev
       | `Connection_failed as ev ->
-          event connecting_action tick client actions ev
+          event (connecting_action test) tick client actions ev
       | #Miragevpn.event as ev ->
           event
-            (established_action proto fd incoming ifconfig)
+            (established_action test proto fd incoming ifconfig)
             tick client actions ev
       | `Ping -> (
           Logs.app (fun m -> m "Sending ping icmp_seq=%d..." ifconfig.seq_no);
-          let ifconfig = { ifconfig with ping = pinger () } in
-          let ifconfig, data = ping ifconfig in
+          let ping =
+            let+ () = Lwt_unix.sleep 1. in
+            `Ping
+          in
+          let ifconfig = { ifconfig with ping } in
+          let ifconfig, data = send_ping ifconfig in
           match Miragevpn.outgoing client data with
           | Ok (client, data) ->
-              established_action proto fd incoming ifconfig tick client
+              established_action test proto fd incoming ifconfig tick client
                 (`Transmit data :: actions)
           | Error `Not_ready ->
               Logs.warn (fun m ->
                   m
                     "Trying to ping when miragevpn state machine is not ready; \
                      this should never happen");
-              established_action proto fd incoming ifconfig tick client actions)
-      )
+              established_action test proto fd incoming ifconfig tick client
+                actions))
   | `Payload data ->
       (match pong ifconfig data with
       | Ok (_id, seq_no) ->
-          Logs.app (fun m -> m "Received pong icmp_seq=%d" seq_no)
+          Logs.app (fun m -> m "Received pong icmp_seq=%d" seq_no);
+          if test then exit 0
       | Error msg -> Logs.app (fun m -> m "Received unexpected data: %s" msg));
-      established_action proto fd incoming ifconfig tick client actions
+      established_action test proto fd incoming ifconfig tick client actions
   | `Exit -> Lwt_result.fail (`Msg "Exiting due to Miragevpn engine exit")
   | `Transmit data ->
       let* r = Common.transmit proto fd data in
@@ -203,7 +204,7 @@ let rec established_action proto fd incoming ifconfig tick client actions =
       | Error (`Msg e) ->
           Logs.err (fun m -> m "transmit error: %s" e);
           exit 3);
-      established_action proto fd incoming ifconfig tick client actions
+      established_action test proto fd incoming ifconfig tick client actions
   | `Established _ ->
       Logs.err (fun m -> m "Unexpected action %a" pp_action action);
       assert false
@@ -213,9 +214,9 @@ let rec established_action proto fd incoming ifconfig tick client actions =
       exit 0
   | (`Connect _ | `Resolve _) as action ->
       let* () = Common.safe_close fd in
-      connecting_action tick client (action :: actions)
+      connecting_action test tick client (action :: actions)
 
-and connected_action proto fd incoming tick client actions =
+and connected_action test proto fd incoming tick client actions =
   let action, actions =
     match actions with
     | action :: actions -> ((action :> action), actions)
@@ -233,16 +234,16 @@ and connected_action proto fd incoming tick client actions =
       in
       let k =
         match ev with
-        | `Data _ -> connected_action proto fd (Common.receive proto fd)
-        | `Connection_failed -> connecting_action
-        | _ -> connected_action proto fd incoming
+        | `Data _ -> connected_action test proto fd (Common.receive proto fd)
+        | `Connection_failed -> connecting_action test
+        | _ -> connected_action test proto fd incoming
       in
       event k tick client actions (ev :> Miragevpn.event)
   | `Established ((ip, _, _) as ifconfig) ->
       Logs.info (fun m ->
           m "Connection established! %a" Miragevpn.pp_ip_config ip);
       let ifconfig = mk_ifconfig ifconfig in
-      established_action proto fd incoming ifconfig tick client actions
+      established_action test proto fd incoming ifconfig tick client actions
   | `Exit -> Lwt_result.fail (`Msg "Exiting due to Miragevpn engine exit")
   | `Transmit data ->
       let* r = Common.transmit proto fd data in
@@ -251,7 +252,7 @@ and connected_action proto fd incoming tick client actions =
       | Error (`Msg e) ->
           Logs.err (fun m -> m "transmit error: %s" e);
           exit 3);
-      connected_action proto fd incoming tick client actions
+      connected_action test proto fd incoming tick client actions
   | `Payload _ ->
       Logs.err (fun m -> m "Unexpected action %a" pp_action action);
       assert false
@@ -262,9 +263,9 @@ and connected_action proto fd incoming tick client actions =
       exit 0
   | (`Connect _ | `Resolve _) as action ->
       let* () = Common.safe_close fd in
-      connecting_action tick client (action :: actions)
+      connecting_action test tick client (action :: actions)
 
-and connecting_action tick client actions =
+and connecting_action test tick client actions =
   let action, actions =
     match actions with
     | action :: actions -> (action, actions)
@@ -274,10 +275,10 @@ and connecting_action tick client actions =
   match action with
   | `Suspend ->
       let* `Tick = tick in
-      event connecting_action tick client actions `Tick
+      event (connecting_action test) tick client actions `Tick
   | `Resolve data ->
       let* ev = resolve data in
-      event connecting_action tick client actions ev
+      event (connecting_action test) tick client actions ev
   | `Connect (addr, port, proto) ->
       let dom =
         Ipaddr.(Lwt_unix.(match addr with V4 _ -> PF_INET | V6 _ -> PF_INET6))
@@ -292,13 +293,13 @@ and connecting_action tick client actions =
             let+ () = Lwt_unix.connect fd (ADDR_INET (unix_ip, port)) in
             Logs.app (fun m -> m "Connected to %a:%d" Ipaddr.pp addr port);
             let incoming = Common.receive proto fd in
-            (`Connected, connected_action proto fd incoming))
+            (`Connected, connected_action test proto fd incoming))
           (fun e ->
             Logs.err (fun m ->
                 m "error %s while connecting to %a:%d" (Printexc.to_string e)
                   Ipaddr.pp addr port);
             let+ () = Common.safe_close fd in
-            (`Connection_failed, connecting_action))
+            (`Connection_failed, connecting_action test))
       in
       let* ev, k = connect in
       event k tick client actions ev
@@ -310,7 +311,7 @@ and connecting_action tick client actions =
       Logs.err (fun m -> m "Unexpected action %a" pp_action action);
       assert false
 
-let establish_tunnel config pkcs12_password =
+let establish_tunnel config pkcs12_password test =
   let ts () = Mtime.Span.to_uint64_ns (Mtime_clock.elapsed ())
   and now = Ptime_clock.now
   and rng = Mirage_crypto_rng.generate in
@@ -323,7 +324,7 @@ let establish_tunnel config pkcs12_password =
         let+ () = Lwt_unix.sleep 1. in
         `Tick
       in
-      connecting_action tick client [ (action :> action) ]
+      connecting_action test tick client [ (action :> action) ]
 
 let parse_config filename =
   Lwt.return
@@ -334,20 +335,24 @@ let parse_config filename =
   | Ok str -> Miragevpn.Config.parse_client ~string_of_file str
   | Error _ as e -> e
 
-let jump _ filename pkcs12 =
+let jump _ filename pkcs12 test =
   Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
   Lwt_main.run
     (let* config = parse_config filename in
      match config with
      | Error (`Msg s) -> failwith ("config parser: " ^ s)
-     | Ok config -> establish_tunnel config pkcs12)
+     | Ok config -> establish_tunnel config pkcs12 test)
 
 open Cmdliner
 
 let config =
   let doc = "Configuration file to use" in
   Arg.(required & pos 0 (some file) None & info [] ~doc ~docv:"CONFIG")
 
+let test =
+  let doc = "Testing mode: exit with exit code 0 upon receiving echo reply" in
+  Arg.(value & flag & info [ "test" ] ~doc)
+
 let pkcs12 =
   let doc = "PKCS12 password" in
   Arg.(
@@ -357,7 +362,7 @@ let pkcs12 =
 
 let cmd =
   let term =
-    Term.(term_result (const jump $ Common.setup_log $ config $ pkcs12))
+    Term.(term_result (const jump $ Common.setup_log $ config $ pkcs12 $ test))
   and info = Cmd.info "miragevpn_client" ~version:"%%VERSION_NUM%%" in
   Cmd.v info term
 

app/miragevpn_server_notun.ml

@@ -7,6 +7,7 @@ type t = {
   server : Miragevpn.server;
   ip : Ipaddr.V4.t * Ipaddr.V4.Prefix.t;
   connections : (Ipaddr.V4.t, Lwt_unix.file_descr * Miragevpn.t ref) Hashtbl.t;
+  test : bool;
 }
 
 let pp_dst ppf (dst, port) = Fmt.pf ppf "%a:%u" Ipaddr.pp dst port
@@ -59,18 +60,40 @@ let handle_payload t dst source_ip data =
       match Icmpv4_packet.Unmarshal.of_cstruct payload with
       | Ok (({ ty = Icmpv4_wire.Echo_request; _ } as icmp), payload) ->
           (* XXX(reynir): also check code = 0?! *)
-          let reply = { icmp with Icmpv4_packet.ty = Icmpv4_wire.Echo_reply }
-          and ip' = { ip with src = ip.dst; dst = ip.src } in
-          let data =
-            Cstruct.append
-              (Icmpv4_packet.Marshal.make_cstruct ~payload reply)
-              payload
+          let* () =
+            let reply = { icmp with Icmpv4_packet.ty = Icmpv4_wire.Echo_reply }
+            and ip' = { ip with src = ip.dst; dst = ip.src } in
+            let data =
+              Cstruct.append
+                (Icmpv4_packet.Marshal.make_cstruct ~payload reply)
+                payload
+            in
+            let hdr =
+              Ipv4_packet.Marshal.make_cstruct
+                ~payload_len:(Cstruct.length data) ip'
+            in
+            write t ip.src (Cstruct.append hdr data)
           in
-          let hdr =
-            Ipv4_packet.Marshal.make_cstruct ~payload_len:(Cstruct.length data)
-              ip'
-          in
-          write t ip.src (Cstruct.append hdr data)
+          if t.test then (
+            Logs.app (fun m ->
+                m "Received echo request from %a" Ipaddr.V4.pp source_ip);
+            let client_fd, client = Hashtbl.find t.connections source_ip in
+            match Miragevpn.send_control_message !client "HALT" with
+            | Error `Not_ready ->
+                Logs.warn (fun m -> m "Failed to send HALT to client");
+                exit 0
+            | Ok (client', datas) ->
+                Logs.app (fun m -> m "Sending HALT to client");
+                client := client';
+                let* () =
+                  Lwt_list.iter_s
+                    (fun data ->
+                      let+ _ = Common.write_to_fd client_fd data in
+                      ())
+                    datas
+                in
+                exit 0)
+          else Lwt.return_unit
       | Ok (icmp, _payload) ->
           Logs.warn (fun m ->
               m "ignoring icmp frame from %a: %a" Ipaddr.V4.pp ip.src
@@ -264,7 +287,7 @@ let callback t fd =
           let client_state = ref t in
           handle client_state out payloads action)
 
-let connect config =
+let connect config test =
   let open Lwt.Infix in
   let connections = Hashtbl.create 7 in
   let is_not_taken ip = not (Hashtbl.mem connections ip) in
@@ -283,7 +306,7 @@ let connect config =
           m "miragevpn server listening on port %d, using %a/%d" port
             Ipaddr.V4.pp (fst ip)
             (Ipaddr.V4.Prefix.bits (snd ip)));
-      let server = { config; server; ip; connections } in
+      let server = { config; server; ip; connections; test } in
       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);
@@ -310,22 +333,26 @@ let parse_config filename =
   | Ok str -> Miragevpn.Config.parse_server ~string_of_file str
   | Error _ as e -> e
 
-let jump _ filename =
+let jump _ filename test =
   Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna);
   Lwt_main.run
     (let* config = parse_config filename in
      match config with
      | Error (`Msg s) -> Lwt.return (Error (`Msg ("config parser: " ^ s)))
-     | Ok config -> connect config)
+     | Ok config -> connect config test)
 
 open Cmdliner
 
 let config =
   let doc = "Configuration file to use" in
   Arg.(required & pos 0 (some file) None & info [] ~doc ~docv:"CONFIG")
 
+let test =
+  let doc = "Testing mode: exit with exit code 0 upon receiving echo request" in
+  Arg.(value & flag & info [ "test" ] ~doc)
+
 let cmd =
-  let term = Term.(term_result (const jump $ Common.setup_log $ config))
+  let term = Term.(term_result (const jump $ Common.setup_log $ config $ test))
   and info = Cmd.info "miragevpn_server_notun" ~version:"%%VERSION_NUM%%" in
   Cmd.v info term