Git-Mirrors/qubes-mirage-firewall
1
0
Fork 0
mirror of https://github.com/mirage/qubes-mirage-firewall.git synced 2024-12-24 06:39:31 -05:00
Code Issues Packages Projects Releases Wiki Activity

Move NAT code to router and add DNS redirects

Browse Source
This commit is contained in:
Thomas Leonard 2015-12-30 16:07:16 +00:00
parent 5a2f6f7ce8
commit cd69ce5a86
15 changed files with 266 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
README.md
View File

@ -3,11 +3,7 @@
An **experimental** unikernel that can run as a QubesOS ProxyVM, replacing `sys-firewall`.
It uses the [mirage-qubes][] library to implement the Qubes protocols.
Note: This firewall *ignores the rules set in the Qubes GUI*.
Currently it only prevents incoming connections from the outside world (which is really just a side-effect of doing NAT). So currently it's really just a router rather than a firewall.
Also, it doesn't yet proxy DNS requests.
Note: This firewall *ignores the rules set in the Qubes GUI*. See `rules.ml` for the actual policy.
To build:

1
_tags
View File

@ -1,2 +1,3 @@
not <main.*>: warn(A-4), strict_sequence
<qubes_protocol.*>: package(cstruct.syntax)
true: -syntax(camlp4o)

17
client_eth.ml
View File

