Git-Mirrors/qubes-mirage-firewall
1
0
Fork 0
mirror of https://github.com/mirage/qubes-mirage-firewall.git synced 2025-04-25 01:19:18 -04:00
Code Issues Packages Projects Releases Wiki Activity

apply rules to incoming traffic (but...)

Browse Source 
...we try to read them before they've been written to QubesDB, so we
think there aren't any.  To get useful results, we'll need to either
delay the rule read, or implement a proper watcher for the firewall
rules using the QubesDB watch interface.
This commit is contained in:
Mindy 2019-05-23 17:40:07 -05:00
parent 068c5dca9b
commit b15dd32df8
6 changed files with 65 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
client_net.ml
View File

@ -31,6 +31,7 @@ class client_iface eth ~domid ~gateway_ip ~client_ip client_mac rules : client_l
object
val queue = FrameQ.create (Ipaddr.V4.to_string client_ip)
val rules = rules
method get_rules = rules
method my_mac = ClientEth.mac eth
method other_mac = client_mac
method my_ip = gateway_ip
@ -103,7 +104,8 @@ let add_vif { Dao.ClientVif.domid; device_id } ~client_ip ~router ~cleanup_tasks
(** A new client VM has been found in XenStore. Find its interface and connect to it. *)
let add_client ~router vif client_ip rules =
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);
Log.info (fun f -> f "add client vif %a with IP %a and %d firewall rules"
Dao.ClientVif.pp vif Ipaddr.V4.pp client_ip (List.length rules));
Lwt.async (fun () ->
Lwt.catch (fun () ->
add_vif vif ~client_ip ~router ~cleanup_tasks rules
@ -138,6 +140,7 @@ let listen qubesDB router =
new_set |> Dao.VifMap.iter (fun key (ip_addr, rules) ->
if not (Dao.VifMap.mem key !clients) then (
let cleanup = add_client ~router key ip_addr rules in
Log.debug (fun f -> f "client %a arrived with %d rules" Dao.ClientVif.pp key (List.length rules));
clients := !clients |> Dao.VifMap.add key cleanup
)
)

31
dao.ml
View File

@ -36,20 +36,32 @@ let directory ~handle dir =
let read_rules qubesDB client_ip =
let root = "/qubes-firewall/" ^ (Ipaddr.V4.to_string client_ip) ^ "/" in
let rec get_rule n l =
let rec get_rule n l : (Pf_qubes.Parse_qubes.rule list, string) result =
let pattern = root ^ Printf.sprintf "%04d" n in
Log.info (fun f -> f "reading %s" pattern);
Log.debug (fun f -> f "reading %s" pattern);
match Qubes.DB.read qubesDB pattern with
| None ->
Log.info (fun f -> f "rule %d was empty " n);
List.rev l
Log.debug (fun f -> f "rule %d does not exist; won't look for more" n);
Ok (List.rev l)
| Some rule ->
Log.info (fun f -> f "rule %d: %s" n rule);
Log.debug (fun f -> f "rule %d: %s" n rule);
match Pf_qubes.Parse_qubes.parse_qubes ~number:n rule with
| Error e -> (* TODOOOOOOO!! Traffic should be dropped!!*) l
| Ok rule -> get_rule (n+1) (rule :: l)
| Error e -> Log.warn (fun f -> f "Error parsing rule %d: %s" n e); Error e
| Ok rule ->
Log.debug (fun f -> f "parsed rule: %a" Pf_qubes.Parse_qubes.pp_rule rule);
get_rule (n+1) (rule :: l)
in
get_rule 0 []
match get_rule 0 [] with
| Ok l -> l
| Error e ->
Log.warn (fun f -> f "Defaulting to deny-all because of rule parse failure (%s)" e);
[ Pf_qubes.Parse_qubes.({action = Drop;
proto = None;
specialtarget = None;
dst = `any;
dstports = [];
icmp_type = None;
number = 0;})]
let vifs qubesDB ~handle domid =
match String.to_int domid with
@ -131,7 +143,4 @@ let read_network_config qubesDB =
in
aux (DB.bindings qubesDB)
let read_fw_rules qubesDB domid =
[]
let set_iptables_error db = Qubes.DB.write db "/qubes-iptables-error"

2
dao.mli
View File

@ -30,6 +30,4 @@ 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 read_fw_rules: Qubes.DB.t -> int -> Pf_qubes.Parse_qubes.rule list
val set_iptables_error : Qubes.DB.t -> string -> unit Lwt.t

23
firewall.ml
View File

@ -50,17 +50,6 @@ let forward_ipv4 t packet =
let parse_ips ips = List.map (fun (ip_str, id) -> (Ipaddr.of_string_exn ip_str, id)) ips
let clients = parse_ips Rules.clients
let externals = parse_ips Rules.externals
let resolve_client client =
`Client (try List.assoc (Ipaddr.V4 client#other_ip) clients with Not_found -> `Unknown)
let resolve_host = function
| `Client c -> resolve_client c
| `External ip -> `External (try List.assoc ip externals with Not_found -> `Unknown)
| (`Client_gateway | `Firewall_uplink | `NetVM) as x -> x
(* NAT *)
let translate t packet =
@ -97,7 +86,9 @@ let apply_rules t (rules : ('a, 'b) Packet.t -> Packet.action) ~dst (annotated_p
| `Accept, (`Firewall_uplink | `Client_gateway) ->
Log.warn (fun f -> f "Bad rule: firewall can't accept packets %a" Nat_packet.pp packet);
return ()
| `NAT, _ -> add_nat_and_forward_ipv4 t packet
| `NAT, _ ->
Log.debug (fun f -> f "adding NAT rule for %a" Nat_packet.pp packet);
add_nat_and_forward_ipv4 t packet
| `NAT_to (host, port), _ -> nat_to t packet ~host ~port
| `Drop reason, _ ->
Log.info (fun f -> f "Dropped packet (%s) %a" reason Nat_packet.pp packet);
@ -122,11 +113,7 @@ let ipv4_from_client t ~src packet =
(* No existing NAT entry. Check the firewall rules. *)
let `IPv4 (ip, _transport) = packet in
let dst = Router.classify t (Ipaddr.V4 ip.Ipv4_packet.dst) in
let src = Router.classify t (Ipaddr.V4 ip.Ipv4_packet.src) in
match of_mirage_nat_packet
~src:(src)
~dst:(resolve_host dst)
packet with
match of_mirage_nat_packet ~src:(`Client src) ~dst packet with
| None -> return ()
| Some firewall_packet -> apply_rules t Rules.from_client ~dst firewall_packet
@ -137,7 +124,7 @@ let ipv4_from_netvm t packet =
let `IPv4 (ip, _transport) = packet in
let src = Router.classify t (Ipaddr.V4 ip.Ipv4_packet.src) in
let dst = Router.classify t (Ipaddr.V4 ip.Ipv4_packet.dst) in
match Packet.of_mirage_nat_packet ~src ~dst:(resolve_host dst) packet with
match Packet.of_mirage_nat_packet ~src ~dst packet with
| None -> Lwt.return_unit
| Some _ ->
match src with

92
rules.ml
View File

@ -1,34 +1,19 @@
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *)
(** Put your firewall rules in this file. *)
(** Enforce firewall rules from QubesDB. *)
open Packet (* Allow us to use definitions in packet.ml *)
open Packet
module Q = Pf_qubes.Parse_qubes
let src = Logs.Src.create "rules" ~doc:"Firewall rules"
module Log = (val Logs.src_log src : Logs.LOG)
let dns_port = 53
(* List your AppVM IP addresses here if you want to match on them in the rules below.
Any client not listed here will appear as [`Client `Unknown]. *)
let clients = [
(*
"10.137.0.12", `Dev;
"10.137.0.14", `Untrusted;
*)
]
(* List your external (non-AppVM) IP addresses here if you want to match on them in the rules below.
Any external machine not listed here will appear as [`External `Unknown]. *)
let externals = [
(*
"8.8.8.8", `GoogleDNS;
*)
]
(* OCaml normally warns if you don't match all fields, but that's OK here. *)
[@@@ocaml.warning "-9"]
module Q = Pf_qubes.Parse_qubes
(* we want to replace this list with a structure including rules from QubesDB.
we need:
1) code for reading the rules (we have some for noticing new clients: dao.ml)
@ -40,19 +25,11 @@ module Q = Pf_qubes.Parse_qubes
- initially we can set them up with a list, and then look for faster/better/clearer structures later
4) code for applying the rules to incoming traffic (below, already in this file)
*)
let dummy_rules =
Pf_qubes.Parse_qubes.([{ action = Drop ;
proto = None ;
specialtarget = None ;
dst = `any ;
dstports = [] ;
icmp_type = None ;
number = 0 ;
}])
(* Does the packet match our rules? *)
let classify_client_packet (packet : ([`Client of _], _) Packet.t) (client_link : Fw_utils.client_link) : Packet.action =
let classify_client_packet (packet : ([`Client of Fw_utils.client_link], _) Packet.t) : Packet.action =
let matches_port dstports (port : int) =
List.length dstports = 0 ||
List.exists (fun (Q.Range_inclusive (min, max)) -> (min <= port && port <= max)) dstports
in
let matches_proto rule packet = match rule.Pf_qubes.Parse_qubes.proto with
@ -74,15 +51,25 @@ let classify_client_packet (packet : ([`Client of _], _) Packet.t) (client_link
| `hosts subnet ->
Ipaddr.Prefix.mem (V4 packet.ipv4_header.Ipv4_packet.dst) subnet
in
let action = List.fold_left (fun found rule -> match found with
| Some action -> Some action
| None -> if matches_proto rule packet && matches_dest rule packet then Some rule.action else None) None client_link#get_rules
in
match action with
| None -> `Drop "No matching rule"
| Some Accept -> `Accept
| Some Drop -> `Drop "Drop rule matched"
let (`Client client_link) = packet.src in
Log.debug (fun f -> f "checking %d rules for a match" (List.length client_link#get_rules));
List.find_opt (fun rule ->
if not (matches_proto rule packet) then begin
Log.debug (fun f -> f "rule %d is not a match - proto" rule.Q.number);
false
end else if not (matches_dest rule packet) then begin
Log.debug (fun f -> f "rule %d is not a match - dest" rule.Q.number);
false
end else begin
Log.debug (fun f -> f "rule %d is a match" rule.Q.number);
true
end) client_link#get_rules |> function
| None -> `Drop "No matching rule; assuming default drop"
| Some {Q.action = Accept; number; _} ->
Log.debug (fun f -> f "allowing packet matching rule %d" number);
`Accept
| Some {Q.action = Drop; number; _} ->
`Drop (Printf.sprintf "rule %d explicitly drops this packet" number)
(** This function decides what to do with a packet from a client VM.
@ -94,28 +81,19 @@ let classify_client_packet (packet : ([`Client of _], _) Packet.t) (client_link
Note: If the packet matched an existing NAT rule then this isn't called. *)
let from_client (packet : ([`Client of Fw_utils.client_link], _) Packet.t) : Packet.action =
match packet with
(* Examples (add your own rules here):
1. Allows Dev to send SSH packets to Untrusted.
Note: responses are not covered by this!
2. Allows Untrusted to reply to Dev.
3. Blocks an external site.
In all cases, make sure you've added the VM name to [clients] or [externals] above, or it won't
match anything! *)
(*
| { src = `Client `Dev; dst = `Client `Untrusted; proto = `TCP { dport = 22 } } -> `Accept
| { src = `Client `Untrusted; dst = `Client `Dev; proto = `TCP _; packet }
when not (is_tcp_start packet) -> `Accept
| { dst = `External `GoogleDNS } -> `Drop "block Google DNS"
*)
| { dst = (`External _ | `NetVM) } -> `NAT
| { dst = (`External _ | `NetVM) } -> begin
(* see whether this traffic is allowed *)
match classify_client_packet packet with
| `Accept -> `NAT
| `Drop s -> `Drop s
end
| { dst = `Client_gateway; transport_header = `UDP header; _ } ->
(* TODO: this is where we should implement specialtarget dns rules? *)
if header.dst_port = dns_port
then `NAT_to (`NetVM, dns_port)
else `Drop "packet addressed to client gateway"
| { dst = (`Client_gateway | `Firewall_uplink) } -> `Drop "packet addressed to firewall itself"
| { dst = `Client client_link } -> classify_client_packet packet client_link
| { dst = `Client _ } -> classify_client_packet packet
(** Decide what to do with a packet received from the outside world.
Note: If the packet matched an existing NAT rule then this isn't called. *)

2
test/test.sh
View File

@ -76,7 +76,7 @@ fi
echo "We're gonna set up a unikernel for the mirage-fw-test qube"
cd ..
mirage configure -t xen && \
mirage configure -t xen -l "*:debug" && \
make depend && \
make
if [ $? -ne 0 ]; then