Initial test setup. :)

This commit is contained in:
linse 2019-05-17 01:35:11 +02:00
parent 47e3c6c64c
commit 1599f63838
2 changed files with 46 additions and 24 deletions

View File

@ -1,12 +1,52 @@
#!/bin/sh #!/bin/bash
function explain_commands {
echo "1) Set up test qubes:"
echo "Follow the instructions in http://github.com/talex5/qubes-test-mirage to set up the boot-mirage and test-mirage scripts. Make two new qubes in dom0, called mirage-fw-test and fetchmotron, following the instructions for template and qube settings." echo "Follow the instructions in http://github.com/talex5/qubes-test-mirage to set up the boot-mirage and test-mirage scripts. Make two new qubes in dom0, called mirage-fw-test and fetchmotron, following the instructions for template and qube settings."
}
function explain_service {
echo "2) Set up rule update service:"
echo "In dom0, make a new service:
touch /etc/qubes-rpc/yomimono.updateFirewall
sudo bash
cd /etc/qubes-rpc
cat << EOF >> yomimono.updateFirewall
/usr/local/bin/update-firewall
EOF
Make a policy file for this service, YOUR_DEV_VM being the qube from which you build (e.g. ocamldev):
sudo bash
cd /etc/qubes-rpc/policy
cat << EOF >> yomimono.updateFirewall
YOUR_DEV_VM dom0 allow
make the update-firewall script:
sudo bash
cd /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"
}
if ! [ -x "$(command -v boot-mirage)" ]; then if ! [ -x "$(command -v boot-mirage)" ]; then
echo 'Error: boot-mirage is not installed.' >&2 echo 'Error: boot-mirage is not installed.' >&2
explain_commands >&2
exit 1 exit 1
fi fi
if ! [ -x "$(command -v test-mirage)" ]; then if ! [ -x "$(command -v test-mirage)" ]; then
echo 'Error: test-mirage is not installed.' >&2 echo 'Error: test-mirage is not installed.' >&2
explain_commands >&2
exit 1
fi
if $(qrexec-client-vm dom0 yomimono.updateFirewall); then
echo "Error: can't update firewall rules." >&2
explain_service >&2
exit 1 exit 1
fi fi

View File

@ -7,9 +7,8 @@ let green fmt = sprintf ("\027[32m"^^fmt^^"\027[m")
let yellow fmt = sprintf ("\027[33m"^^fmt^^"\027[m") let yellow fmt = sprintf ("\027[33m"^^fmt^^"\027[m")
let blue fmt = sprintf ("\027[36m"^^fmt^^"\027[m") let blue fmt = sprintf ("\027[36m"^^fmt^^"\027[m")
let domain = "anil.recoil.org" (* Point-to-point links out of a netvm always have this IP TODO clarify with Marek *)
let uri = Uri.of_string "http://anil.recoil.org" let uri = Uri.of_string "http://10.137.0.5:8082"
let ns = "8.8.8.8"
module Client (T: TIME) (C: CONSOLE) (RES: Resolver_lwt.S) (CON: Conduit_mirage.S) = struct module Client (T: TIME) (C: CONSOLE) (RES: Resolver_lwt.S) (CON: Conduit_mirage.S) = struct
@ -22,27 +21,10 @@ 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 (sprintf "Received body length: %d" (String.length body)) >>= fun () ->
C.log c "Cohttp fetch done\n------------\n" C.log c "Cohttp fetch done\n------------\n"
let manual_http_fetch c resolver ctx =
Resolver_lwt.resolve_uri ~uri resolver >>= fun endp ->
Conduit_mirage.client endp >>= fun client ->
C.log c (Sexplib.Sexp.to_string_hum (Conduit.sexp_of_endp endp)) >>= fun () ->
CON.connect ctx client >>= fun flow ->
let page = Io_page.(to_cstruct (get 1)) in
let http_get = "GET / HTTP/1.1\nHost: anil.recoil.org\n\n" in
Cstruct.blit_from_string http_get 0 page 0 (String.length http_get);
let buf = Cstruct.sub page 0 (String.length http_get) in
Conduit_mirage.Flow.write flow buf >>= function
| Error _ -> C.log c "ERR on write"
| Ok () ->
Conduit_mirage.Flow.read flow >>= function
| Error _ -> C.log c "ERR"
| Ok `Eof -> C.log c "EOF"
| Ok (`Data buf) -> C.log c (sprintf "OK\n%s\n" (Cstruct.to_string buf))
let start _time c res (ctx:CON.t) = let start _time c res (ctx:CON.t) =
C.log c (sprintf "Resolving in 1s using DNS server %s" ns) >>= fun () -> 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 () -> OS.Time.sleep_ns (Duration.of_sec 1) >>= fun () ->
http_fetch c res ctx >>= fun () -> http_fetch c res ctx
manual_http_fetch c res ctx
end end