Git-Mirrors/qubes-mirage-firewall
1
0
Fork 0
mirror of https://github.com/mirage/qubes-mirage-firewall.git synced 2024-06-29 07:32:21 +00:00
Code Issues Packages Projects Releases Wiki Activity

read DNS resolver IP addresses from QubesDB

Browse Source 
as specified in https://www.qubes-os.org/doc/vm-interface/
This commit is contained in:
Hannes Mehnert 2021-11-05 19:53:39 +01:00
parent 65ff2a9203
commit 7e3303a8d6
4 changed files with 14 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
dao.ml
View File

@ -125,11 +125,11 @@ type network_config = {
uplink_our_ip : Ipaddr.V4.t; (* The IP address of our interface to NetVM *)
clients_our_ip : Ipaddr.V4.t; (* The IP address of our interface to our client VMs (their gateway) *)
dns : Ipaddr.V4.t list;
}
exception Missing_key of string
(* TODO: /qubes-secondary-dns *)
let try_read_network_config db =
let get name =
match DB.KeyMap.find_opt name db with
@ -138,14 +138,20 @@ let try_read_network_config db =
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
let dns =
[ get "/qubes-primary-dns" |> Ipaddr.V4.of_string_exn ;
get "/qubes-secondary-dns" |> 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@]"
Our IP on client networks: %a@,\
DNS resolvers: %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 }
Ipaddr.V4.pp clients_our_ip
Fmt.(list ~sep:(any ", ") Ipaddr.V4.pp) dns);
{ uplink_netvm_ip; uplink_our_ip; clients_our_ip ; dns }
let read_network_config qubesDB =
let rec aux bindings =

1
dao.mli
View File

@ -24,6 +24,7 @@ type network_config = {
uplink_our_ip : Ipaddr.V4.t; (* The IP address of our interface to NetVM *)
clients_our_ip : Ipaddr.V4.t; (* The IP address of our interface to our client VMs (their gateway) *)
dns : Ipaddr.V4.t list;
}
val read_network_config : Qubes.DB.t -> network_config Lwt.t

2
my_dns.ml
View File

@ -34,7 +34,7 @@ module Transport (R : Mirage_random.S) (C : Mirage_clock.MCLOCK) = struct
let open Router in
let open My_nat in
let nslist = snd ctx.t.nameservers in
let dst, dst_port = List.hd(nslist) in
let dst, dst_port = List.hd nslist in
let router, send_udp, _ = ctx.t.stack in
let src_port = Ports.pick_free_port ~consult:router.ports.nat_udp router.ports.dns_udp in
ctx.src_port <- src_port;

3
unikernel.ml
View File

@ -81,7 +81,8 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK) = struct
let send_dns_query = Uplink.send_dns_client_query uplink in
let dns_mvar = Lwt_mvar.create_empty () in
let dns_client = Dns_client.create (router, send_dns_query, dns_mvar) in
let nameservers = `Udp, List.map (fun ip -> ip, 53) config.Dao.dns in
let dns_client = Dns_client.create ~nameservers (router, send_dns_query, dns_mvar) in
let net_listener = network (Dns_client.getaddrinfo dns_client Dns.Rr_map.A) dns_mvar uplink qubesDB router in