mirror of
https://github.com/mirage/qubes-mirage-firewall.git
synced 2024-12-28 08:39:34 -05:00
commit
32e4b8a31a
@ -2,3 +2,6 @@
|
||||
_build
|
||||
*.xen
|
||||
*.bz2
|
||||
*.tar.bz2
|
||||
*.tgz
|
||||
mirage-firewall-bin*
|
||||
|
@ -1,16 +1,15 @@
|
||||
# Pin the base image to a specific hash for maximum reproducibility.
|
||||
# It will probably still work on newer images, though, unless Debian
|
||||
# changes some compiler optimisations (unlikely).
|
||||
#FROM ocaml/opam2:debian-9-ocaml-4.07
|
||||
FROM ocaml/opam2@sha256:74fb6e30a95e1569db755b3c061970a8270dfc281c4e69bffe2cf9905d356b38
|
||||
#FROM ocurrent/opam:alpine-3.10-ocaml-4.08
|
||||
FROM ocurrent/opam@sha256:4cf6f8a427e7f65a250cd5dbc9f5069e8f8213467376af5136bf67a21d39d6ec
|
||||
|
||||
# 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 git fetch origin && git reset --hard 3389beb33b37da54c9f5a41f19291883dfb59bfb && opam update
|
||||
RUN cd ~/opam-repository && git fetch origin master && git reset --hard a83bd077e4e54c41b0664a2e1618670d57b7c79d && opam update
|
||||
|
||||
RUN sudo apt-get install -y m4 libxen-dev pkg-config
|
||||
RUN opam install -y mirage lwt
|
||||
RUN opam depext -i -y mirage lwt
|
||||
RUN mkdir /home/opam/qubes-mirage-firewall
|
||||
ADD config.ml /home/opam/qubes-mirage-firewall/config.ml
|
||||
WORKDIR /home/opam/qubes-mirage-firewall
|
||||
|
@ -1,2 +1,2 @@
|
||||
MIRAGE_KERNEL_NAME = qubes_firewall.xen
|
||||
OCAML_VERSION ?= 4.08.0
|
||||
OCAML_VERSION ?= 4.08.1
|
||||
|
@ -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 qubes_firewall.xen)"
|
||||
echo "SHA2 last known: 5707d97d78eb54cad9bade5322c197d8b3706335aa277ccad31fceac564f3319"
|
||||
echo "SHA2 last known: 3cf9358df911c7bc5a28846087c5359e5b550e5d0c6cf342a6e1c90545518ac6"
|
||||
echo "(hashes should match for released versions)"
|
||||
|
@ -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(Os_xen.Xs))
|
||||
module ClientEth = Ethernet.Make(Netback)
|
||||
|
||||
let src = Logs.Src.create "client_net" ~doc:"Client networking"
|
||||
|
@ -33,6 +33,7 @@ let main =
|
||||
package "mirage-qubes";
|
||||
package "mirage-nat" ~min:"1.2.0";
|
||||
package "mirage-logs";
|
||||
package "mirage-xen" ~min:"4.0.0";
|
||||
]
|
||||
"Unikernel.Main" (mclock @-> job)
|
||||
|
||||
|
8
dao.ml
8
dao.ml
@ -30,7 +30,7 @@ module VifMap = struct
|
||||
end
|
||||
|
||||
let directory ~handle dir =
|
||||
OS.Xs.directory handle dir >|= function
|
||||
Os_xen.Xs.directory handle dir >|= function
|
||||
| [""] -> [] (* XenStore client bug *)
|
||||
| items -> items
|
||||
|
||||
@ -46,7 +46,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 () -> Os_xen.Xs.read handle (Printf.sprintf "%s/%d/ip" path device_id))
|
||||
(fun client_ip ->
|
||||
let client_ip = Ipaddr.V4.of_string_exn client_ip in
|
||||
Lwt.return (Some (vif, client_ip))
|
||||
@ -61,10 +61,10 @@ let vifs ~handle domid =
|
||||
)
|
||||
|
||||
let watch_clients fn =
|
||||
OS.Xs.make () >>= fun xs ->
|
||||
Os_xen.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 ->
|
||||
Os_xen.Xs.wait xs (fun handle ->
|
||||
begin Lwt.catch
|
||||
(fun () -> directory ~handle backend_vifs)
|
||||
(function
|
||||
|
@ -6,7 +6,7 @@ open Lwt
|
||||
let src = Logs.Src.create "memory_pressure" ~doc:"Memory pressure monitor"
|
||||
module Log = (val Logs.src_log src : Logs.LOG)
|
||||
|
||||
let total_pages = OS.MM.Heap_pages.total ()
|
||||
let total_pages = Os_xen.MM.Heap_pages.total ()
|
||||
let pagesize_kb = Io_page.page_size / 1024
|
||||
|
||||
let meminfo ~used =
|
||||
@ -23,7 +23,7 @@ let meminfo ~used =
|
||||
|
||||
let report_mem_usage used =
|
||||
Lwt.async (fun () ->
|
||||
let open OS in
|
||||
let open Os_xen in
|
||||
Xs.make () >>= fun xs ->
|
||||
Xs.immediate xs (fun h ->
|
||||
Xs.write h "memory/meminfo" (meminfo ~used)
|
||||
@ -32,16 +32,16 @@ let report_mem_usage used =
|
||||
|
||||
let init () =
|
||||
Gc.full_major ();
|
||||
let used = OS.MM.Heap_pages.used () in
|
||||
let used = Os_xen.MM.Heap_pages.used () in
|
||||
report_mem_usage used
|
||||
|
||||
let status () =
|
||||
let used = OS.MM.Heap_pages.used () |> float_of_int in
|
||||
let used = Os_xen.MM.Heap_pages.used () |> float_of_int in
|
||||
let frac = used /. float_of_int total_pages in
|
||||
if frac < 0.9 then `Ok
|
||||
else (
|
||||
Gc.full_major ();
|
||||
let used = OS.MM.Heap_pages.used () in
|
||||
let used = Os_xen.MM.Heap_pages.used () in
|
||||
report_mem_usage used;
|
||||
let frac = float_of_int used /. float_of_int total_pages in
|
||||
if frac > 0.9 then `Memory_critical
|
||||
|
Loading…
Reference in New Issue
Block a user