Merge pull request #64 from talex5/combine-ips

Combine Client_gateway and Firewall_uplink

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: 888cfd66e54c14da75be2bc4272efdb74c2ec8f9f144979f508a09410121482e"
+echo "SHA2 last known: 5ee982b12fb3964e7d9e32ca74ce377ec068b3bbef2b6c86c131f8bb422a3134"
 echo "(hashes should match for released versions)"

client_eth.ml

@@ -15,7 +15,7 @@ type t = {
 
 type host =
   [ `Client of client_link
-  | `Client_gateway
+  | `Firewall
   | `External of Ipaddr.t ]
 
 let create ~client_gw =
@@ -52,14 +52,14 @@ let classify t ip =
   match ip with
   | Ipaddr.V6 _ -> `External ip
   | Ipaddr.V4 ip4 ->
-    if ip4 = t.client_gw then `Client_gateway
+    if ip4 = t.client_gw then `Firewall
     else match lookup t ip4 with
       | Some client_link -> `Client client_link
       | None -> `External ip
 
 let resolve t : host -> Ipaddr.t = function
   | `Client client_link -> Ipaddr.V4 client_link#other_ip
-  | `Client_gateway -> Ipaddr.V4 t.client_gw
+  | `Firewall -> Ipaddr.V4 t.client_gw
   | `External addr -> addr
 
 module ARP = struct

client_eth.mli

@@ -11,7 +11,7 @@ type t
 
 type host =
   [ `Client of client_link
-  | `Client_gateway
+  | `Firewall
   | `External of Ipaddr.t ]
 (* Note: Qubes does not allow us to distinguish between an external address and a
    disconnected client.

firewall.ml

@@ -59,7 +59,7 @@ let resolve_client client =
 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
+  | (`Firewall | `NetVM) as x -> x
 
 let classify ~src ~dst packet =
   let `IPv4 (_ip, transport) = packet in
@@ -84,8 +84,7 @@ let pp_host fmt = function
   | `Unknown_client ip -> Format.fprintf fmt "unknown-client(%a)" Ipaddr.pp ip
   | `NetVM -> Format.pp_print_string fmt "net-vm"
   | `External ip -> Format.fprintf fmt "external(%a)" Ipaddr.pp ip
-  | `Firewall_uplink -> Format.pp_print_string fmt "firewall(uplink)"
-  | `Client_gateway -> Format.pp_print_string fmt "firewall(client-gw)"
+  | `Firewall -> Format.pp_print_string fmt "firewall"
 
 let pp_proto fmt = function
   | `UDP ports -> Format.fprintf fmt "UDP(%a)" pp_ports ports
@@ -146,7 +145,7 @@ let apply_rules t rules ~dst info =
   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) ->
+  | `Accept, `Firewall ->
       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
@@ -189,7 +188,7 @@ let ipv4_from_netvm t packet =
   | None -> return ()
   | Some info ->
   match src with
-  | `Client _ | `Firewall_uplink | `Client_gateway ->
+  | `Client _ | `Firewall ->
     Log.warn (fun f -> f "Frame from NetVM has internal source IP address! %a" (pp_packet t) info);
     return ()
   | `External _ | `NetVM as src ->

packet.ml

@@ -11,7 +11,7 @@ type ports = {
 }
 
 type host = 
-  [ `Client of client_link | `Client_gateway | `Firewall_uplink | `NetVM | `External of Ipaddr.t ]
+  [ `Client of client_link | `Firewall | `NetVM | `External of Ipaddr.t ]
 
 type ('src, 'dst) info = {
   packet : Nat_packet.t;

router.ml

@@ -24,11 +24,11 @@ let add_client t = Client_eth.add_client t.client_eth
 let remove_client t = Client_eth.remove_client t.client_eth
 
 let classify t ip =
-  if ip = Ipaddr.V4 t.uplink#my_ip then `Firewall_uplink
+  if ip = Ipaddr.V4 t.uplink#my_ip then `Firewall
   else if ip = Ipaddr.V4 t.uplink#other_ip then `NetVM
   else (Client_eth.classify t.client_eth ip :> Packet.host)
 
 let resolve t = function
-  | `Firewall_uplink -> Ipaddr.V4 t.uplink#my_ip
+  | `Firewall -> Ipaddr.V4 t.uplink#my_ip
   | `NetVM -> Ipaddr.V4 t.uplink#other_ip
   | #Client_eth.host as host -> Client_eth.resolve t.client_eth host

rules.ml

@@ -51,8 +51,8 @@ let from_client (info : ([`Client of _], _) Packet.info) : Packet.action =
   | { 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 = `Firewall; proto = `UDP { dport = 53 } } -> `NAT_to (`NetVM, 53)
+  | { dst = `Firewall } -> `Drop "packet addressed to firewall itself"
   | { dst = `Client _ } -> `Drop "prevent communication between client VMs by default"
 
 (** Decide what to do with a packet received from the outside world.