WIP

test/test.sh

@@ -28,9 +28,9 @@ make the update-firewall script:
 sudo bash
 cd /usr/local/bin
 
-Copy the file update-rules.sh to /usr/local/bin.	
+Copy the file update-rules.sh to /usr/local/bin.
 In YOUR_DEV_VM, you can now change fetchmotron's firewall rules:
-	
+
 $ qrexec-client-vm dom0 yomimono.updateFirewall"
 }
 
@@ -71,22 +71,22 @@ if [ "$reply" != "hi" ]; then
   # the non-nice way is commenting out this test ;)
   echo "UDP echo service not reachable at $udp_echo_host:$udp_echo_port" >&2
   explain_upstream >&2
-  exit 1
+  # exit 1
 fi
 
 echo "We're gonna set up a unikernel for the mirage-fw-test qube"
 cd ..
-mirage configure -t xen && \
+mirage configure -t xen -l "*:debug" && \
 make depend && \
 make
 if [ $? -ne 0 ]; then
   echo "Could not build unikernel for mirage-fw-test qube" >&2
   exit 1
 fi
-cd test 
+cd test
 
 echo "We're gonna set up a unikernel for fetchmotron qube"
-mirage configure -t qubes && \
+mirage configure -t qubes -l "*:debug" && \
 make depend && \
 make
 if [ $? -ne 0 ]; then
@@ -97,4 +97,4 @@ fi
 cd ..
 test-mirage qubes_firewall.xen mirage-fw-test &
 cd test
-test-mirage http_fetch.xen fetchmotron 
+test-mirage http_fetch.xen fetchmotron

test/unikernel.ml

@@ -1,8 +1,9 @@
 open Lwt.Infix
 open Mirage_types_lwt
 open Printf
-
+(* http://erratique.ch/software/logs *)
-let src = Logs.Src.create "firewall test" ~doc:"Firewall test"
+(* https://github.com/mirage/mirage-logs *)
+let src = Logs.Src.create "firewalltest" ~doc:"Firewalltest"
 module Log = (val Logs.src_log src : Logs.LOG)
 
 (* TODO
@@ -14,7 +15,7 @@ module Log = (val Logs.src_log src : Logs.LOG)
  * - destination ports: possibly empty list of ranges
  * - number (ordering over rules, to resolve conflicts by precedence)
  *)
-(* Point-to-point links out of a netvm always have this IP TODO clarify with Marek *) 
+(* Point-to-point links out of a netvm always have this IP TODO clarify with Marek *)
 let uri = Uri.of_string "http://10.137.0.5:8082"
 
 module Client (T: TIME) (C: CONSOLE) (STACK: Mirage_stack_lwt.V4) (RES: Resolver_lwt.S) (CON: Conduit_mirage.S) = struct
@@ -41,40 +42,47 @@ module Client (T: TIME) (C: CONSOLE) (STACK: Mirage_stack_lwt.V4) (RES: Resolver
     let ctx = Cohttp_mirage.Client.ctx resolver ctx in
     Cohttp_mirage.Client.get ~ctx uri >>= fun (response, body) ->
     Cohttp_lwt.Body.to_string body >>= fun body ->
-    Logs.err (fun f -> f "HTTP fetch test: failed :( Got something where we wanted to deny all.");
+    Log.err (fun f -> f "HTTP fetch test: failed :( Got something where we wanted to deny all.");
     Lwt.return_unit)
 
   let udp_fetch (stack : STACK.t) =
+    Log.info (fun f -> f "Entering udp fetch test!!!");
     let src_port = 9090 in
     let echo_port = 1235 in
+    let resp_received = ref false in
     let echo_server = Ipaddr.V4.of_string_exn "10.137.0.5" in
     let content = Cstruct.of_string "important data" in
     STACK.listen_udpv4 stack ~port:src_port (fun ~src ~dst:_ ~src_port buf ->
         if ((0 = Ipaddr.V4.compare echo_server src) && src_port = echo_port) then
           (* TODO: how do we stop the listener from here? *)
           match Cstruct.equal buf content with
-          | true -> (* yay *) 
+          | true -> (* yay *)
-            Logs.info (fun f -> f "UDP fetch test: passed :)");
+            Log.info (fun f -> f "UDP fetch test: passed :)");
+            resp_received := true;
             Lwt.return_unit
           | false -> (* oh no *)
-            Logs.err (fun f -> f "UDP fetch test: failed. :( Packet corrupted; expected %a but got %a" Cstruct.hexdump_pp content Cstruct.hexdump_pp buf);
+            Log.err (fun f -> f "UDP fetch test: failed. :( Packet corrupted; expected %a but got %a" Cstruct.hexdump_pp content Cstruct.hexdump_pp buf);
             Lwt.return_unit
         else
-          (* disregard this packet *)
+          begin
-          Lwt.return_unit
+            (* disregard this packet *)
-      );
+            Lwt.return_unit
-    Lwt.async (fun () ->
+          end
-        Lwt.pick [
-          T.sleep_ns 1_000_000_000L;
-          STACK.listen stack;
-        ]
       );
+    Lwt.async (fun () -> STACK.listen stack);
     STACK.UDPV4.write echo_server echo_port (STACK.udpv4 stack) content >>= function
-    | Ok () -> (* .. listener: test with accept rule, if we get reply we're good *) Lwt.return_unit
+    | Ok () -> (* .. listener: test with accept rule, if we get reply we're good *)
-    | Error _ -> Lwt.return_unit
+      T.sleep_ns 2_000_000_000L >>= fun () ->
-      
+      if !resp_received then Lwt.return_unit else begin
+        Log.err (fun f -> f "UDP fetch test: failed. :( no response was received");
+        Lwt.return_unit
+      end
+    | Error _ ->
+      Log.err (fun f -> f "UDP fetch test: failed: :( couldn't write the packet");
+      Lwt.return_unit
+
   let start _time c stack res (ctx:CON.t) =
-    udp_fetch stack >>= fun () ->
+    udp_fetch stack (*>>= fun () ->
-    http_fetch c res ctx 
+    http_fetch c res ctx *)
 
 end