@ -18,19 +18,28 @@ let create ~prefix ~client_gw =
let prefix t = t.prefix
let add_client t iface =
let ip = iface#client_ip in
let ip = iface#other_ip in
assert (Ipaddr.V4.Prefix.mem ip t.prefix);
(* TODO: Should probably wait for the previous client to disappear. *)
(* assert (not (IpMap.mem ip t.iface_of_ip)); *)
t.iface_of_ip <- t.iface_of_ip |> IpMap.add ip iface
let remove_client t iface =
let ip = iface#client_ip in
let ip = iface#other_ip in
assert (IpMap.mem ip t.iface_of_ip);
t.iface_of_ip <- t.iface_of_ip |> IpMap.remove ip
let lookup t ip = IpMap.find ip t.iface_of_ip
let classify t = function
| Ipaddr.V6 _ -> `External
| Ipaddr.V4 ip ->
if ip === t.client_gw then `Client_gateway
else match lookup t ip with
| Some client_link -> `Client client_link
| None when Ipaddr.V4.Prefix.mem ip t.prefix -> `Unknown_client
| None -> `External
module ARP = struct
type arp = {
net : t;
@ -40,7 +49,7 @@ module ARP = struct
let lookup t ip =
if ip === t.net.client_gw then Some t.client_link#my_mac
else match IpMap.find ip t.net.iface_of_ip with
| Some client_iface -> Some client_iface#client_mac
| Some client_iface -> Some client_iface#other_mac
| None -> None
let create ~net client_link = {net; client_link}
@ -87,7 +96,7 @@ module ARP = struct
let open Arpv4_wire in
let req_ipv4 = Ipaddr.V4.of_int32 (get_arp_tpa frame) in
Log.info "who-has %s?" (fun f -> f (Ipaddr.V4.to_string req_ipv4));
if req_ipv4 === t.client_link#client_ip then (
if req_ipv4 === t.client_link#other_ip then (
Log.info "ignoring request for client's own IP" Logs.unit;
None
) else match lookup t req_ipv4 with

3
client_eth.mli
View File

@ -18,6 +18,9 @@ val remove_client : t -> client_link -> unit
val prefix : t -> Ipaddr.V4.Prefix.t
val classify : t -> Ipaddr.t ->
[ `Client of client_link | `Unknown_client | `Client_gateway | `External ]
val lookup : t -> Ipaddr.V4.t -> client_link option
module ARP : sig

12
client_net.ml
View File

@ -12,8 +12,8 @@ module Log = (val Logs.src_log src : Logs.LOG)
class client_iface eth client_ip client_mac : client_link = object
method my_mac = ClientEth.mac eth
method client_mac = client_mac
method client_ip = client_ip
method other_mac = client_mac
method other_ip = client_ip
method writev ip =
let eth_hdr = eth_header_ipv4 ~src:(ClientEth.mac eth) ~dst:client_mac in
ClientEth.writev eth (fixup_checksums (Cstruct.concat (eth_hdr :: ip)))
@ -41,10 +41,10 @@ let start_client ~router domid =
ClientEth.connect backend >>= or_fail "Can't make Ethernet device" >>= fun eth ->
let client_mac = Netback.mac backend in
let iface = new client_iface eth client_ip client_mac in
let fixed_arp = Client_eth.ARP.create ~net:(Router.client_eth router) iface in
let fixed_arp = Client_eth.ARP.create ~net:router.Router.client_eth iface in
Router.add_client router iface;
Cleanup.on_cleanup cleanup_tasks (fun () -> Router.remove_client router iface);
Netback.listen backend (
Netback.listen backend (fun frame ->
ClientEth.input
~arpv4:(fun buf ->
match Client_eth.ARP.input fixed_arp buf with
@ -53,7 +53,7 @@ let start_client ~router domid =
)
~ipv4:(fun packet ->
let src = Wire_structs.Ipv4_wire.get_ipv4_src packet |> Ipaddr.V4.of_int32 in
if src === client_ip then Router.forward_ipv4 router packet
if src === client_ip then Firewall.ipv4_from_client router frame
else (
Log.warn "Incorrect source IP %a in IP packet from %a (dropping)"
(fun f -> f Ipaddr.V4.pp_hum src Ipaddr.V4.pp_hum client_ip);
@ -61,7 +61,7 @@ let start_client ~router domid =
)
)
~ipv6:(fun _buf -> return ())
eth
eth frame
)
)
(fun ex ->

154
firewall.ml Normal file
View File

@ -0,0 +1,154 @@
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *)
open Utils
open Packet
let src = Logs.Src.create "firewall" ~doc:"Packet handler"
module Log = (val Logs.src_log src : Logs.LOG)
(* Transmission *)
let transmit ~frame iface =
let packet = Cstruct.shift frame Wire_structs.sizeof_ethernet in
iface#writev [packet]
let forward_ipv4 t frame =
let packet = Cstruct.shift frame Wire_structs.sizeof_ethernet in
match Router.target t packet with
| Some iface -> iface#writev [packet]
| None -> return ()
(* Packet classification *)
let ports transport =
let sport, dport = Nat_rewrite.ports_of_transport transport in
{ sport; dport }
let classify t frame =
match Nat_rewrite.layers frame with
| None ->
Log.warn "Failed to parse frame" Logs.unit;
None
| Some (_eth, ip, transport) ->
let src, dst = Nat_rewrite.addresses_of_ip ip in
let proto =
match Nat_rewrite.proto_of_ip ip with
| 1 -> `ICMP
| 6 -> `TCP (ports transport)
| 17 -> `UDP (ports transport)
| _ -> `Unknown in
Some {
frame;
src = Router.classify t src;
dst = Router.classify t dst;
proto;
}
(* NAT *)
let translate t frame =
match Nat_rewrite.translate t.Router.nat frame with
| None -> None
| Some frame -> Some (fixup_checksums frame |> Cstruct.concat)
let random_user_port () =
1024 + Random.int (0xffff - 1024)
let rec add_nat_rule_and_transmit t frame fn fmt logf =
let xl_port = random_user_port () in
match fn xl_port with
| Nat_rewrite.Overlap -> add_nat_rule_and_transmit t frame fn fmt logf (* Try a different port *)
| Nat_rewrite.Unparseable ->
Log.warn "Failed to add NAT rule: Unparseable" Logs.unit;
return ()
| Nat_rewrite.Ok _ ->
Log.info fmt (logf xl_port);
match translate t frame with
| Some frame -> forward_ipv4 t frame
| None ->
Log.warn "No NAT entry, even after adding one!" Logs.unit;
return ()
(* Add a NAT rule for the endpoints in this frame, via a random port on the firewall. *)
let add_nat_and_forward_ipv4 t frame =
add_nat_rule_and_transmit t frame
(Nat_rewrite.make_nat_entry t.Router.nat frame t.Router.my_uplink_ip)
"added NAT entry: %s:%d -> firewall:%d -> %d:%s"
(fun xl_port f ->
match Nat_rewrite.layers frame with
| None -> assert false
| Some (_eth, ip, transport) ->
let src, dst = Nat_rewrite.addresses_of_ip ip in
let sport, dport = Nat_rewrite.ports_of_transport transport in
f (Ipaddr.to_string src) sport xl_port dport (Ipaddr.to_string dst)
)
(* Add a NAT rule to redirect this conversation to NetVM instead of us. *)
let redirect_to_netvm t ~frame ~port =
let gw = Ipaddr.V4 t.Router.default_gateway#other_ip in
add_nat_rule_and_transmit t frame
(fun xl_port ->
Nat_rewrite.make_redirect_entry t.Router.nat frame (t.Router.my_uplink_ip, xl_port) (gw, port)
)
"added NAT redirect %s:%d -> %d:firewall:%d -> %d:NetVM"
(fun xl_port f ->
match Nat_rewrite.layers frame with
| None -> assert false
| Some (_eth, ip, transport) ->
let src, _dst = Nat_rewrite.addresses_of_ip ip in
let sport, dport = Nat_rewrite.ports_of_transport transport in
f (Ipaddr.to_string src) sport dport xl_port port
)
(* Handle incoming packets *)
let ipv4_from_client t frame =
match Memory_pressure.status () with
| `Memory_critical -> (* TODO: should happen before copying and async *)
Log.warn "Memory low - dropping packet" Logs.unit;
return ()
| `Ok ->
(* Check for existing NAT entry for this packet *)
match translate t frame with
| Some frame -> forward_ipv4 t frame (* Some existing connection or redirect *)
| None ->
(* No existing NAT entry. Check the firewall rules. *)
match classify t frame with
| None -> return ()
| Some info ->
match Rules.from_client info, info.dst with
| `Accept, `Client client_link -> transmit ~frame client_link
| `Accept, `External -> add_nat_and_forward_ipv4 t frame
| `Accept, `Unknown_client ->
Log.warn "Dropping packet to unknown client" Logs.unit;
return ()
| `Accept, (`Firewall_uplink | `Client_gateway) ->
Log.warn "Bad rule: firewall can't accept packets" Logs.unit;
return ()
| `Redirect_to_netvm port, _ -> redirect_to_netvm t ~frame ~port
| `Drop reason, _ ->
Log.info "Dropped packet (%s)" (fun f -> f reason);
return ()
let ipv4_from_netvm t frame =
match Memory_pressure.status () with
| `Memory_critical -> (* TODO: should happen before copying and async *)
Log.warn "Memory low - dropping packet" Logs.unit;
return ()
| `Ok ->
match classify t frame with
| None -> return ()
| Some info ->
match info.src with
| `Client _ | `Unknown_client | `Firewall_uplink | `Client_gateway ->
Log.warn "Frame from NetVM has internal source IP address!" Logs.unit;
return ()
| `External ->
match translate t frame with
| Some frame -> forward_ipv4 t frame
| None ->
match Rules.from_netvm info with
| `Drop reason ->
Log.info "Dropped packet (%s)" (fun f -> f reason);
return ()

