mirror of
https://github.com/mirage/qubes-mirage-firewall.git
synced 2024-10-01 01:05:39 -04:00
update to mirage 4.0.0 & mirage-xen 7.0.0
This commit is contained in:
parent
ef2419bf6f
commit
a99d7f8792
@ -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
|
||||
|
@ -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
|
||||
|
@ -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"
|
||||
|
13
config.ml
13
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
|
||||
|
8
dao.ml
8
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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
12
unikernel.ml
12
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
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user