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

View File

@ -71,12 +71,12 @@ if [ "$reply" != "hi" ]; then
# the non-nice way is commenting out this test ;) # the non-nice way is commenting out this test ;)
echo "UDP echo service not reachable at $udp_echo_host:$udp_echo_port" >&2 echo "UDP echo service not reachable at $udp_echo_host:$udp_echo_port" >&2
explain_upstream >&2 explain_upstream >&2
exit 1 # exit 1
fi fi
echo "We're gonna set up a unikernel for the mirage-fw-test qube" echo "We're gonna set up a unikernel for the mirage-fw-test qube"
cd .. cd ..
mirage configure -t xen && \ mirage configure -t xen -l "*:debug" && \
make depend && \ make depend && \
make make
if [ $? -ne 0 ]; then if [ $? -ne 0 ]; then
@ -86,7 +86,7 @@ fi
cd test cd test
echo "We're gonna set up a unikernel for fetchmotron qube" echo "We're gonna set up a unikernel for fetchmotron qube"
mirage configure -t qubes && \ mirage configure -t qubes -l "*:debug" && \
make depend && \ make depend && \
make make
if [ $? -ne 0 ]; then if [ $? -ne 0 ]; then

View File

@ -1,8 +1,9 @@
open Lwt.Infix open Lwt.Infix
open Mirage_types_lwt open Mirage_types_lwt
open Printf 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) module Log = (val Logs.src_log src : Logs.LOG)
(* TODO (* 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 let ctx = Cohttp_mirage.Client.ctx resolver ctx in
Cohttp_mirage.Client.get ~ctx uri >>= fun (response, body) -> Cohttp_mirage.Client.get ~ctx uri >>= fun (response, body) ->
Cohttp_lwt.Body.to_string body >>= fun 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) Lwt.return_unit)
let udp_fetch (stack : STACK.t) = let udp_fetch (stack : STACK.t) =
Log.info (fun f -> f "Entering udp fetch test!!!");
let src_port = 9090 in let src_port = 9090 in
let echo_port = 1235 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 echo_server = Ipaddr.V4.of_string_exn "10.137.0.5" in
let content = Cstruct.of_string "important data" in let content = Cstruct.of_string "important data" in
STACK.listen_udpv4 stack ~port:src_port (fun ~src ~dst:_ ~src_port buf -> 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? *) (* TODO: how do we stop the listener from here? *)
match Cstruct.equal buf content with 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 Lwt.return_unit
| false -> (* oh no *) | 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 Lwt.return_unit
else else
begin
(* disregard this packet *) (* disregard this packet *)
Lwt.return_unit Lwt.return_unit
end
); );
Lwt.async (fun () -> Lwt.async (fun () -> STACK.listen stack);
Lwt.pick [
T.sleep_ns 1_000_000_000L;
STACK.listen stack;
]
);
STACK.UDPV4.write echo_server echo_port (STACK.udpv4 stack) content >>= function 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) = 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 end