11
firewall.mli Normal file
View File

@ -0,0 +1,11 @@
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *)
(** Classify IP packets, apply rules and send as appropriate. *)
val ipv4_from_netvm : Router.t -> Cstruct.t -> unit Lwt.t
(** Handle a frame from the outside world (this module will validate the source IP). *)
val ipv4_from_client : Router.t -> Cstruct.t -> unit Lwt.t
(** Handle a frame from a client. Caller must check the source IP matches the client's
before calling this. *)

57
nat_rules.ml
View File

@ -1,57 +0,0 @@
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *)
(** Perform NAT on the interface to our NetVM.
Based on https://github.com/yomimono/simple-nat *)
let src = Logs.Src.create "nat-rules" ~doc:"Firewall NAT rules"
module Log = (val Logs.src_log src : Logs.LOG)
let random_user_port () =
1024 + Random.int (0xffff - 1024)
(* Add a NAT rule for the endpoints in this frame, via a random port on [ip]. *)
let allow_nat_traffic table frame (ip : Ipaddr.t) =
let rec stubborn_insert port =
(* TODO: in the unlikely event that no port is available, this
function will never terminate (this is really a tcpip todo) *)
let open Nat_rewrite in
match make_nat_entry table frame ip port with
| Ok t ->
Log.info "added NAT entry: %s:%d -> firewall:%d -> %s:%d"
(fun f ->
match Nat_rewrite.layers frame with
| None -> assert false
| Some (_eth, ip, transport) ->
let src, dst = Nat_rewrite.addresses_of_ip ip in
let sport, dport = Nat_rewrite.ports_of_transport transport in
f (Ipaddr.to_string src) sport port (Ipaddr.to_string dst) dport
);
Some t
| Unparseable -> None
| Overlap -> stubborn_insert (random_user_port ())
in
(* TODO: connection tracking logic *)
stubborn_insert (random_user_port ())
(** Perform translation on [frame] and return translated packet.
Update NAT table for new outbound connections. *)
let nat translation_ip nat_table direction frame =
let rec retry () =
(* typical NAT logic: traffic from the internal "trusted" interface gets
new mappings by default; traffic from other interfaces gets dropped if
no mapping exists (which it doesn't, since we already checked) *)
let open Nat_rewrite in
match direction, Nat_rewrite.translate nat_table direction frame with
| _, Some f -> Some f
| Destination, None -> None (* nothing in the table, drop it *)
| Source, None ->
(* mutate nat_table to include entries for the frame *)
match allow_nat_traffic nat_table frame translation_ip with
| Some _t ->
(* try rewriting again; we should now have an entry for this packet *)
retry ()
| None ->
(* this frame is hopeless! *)
None in
retry ()

21
packet.ml Normal file
View File

@ -0,0 +1,21 @@
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *)
open Utils
type port = int
type ports = {
sport : port; (* Source port *)
dport : port; (* Destination *)
}
type host =
[ `Client of client_link | `Unknown_client | `Client_gateway | `Firewall_uplink | `External ]
type info = {
frame : Cstruct.t;
src : host;
dst : host;
proto : [ `UDP of ports | `TCP of ports | `ICMP | `Unknown ];
}

24
router.ml
View File

@ -6,19 +6,22 @@ open Utils
let src = Logs.Src.create "router" ~doc:"Router"
module Log = (val Logs.src_log src : Logs.LOG)
(* The routing table *)
type t = {
client_eth : Client_eth.t;
nat : Nat_lookup.t;
default_gateway : interface;
my_uplink_ip : Ipaddr.t;
}
let create ~client_eth ~default_gateway = { client_eth; default_gateway }
let client_eth t = t.client_eth
let create ~client_eth ~default_gateway ~my_uplink_ip =
let nat = Nat_lookup.empty () in
{ client_eth; nat; default_gateway; my_uplink_ip }
let target t buf =
let open Wire_structs.Ipv4_wire in
let dst_ip = get_ipv4_dst buf |> Ipaddr.V4.of_int32 in
Log.debug "Got IPv4: dst=%s" (fun f -> f (Ipaddr.V4.to_string dst_ip));
if Ipaddr.V4.Prefix.mem dst_ip (Client_eth.prefix t.client_eth) then (
match Client_eth.lookup t.client_eth dst_ip with
| Some client_link -> Some (client_link :> interface)
@ -31,12 +34,7 @@ let target t buf =
let add_client t = Client_eth.add_client t.client_eth
let remove_client t = Client_eth.remove_client t.client_eth
let forward_ipv4 router buf =
match Memory_pressure.status () with
| `Memory_critical -> (* TODO: should happen before copying and async *)
Log.warn "Memory low - dropping packet" Logs.unit;
return ()
| `Ok ->
match target router buf with
| Some iface -> iface#writev [buf]
| None -> return ()
let classify t ip =
let (===) a b = (Ipaddr.compare a b = 0) in
if ip === t.my_uplink_ip then `Firewall_uplink
else (Client_eth.classify t.client_eth ip :> Packet.host)

18
router.mli
View File

@ -5,17 +5,22 @@
open Utils
type t
type t = private {
client_eth : Client_eth.t;
nat : Nat_lookup.t;
default_gateway : interface;
my_uplink_ip : Ipaddr.t;
}
(** A routing table. *)
val create :
client_eth:Client_eth.t ->
default_gateway:interface ->
my_uplink_ip:Ipaddr.t ->
t
(** [create ~client_eth ~default_gateway] is a new routing table that routes packets outside
of [client_eth] to [default_gateway]. *)
val client_eth : t -> Client_eth.t
(** [create ~client_eth ~default_gateway ~my_uplink_ip] is a new routing table
that routes packets outside of [client_eth] to [default_gateway], changing their
source address to [my_uplink_ip] for NAT. *)
val target : t -> Cstruct.t -> interface option
(** [target t packet] is the interface to which [packet] (an IP packet) should be routed. *)
@ -26,5 +31,4 @@ val add_client : t -> client_link -> unit
val remove_client : t -> client_link -> unit
val forward_ipv4 : t -> Cstruct.t -> unit Lwt.t
(** [forward_ipv4 t packet] sends the packet to [target t packet]. *)
val classify : t -> Ipaddr.t -> Packet.host

23
rules.ml Normal file
View File

@ -0,0 +1,23 @@
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *)
(** Put your firewall rules here. *)
open Packet
(* OCaml normally warns if you don't match all fields, but that's OK here. *)
[@@@ocaml.warning "-9"]
(** 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
| { dst = `External } -> `Accept
| { dst = `Client_gateway; proto = `UDP { dport = 53 } } -> `Redirect_to_netvm 53
| { dst = (`Client_gateway | `Firewall_uplink) } -> `Drop "packet addressed to firewall itself"
| { dst = `Client _ } -> `Drop "prevent communication between client VMs"
| { dst = `Unknown_client } -> `Drop "target client not running"
(** 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
| _ -> `Drop "drop by default"

3
unikernel.ml
View File

@ -37,7 +37,8 @@ module Main (Clock : V1.CLOCK) = struct
(* Set up routing between networks and hosts *)
let router = Router.create
~client_eth
~default_gateway:(Uplink.interface uplink) in
~default_gateway:(Uplink.interface uplink)
~my_uplink_ip:(Ipaddr.V4 config.Dao.uplink_our_ip) in
(* Handle packets from both networks *)
Lwt.join [
Client_net.listen router;

26
uplink.ml
View File

@ -19,35 +19,24 @@ module Make(Clock : V1.CLOCK) = struct
arp : Arp.t;
interface : interface;
my_ip : Ipaddr.t;
nat_table : Nat_lookup.t;
}
class netvm_iface eth my_ip mac nat_table = object
class netvm_iface eth mac netvm_ip : interface = object
method my_mac = Eth.mac eth
method other_ip = netvm_ip
method writev ip =
mac >>= fun dst ->
let eth_hdr = eth_header_ipv4 ~src:(Eth.mac eth) ~dst in
match Nat_rules.nat my_ip nat_table Nat_rewrite.Source (Cstruct.concat (eth_hdr :: ip)) with
| None -> return ()
| Some frame -> Eth.writev eth (fixup_checksums frame)
Eth.writev eth (eth_hdr :: ip)
end
let unnat t router frame _ip =
match Nat_rules.nat t.my_ip t.nat_table Nat_rewrite.Destination frame with
| None ->
Log.debug "Discarding unexpected frame" Logs.unit;
return ()
| Some frame ->
let frame = fixup_checksums frame |> Cstruct.concat in
Router.forward_ipv4 router (Cstruct.shift frame Wire_structs.sizeof_ethernet)
let listen t router =
Netif.listen t.net (fun frame ->
(* Handle one Ethernet frame from NetVM *)
Eth.input t.eth
~arpv4:(Arp.input t.arp)
~ipv4:(unnat t router frame)
~ipv6:(fun _buf -> return ())
~ipv4:(fun _ip -> Firewall.ipv4_from_netvm router frame)
~ipv6:(fun _ip -> return ())
frame
)
@ -67,7 +56,6 @@ module Make(Clock : V1.CLOCK) = struct
| `Timeout -> failwith "ARP timeout getting MAC of our NetVM"
| `Ok netvm_mac -> netvm_mac in
let my_ip = Ipaddr.V4 ip in
let nat_table = Nat_lookup.empty () in
let interface = new netvm_iface eth my_ip netvm_mac nat_table in
return { net; eth; arp; interface; my_ip; nat_table }
let interface = new netvm_iface eth netvm_mac config.Dao.uplink_netvm_ip in
return { net; eth; arp; interface; my_ip }
end

4
utils.ml
View File

@ -22,13 +22,13 @@ module IntMap = Map.Make(Int)
class type interface = object
method my_mac : Macaddr.t
method writev : Cstruct.t list -> unit Lwt.t
method other_ip : Ipaddr.V4.t
end
(** An Ethernet interface connected to a clientVM. *)
class type client_link = object
inherit interface
method client_ip : Ipaddr.V4.t
method client_mac : Macaddr.t
method other_mac : Macaddr.t
end
(** An Ethernet header from [src]'s MAC address to [dst]'s with an IPv4 payload. *)