allow to have no netvm defined (will fail on uplink.connect)

This commit is contained in:
palainp 2023-06-30 13:59:03 +02:00
parent 609f5295c7
commit 9cabe7e303
7 changed files with 29 additions and 29 deletions

View File

@ -10,7 +10,7 @@ module Log = (val Logs.src_log src : Logs.LOG)
type t = { type t = {
mutable iface_of_ip : client_link IpMap.t; mutable iface_of_ip : client_link IpMap.t;
changed : unit Lwt_condition.t; (* Fires when [iface_of_ip] changes. *) changed : unit Lwt_condition.t; (* Fires when [iface_of_ip] changes. *)
client_gw : Ipaddr.V4.t; (* The IP that clients are given as their default gateway. *) my_ip : Ipaddr.V4.t; (* The IP that clients are given as their default gateway. *)
} }
type host = type host =
@ -18,11 +18,12 @@ type host =
| `Firewall | `Firewall
| `External of Ipaddr.t ] | `External of Ipaddr.t ]
let create ~client_gw = let create config =
let changed = Lwt_condition.create () in let changed = Lwt_condition.create () in
{ iface_of_ip = IpMap.empty; client_gw; changed } let my_ip = config.Dao.uplink_our_ip in
Lwt.return { iface_of_ip = IpMap.empty; my_ip; changed }
let client_gw t = t.client_gw let client_gw t = t.my_ip
let add_client t iface = let add_client t iface =
let ip = iface#other_ip in let ip = iface#other_ip in
@ -52,14 +53,14 @@ let classify t ip =
match ip with match ip with
| Ipaddr.V6 _ -> `External ip | Ipaddr.V6 _ -> `External ip
| Ipaddr.V4 ip4 -> | Ipaddr.V4 ip4 ->
if ip4 = t.client_gw then `Firewall if ip4 = t.my_ip then `Firewall
else match lookup t ip4 with else match lookup t ip4 with
| Some client_link -> `Client client_link | Some client_link -> `Client client_link
| None -> `External ip | None -> `External ip
let resolve t : host -> Ipaddr.t = function let resolve t : host -> Ipaddr.t = function
| `Client client_link -> Ipaddr.V4 client_link#other_ip | `Client client_link -> Ipaddr.V4 client_link#other_ip
| `Firewall -> Ipaddr.V4 t.client_gw | `Firewall -> Ipaddr.V4 t.my_ip
| `External addr -> addr | `External addr -> addr
module ARP = struct module ARP = struct
@ -69,7 +70,7 @@ module ARP = struct
} }
let lookup t ip = let lookup t ip =
if ip = t.net.client_gw then Some t.client_link#my_mac if ip = t.net.my_ip then Some t.client_link#my_mac
else if (Ipaddr.V4.to_octets ip).[3] = '\x01' then ( else if (Ipaddr.V4.to_octets ip).[3] = '\x01' then (
Log.info (fun f -> f ~header:t.client_link#log_header Log.info (fun f -> f ~header:t.client_link#log_header
"Request for %a is invalid, but pretending it's me (see Qubes issue #5022)" Ipaddr.V4.pp ip); "Request for %a is invalid, but pretending it's me (see Qubes issue #5022)" Ipaddr.V4.pp ip);

View File

@ -17,7 +17,7 @@ type host =
disconnected client. disconnected client.
See: https://github.com/talex5/qubes-mirage-firewall/issues/9#issuecomment-246956850 *) See: https://github.com/talex5/qubes-mirage-firewall/issues/9#issuecomment-246956850 *)
val create : client_gw:Ipaddr.V4.t -> t val create : Dao.network_config -> t Lwt.t
(** [create ~client_gw] is a network of client machines. (** [create ~client_gw] is a network of client machines.
Qubes will have configured the client machines to use [client_gw] as their default gateway. *) Qubes will have configured the client machines to use [client_gw] as their default gateway. *)

View File

@ -80,7 +80,7 @@ let add_vif get_ts { Dao.ClientVif.domid; device_id } dns_client dns_servers ~cl
Log.info (fun f -> f "Client %d (IP: %s) ready" domid (Ipaddr.V4.to_string client_ip)); Log.info (fun f -> f "Client %d (IP: %s) ready" domid (Ipaddr.V4.to_string client_ip));
ClientEth.connect backend >>= fun eth -> ClientEth.connect backend >>= fun eth ->
let client_mac = Netback.frontend_mac backend in let client_mac = Netback.frontend_mac backend in
let client_eth = router.Router.client_eth in let client_eth = router.Router.clients in
let gateway_ip = Client_eth.client_gw client_eth in let gateway_ip = Client_eth.client_gw client_eth in
let iface = new client_iface eth ~domid ~gateway_ip ~client_ip client_mac in let iface = new client_iface eth ~domid ~gateway_ip ~client_ip client_mac in
(* update the rules whenever QubesDB notices a change for this IP *) (* update the rules whenever QubesDB notices a change for this IP *)

14
dao.ml
View File

@ -136,13 +136,13 @@ exception Missing_key of string
let try_read_network_config db = let try_read_network_config db =
let get name = let get name =
match DB.KeyMap.find_opt name db with match DB.KeyMap.find_opt name db with
| None -> raise (Missing_key name) | None -> Ipaddr.V4.make 0 0 0 0
| Some value -> value in | Some value -> Ipaddr.V4.of_string_exn value in
let uplink_our_ip = get "/qubes-ip" |> Ipaddr.V4.of_string_exn in let uplink_our_ip = get "/qubes-ip" in
let uplink_netvm_ip = get "/qubes-gateway" |> Ipaddr.V4.of_string_exn in let uplink_netvm_ip = get "/qubes-gateway" in
let clients_our_ip = get "/qubes-netvm-gateway" |> Ipaddr.V4.of_string_exn in let clients_our_ip = get "/qubes-netvm-gateway" in
let dns = get "/qubes-primary-dns" |> Ipaddr.V4.of_string_exn in let dns = get "/qubes-primary-dns" in
let dns2 = get "/qubes-secondary-dns" |> Ipaddr.V4.of_string_exn in let dns2 = get "/qubes-secondary-dns" in
Log.info (fun f -> f "@[<v2>Got network configuration from QubesDB:@,\ Log.info (fun f -> f "@[<v2>Got network configuration from QubesDB:@,\
NetVM IP on uplink network: %a@,\ NetVM IP on uplink network: %a@,\
Our IP on uplink network: %a@,\ Our IP on uplink network: %a@,\

View File

@ -6,29 +6,29 @@ open Fw_utils
(* The routing table *) (* The routing table *)
type t = { type t = {
client_eth : Client_eth.t; clients : Client_eth.t;
nat : My_nat.t; nat : My_nat.t;
uplink : interface; uplink : interface;
} }
let create ~client_eth ~uplink ~nat = let create ~clients ~uplink ~nat =
{ client_eth; nat; uplink } { clients; nat; uplink }
let target t buf = let target t buf =
let dst_ip = buf.Ipv4_packet.dst in let dst_ip = buf.Ipv4_packet.dst in
match Client_eth.lookup t.client_eth dst_ip with match Client_eth.lookup t.clients dst_ip with
| Some client_link -> Some (client_link :> interface) | Some client_link -> Some (client_link :> interface)
| None -> Some t.uplink | None -> Some t.uplink
let add_client t = Client_eth.add_client t.client_eth let add_client t = Client_eth.add_client t.clients
let remove_client t = Client_eth.remove_client t.client_eth let remove_client t = Client_eth.remove_client t.clients
let classify t ip = let classify t ip =
if ip = Ipaddr.V4 t.uplink#my_ip then `Firewall if ip = Ipaddr.V4 t.uplink#my_ip then `Firewall
else if ip = Ipaddr.V4 t.uplink#other_ip then `NetVM else if ip = Ipaddr.V4 t.uplink#other_ip then `NetVM
else (Client_eth.classify t.client_eth ip :> Packet.host) else (Client_eth.classify t.clients ip :> Packet.host)
let resolve t = function let resolve t = function
| `Firewall -> Ipaddr.V4 t.uplink#my_ip | `Firewall -> Ipaddr.V4 t.uplink#my_ip
| `NetVM -> Ipaddr.V4 t.uplink#other_ip | `NetVM -> Ipaddr.V4 t.uplink#other_ip
| #Client_eth.host as host -> Client_eth.resolve t.client_eth host | #Client_eth.host as host -> Client_eth.resolve t.clients host

View File

@ -6,13 +6,13 @@
open Fw_utils open Fw_utils
type t = private { type t = private {
client_eth : Client_eth.t; clients : Client_eth.t;
nat : My_nat.t; nat : My_nat.t;
uplink : interface; uplink : interface;
} }
val create : val create :
client_eth:Client_eth.t -> clients:Client_eth.t ->
uplink:interface -> uplink:interface ->
nat:My_nat.t -> nat:My_nat.t ->
t t

View File

@ -52,11 +52,10 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_tim
Uplink.connect config >>= fun uplink -> Uplink.connect config >>= fun uplink ->
(* Set up client-side networking *) (* Set up client-side networking *)
let client_eth = Client_eth.create Client_eth.create config >>= fun clients ->
~client_gw:config.Dao.clients_our_ip in
(* Set up routing between networks and hosts *) (* Set up routing between networks and hosts *)
let router = Router.create let router = Router.create
~client_eth ~clients
~uplink:(Uplink.interface uplink) ~uplink:(Uplink.interface uplink)
~nat ~nat
in in