Git-Mirrors
/
qubes-mirage-firewall
mirror of https://github.com/mirage/qubes-mirage-firewall.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

in rules, instead of hardcoding IPv4 addresses of name servers, use those present in QubesDB

This commit is contained in:
Hannes Mehnert 2022-09-07 16:53:45 +02:00
parent 5fdcaae7e8
commit c643f97700
8 changed files with 37 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
client_net.ml
View File

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

4
client_net.mli
View File

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

10
dao.ml
View File

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

1
dao.mli
View File

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

4
firewall.ml
View File

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

2
firewall.mli
View File

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

28
rules.ml
View File

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

9
unikernel.ml
View File

@ -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 ();