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.
This commit is contained in:
Thomas Leonard 2019-04-28 16:06:03 +01:00
parent 5e1588f861
commit c7fc54af02
3 changed files with 25 additions and 5 deletions

24
dao.ml
View File

@ -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 "@[<v2>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"

View File

@ -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

View File

@ -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 *)