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

WIP

Browse Source
This commit is contained in:
linse 2019-06-07 15:44:45 +02:00
parent 056873e25b
commit 934dd81edf
2 changed files with 35 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
test/test.sh
View File

@ -71,12 +71,12 @@ 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
@ -86,7 +86,7 @@ fi
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

42
test/unikernel.ml
View File

@ -1,8 +1,9 @@
open Lwt.Infix
open Mirage_types_lwt
open Printf
let src = Logs.Src.create "firewall test" ~doc:"Firewall test"
(* http://erratique.ch/software/logs *)
(* https://github.com/mirage/mirage-logs *)
let src = Logs.Src.create "firewalltest" ~doc:"Firewalltest"
module Log = (val Logs.src_log src : Logs.LOG)
(* TODO
@ -41,12 +42,14 @@ 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 ->
@ -54,27 +57,32 @@ module Client (T: TIME) (C: CONSOLE) (STACK: Mirage_stack_lwt.V4) (RES: Resolver
(* TODO: how do we stop the listener from here? *)
match Cstruct.equal buf content with
| 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 *)
Lwt.return_unit
);
Lwt.async (fun () ->
Lwt.pick [
T.sleep_ns 1_000_000_000L;
STACK.listen stack;
]
begin
(* disregard this packet *)
Lwt.return_unit
end
);
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
| Error _ -> Lwt.return_unit
| Ok () -> (* .. listener: test with accept rule, if we get reply we're good *)
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 () ->
http_fetch c res ctx
udp_fetch stack (*>>= fun () ->
http_fetch c res ctx *)
end