From c643f977009c9bd842262a17f8628272aaee1a33 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 7 Sep 2022 16:53:45 +0200 Subject: [PATCH] in rules, instead of hardcoding IPv4 addresses of name servers, use those present in QubesDB --- client_net.ml | 16 ++++++++-------- client_net.mli | 4 ++-- dao.ml | 10 +++++++--- dao.mli | 1 + firewall.ml | 4 ++-- firewall.mli | 2 +- rules.ml | 28 +++++++++++----------------- unikernel.ml | 9 +++++---- 8 files changed, 37 insertions(+), 37 deletions(-) diff --git a/client_net.ml b/client_net.ml index fc501df..84a1401 100644 --- a/client_net.ml +++ b/client_net.ml @@ -59,7 +59,7 @@ let input_arp ~fixed_arp ~iface request = iface#writev `ARP (fun b -> Arp_packet.encode_into response b; Arp_packet.size) (** Handle an IPv4 packet from the client. *) -let input_ipv4 get_ts cache ~iface ~router dns_client packet = +let input_ipv4 get_ts cache ~iface ~router dns_client dns_servers packet = let cache', r = Nat_packet.of_ipv4_packet !cache ~now:(get_ts ()) packet in cache := cache'; match r with @@ -70,7 +70,7 @@ let input_ipv4 get_ts cache ~iface ~router dns_client packet = | Ok (Some packet) -> let `IPv4 (ip, _) = packet in let src = ip.Ipv4_packet.src in - if src = iface#other_ip then Firewall.ipv4_from_client dns_client router ~src:iface packet + if src = iface#other_ip then Firewall.ipv4_from_client dns_client dns_servers router ~src:iface packet else ( Log.warn (fun f -> f "Incorrect source IP %a in IP packet from %a (dropping)" Ipaddr.V4.pp src Ipaddr.V4.pp iface#other_ip); @@ -78,7 +78,7 @@ let input_ipv4 get_ts cache ~iface ~router dns_client packet = ) (** Connect to a new client's interface and listen for incoming frames and firewall rule changes. *) -let add_vif get_ts { Dao.ClientVif.domid; device_id } dns_client ~client_ip ~router ~cleanup_tasks qubesDB = +let add_vif get_ts { Dao.ClientVif.domid; device_id } dns_client dns_servers ~client_ip ~router ~cleanup_tasks qubesDB = Netback.make ~domid ~device_id >>= fun backend -> Log.info (fun f -> f "Client %d (IP: %s) ready" domid (Ipaddr.V4.to_string client_ip)); ClientEth.connect backend >>= fun eth -> @@ -122,7 +122,7 @@ let add_vif get_ts { Dao.ClientVif.domid; device_id } dns_client ~client_ip ~rou | Ok (eth, payload) -> match eth.Ethernet.Packet.ethertype with | `ARP -> input_arp ~fixed_arp ~iface payload - | `IPv4 -> input_ipv4 get_ts fragment_cache ~iface ~router dns_client payload + | `IPv4 -> input_ipv4 get_ts fragment_cache ~iface ~router dns_client dns_servers payload | `IPv6 -> Lwt.return_unit (* TODO: oh no! *) ) >|= or_raise "Listen on client interface" Netback.pp_error) @@ -132,13 +132,13 @@ let add_vif get_ts { Dao.ClientVif.domid; device_id } dns_client ~client_ip ~rou Lwt.pick [ qubesdb_updater ; listener ] (** A new client VM has been found in XenStore. Find its interface and connect to it. *) -let add_client get_ts dns_client ~router vif client_ip qubesDB = +let add_client get_ts dns_client dns_servers ~router vif client_ip qubesDB = let cleanup_tasks = Cleanup.create () in Log.info (fun f -> f "add client vif %a with IP %a" Dao.ClientVif.pp vif Ipaddr.V4.pp client_ip); Lwt.async (fun () -> Lwt.catch (fun () -> - add_vif get_ts vif dns_client ~client_ip ~router ~cleanup_tasks qubesDB + add_vif get_ts vif dns_client dns_servers ~client_ip ~router ~cleanup_tasks qubesDB ) (fun ex -> Log.warn (fun f -> f "Error with client %a: %s" @@ -149,7 +149,7 @@ let add_client get_ts dns_client ~router vif client_ip qubesDB = cleanup_tasks (** Watch XenStore for notifications of new clients. *) -let listen get_ts dns_client qubesDB router = +let listen get_ts dns_client dns_servers qubesDB router = Dao.watch_clients (fun new_set -> (* Check for removed clients *) !clients |> Dao.VifMap.iter (fun key cleanup -> @@ -162,7 +162,7 @@ let listen get_ts dns_client qubesDB router = (* Check for added clients *) new_set |> Dao.VifMap.iter (fun key ip_addr -> if not (Dao.VifMap.mem key !clients) then ( - let cleanup = add_client get_ts dns_client ~router key ip_addr qubesDB in + let cleanup = add_client get_ts dns_client dns_servers ~router key ip_addr qubesDB in Log.debug (fun f -> f "client %a arrived" Dao.ClientVif.pp key); clients := !clients |> Dao.VifMap.add key cleanup ) diff --git a/client_net.mli b/client_net.mli index 192fc29..e6254a6 100644 --- a/client_net.mli +++ b/client_net.mli @@ -5,8 +5,8 @@ val listen : (unit -> int64) -> ([ `host ] Domain_name.t -> (int32 * Ipaddr.V4.Set.t, [> `Msg of string ]) result Lwt.t) -> - Qubes.DB.t -> Router.t -> 'a Lwt.t -(** [listen get_timestamp resolver db router] is a thread that watches for clients being added to and + Ipaddr.V4.t list -> Qubes.DB.t -> Router.t -> 'a Lwt.t +(** [listen get_timestamp resolver dns_servers db router] is a thread that watches for clients being added to and removed from XenStore. Clients are connected to the client network and packets are sent via [router]. We ensure the source IP address is correct before routing a packet. *) diff --git a/dao.ml b/dao.ml index 241a90f..1ef5517 100644 --- a/dao.ml +++ b/dao.ml @@ -126,6 +126,7 @@ type network_config = { clients_our_ip : Ipaddr.V4.t; (* The IP address of our interface to our client VMs (their gateway) *) dns : Ipaddr.V4.t; + dns2 : Ipaddr.V4.t; } exception Missing_key of string @@ -139,16 +140,19 @@ let try_read_network_config db = 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 in + let dns2 = get "/qubes-secondary-dns" |> 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@,\ - DNS resolver: %a@]" + DNS primary resolver: %a@,\ + DNS secondary resolver: %a@]" Ipaddr.V4.pp uplink_netvm_ip Ipaddr.V4.pp uplink_our_ip Ipaddr.V4.pp clients_our_ip - Ipaddr.V4.pp dns); - { uplink_netvm_ip; uplink_our_ip; clients_our_ip ; dns } + Ipaddr.V4.pp dns + Ipaddr.V4.pp dns2); + { uplink_netvm_ip; uplink_our_ip; clients_our_ip ; dns ; dns2 } let read_network_config qubesDB = let rec aux bindings = diff --git a/dao.mli b/dao.mli index be6ebb9..2b3d97a 100644 --- a/dao.mli +++ b/dao.mli @@ -25,6 +25,7 @@ type network_config = { clients_our_ip : Ipaddr.V4.t; (* The IP address of our interface to our client VMs (their gateway) *) dns : Ipaddr.V4.t; + dns2 : Ipaddr.V4.t; } val read_network_config : Qubes.DB.t -> network_config Lwt.t diff --git a/firewall.ml b/firewall.ml index aecc383..44e6c9b 100644 --- a/firewall.ml +++ b/firewall.ml @@ -91,7 +91,7 @@ let handle_low_memory t = `Memory_critical | `Ok -> Lwt.return `Ok -let ipv4_from_client resolver t ~src packet = +let ipv4_from_client resolver dns_servers t ~src packet = handle_low_memory t >>= function | `Memory_critical -> Lwt.return_unit | `Ok -> @@ -104,7 +104,7 @@ let ipv4_from_client resolver t ~src packet = let dst = Router.classify t (Ipaddr.V4 ip.Ipv4_packet.dst) in match of_mirage_nat_packet ~src:(`Client src) ~dst packet with | None -> Lwt.return_unit - | Some firewall_packet -> apply_rules t (Rules.from_client resolver) ~dst firewall_packet + | Some firewall_packet -> apply_rules t (Rules.from_client resolver dns_servers) ~dst firewall_packet let ipv4_from_netvm t packet = handle_low_memory t >>= function diff --git a/firewall.mli b/firewall.mli index 0141d94..c26cfbe 100644 --- a/firewall.mli +++ b/firewall.mli @@ -8,6 +8,6 @@ val ipv4_from_netvm : Router.t -> Nat_packet.t -> unit Lwt.t (* TODO the function type is a workaround, rework the module dependencies / functors to get rid of it *) val ipv4_from_client : ([ `host ] Domain_name.t -> (int32 * Ipaddr.V4.Set.t, [> `Msg of string ]) result Lwt.t) -> - Router.t -> src:Fw_utils.client_link -> Nat_packet.t -> unit Lwt.t + Ipaddr.V4.t list -> Router.t -> src:Fw_utils.client_link -> Nat_packet.t -> unit Lwt.t (** Handle a packet from a client. Caller must check the source IP matches the client's before calling this. *) diff --git a/rules.ml b/rules.ml index f72d6c0..9210b47 100644 --- a/rules.ml +++ b/rules.ml @@ -10,12 +10,6 @@ module Q = Pf_qubes.Parse_qubes let src = Logs.Src.create "rules" ~doc:"Firewall rules" module Log = (val Logs.src_log src : Logs.LOG) -(* the upstream NetVM will redirect TCP and UDP port 53 traffic with - these destination IPs to its upstream nameserver. *) -let default_dns_servers = [ - Ipaddr.V4.of_string_exn "10.139.1.1"; - Ipaddr.V4.of_string_exn "10.139.1.2"; -] let dns_port = 53 module Classifier = struct @@ -24,9 +18,9 @@ module Classifier = struct | None -> true | Some (Q.Range_inclusive (min, max)) -> min <= port && port <= max - let matches_proto rule packet = match rule.Q.proto, rule.Q.specialtarget with + let matches_proto rule dns_servers packet = match rule.Q.proto, rule.Q.specialtarget with | None, None -> true - | None, Some `dns when List.mem packet.ipv4_header.Ipv4_packet.dst default_dns_servers -> begin + | None, Some `dns when List.mem packet.ipv4_header.Ipv4_packet.dst dns_servers -> begin (* specialtarget=dns applies only to the specialtarget destination IPs, and specialtarget=dns is also implicitly tcp/udp port 53 *) match packet.transport_header with @@ -70,35 +64,35 @@ module Classifier = struct end -let find_first_match dns_client packet acc rule = +let find_first_match dns_client dns_servers packet acc rule = match acc with | `No_match -> - if Classifier.matches_proto rule packet + if Classifier.matches_proto rule dns_servers packet then Classifier.matches_dest dns_client rule packet else Lwt.return `No_match | q -> Lwt.return q (* Does the packet match our rules? *) -let classify_client_packet dns_client (packet : ([`Client of Fw_utils.client_link], _) Packet.t) = +let classify_client_packet dns_client dns_servers (packet : ([`Client of Fw_utils.client_link], _) Packet.t) = let (`Client client_link) = packet.src in let rules = client_link#get_rules in - Lwt_list.fold_left_s (find_first_match dns_client packet) `No_match rules >|= function + Lwt_list.fold_left_s (find_first_match dns_client dns_servers packet) `No_match rules >|= function | `No_match -> `Drop "No matching rule; assuming default drop" | `Match {Q.action = Q.Accept; _} -> `Accept | `Match ({Q.action = Q.Drop; _} as rule) -> `Drop (Format.asprintf "rule number %a explicitly drops this packet" Q.pp_rule rule) -let translate_accepted_packets dns_client packet = - classify_client_packet dns_client packet >|= function +let translate_accepted_packets dns_client dns_servers packet = + classify_client_packet dns_client dns_servers packet >|= function | `Accept -> `NAT | `Drop s -> `Drop s (** Packets from the private interface that don't match any NAT table entry are being checked against the fw rules here *) -let from_client dns_client (packet : ([`Client of Fw_utils.client_link], _) Packet.t) : Packet.action Lwt.t = +let from_client dns_client dns_servers (packet : ([`Client of Fw_utils.client_link], _) Packet.t) : Packet.action Lwt.t = match packet with - | { dst = `External _ ; _ } | { dst = `NetVM; _ } -> translate_accepted_packets dns_client packet + | { dst = `External _ ; _ } | { dst = `NetVM; _ } -> translate_accepted_packets dns_client dns_servers packet | { dst = `Firewall ; _ } -> Lwt.return @@ `Drop "packet addressed to firewall itself" - | { dst = `Client _ ; _ } -> classify_client_packet dns_client packet + | { dst = `Client _ ; _ } -> classify_client_packet dns_client dns_servers packet | _ -> Lwt.return @@ `Drop "could not classify packet" (** Packets from the outside world that don't match any NAT table entry are being dropped by default *) diff --git a/unikernel.ml b/unikernel.ml index 6f06efd..02cb5a3 100644 --- a/unikernel.ml +++ b/unikernel.ml @@ -13,12 +13,12 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_tim module Dns_client = Dns_client.Make(Dns_transport) (* Set up networking and listen for incoming packets. *) - let network dns_client dns_responses uplink qubesDB router = + let network dns_client dns_responses dns_servers uplink qubesDB router = (* Report success *) Dao.set_iptables_error qubesDB "" >>= fun () -> (* Handle packets from both networks *) Lwt.choose [ - Client_net.listen Clock.elapsed_ns dns_client qubesDB router; + Client_net.listen Clock.elapsed_ns dns_client dns_servers qubesDB router; Uplink.listen uplink Clock.elapsed_ns dns_responses router ] @@ -63,10 +63,11 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_tim let send_dns_query = Uplink.send_dns_client_query uplink in let dns_mvar = Lwt_mvar.create_empty () in - let nameservers = `Udp, [ config.Dao.dns, 53 ] in + let nameservers = `Udp, [ config.Dao.dns, 53 ; config.Dao.dns2, 53 ] 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 + let dns_servers = [ config.Dao.dns ; config.Dao.dns2 ] in + let net_listener = network (Dns_client.getaddrinfo dns_client Dns.Rr_map.A) dns_mvar dns_servers uplink qubesDB router in (* Report memory usage to XenStore *) Memory_pressure.init ();