From a99d7f8792f977b7a91abb8fdbce4bd73f459f33 Mon Sep 17 00:00:00 2001 From: palainp Date: Wed, 30 Mar 2022 03:12:01 -0400 Subject: [PATCH 01/10] update to mirage 4.0.0 & mirage-xen 7.0.0 --- Makefile.user | 2 +- README.md | 2 +- client_net.ml | 2 +- config.ml | 13 ++++++------- dao.ml | 8 ++++---- memory_pressure.ml | 12 ++++++------ my_dns.ml | 4 ++-- unikernel.ml | 12 ++++++------ uplink.ml | 4 ++-- uplink.mli | 2 +- 10 files changed, 30 insertions(+), 31 deletions(-) diff --git a/Makefile.user b/Makefile.user index cc7a7f4..04d772b 100644 --- a/Makefile.user +++ b/Makefile.user @@ -1,7 +1,7 @@ tar: build rm -rf _build/mirage-firewall mkdir _build/mirage-firewall - cp qubes_firewall.xen _build/mirage-firewall/vmlinuz + cp dist/qubes-firewall.xen _build/mirage-firewall/vmlinuz touch _build/mirage-firewall/modules.img cat /dev/null | gzip -n > _build/mirage-firewall/initramfs tar cjf mirage-firewall.tar.bz2 -C _build --mtime=./build-with-docker.sh mirage-firewall diff --git a/README.md b/README.md index 7b8abbb..4216e49 100644 --- a/README.md +++ b/README.md @@ -145,7 +145,7 @@ The boot process: ### Easy deployment for developers -For development, use the [test-mirage][] scripts to deploy the unikernel (`qubes_firewall.xen`) from your development AppVM. +For development, use the [test-mirage][] scripts to deploy the unikernel (`qubes-firewall.xen`) from your development AppVM. This takes a little more setting up the first time, but will be much quicker after that. e.g. $ test-mirage qubes_firewall.xen mirage-firewall diff --git a/client_net.ml b/client_net.ml index a493f9b..fc501df 100644 --- a/client_net.ml +++ b/client_net.ml @@ -4,7 +4,7 @@ open Lwt.Infix open Fw_utils -module Netback = Netchannel.Backend.Make(Netchannel.Xenstore.Make(OS.Xs)) +module Netback = Netchannel.Backend.Make(Netchannel.Xenstore.Make(Xen_os.Xs)) module ClientEth = Ethernet.Make(Netback) let src = Logs.Src.create "client_net" ~doc:"Client networking" diff --git a/config.ml b/config.ml index 2363eb5..a7a1f99 100644 --- a/config.ml +++ b/config.ml @@ -6,17 +6,16 @@ open Mirage let table_size = - let open Functoria_key in - let info = Arg.info + let info = Key.Arg.info ~doc:"The number of NAT entries to allocate." ~docv:"ENTRIES" ["nat-table-size"] in - let key = Arg.opt ~stage:`Both Arg.int 5_000 info in - create "nat_table_size" key + let key = Key.Arg.opt ~stage:`Both Key.Arg.int 5_000 info in + Key.create "nat_table_size" key let main = foreign - ~keys:[Functoria_key.abstract table_size] + ~keys:[Key.v table_size] ~packages:[ package "vchan" ~min:"4.0.2"; package "cstruct"; @@ -35,8 +34,8 @@ let main = package ~min:"6.1.0" "dns-client"; package "pf-qubes"; ] - "Unikernel.Main" (random @-> mclock @-> job) + "Unikernel.Main" (random @-> mclock @-> time @-> job) let () = - register "qubes-firewall" [main $ default_random $ default_monotonic_clock] + register "qubes-firewall" [main $ default_random $ default_monotonic_clock $ default_time] ~argv:no_argv diff --git a/dao.ml b/dao.ml index 30b4c2d..241a90f 100644 --- a/dao.ml +++ b/dao.ml @@ -29,7 +29,7 @@ module VifMap = struct end let directory ~handle dir = - OS.Xs.directory handle dir >|= function + Xen_os.Xs.directory handle dir >|= function | [""] -> [] (* XenStore client bug *) | items -> items @@ -77,7 +77,7 @@ let vifs ~handle domid = | Some device_id -> let vif = { ClientVif.domid; device_id } in Lwt.try_bind - (fun () -> OS.Xs.read handle (Printf.sprintf "%s/%d/ip" path device_id)) + (fun () -> Xen_os.Xs.read handle (Printf.sprintf "%s/%d/ip" path device_id)) (fun client_ip -> let client_ip' = match String.cuts ~sep:" " client_ip with | [] -> Log.err (fun m -> m "unexpected empty list"); "" @@ -104,10 +104,10 @@ let vifs ~handle domid = ) let watch_clients fn = - OS.Xs.make () >>= fun xs -> + Xen_os.Xs.make () >>= fun xs -> let backend_vifs = "backend/vif" in Log.info (fun f -> f "Watching %s" backend_vifs); - OS.Xs.wait xs (fun handle -> + Xen_os.Xs.wait xs (fun handle -> begin Lwt.catch (fun () -> directory ~handle backend_vifs) (function diff --git a/memory_pressure.ml b/memory_pressure.ml index cecf4a9..7f367fb 100644 --- a/memory_pressure.ml +++ b/memory_pressure.ml @@ -9,11 +9,11 @@ module Log = (val Logs.src_log src : Logs.LOG) let wordsize_in_bytes = Sys.word_size / 8 let fraction_free stats = - let { OS.Memory.free_words; heap_words; _ } = stats in + let { Xen_os.Memory.free_words; heap_words; _ } = stats in float free_words /. float heap_words let meminfo stats = - let { OS.Memory.free_words; heap_words; _ } = stats in + let { Xen_os.Memory.free_words; heap_words; _ } = stats in let mem_total = heap_words * wordsize_in_bytes in let mem_free = free_words * wordsize_in_bytes in Log.info (fun f -> f "Writing meminfo: free %a / %a (%.2f %%)" @@ -29,7 +29,7 @@ let meminfo stats = let report_mem_usage stats = Lwt.async (fun () -> - let open OS in + let open Xen_os in Xs.make () >>= fun xs -> Xs.immediate xs (fun h -> Xs.write h "memory/meminfo" (meminfo stats) @@ -38,15 +38,15 @@ let report_mem_usage stats = let init () = Gc.full_major (); - let stats = OS.Memory.quick_stat () in + let stats = Xen_os.Memory.quick_stat () in report_mem_usage stats let status () = - let stats = OS.Memory.quick_stat () in + let stats = Xen_os.Memory.quick_stat () in if fraction_free stats > 0.1 then `Ok else ( Gc.full_major (); - let stats = OS.Memory.quick_stat () in + let stats = Xen_os.Memory.quick_stat () in report_mem_usage stats; if fraction_free stats < 0.1 then `Memory_critical else `Ok diff --git a/my_dns.ml b/my_dns.ml index a0e8b18..01ce370 100644 --- a/my_dns.ml +++ b/my_dns.ml @@ -1,6 +1,6 @@ open Lwt.Infix -module Transport (R : Mirage_random.S) (C : Mirage_clock.MCLOCK) = struct +module Transport (R : Mirage_random.S) (C : Mirage_clock.MCLOCK) (Time : Mirage_time.S) = struct type +'a io = 'a Lwt.t type io_addr = Ipaddr.V4.t * int type stack = Router.t * (src_port:int -> dst:Ipaddr.V4.t -> dst_port:int -> Cstruct.t -> (unit, [ `Msg of string ]) result Lwt.t) * (Udp_packet.t * Cstruct.t) Lwt_mvar.t @@ -25,7 +25,7 @@ module Transport (R : Mirage_random.S) (C : Mirage_clock.MCLOCK) = struct { protocol ; nameserver ; stack ; timeout_ns = timeout } let with_timeout timeout_ns f = - let timeout = OS.Time.sleep_ns timeout_ns >|= fun () -> Error (`Msg "DNS request timeout") in + let timeout = Time.sleep_ns timeout_ns >|= fun () -> Error (`Msg "DNS request timeout") in Lwt.pick [ f ; timeout ] let connect (t : t) = Lwt.return (Ok t) diff --git a/unikernel.ml b/unikernel.ml index cccb710..f4e65fe 100644 --- a/unikernel.ml +++ b/unikernel.ml @@ -7,9 +7,9 @@ open Qubes let src = Logs.Src.create "unikernel" ~doc:"Main unikernel code" module Log = (val Logs.src_log src : Logs.LOG) -module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK) = struct - module Uplink = Uplink.Make(R)(Clock) - module Dns_transport = My_dns.Transport(R)(Clock) +module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_time.S) = struct + module Uplink = Uplink.Make(R)(Clock)(Time) + module Dns_transport = My_dns.Transport(R)(Clock)(Time) module Dns_client = Dns_client.Make(Dns_transport) (* Set up networking and listen for incoming packets. *) @@ -40,7 +40,7 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK) = struct ) (* Main unikernel entry point (called from auto-generated main.ml). *) - let start _random _clock = + let start _random _clock _time = let start_time = Clock.elapsed_ns () in (* Start qrexec agent, GUI agent and QubesDB agent in parallel *) let qrexec = RExec.connect ~domid:0 () in @@ -59,7 +59,7 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK) = struct Log.info (fun f -> f "QubesDB and qrexec agents connected in %.3f s" startup_time); (* Watch for shutdown requests from Qubes *) let shutdown_rq = - OS.Lifecycle.await_shutdown_request () >>= fun (`Poweroff | `Reboot) -> + Xen_os.Lifecycle.await_shutdown_request () >>= fun (`Poweroff | `Reboot) -> Lwt.return_unit in (* Set up networking *) let max_entries = Key_gen.nat_table_size () in @@ -91,5 +91,5 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK) = struct (* Run until something fails or we get a shutdown request. *) Lwt.choose [agent_listener; net_listener; shutdown_rq] >>= fun () -> (* Give the console daemon time to show any final log messages. *) - OS.Time.sleep_ns (1.0 *. 1e9 |> Int64.of_float) + Time.sleep_ns (1.0 *. 1e9 |> Int64.of_float) end diff --git a/uplink.ml b/uplink.ml index c058d54..1e5d30e 100644 --- a/uplink.ml +++ b/uplink.ml @@ -9,8 +9,8 @@ module Eth = Ethernet.Make(Netif) let src = Logs.Src.create "uplink" ~doc:"Network connection to NetVM" module Log = (val Logs.src_log src : Logs.LOG) -module Make (R:Mirage_random.S) (Clock : Mirage_clock.MCLOCK) = struct - module Arp = Arp.Make(Eth)(OS.Time) +module Make (R:Mirage_random.S) (Clock : Mirage_clock.MCLOCK) (Time : Mirage_time.S) = struct + module Arp = Arp.Make(Eth)(Time) module I = Static_ipv4.Make(R)(Clock)(Eth)(Arp) module U = Udp.Make(I)(R) diff --git a/uplink.mli b/uplink.mli index 438e04a..0052d75 100644 --- a/uplink.mli +++ b/uplink.mli @@ -6,7 +6,7 @@ open Fw_utils [@@@ocaml.warning "-67"] -module Make (R: Mirage_random.S)(Clock : Mirage_clock.MCLOCK) : sig +module Make (R: Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_time.S) : sig type t val connect : Dao.network_config -> t Lwt.t From 3cce2a5629a6aaeae75b5534650d0594a0ea208c Mon Sep 17 00:00:00 2001 From: palainp Date: Wed, 30 Mar 2022 03:15:11 -0400 Subject: [PATCH 02/10] bump lower bound for mirage-xen --- config.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config.ml b/config.ml index a7a1f99..ba29704 100644 --- a/config.ml +++ b/config.ml @@ -30,7 +30,7 @@ let main = package "mirage-qubes" ~min:"0.9.1"; package "mirage-nat" ~min:"2.2.1"; package "mirage-logs"; - package "mirage-xen" ~min:"6.0.0"; + package "mirage-xen" ~min:"7.0.0"; package ~min:"6.1.0" "dns-client"; package "pf-qubes"; ] From dbe068c0fe7913413cbbadfed02164b21afc7d02 Mon Sep 17 00:00:00 2001 From: palainp Date: Mon, 4 Apr 2022 10:09:16 -0400 Subject: [PATCH 03/10] update qubes-builder script for mirage 4.0 --- Makefile.builder | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Makefile.builder b/Makefile.builder index 68a35b9..6ef27b3 100644 --- a/Makefile.builder +++ b/Makefile.builder @@ -1,8 +1,7 @@ MIRAGE_KERNEL_NAME = qubes_firewall.xen -OCAML_VERSION ?= 4.10.0 +OCAML_VERSION ?= 4.14.0 SOURCE_BUILD_DEP := firewall-build-dep firewall-build-dep: - opam install -y depext - opam depext -i -y mirage + opam -i -y mirage From 6f257c5b7b3f11e18401e300fd64ed15ea5ee39f Mon Sep 17 00:00:00 2001 From: palainp Date: Mon, 4 Apr 2022 10:10:43 -0400 Subject: [PATCH 04/10] fix opam option --- Makefile.builder | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.builder b/Makefile.builder index 6ef27b3..bfcf4dc 100644 --- a/Makefile.builder +++ b/Makefile.builder @@ -3,5 +3,5 @@ OCAML_VERSION ?= 4.14.0 SOURCE_BUILD_DEP := firewall-build-dep firewall-build-dep: - opam -i -y mirage + opam install -y mirage From f33db2b42a5cca3ee10c169aaea0f86cda1b4553 Mon Sep 17 00:00:00 2001 From: palainp Date: Mon, 4 Apr 2022 10:23:54 -0400 Subject: [PATCH 05/10] fix kernel name --- Makefile.builder | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile.builder b/Makefile.builder index bfcf4dc..5d79a54 100644 --- a/Makefile.builder +++ b/Makefile.builder @@ -1,4 +1,4 @@ -MIRAGE_KERNEL_NAME = qubes_firewall.xen +MIRAGE_KERNEL_NAME = dist/qubes-firewall.xen OCAML_VERSION ?= 4.14.0 SOURCE_BUILD_DEP := firewall-build-dep From 7718c95f203e21f7331a7893e17c63189aa27907 Mon Sep 17 00:00:00 2001 From: palainp Date: Fri, 27 May 2022 15:59:49 +0200 Subject: [PATCH 06/10] no_argv not needed anymore with no-default-kernelopts for the VM in Qubes --- config.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/config.ml b/config.ml index ba29704..a28f2f0 100644 --- a/config.ml +++ b/config.ml @@ -38,4 +38,3 @@ let main = let () = register "qubes-firewall" [main $ default_random $ default_monotonic_clock $ default_time] - ~argv:no_argv From 68ab4f37c11ee955cc85a2c7a223edb3cd52bbe5 Mon Sep 17 00:00:00 2001 From: palainp Date: Wed, 27 Jul 2022 14:26:58 +0200 Subject: [PATCH 07/10] use the new quick_stat+trim from mirage-xen 8.0.0 --- config.ml | 2 +- memory_pressure.ml | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/config.ml b/config.ml index a28f2f0..d33bf23 100644 --- a/config.ml +++ b/config.ml @@ -30,7 +30,7 @@ let main = package "mirage-qubes" ~min:"0.9.1"; package "mirage-nat" ~min:"2.2.1"; package "mirage-logs"; - package "mirage-xen" ~min:"7.0.0"; + package "mirage-xen" ~min:"8.0.0"; package ~min:"6.1.0" "dns-client"; package "pf-qubes"; ] diff --git a/memory_pressure.ml b/memory_pressure.ml index 7f367fb..665ae14 100644 --- a/memory_pressure.ml +++ b/memory_pressure.ml @@ -43,11 +43,12 @@ let init () = let status () = let stats = Xen_os.Memory.quick_stat () in - if fraction_free stats > 0.1 then `Ok + if fraction_free stats > 0.4 then `Ok else ( Gc.full_major (); + Xen_os.Memory.trim (); let stats = Xen_os.Memory.quick_stat () in report_mem_usage stats; - if fraction_free stats < 0.1 then `Memory_critical + if fraction_free stats < 0.4 then `Memory_critical else `Ok ) From e73c160cd40edfff7b8c35ced2f422cd2d91ef47 Mon Sep 17 00:00:00 2001 From: palainp Date: Tue, 9 Aug 2022 14:16:16 +0200 Subject: [PATCH 08/10] update docker build for mirage 4.2 --- Dockerfile | 16 +++++++++------- build-with-docker.sh | 4 ++-- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/Dockerfile b/Dockerfile index c903ce6..2655efc 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,18 +1,20 @@ # Pin the base image to a specific hash for maximum reproducibility. # It will probably still work on newer images, though, unless an update # changes some compiler optimisations (unlikely). -#FROM ocurrent/opam:fedora-32-ocaml-4.11 -FROM ocurrent/opam@sha256:fce44a073ff874166b51c33a4e37782286d48dbba1b5aa43563a0dd35d15510f +FROM ocaml/opam@sha256:68b7ce1fd4c992d6f3bfc9b4b0a88ee572ced52427f0547b6e4eb6194415f585 +ENV PATH="${PATH}:/home/opam/.opam/4.14/bin" + +# Since mirage 4.2 we must use opam version 2.1 or later +RUN sudo cp /usr/bin/opam-2.1 /usr/bin/opam # Pin last known-good version for reproducible builds. # Remove this line (and the base image pin above) if you want to test with the # latest versions. -RUN cd ~/opam-repository && git fetch origin master && git reset --hard 479a47921a489d11833e03cf949bfb612bd65e41 && opam update +RUN cd /home/opam/opam-repository && git fetch origin master && git reset --hard f85e121f6dd1fd92d9a3d9c8ac9fa553495258bc && opam update -RUN opam depext -i -y mirage +RUN opam install -y mirage opam-monorepo RUN mkdir /home/opam/qubes-mirage-firewall ADD config.ml /home/opam/qubes-mirage-firewall/config.ml WORKDIR /home/opam/qubes-mirage-firewall -RUN opam config exec -- mirage configure -t xen && make depend -CMD opam config exec -- mirage configure -t xen && \ - opam config exec -- make tar +RUN opam exec -- mirage configure -t xen && make depend +CMD opam exec -- mirage configure -t xen && make tar diff --git a/build-with-docker.sh b/build-with-docker.sh index ebacfca..3be3e7b 100755 --- a/build-with-docker.sh +++ b/build-with-docker.sh @@ -4,6 +4,6 @@ echo Building Docker image with dependencies.. docker build -t qubes-mirage-firewall . echo Building Firewall... docker run --rm -i -v `pwd`:/home/opam/qubes-mirage-firewall qubes-mirage-firewall -echo "SHA2 of build: $(sha256sum qubes_firewall.xen)" -echo "SHA2 last known: e2af3718b7f40ba533f378d1402a41008c3520fe84d991ab58d3230772cc824c" +echo "SHA2 of build: $(sha256sum ./dist/qubes-firewall.xen)" +echo "SHA2 last known: c0a94169eb0642db26168688e735f616c675f9b9c02349cac485ec8925e28d10" echo "(hashes should match for released versions)" From ba1b04432dd682f4be44326229009d1ae72d7f8b Mon Sep 17 00:00:00 2001 From: palainp Date: Thu, 11 Aug 2022 13:17:44 +0200 Subject: [PATCH 09/10] must make depend before building solo5 with make tar --- Dockerfile | 3 +-- build-with-docker.sh | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/Dockerfile b/Dockerfile index 2655efc..fcd5c43 100644 --- a/Dockerfile +++ b/Dockerfile @@ -16,5 +16,4 @@ RUN opam install -y mirage opam-monorepo RUN mkdir /home/opam/qubes-mirage-firewall ADD config.ml /home/opam/qubes-mirage-firewall/config.ml WORKDIR /home/opam/qubes-mirage-firewall -RUN opam exec -- mirage configure -t xen && make depend -CMD opam exec -- mirage configure -t xen && make tar +CMD opam exec -- mirage configure -t xen && make depend && make tar diff --git a/build-with-docker.sh b/build-with-docker.sh index 3be3e7b..821821d 100755 --- a/build-with-docker.sh +++ b/build-with-docker.sh @@ -5,5 +5,5 @@ docker build -t qubes-mirage-firewall . echo Building Firewall... docker run --rm -i -v `pwd`:/home/opam/qubes-mirage-firewall qubes-mirage-firewall echo "SHA2 of build: $(sha256sum ./dist/qubes-firewall.xen)" -echo "SHA2 last known: c0a94169eb0642db26168688e735f616c675f9b9c02349cac485ec8925e28d10" +echo "SHA2 last known: 588e921b9d78a99f6f49d468a7b68284c50dabeba95698648ea52e99b381723b" echo "(hashes should match for released versions)" From df4f7bf8117bc4dec0f7da74b83f390854db6e2b Mon Sep 17 00:00:00 2001 From: palainp Date: Mon, 29 Aug 2022 11:31:44 +0200 Subject: [PATCH 10/10] update to mirage 4.2.1 --- Dockerfile | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Dockerfile b/Dockerfile index fcd5c43..e4aa533 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,16 +1,17 @@ # Pin the base image to a specific hash for maximum reproducibility. # It will probably still work on newer images, though, unless an update # changes some compiler optimisations (unlikely). +# fedora-35-ocaml-4.14 FROM ocaml/opam@sha256:68b7ce1fd4c992d6f3bfc9b4b0a88ee572ced52427f0547b6e4eb6194415f585 ENV PATH="${PATH}:/home/opam/.opam/4.14/bin" # Since mirage 4.2 we must use opam version 2.1 or later -RUN sudo cp /usr/bin/opam-2.1 /usr/bin/opam +RUN sudo ln -sf /usr/bin/opam-2.1 /usr/bin/opam # Pin last known-good version for reproducible builds. # Remove this line (and the base image pin above) if you want to test with the # latest versions. -RUN cd /home/opam/opam-repository && git fetch origin master && git reset --hard f85e121f6dd1fd92d9a3d9c8ac9fa553495258bc && opam update +RUN cd /home/opam/opam-repository && git fetch origin master && git reset --hard f904585098b809001380caada4b7426c112d086c && opam update RUN opam install -y mirage opam-monorepo RUN mkdir /home/opam/qubes-mirage-firewall