diff --git a/.gitignore b/.gitignore
index f5cd959..bd2f111 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,4 @@
-Makefile
+/Makefile
_build/
log
key_gen.ml
diff --git a/README.md b/README.md
index bfbef5f..960e568 100644
--- a/README.md
+++ b/README.md
@@ -86,6 +86,29 @@ qvm-prefs --set my-app-vm netvm mirage-firewall
Alternatively, you can configure `mirage-firewall` to be your default firewall VM.
+### Components
+
+This diagram show the main components (each box corresponds to a source `.ml` file with the same name):
+
+
+
+
+
+Ethernet frames arrives from client qubes (such as `work` or `personal`) or from `sys-net`.
+Internet (IP) packets are sent to `firewall`, which consults `rules` to decide what to do with the packet.
+If it should be sent on, it uses `router` to send it to the chosen destination.
+`client_net` watches the XenStore database provided by dom0
+to find out when clients need to be added or removed.
+
+The boot process:
+
+- `config.ml` describes the libraries used and static configuration settings (NAT table size).
+ The `mirage` tool uses this to generate `main.ml`.
+- `main.ml` initialises the drivers selected by `config.ml`
+ and calls the `start` function in `unikernel.ml`.
+- `unikernel.ml` connects the Qubes agents, sets up the networking components,
+ and then waits for a shutdown request.
+
### Easy deployment for developers
For development, use the [test-mirage][] scripts to deploy the unikernel (`qubes_firewall.xen`) from your development AppVM.
diff --git a/build-with-docker.sh b/build-with-docker.sh
index d14c057..7345ca5 100755
--- a/build-with-docker.sh
+++ b/build-with-docker.sh
@@ -5,5 +5,5 @@ docker build -t qubes-mirage-firewall .
echo Building Firewall...
docker run --rm -i -v `pwd`:/home/opam/qubes-mirage-firewall qubes-mirage-firewall
echo "SHA2 of build: $(sha256sum qubes_firewall.xen)"
-echo "SHA2 last known: dbf7460fa628bea5d132a96fe7ba2cd832e3d9da7005ae74f6a124957f4848ea"
+echo "SHA2 last known: 888cfd66e54c14da75be2bc4272efdb74c2ec8f9f144979f508a09410121482e"
echo "(hashes should match for released versions)"
diff --git a/client_net.ml b/client_net.ml
index 0649567..68fe6d3 100644
--- a/client_net.ml
+++ b/client_net.ml
@@ -56,7 +56,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 ~client_ip ~router packet =
+let input_ipv4 ~iface ~router packet =
match Nat_packet.of_ipv4_packet packet with
| Error e ->
Log.warn (fun f -> f "Ignored unknown IPv4 message: %a" Nat_packet.pp_error e);
@@ -64,10 +64,10 @@ let input_ipv4 ~client_ip ~router packet =
| Ok packet ->
let `IPv4 (ip, _) = packet in
let src = ip.Ipv4_packet.src in
- if src = client_ip then Firewall.ipv4_from_client router packet
+ if src = iface#other_ip then Firewall.ipv4_from_client 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 client_ip);
+ Ipaddr.V4.pp src Ipaddr.V4.pp iface#other_ip);
return ()
)
@@ -94,7 +94,7 @@ let add_vif { Dao.ClientVif.domid; device_id } ~client_ip ~router ~cleanup_tasks
| Ok (eth, payload) ->
match eth.Ethernet_packet.ethertype with
| `ARP -> input_arp ~fixed_arp ~iface payload
- | `IPv4 -> input_ipv4 ~client_ip ~router payload
+ | `IPv4 -> input_ipv4 ~iface ~router payload
| `IPv6 -> return () (* TODO: oh no! *)
)
>|= or_raise "Listen on client interface" Netback.pp_error
diff --git a/diagrams/Makefile b/diagrams/Makefile
new file mode 100644
index 0000000..a6fbc5f
--- /dev/null
+++ b/diagrams/Makefile
@@ -0,0 +1,6 @@
+# Requires https://github.com/blampe/goat
+
+all: components.svg
+
+%.svg: %.txt
+ goat $^ > $@
diff --git a/diagrams/components.svg b/diagrams/components.svg
new file mode 100644
index 0000000..1e996b1
--- /dev/null
+++ b/diagrams/components.svg
@@ -0,0 +1,149 @@
+
diff --git a/diagrams/components.txt b/diagrams/components.txt
new file mode 100644
index 0000000..62e4f9e
--- /dev/null
+++ b/diagrams/components.txt
@@ -0,0 +1,20 @@
+ +----------+
+ | rules |
+ +----------+
+ ^
+ |checks
+ |
+ +------------+ +-----+----+
+ work <---->| +---->| firewall |<--------.
+ | | +-----+----+ |
+ | | | +----+---+
+ [...] <---->| client_net | | | uplink |<----> sys-net
+ | | v +--------+
+ | | +----------+ ^
+personal <---->| |<----+ router +---------'
+ +------+-----+ +----------+
+ |
+ |monitors
+ v
+ XenStore
+ (dom0)
diff --git a/firewall.ml b/firewall.ml
index 39254d3..cbb47b7 100644
--- a/firewall.ml
+++ b/firewall.ml
@@ -48,8 +48,21 @@ let forward_ipv4 t packet =
(* Packet classification *)
-let classify t packet =
- let `IPv4 (ip, transport) = packet in
+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
+
+let classify ~src ~dst packet =
+ let `IPv4 (_ip, transport) = packet in
let proto =
match transport with
| `TCP ({Tcp.Tcp_packet.src_port; dst_port; _}, _) -> `TCP {sport = src_port; dport = dst_port}
@@ -58,8 +71,8 @@ let classify t packet =
in
Some {
packet;
- src = Router.classify t (Ipaddr.V4 ip.Ipv4_packet.src);
- dst = Router.classify t (Ipaddr.V4 ip.Ipv4_packet.dst);
+ src;
+ dst;
proto;
}
@@ -80,7 +93,10 @@ let pp_proto fmt = function
| `ICMP -> Format.pp_print_string fmt "ICMP"
| `Unknown -> Format.pp_print_string fmt "UnknownProtocol"
-let pp_packet fmt {src; dst; proto; packet = _} =
+let pp_packet t fmt {src = _; dst = _; proto; 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
Format.fprintf fmt "[src=%a dst=%a proto=%a]"
pp_host src
pp_host dst
@@ -125,18 +141,18 @@ let nat_to t ~host ~port packet =
(* Handle incoming packets *)
-let apply_rules t rules info =
+let apply_rules t rules ~dst info =
let packet = info.packet in
- match rules info, info.dst with
+ match rules info, dst with
| `Accept, `Client client_link -> transmit_ipv4 packet client_link
| `Accept, (`External _ | `NetVM) -> transmit_ipv4 packet t.Router.uplink
| `Accept, (`Firewall_uplink | `Client_gateway) ->
- Log.warn (fun f -> f "Bad rule: firewall can't accept packets %a" pp_packet info);
+ Log.warn (fun f -> f "Bad rule: firewall can't accept packets %a" (pp_packet t) info);
return ()
| `NAT, _ -> 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 pp_packet info);
+ Log.info (fun f -> f "Dropped packet (%s) %a" reason (pp_packet t) info);
return ()
let handle_low_memory t =
@@ -147,7 +163,7 @@ let handle_low_memory t =
`Memory_critical
| `Ok -> Lwt.return `Ok
-let ipv4_from_client t packet =
+let ipv4_from_client t ~src packet =
handle_low_memory t >>= function
| `Memory_critical -> return ()
| `Ok ->
@@ -156,23 +172,28 @@ let ipv4_from_client t packet =
| Some frame -> forward_ipv4 t frame (* Some existing connection or redirect *)
| None ->
(* No existing NAT entry. Check the firewall rules. *)
- match classify t packet with
+ let `IPv4 (ip, _transport) = packet in
+ let dst = Router.classify t (Ipaddr.V4 ip.Ipv4_packet.dst) in
+ match classify ~src:(resolve_client src) ~dst:(resolve_host dst) packet with
| None -> return ()
- | Some info -> apply_rules t Rules.from_client info
+ | Some info -> apply_rules t Rules.from_client ~dst info
let ipv4_from_netvm t packet =
handle_low_memory t >>= function
| `Memory_critical -> return ()
| `Ok ->
- match classify t packet with
+ 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 classify ~src ~dst:(resolve_host dst) packet with
| None -> return ()
| Some info ->
- match info.src with
+ match src with
| `Client _ | `Firewall_uplink | `Client_gateway ->
- Log.warn (fun f -> f "Frame from NetVM has internal source IP address! %a" pp_packet info);
+ Log.warn (fun f -> f "Frame from NetVM has internal source IP address! %a" (pp_packet t) info);
return ()
- | `External _ | `NetVM ->
+ | `External _ | `NetVM as src ->
translate t packet >>= function
| Some frame -> forward_ipv4 t frame
| None ->
- apply_rules t Rules.from_netvm info
+ apply_rules t Rules.from_netvm ~dst { info with src }
diff --git a/firewall.mli b/firewall.mli
index 3909ee0..9900f56 100644
--- a/firewall.mli
+++ b/firewall.mli
@@ -6,6 +6,6 @@
val ipv4_from_netvm : Router.t -> Nat_packet.t -> unit Lwt.t
(** Handle a packet from the outside world (this module will validate the source IP). *)
-val ipv4_from_client : Router.t -> Nat_packet.t -> unit Lwt.t
+val ipv4_from_client : 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/packet.ml b/packet.ml
index a9fa4e7..d9b49bb 100644
--- a/packet.ml
+++ b/packet.ml
@@ -13,9 +13,25 @@ type ports = {
type host =
[ `Client of client_link | `Client_gateway | `Firewall_uplink | `NetVM | `External of Ipaddr.t ]
-type info = {
+type ('src, 'dst) info = {
packet : Nat_packet.t;
- src : host;
- dst : host;
+ src : 'src;
+ dst : 'dst;
proto : [ `UDP of ports | `TCP of ports | `ICMP | `Unknown ];
}
+
+(* The first message in a TCP connection has SYN set and ACK clear. *)
+let is_tcp_start = function
+ | `IPv4 (_ip, `TCP (hdr, _body)) -> Tcp.Tcp_packet.(hdr.syn && not hdr.ack)
+ | _ -> false
+
+(* The possible actions we can take for a packet: *)
+type action = [
+ | `Accept (* Send the packet to its destination. *)
+ | `NAT (* Rewrite the packet's source field so packet appears to
+ have come from the firewall, via an unused port.
+ Also, add NAT rules so related packets will be translated accordingly. *)
+ | `NAT_to of host * port (* As for [`NAT], but also rewrite the packet's
+ destination fields so it will be sent to [host:port]. *)
+ | `Drop of string (* Drop the packet and log the given reason. *)
+]
diff --git a/rules.ml b/rules.ml
index 7e62790..3959d14 100644
--- a/rules.ml
+++ b/rules.ml
@@ -1,39 +1,62 @@
(* Copyright (C) 2015, Thomas Leonard
See the README file for details. *)
-(** Put your firewall rules here. *)
+(** Put your firewall rules in this file. *)
-open Packet
+open Packet (* Allow us to use definitions in packet.ml *)
+
+(* 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"]
-(** {2 Actions}
+(** This function decides what to do with a packet from a client VM.
- The possible actions are:
+ It takes as input an argument [info] (of type [Packet.info]) describing the
+ packet, and returns an action (of type [Packet.action]) to perform.
- - [`Accept] : Send the packet to its destination.
+ See packet.ml for the definitions of [info] and [action].
- - [`NAT] : Rewrite the packet's source field so packet appears to
- have come from the firewall, via an unused port.
- Also, add NAT rules so related packets will be translated accordingly.
-
- - [`NAT_to (host, port)] :
- As for [`NAT], but also rewrite the packet's destination fields so it
- will be sent to [host:port].
-
- - [`Drop reason] drop the packet and log the reason.
-*)
-
-(** Decide what to do with a packet from a client VM.
Note: If the packet matched an existing NAT rule then this isn't called. *)
-let from_client = function
+let from_client (info : ([`Client of _], _) Packet.info) : Packet.action =
+ match info 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 = `Client_gateway; proto = `UDP { dport = 53 } } -> `NAT_to (`NetVM, 53)
| { dst = (`Client_gateway | `Firewall_uplink) } -> `Drop "packet addressed to firewall itself"
- | { dst = `Client _ } -> `Drop "prevent communication between client VMs"
+ | { dst = `Client _ } -> `Drop "prevent communication between client VMs by default"
(** 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. *)
-let from_netvm = function
+let from_netvm (info : ([`NetVM | `External of _], _) Packet.info) : Packet.action =
+ match info with
| _ -> `Drop "drop by default"
+