qubes-mirage-firewall/packet.ml

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

open Fw_utils

type port = int

type ports = {
  sport : port; (* Source port *)
  dport : port; (* Destination *)
}

type host = 
  [ `Client of client_link | `Client_gateway | `Firewall_uplink | `NetVM | `External of Ipaddr.t ]

type ('src, 'dst) info = {
  packet : Nat_packet.t;
  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. *)
]
Move NAT code to router and add DNS redirects 2015-12-30 11:07:16 -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`
Move NAT code to router and add DNS redirects 2015-12-30 11:07:16 -05:00
			`type port = int`

			`type ports = {`
			`sport : port; (* Source port *)`
			`dport : port; (* Destination *)`
			`}`

			`type host =`
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			[ `Client of client_link \| `Client_gateway \| `Firewall_uplink \| `NetVM \| `External of Ipaddr.t ]
Move NAT code to router and add DNS redirects 2015-12-30 11:07:16 -05:00
Give exact types for Packet.src Before, the packet passed to rules.ml could have any host as its src. Now, `from_client` knows that `src` must be a `Client`, and `from_netvm` knows that `src` is `External` or `NetVM`. 2019-04-17 06:03:17 -04:00			`type ('src, 'dst) info = {`
Update to new mirage-nat API 2017-03-05 11:31:04 -05:00			`packet : Nat_packet.t;`
Give exact types for Packet.src Before, the packet passed to rules.ml could have any host as its src. Now, `from_client` knows that `src` must be a `Client`, and `from_netvm` knows that `src` is `External` or `NetVM`. 2019-04-17 06:03:17 -04:00			`src : 'src;`
			`dst : 'dst;`
Move NAT code to router and add DNS redirects 2015-12-30 11:07:16 -05:00			proto : [ `UDP of ports \| `TCP of ports \| `ICMP \| `Unknown ];
			`}`
Allow naming hosts and add examples to rules.ml Previously we passed in the interface, from which it was possible (but a little difficult) to extract the IP address and compare with some predefined ones. Now, we allow the user to list IP addresses and named tags for them, which can be matched on easily. Added example rules showing how to block access to an external service or allow SSH between AppVMs. Requested at https://groups.google.com/d/msg/qubes-users/BnL0nZGpJOE/61HOBg1rCgAJ. 2019-04-11 07:25:19 -04:00
			`(* 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`
Add some types to the rules Before, we inferred the types from rules.ml and then the compiler checked that it was consistent with what firewall.ml expected. If it wasn't it reported the problem as being with firewall.ml, which could be confusing to users. 2019-04-17 05:26:32 -04:00
			`(* 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. *)
			`]`