From aca6ac84d894c78cea7770585cb640299e97c5cc Mon Sep 17 00:00:00 2001 From: linse Date: Sat, 18 May 2019 01:29:50 +0200 Subject: [PATCH] WIP. --- test/config.ml | 4 ++-- test/unikernel.ml | 9 +++++++-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/test/config.ml b/test/config.ml index 889a853..3f7bbe8 100644 --- a/test/config.ml +++ b/test/config.ml @@ -4,11 +4,11 @@ let client = let packages = [ package "cohttp-mirage"; package "duration" ] in foreign ~packages - "Unikernel.Client" @@ time @-> console @-> resolver @-> conduit @-> job + "Unikernel.Client" @@ time @-> console @-> stackv4 @-> resolver @-> conduit @-> job let () = let stack = generic_stackv4 default_network in let res_dns = resolver_dns stack in let conduit = conduit_direct stack in - let job = [ client $ default_time $ default_console $ res_dns $ conduit ] in + let job = [ client $ default_time $ default_console $ stack $ res_dns $ conduit ] in register "http-fetch" job diff --git a/test/unikernel.ml b/test/unikernel.ml index bd117df..f3f3c2e 100644 --- a/test/unikernel.ml +++ b/test/unikernel.ml @@ -14,7 +14,7 @@ open Printf (* 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) (RES: Resolver_lwt.S) (CON: Conduit_mirage.S) = struct +module Client (T: TIME) (C: CONSOLE) (STACK: Mirage_stack_lwt.V4) (RES: Resolver_lwt.S) (CON: Conduit_mirage.S) = struct exception Check_error of string let check_err fmt = Format.ksprintf (fun err -> raise (Check_error err)) fmt @@ -42,7 +42,12 @@ module Client (T: TIME) (C: CONSOLE) (RES: Resolver_lwt.S) (CON: Conduit_mirage. C.log c (sprintf "Received body length: %d" (String.length body)) >>= fun () -> C.log c "Cohttp fetch done\n------------\n" - let start _time c res (ctx:CON.t) = + let udp_fetch stack = + STACK.UDPV4.write (Ipaddr.V4.of_string_exn "8.8.8.8") 53 STACK.udp (Cstruct.empty) >>= function + | Ok () -> .. listener: test with accept rule, if we get reply we're good + | Error _ -> + + let start _time c stack res (ctx:CON.t) = C.log c (sprintf "Resolving using DNS server 8.8.8.8 (hardcoded)") >>= fun () -> (* wait a sec so we catch the output if it's fast *) OS.Time.sleep_ns (Duration.of_sec 1) >>= fun () ->