From a5d61cb034c1ffe4aaee6b692ef75d85baf7a89f Mon Sep 17 00:00:00 2001 From: Pierre Alain Date: Fri, 20 Dec 2024 08:25:36 +0100 Subject: [PATCH 1/7] revert client connexion management --- dispatcher.ml | 70 +++++++++++++++++++++++++-------------------------- 1 file changed, 34 insertions(+), 36 deletions(-) diff --git a/dispatcher.ml b/dispatcher.ml index 60927f6..4803679 100644 --- a/dispatcher.ml +++ b/dispatcher.ml @@ -17,6 +17,8 @@ struct module I = Static_ipv4.Make (R) (Clock) (UplinkEth) (Arp) module U = Udp.Make (I) (R) + let clients : Cleanup.t Dao.VifMap.t ref = ref Dao.VifMap.empty + class client_iface eth ~domid ~gateway_ip ~client_ip client_mac : client_link = let log_header = Fmt.str "dom%d:%a" domid Ipaddr.V4.pp client_ip in @@ -342,7 +344,7 @@ struct (** Connect to a new client's interface and listen for incoming frames and firewall rule changes. *) let add_vif get_ts { Dao.ClientVif.domid; device_id } dns_client dns_servers - ~client_ip ~router ~cleanup_tasks qubesDB () = + ~client_ip ~router ~cleanup_tasks qubesDB = let open Lwt.Syntax in let* backend = Netback.make ~domid ~device_id in Log.info (fun f -> @@ -405,8 +407,7 @@ struct Cleanup.on_cleanup cleanup_tasks (fun () -> Lwt.cancel listener); (* NOTE(dinosaure): [qubes_updater] and [listener] can be forgotten, our [cleanup_task] will cancel them if the client is disconnected. *) - Lwt.async (fun () -> Lwt.pick [ qubesdb_updater; listener ]); - Lwt.return_unit + Lwt.pick [ qubesdb_updater; listener ] (** A new client VM has been found in XenStore. Find its interface and connect to it. *) let add_client get_ts dns_client dns_servers ~router vif client_ip qubesDB = @@ -415,42 +416,39 @@ struct Log.info (fun f -> f "add client vif %a with IP %a" Dao.ClientVif.pp vif Ipaddr.V4.pp client_ip); - let* () = - Lwt.catch (add_vif get_ts vif dns_client dns_servers ~client_ip ~router - ~cleanup_tasks qubesDB) - @@ fun exn -> - Log.warn (fun f -> - f "Error with client %a: %s" Dao.ClientVif.pp vif - (Printexc.to_string exn)); - Lwt.return_unit - in - Lwt.return cleanup_tasks + Lwt.async (fun () -> + Lwt.catch + (fun () -> + add_vif get_ts vif dns_client dns_servers ~client_ip ~router + ~cleanup_tasks qubesDB) + (fun ex -> + Log.warn (fun f -> + f "Error with client %a: %s" Dao.ClientVif.pp vif + (Printexc.to_string ex)); + Lwt.return_unit)); + cleanup_tasks (** Watch XenStore for notifications of new clients. *) let wait_clients get_ts dns_client dns_servers qubesDB router = - let open Lwt.Syntax in - let clients : Cleanup.t Dao.VifMap.t ref = ref Dao.VifMap.empty in - Dao.watch_clients @@ fun new_set -> - (* Check for removed clients *) - let clean_up_clients key cleanup = - if not (Dao.VifMap.mem key new_set) then begin - clients := !clients |> Dao.VifMap.remove key; - Log.info (fun f -> f "client %a has gone" Dao.ClientVif.pp key); - Cleanup.cleanup cleanup - end - in - Dao.VifMap.iter clean_up_clients !clients; - (* Check for added clients *) - let rec go seq = match Seq.uncons seq with - | None -> Lwt.return_unit - | Some ((key, ipaddr), seq) when not (Dao.VifMap.mem key !clients) -> - let* cleanup = add_client get_ts dns_client dns_servers ~router key ipaddr qubesDB in - Log.debug (fun f -> f "client %a arrived" Dao.ClientVif.pp key); - clients := Dao.VifMap.add key cleanup !clients; - go seq - | Some (_, seq) -> go seq - in - go (Dao.VifMap.to_seq new_set) + Dao.watch_clients (fun new_set -> + (* Check for removed clients *) + !clients + |> Dao.VifMap.iter (fun key cleanup -> + if not (Dao.VifMap.mem key new_set) then ( + clients := !clients |> Dao.VifMap.remove key; + Log.info (fun f -> f "client %a has gone" Dao.ClientVif.pp key); + Cleanup.cleanup cleanup)); + (* 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 get_ts dns_client dns_servers ~router key ip_addr + qubesDB + in + Log.debug (fun f -> f "client %a arrived" Dao.ClientVif.pp key); + clients := !clients |> Dao.VifMap.add key cleanup)); + Lwt.return_unit) let send_dns_client_query t ~src_port ~dst ~dst_port buf = match t.uplink with From d8a20eadc8c43e153130737cfda854eeae6e71f9 Mon Sep 17 00:00:00 2001 From: Pierre Alain Date: Sun, 22 Dec 2024 19:15:36 +0100 Subject: [PATCH 2/7] get back add_client with local clients map --- dispatcher.ml | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/dispatcher.ml b/dispatcher.ml index 4803679..45db140 100644 --- a/dispatcher.ml +++ b/dispatcher.ml @@ -17,8 +17,6 @@ struct module I = Static_ipv4.Make (R) (Clock) (UplinkEth) (Arp) module U = Udp.Make (I) (R) - let clients : Cleanup.t Dao.VifMap.t ref = ref Dao.VifMap.empty - class client_iface eth ~domid ~gateway_ip ~client_ip client_mac : client_link = let log_header = Fmt.str "dom%d:%a" domid Ipaddr.V4.pp client_ip in @@ -411,7 +409,6 @@ struct (** A new client VM has been found in XenStore. Find its interface and connect to it. *) let add_client get_ts dns_client dns_servers ~router vif client_ip qubesDB = - let open Lwt.Syntax in 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 @@ -430,25 +427,28 @@ struct (** Watch XenStore for notifications of new clients. *) let wait_clients get_ts dns_client dns_servers qubesDB router = - Dao.watch_clients (fun new_set -> - (* Check for removed clients *) - !clients - |> Dao.VifMap.iter (fun key cleanup -> - if not (Dao.VifMap.mem key new_set) then ( - clients := !clients |> Dao.VifMap.remove key; - Log.info (fun f -> f "client %a has gone" Dao.ClientVif.pp key); - Cleanup.cleanup cleanup)); - (* 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 get_ts dns_client dns_servers ~router key ip_addr - qubesDB - in - Log.debug (fun f -> f "client %a arrived" Dao.ClientVif.pp key); - clients := !clients |> Dao.VifMap.add key cleanup)); - Lwt.return_unit) + let clients : Cleanup.t Dao.VifMap.t ref = ref Dao.VifMap.empty in + Dao.watch_clients @@ fun new_set -> + (* Check for removed clients *) + let clean_up_clients key cleanup = + if not (Dao.VifMap.mem key new_set) then begin + clients := !clients |> Dao.VifMap.remove key; + Log.info (fun f -> f "client %a has gone" Dao.ClientVif.pp key); + Cleanup.cleanup cleanup + end + in + Dao.VifMap.iter clean_up_clients !clients; + (* Check for added clients *) + let rec go seq = match Seq.uncons seq with + | None -> Lwt.return_unit + | Some ((key, ipaddr), seq) when not (Dao.VifMap.mem key !clients) -> + let cleanup = add_client get_ts dns_client dns_servers ~router key ipaddr qubesDB in + Log.debug (fun f -> f "client %a arrived" Dao.ClientVif.pp key); + clients := Dao.VifMap.add key cleanup !clients; + go seq + | Some (_, seq) -> go seq + in + go (Dao.VifMap.to_seq new_set) let send_dns_client_query t ~src_port ~dst ~dst_port buf = match t.uplink with From 3bc01998a6bcc50990a95f9050e1321cd0c2c854 Mon Sep 17 00:00:00 2001 From: palainp Date: Tue, 31 Dec 2024 11:23:06 -0500 Subject: [PATCH 3/7] add_client can return a Lwt promise --- dispatcher.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/dispatcher.ml b/dispatcher.ml index 45db140..be12aa3 100644 --- a/dispatcher.ml +++ b/dispatcher.ml @@ -423,10 +423,11 @@ struct f "Error with client %a: %s" Dao.ClientVif.pp vif (Printexc.to_string ex)); Lwt.return_unit)); - cleanup_tasks + Lwt.return cleanup_tasks (** Watch XenStore for notifications of new clients. *) let wait_clients get_ts dns_client dns_servers qubesDB router = + let open Lwt.Syntax in let clients : Cleanup.t Dao.VifMap.t ref = ref Dao.VifMap.empty in Dao.watch_clients @@ fun new_set -> (* Check for removed clients *) @@ -442,7 +443,7 @@ struct let rec go seq = match Seq.uncons seq with | None -> Lwt.return_unit | Some ((key, ipaddr), seq) when not (Dao.VifMap.mem key !clients) -> - let cleanup = add_client get_ts dns_client dns_servers ~router key ipaddr qubesDB in + let* cleanup = add_client get_ts dns_client dns_servers ~router key ipaddr qubesDB in Log.debug (fun f -> f "client %a arrived" Dao.ClientVif.pp key); clients := Dao.VifMap.add key cleanup !clients; go seq From 763a3de57a2476e6e5581d5c8b80eda33a7b71ed Mon Sep 17 00:00:00 2001 From: palainp Date: Tue, 31 Dec 2024 12:11:42 -0500 Subject: [PATCH 4/7] remove note as the code has changed --- dispatcher.ml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/dispatcher.ml b/dispatcher.ml index be12aa3..6837555 100644 --- a/dispatcher.ml +++ b/dispatcher.ml @@ -341,9 +341,10 @@ struct Lwt.return_unit) (** Connect to a new client's interface and listen for incoming frames and firewall rule changes. *) - let add_vif get_ts { Dao.ClientVif.domid; device_id } dns_client dns_servers + let add_vif get_ts vif dns_client dns_servers ~client_ip ~router ~cleanup_tasks qubesDB = let open Lwt.Syntax in + let { Dao.ClientVif.domid; device_id } = vif in let* backend = Netback.make ~domid ~device_id in Log.info (fun f -> f "Client %d (IP: %s) ready" domid (Ipaddr.V4.to_string client_ip)); @@ -403,8 +404,6 @@ struct (function Lwt.Canceled -> Lwt.return_unit | e -> Lwt.fail e) in Cleanup.on_cleanup cleanup_tasks (fun () -> Lwt.cancel listener); - (* NOTE(dinosaure): [qubes_updater] and [listener] can be forgotten, our [cleanup_task] - will cancel them if the client is disconnected. *) Lwt.pick [ qubesdb_updater; listener ] (** A new client VM has been found in XenStore. Find its interface and connect to it. *) From 85de608392eebf57535d02d5fc078643945c6ad5 Mon Sep 17 00:00:00 2001 From: palainp Date: Sat, 4 Jan 2025 04:45:29 -0500 Subject: [PATCH 5/7] in Dispatcher.add_client: keep Client_eth.add_client into Lwt.async --- dispatcher.ml | 46 ++++++++++++++++++++++++++++++---------------- 1 file changed, 30 insertions(+), 16 deletions(-) diff --git a/dispatcher.ml b/dispatcher.ml index 6837555..7e6f10e 100644 --- a/dispatcher.ml +++ b/dispatcher.ml @@ -341,18 +341,12 @@ struct Lwt.return_unit) (** Connect to a new client's interface and listen for incoming frames and firewall rule changes. *) - let add_vif get_ts vif dns_client dns_servers - ~client_ip ~router ~cleanup_tasks qubesDB = - let open Lwt.Syntax in + let conf_vif get_ts vif backend client_eth dns_client dns_servers + ~client_ip ~iface ~router ~cleanup_tasks qubesDB = let { Dao.ClientVif.domid; device_id } = vif in - let* backend = Netback.make ~domid ~device_id in Log.info (fun f -> - f "Client %d (IP: %s) ready" domid (Ipaddr.V4.to_string client_ip)); - let* eth = ClientEth.connect backend in - let client_mac = Netback.frontend_mac backend in - let client_eth = router.clients 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 + f "Client %d:%d (IP: %s) ready" domid device_id (Ipaddr.V4.to_string client_ip)); + (* update the rules whenever QubesDB notices a change for this IP *) let qubesdb_updater = Lwt.catch @@ -380,8 +374,7 @@ struct (function Lwt.Canceled -> Lwt.return_unit | e -> Lwt.fail e) in Cleanup.on_cleanup cleanup_tasks (fun () -> Lwt.cancel qubesdb_updater); - add_client router iface >>= fun () -> - Cleanup.on_cleanup cleanup_tasks (fun () -> remove_client router iface); + let fixed_arp = Client_eth.ARP.create ~net:client_eth iface in let fragment_cache = ref (Fragments.Cache.empty (256 * 1024)) in let listener = @@ -404,24 +397,45 @@ struct (function Lwt.Canceled -> Lwt.return_unit | e -> Lwt.fail e) in Cleanup.on_cleanup cleanup_tasks (fun () -> Lwt.cancel listener); - Lwt.pick [ qubesdb_updater; listener ] + Lwt.async (fun () -> + Lwt.catch + (fun () -> + Lwt.pick [ qubesdb_updater; listener ]) + (fun ex -> + Log.warn (fun f -> + f "Error with client %a: %s" Dao.ClientVif.pp vif + (Printexc.to_string ex)); + Lwt.return_unit)) ; + Lwt.return_unit (** A new client VM has been found in XenStore. Find its interface and connect to it. *) let add_client get_ts dns_client dns_servers ~router vif client_ip qubesDB = + let open Lwt.Syntax in 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); + let { Dao.ClientVif.domid; device_id } = vif in + let* backend = Netback.make ~domid ~device_id in + let* eth = ClientEth.connect backend in + let client_mac = Netback.frontend_mac backend in + let client_eth = router.clients 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 + + Cleanup.on_cleanup cleanup_tasks (fun () -> remove_client router iface); Lwt.async (fun () -> Lwt.catch (fun () -> - add_vif get_ts vif dns_client dns_servers ~client_ip ~router - ~cleanup_tasks qubesDB) + add_client router iface) (fun ex -> Log.warn (fun f -> f "Error with client %a: %s" Dao.ClientVif.pp vif (Printexc.to_string ex)); - Lwt.return_unit)); + Lwt.return_unit)) ; + + conf_vif get_ts vif backend client_eth dns_client dns_servers ~client_ip ~iface ~router + ~cleanup_tasks qubesDB >>= fun () -> Lwt.return cleanup_tasks (** Watch XenStore for notifications of new clients. *) From 812b99842f431937866bf7e4779190422463e64a Mon Sep 17 00:00:00 2001 From: palainp Date: Sat, 4 Jan 2025 04:55:47 -0500 Subject: [PATCH 6/7] get catch back into add_client --- dispatcher.ml | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/dispatcher.ml b/dispatcher.ml index 7e6f10e..f6c29c4 100644 --- a/dispatcher.ml +++ b/dispatcher.ml @@ -342,7 +342,7 @@ struct (** Connect to a new client's interface and listen for incoming frames and firewall rule changes. *) let conf_vif get_ts vif backend client_eth dns_client dns_servers - ~client_ip ~iface ~router ~cleanup_tasks qubesDB = + ~client_ip ~iface ~router ~cleanup_tasks qubesDB () = let { Dao.ClientVif.domid; device_id } = vif in Log.info (fun f -> f "Client %d:%d (IP: %s) ready" domid device_id (Ipaddr.V4.to_string client_ip)); @@ -397,15 +397,9 @@ struct (function Lwt.Canceled -> Lwt.return_unit | e -> Lwt.fail e) in Cleanup.on_cleanup cleanup_tasks (fun () -> Lwt.cancel listener); - Lwt.async (fun () -> - Lwt.catch - (fun () -> - Lwt.pick [ qubesdb_updater; listener ]) - (fun ex -> - Log.warn (fun f -> - f "Error with client %a: %s" Dao.ClientVif.pp vif - (Printexc.to_string ex)); - Lwt.return_unit)) ; + (* NOTE(dinosaure): [qubes_updater] and [listener] can be forgotten, our [cleanup_task] + will cancel them if the client is disconnected. *) + Lwt.async (fun () -> Lwt.pick [ qubesdb_updater; listener ]); Lwt.return_unit (** A new client VM has been found in XenStore. Find its interface and connect to it. *) @@ -434,8 +428,16 @@ struct (Printexc.to_string ex)); Lwt.return_unit)) ; - conf_vif get_ts vif backend client_eth dns_client dns_servers ~client_ip ~iface ~router - ~cleanup_tasks qubesDB >>= fun () -> + let* () = + Lwt.catch ( + conf_vif get_ts vif backend client_eth dns_client dns_servers ~client_ip ~iface ~router + ~cleanup_tasks qubesDB) + @@ fun exn -> + Log.warn (fun f -> + f "Error with client %a: %s" Dao.ClientVif.pp vif + (Printexc.to_string exn)); + Lwt.return_unit + in Lwt.return cleanup_tasks (** Watch XenStore for notifications of new clients. *) From 6d0cc1cf9decf4f02c3b1e4823210a50a23ffa12 Mon Sep 17 00:00:00 2001 From: palainp Date: Sat, 4 Jan 2025 06:02:40 -0500 Subject: [PATCH 7/7] add hashsum --- qubes-firewall.sha256 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/qubes-firewall.sha256 b/qubes-firewall.sha256 index b89e36f..c02b661 100644 --- a/qubes-firewall.sha256 +++ b/qubes-firewall.sha256 @@ -1 +1 @@ -78a1ee52574b9a4fc5eda265922bcbcface90f7c43ed7a68dc8e201a2ac0a7dc dist/qubes-firewall.xen +b78d6711b502f8babcc5c4083b0352b78be8e8a6bef044189ce7a00e6e564612 dist/qubes-firewall.xen