qubes-mirage-firewall/router.ml

(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
   See the README file for details. *)

open Fw_utils

(* The routing table *)

type t = {
  client_eth : Client_eth.t;
  nat : My_nat.t;
  uplink : interface;
}

let create ~client_eth ~uplink ~nat =
  { client_eth; nat; uplink }

let target t buf =
  let dst_ip = buf.Ipv4_packet.dst in
  match Client_eth.lookup t.client_eth dst_ip with
  | Some client_link -> Some (client_link :> interface)
  | None -> Some t.uplink

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
  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
  | `NetVM -> Ipaddr.V4 t.uplink#other_ip
  | #Client_eth.host as host -> Client_eth.resolve t.client_eth host
Initial import 2015-12-30 04:52:24 -05:00			`(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>`
			`See the README file for details. *)`

Mirage 3 support 2017-03-02 09:52:55 -05:00			`open Fw_utils`
Initial import 2015-12-30 04:52:24 -05:00
Move NAT code to router and add DNS redirects 2015-12-30 11:07:16 -05:00			`(* The routing table *)`

Initial import 2015-12-30 04:52:24 -05:00			`type t = {`
Moved client networking to its own module Renamed the old Client_net to Client_eth, as it just handles the Ethernet layer. 2015-12-30 08:48:13 -05:00			`client_eth : Client_eth.t;`
Mirage 3 support 2017-03-02 09:52:55 -05:00			`nat : My_nat.t;`
Rationalised firewall rules syntax Added explicit NAT target, allowing NAT even within client net and making it clear that NAT is used externally. Changed Redirect_to_netvm to NAT_to, and allow specifying any target host. 2016-01-01 06:32:57 -05:00			`uplink : interface;`
Initial import 2015-12-30 04:52:24 -05:00			`}`

Mirage 3 support 2017-03-02 09:52:55 -05:00			`let create ~client_eth ~uplink ~nat =`
Rationalised firewall rules syntax Added explicit NAT target, allowing NAT even within client net and making it clear that NAT is used externally. Changed Redirect_to_netvm to NAT_to, and allow specifying any target host. 2016-01-01 06:32:57 -05:00			`{ client_eth; nat; uplink }`
Initial import 2015-12-30 04:52:24 -05:00
			`let target t buf =`
Mirage 3 support 2017-03-02 09:52:55 -05:00			`let dst_ip = buf.Ipv4_packet.dst in`
Allow clients to have any IP address We previously assumed that Qubes would always give clients IP addresses on a particular network. However, it is not required to do this and in fact uses a different network for disposable VMs. With this change: - We no longer reject clients with unknown IP addresses - The `Unknown_client` classification is gone; we have no way to tell the difference between a client that isn't connected and an external address. - We now consider every client to be on a point-to-point link and do not answer ARP requests on behalf of other clients. Clients should assume their netmask is 255.255.255.255 (and ignore /qubes-netmask). This is a partial fix for #9. It allows disposable VMs to connect to the firewall but for some reason they don't process any frames we send them (we get their ARP requests but they don't get our replies). Taking eth0 down in the disp VM, then bringing it back up (and re-adding the routes) allows it to work. 2016-09-25 09:38:17 -04:00			`match Client_eth.lookup t.client_eth dst_ip with`
			`\| Some client_link -> Some (client_link :> interface)`
			`\| None -> Some t.uplink`
Initial import 2015-12-30 04:52:24 -05:00
Moved client networking to its own module Renamed the old Client_net to Client_eth, as it just handles the Ethernet layer. 2015-12-30 08:48:13 -05:00			`let add_client t = Client_eth.add_client t.client_eth`
			`let remove_client t = Client_eth.remove_client t.client_eth`

Move NAT code to router and add DNS redirects 2015-12-30 11:07:16 -05:00			`let classify t ip =`
Rationalised firewall rules syntax Added explicit NAT target, allowing NAT even within client net and making it clear that NAT is used externally. Changed Redirect_to_netvm to NAT_to, and allow specifying any target host. 2016-01-01 06:32:57 -05:00			if ip = Ipaddr.V4 t.uplink#my_ip then `Firewall_uplink
			else if ip = Ipaddr.V4 t.uplink#other_ip then `NetVM
Move NAT code to router and add DNS redirects 2015-12-30 11:07:16 -05:00			`else (Client_eth.classify t.client_eth ip :> Packet.host)`
Rationalised firewall rules syntax Added explicit NAT target, allowing NAT even within client net and making it clear that NAT is used externally. Changed Redirect_to_netvm to NAT_to, and allow specifying any target host. 2016-01-01 06:32:57 -05:00
			`let resolve t = function`
			\| `Firewall_uplink -> 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`