From c7fc54af02621284489069ad91fd648f12cefdec Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Sun, 28 Apr 2019 16:06:03 +0100 Subject: [PATCH 1/2] Wait if dom0 is slow to set the network configuration Sometimes we boot before dom0 has put the network settings in QubesDB. If that happens, log a message, wait until the database changes, and retry. --- dao.ml | 24 +++++++++++++++++++++--- dao.mli | 4 +++- unikernel.ml | 2 +- 3 files changed, 25 insertions(+), 5 deletions(-) diff --git a/dao.ml b/dao.ml index 9ce0766..a68cc64 100644 --- a/dao.ml +++ b/dao.ml @@ -84,15 +84,33 @@ type network_config = { clients_our_ip : Ipaddr.V4.t; (* The IP address of our interface to our client VMs (their gateway) *) } +exception Missing_key of string + (* TODO: /qubes-secondary-dns *) -let read_network_config qubesDB = +let try_read_network_config db = let get name = - match DB.read qubesDB name with - | None -> raise (error "QubesDB key %S not present" name) + match DB.KeyMap.find_opt name db with + | None -> raise (Missing_key name) | Some value -> value in let uplink_our_ip = get "/qubes-ip" |> Ipaddr.V4.of_string_exn in let uplink_netvm_ip = get "/qubes-gateway" |> Ipaddr.V4.of_string_exn in let clients_our_ip = get "/qubes-netvm-gateway" |> Ipaddr.V4.of_string_exn in + Log.info (fun f -> f "@[Got network configuration from QubesDB:@,\ + NetVM IP on uplink network: %a@,\ + Our IP on uplink network: %a@,\ + Our IP on client networks: %a@]" + Ipaddr.V4.pp uplink_netvm_ip + Ipaddr.V4.pp uplink_our_ip + Ipaddr.V4.pp clients_our_ip); { uplink_netvm_ip; uplink_our_ip; clients_our_ip } +let read_network_config qubesDB = + let rec aux bindings = + try Lwt.return (try_read_network_config bindings) + with Missing_key key -> + Log.warn (fun f -> f "QubesDB key %S not (yet) present; waiting for QubesDB to change..." key); + DB.after qubesDB bindings >>= aux + in + aux (DB.bindings qubesDB) + let set_iptables_error db = Qubes.DB.write db "/qubes-iptables-error" diff --git a/dao.mli b/dao.mli index e1b96c6..b1f56b6 100644 --- a/dao.mli +++ b/dao.mli @@ -26,6 +26,8 @@ type network_config = { clients_our_ip : Ipaddr.V4.t; (* The IP address of our interface to our client VMs (their gateway) *) } -val read_network_config : Qubes.DB.t -> network_config +val read_network_config : Qubes.DB.t -> network_config Lwt.t +(** [read_network_config db] fetches the configuration from QubesDB. + If it isn't there yet, it waits until it is. *) val set_iptables_error : Qubes.DB.t -> string -> unit Lwt.t diff --git a/unikernel.ml b/unikernel.ml index 4a63403..84cac6d 100644 --- a/unikernel.ml +++ b/unikernel.ml @@ -13,7 +13,7 @@ module Main (Clock : Mirage_clock_lwt.MCLOCK) = struct (* Set up networking and listen for incoming packets. *) let network ~clock nat qubesDB = (* Read configuration from QubesDB *) - let config = Dao.read_network_config qubesDB in + Dao.read_network_config qubesDB >>= fun config -> (* Initialise connection to NetVM *) Uplink.connect ~clock config >>= fun uplink -> (* Report success *) From 9d2723a08ad0cfef3dd081232491ea7cc49cf11d Mon Sep 17 00:00:00 2001 From: Thomas Leonard Date: Sun, 28 Apr 2019 16:10:02 +0100 Subject: [PATCH 2/2] Require mirage-nat >= 1.2.0 for ICMP support --- config.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/config.ml b/config.ml index f7d5169..50de8ab 100644 --- a/config.ml +++ b/config.ml @@ -31,7 +31,7 @@ let main = package "mirage-net-xen"; package "ipaddr" ~min:"3.0.0"; package "mirage-qubes"; - package "mirage-nat" ~min:"1.1.0"; + package "mirage-nat" ~min:"1.2.0"; package "mirage-logs"; ] "Unikernel.Main" (mclock @-> job)