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

fix: uplink is an option, disconnect* return Lwt.return_unit

Browse Source
This commit is contained in:
Pierre Alain 2024-04-23 20:37:11 +02:00
parent a7a7ea4c38
commit f1a333adce
3 changed files with 11 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
dispatcher.ml
View File

@ -89,7 +89,7 @@ struct
mutable uplink : uplink option;
}
let create ~config ~clients ~nat ?uplink =
let create ~config ~clients ~nat ~uplink =
{
uplink_connected = Lwt_condition.create ();
uplink_disconnect = Lwt_condition.create ();
@ -100,7 +100,7 @@ struct
uplink;
}
let update t ~config ?uplink =
let update t ~config ~uplink =
t.config <- config;
t.uplink <- uplink;
Lwt.return_unit
@ -518,13 +518,13 @@ struct
currently we delay 1s as Netif.disconnect is non-blocking... (need to fix upstream?) *)
Log.info (fun f ->
f "disconnecting from our uplink");
U.disconnect uplink.udp;
I.disconnect uplink.ip;
U.disconnect uplink.udp >>= fun () ->
I.disconnect uplink.ip >>= fun () ->
(* mutable fragments : Fragments.Cache.t; *)
(* interface : interface; *)
Arp.disconnect uplink.arp;
UplinkEth.disconnect uplink.eth;
Netif.disconnect uplink.net;
Arp.disconnect uplink.arp >>= fun () ->
UplinkEth.disconnect uplink.eth >>= fun () ->
Netif.disconnect uplink.net >>= fun () ->
Lwt_condition.broadcast router.uplink_disconnected ();
Lwt.return_unit
| e -> Lwt.fail e)
@ -579,7 +579,7 @@ struct
Dao.read_network_config qubesDB >>= fun config ->
Dao.print_network_config config;
connect config >>= fun uplink ->
update router ~config ?uplink:(Some uplink) >>= fun () ->
update router ~config ~uplink:(Some uplink) >>= fun () ->
Lwt_condition.broadcast router.uplink_connected ();
Lwt.return_unit
| None, Some _ ->
@ -588,10 +588,10 @@ struct
Dao.read_network_config qubesDB >>= fun config ->
Dao.print_network_config config;
connect config >>= fun uplink ->
update router ~config ?uplink:(Some uplink) >>= fun () ->
update router ~config ~uplink:(Some uplink) >>= fun () ->
Lwt_condition.broadcast router.uplink_connected ();
Lwt.return_unit
| Some uplink, None ->
| Some _, None ->
(* This currently is never triggered :( *)
Log.info (fun f ->
f "TODO: Our netvm disapeared, troubles are coming!%!");

2
memory_pressure.ml
View File

@ -4,8 +4,6 @@
let src = Logs.Src.create "memory_pressure" ~doc:"Memory pressure monitor"
module Log = (val Logs.src_log src : Logs.LOG)
let wordsize_in_bytes = Sys.word_size / 8
let fraction_free stats =
let { Xen_os.Memory.free_words; heap_words; _ } = stats in
float free_words /. float heap_words

2
unikernel.ml
View File

@ -100,7 +100,7 @@ module Main (R : Mirage_random.S)(Clock : Mirage_clock.MCLOCK)(Time : Mirage_tim
~config
~clients
~nat
?uplink:None
~uplink:None
in
let send_dns_query = Dispatcher.send_dns_client_query None in