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

mirage-nat 2.0.0 and mirage-qubes 0.8.0 compatibility

Browse Source
This commit is contained in:
Hannes Mehnert 2020-01-11 15:36:02 +01:00
parent c66ee54a9f
commit 0f476c4d7b
8 changed files with 46 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
client_net.ml
View File

@ -56,12 +56,13 @@ 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 ~iface ~router packet =
match Nat_packet.of_ipv4_packet packet with
let input_ipv4 get_ts cache ~iface ~router packet =
match Nat_packet.of_ipv4_packet cache ~now:(get_ts ()) packet with
| Error e ->
Log.warn (fun f -> f "Ignored unknown IPv4 message: %a" Nat_packet.pp_error e);
Lwt.return ()
| Ok packet ->
| Ok None -> Lwt.return ()
| Ok (Some packet) ->
let `IPv4 (ip, _) = packet in
let src = ip.Ipv4_packet.src in
if src = iface#other_ip then Firewall.ipv4_from_client router ~src:iface packet
@ -72,7 +73,7 @@ let input_ipv4 ~iface ~router packet =
)
(** Connect to a new client's interface and listen for incoming frames. *)
let add_vif { Dao.ClientVif.domid; device_id } ~client_ip ~router ~cleanup_tasks =
let add_vif get_ts { Dao.ClientVif.domid; device_id } ~client_ip ~router ~cleanup_tasks =
Netback.make ~domid ~device_id >>= fun backend ->
Log.info (fun f -> f "Client %d (IP: %s) ready" domid (Ipaddr.V4.to_string client_ip));
ClientEth.connect backend >>= fun eth ->
@ -83,6 +84,7 @@ let add_vif { Dao.ClientVif.domid; device_id } ~client_ip ~router ~cleanup_tasks
Router.add_client router iface >>= fun () ->
Cleanup.on_cleanup cleanup_tasks (fun () -> Router.remove_client router iface);
let fixed_arp = Client_eth.ARP.create ~net:client_eth iface in
let fragment_cache = Fragments.Cache.create (256 * 1024) in
Netback.listen backend ~header_size:Ethernet_wire.sizeof_ethernet (fun frame ->
match Ethernet_packet.Unmarshal.of_cstruct frame with
| exception ex ->
@ -94,18 +96,18 @@ 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 ~iface ~router payload
| `IPv4 -> input_ipv4 get_ts fragment_cache ~iface ~router payload
| `IPv6 -> return () (* TODO: oh no! *)
)
>|= or_raise "Listen on client interface" Netback.pp_error
(** A new client VM has been found in XenStore. Find its interface and connect to it. *)
let add_client ~router vif client_ip =
let add_client get_ts ~router vif client_ip =
let cleanup_tasks = Cleanup.create () in
Log.info (fun f -> f "add client vif %a with IP %a" Dao.ClientVif.pp vif Ipaddr.V4.pp client_ip);
Lwt.async (fun () ->
Lwt.catch (fun () ->
add_vif vif ~client_ip ~router ~cleanup_tasks
add_vif get_ts vif ~client_ip ~router ~cleanup_tasks
)
(fun ex ->
Log.warn (fun f -> f "Error with client %a: %s"
@ -116,7 +118,7 @@ let add_client ~router vif client_ip =
cleanup_tasks
(** Watch XenStore for notifications of new clients. *)
let listen router =
let listen get_ts router =
Dao.watch_clients (fun new_set ->
(* Check for removed clients *)
!clients |> Dao.VifMap.iter (fun key cleanup ->
@ -129,7 +131,7 @@ let listen router =
(* Check for added clients *)
new_set |> Dao.VifMap.iter (fun key ip_addr ->
if not (Dao.VifMap.mem key !clients) then (
let cleanup = add_client ~router key ip_addr in
let cleanup = add_client get_ts ~router key ip_addr in
clients := !clients |> Dao.VifMap.add key cleanup
)
)

10
client_net.mli
View File

@ -3,8 +3,8 @@
(** Handling client VMs. *)
val listen : Router.t -> 'a Lwt.t
(** [listen router] is a thread that watches for clients being added to and
removed from XenStore. Clients are connected to the client network and
packets are sent via [router]. We ensure the source IP address is correct
before routing a packet. *)
val listen : (unit -> int64) -> Router.t -> 'a Lwt.t
(** [listen get_timestamp router] is a thread that watches for clients being
added to and removed from XenStore. Clients are connected to the client
network and packets are sent via [router]. We ensure the source IP address
is correct before routing a packet. *)

9
firewall.ml
View File

@ -15,6 +15,7 @@ let transmit_ipv4 packet iface =
(fun () ->
Lwt.catch
(fun () ->
let fragments = ref [] in
iface#writev `IPv4 (fun b ->
match Nat_packet.into_cstruct packet b with
| Error e ->
@ -22,9 +23,11 @@ let transmit_ipv4 packet iface =
Ipaddr.V4.pp iface#other_ip
Nat_packet.pp_error e);
0
| Ok n -> n
)
)
| Ok (n, frags) -> fragments := frags ; n) >>= fun () ->
Lwt_list.iter_s (fun f ->
let size = Cstruct.len f in
iface#writev `IPv4 (fun b -> Cstruct.blit f 0 b 0 size ; size))
!fragments)
(fun ex ->
Log.warn (fun f -> f "Failed to write packet to %a: %s"
Ipaddr.V4.pp iface#other_ip

8
my_nat.ml
View File

@ -15,14 +15,13 @@ module Nat = Mirage_nat_lru
type t = {
table : Nat.t;
get_time : unit -> Mirage_nat.time;
}
let create ~get_time ~max_entries =
let create ~max_entries =
let tcp_size = 7 * max_entries / 8 in
let udp_size = max_entries - tcp_size in
Nat.empty ~tcp_size ~udp_size ~icmp_size:100 >|= fun table ->
{ get_time; table }
{ table }
let translate t packet =
Nat.translate t.table packet >|= function
@ -41,10 +40,9 @@ let reset t =
Nat.reset t.table
let add_nat_rule_and_translate t ~xl_host action packet =
let now = t.get_time () in
let apply_action xl_port =
Lwt.catch (fun () ->
Nat.add t.table ~now packet (xl_host, xl_port) action
Nat.add t.table packet (xl_host, xl_port) action
)
(function
| Out_of_memory -> Lwt.return (Error `Out_of_memory)

2
my_nat.mli
View File

@ -10,7 +10,7 @@ type action = [
| `Redirect of Mirage_nat.endpoint
]
val create : get_time:(unit -> Mirage_nat.time) -> max_entries:int -> t Lwt.t
val create : max_entries:int -> t Lwt.t
val reset : t -> unit Lwt.t
val translate : t -> Nat_packet.t -> Nat_packet.t option Lwt.t
val add_nat_rule_and_translate : t -> xl_host:Ipaddr.V4.t ->

21
unikernel.ml
View File

@ -11,11 +11,11 @@ module Main (Clock : Mirage_clock_lwt.MCLOCK) = struct
module Uplink = Uplink.Make(Clock)
(* Set up networking and listen for incoming packets. *)
let network ~clock nat qubesDB =
let network nat qubesDB =
(* Read configuration from QubesDB *)
Dao.read_network_config qubesDB >>= fun config ->
(* Initialise connection to NetVM *)
Uplink.connect ~clock config >>= fun uplink ->
Uplink.connect config >>= fun uplink ->
(* Report success *)
Dao.set_iptables_error qubesDB "" >>= fun () ->
(* Set up client-side networking *)
@ -29,8 +29,8 @@ module Main (Clock : Mirage_clock_lwt.MCLOCK) = struct
in
(* Handle packets from both networks *)
Lwt.choose [
Client_net.listen router;
Uplink.listen uplink router
Client_net.listen Clock.elapsed_ns router;
Uplink.listen uplink Clock.elapsed_ns router
]
(* We don't use the GUI, but it's interesting to keep an eye on it.
@ -41,7 +41,7 @@ module Main (Clock : Mirage_clock_lwt.MCLOCK) = struct
(fun () ->
gui >>= fun gui ->
Log.info (fun f -> f "GUI agent connected");
GUI.listen gui
GUI.listen gui ()
)
(fun `Cant_happen -> assert false)
(fun ex ->
@ -51,8 +51,8 @@ module Main (Clock : Mirage_clock_lwt.MCLOCK) = struct
)
(* Main unikernel entry point (called from auto-generated main.ml). *)
let start clock =
let start_time = Clock.elapsed_ns clock in
let start _clock =
let start_time = Clock.elapsed_ns () in
(* Start qrexec agent, GUI agent and QubesDB agent in parallel *)
let qrexec = RExec.connect ~domid:0 () in
GUI.connect ~domid:0 () |> watch_gui;
@ -63,7 +63,7 @@ module Main (Clock : Mirage_clock_lwt.MCLOCK) = struct
qubesDB >>= fun qubesDB ->
let startup_time =
let (-) = Int64.sub in
let time_in_ns = Clock.elapsed_ns clock - start_time in
let time_in_ns = Clock.elapsed_ns () - start_time in
Int64.to_float time_in_ns /. 1e9
in
Log.info (fun f -> f "QubesDB and qrexec agents connected in %.3f s" startup_time);
@ -72,10 +72,9 @@ module Main (Clock : Mirage_clock_lwt.MCLOCK) = struct
OS.Lifecycle.await_shutdown_request () >>= fun (`Poweroff | `Reboot) ->
return () in
(* Set up networking *)
let get_time () = Clock.elapsed_ns clock in
let max_entries = Key_gen.nat_table_size () in
My_nat.create ~get_time ~max_entries >>= fun nat ->
let net_listener = network ~clock nat qubesDB in
My_nat.create ~max_entries >>= fun nat ->
let net_listener = network nat qubesDB in
(* Report memory usage to XenStore *)
Memory_pressure.init ();
(* Run until something fails or we get a shutdown request. *)

13
uplink.ml
View File

@ -17,6 +17,7 @@ module Make(Clock : Mirage_clock_lwt.MCLOCK) = struct
eth : Eth.t;
arp : Arp.t;
interface : interface;
fragments : Fragments.Cache.t;
}
class netvm_iface eth mac ~my_ip ~other_ip : interface = object
@ -31,13 +32,13 @@ module Make(Clock : Mirage_clock_lwt.MCLOCK) = struct
)
end
let listen t router =
let listen t get_ts router =
Netif.listen t.net ~header_size:Ethernet_wire.sizeof_ethernet (fun frame ->
(* Handle one Ethernet frame from NetVM *)
Eth.input t.eth
~arpv4:(Arp.input t.arp)
~ipv4:(fun ip ->
match Nat_packet.of_ipv4_packet ip with
match Nat_packet.of_ipv4_packet t.fragments ~now:(get_ts ()) ip with
| exception ex ->
Log.err (fun f -> f "Error unmarshalling ethernet frame from uplink: %s@.%a" (Printexc.to_string ex)
Cstruct.hexdump_pp frame
@ -46,7 +47,8 @@ module Make(Clock : Mirage_clock_lwt.MCLOCK) = struct
| Error e ->
Log.warn (fun f -> f "Ignored unknown IPv4 message from uplink: %a" Nat_packet.pp_error e);
Lwt.return ()
| Ok packet ->
| Ok None -> Lwt.return_unit
| Ok (Some packet) ->
Firewall.ipv4_from_netvm router packet
)
~ipv6:(fun _ip -> return ())
@ -55,7 +57,7 @@ module Make(Clock : Mirage_clock_lwt.MCLOCK) = struct
let interface t = t.interface
let connect ~clock:_ config =
let connect config =
let ip = config.Dao.uplink_our_ip in
Netif.connect "0" >>= fun net ->
Eth.connect net >>= fun eth ->
@ -67,5 +69,6 @@ module Make(Clock : Mirage_clock_lwt.MCLOCK) = struct
let interface = new netvm_iface eth netvm_mac
~my_ip:ip
~other_ip:config.Dao.uplink_netvm_ip in
return { net; eth; arp; interface }
let fragments = Fragments.Cache.create (256 * 1024) in
return { net; eth; arp; interface ; fragments }
end

4
uplink.mli
View File

@ -8,12 +8,12 @@ open Fw_utils
module Make(Clock : Mirage_clock_lwt.MCLOCK) : sig
type t
val connect : clock:Clock.t -> Dao.network_config -> t Lwt.t
val connect : Dao.network_config -> t Lwt.t
(** Connect to our NetVM (gateway). *)
val interface : t -> interface
(** The network interface to NetVM. *)
val listen : t -> Router.t -> unit Lwt.t
val listen : t -> (unit -> int64) -> Router.t -> unit Lwt.t
(** Handle incoming frames from NetVM. *)
end