Git-Mirrors/qubes-mirage-firewall
1
0
Fork 0
mirror of https://github.com/mirage/qubes-mirage-firewall.git synced 2025-04-25 01:19:18 -04:00
Code Issues Packages Projects Releases Wiki Activity

WIP.

Browse Source
This commit is contained in:
linse 2019-05-18 01:29:50 +02:00
parent 41126c9a6b
commit aca6ac84d8
2 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
test/config.ml
View File

@ -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

9
test/unikernel.ml
View File

@ -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 () ->