Git-Mirrors/qubes-mirage-firewall
1
0
Fork 0
mirror of https://github.com/mirage/qubes-mirage-firewall.git synced 2024-06-26 06:02:12 +00: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; mutable uplink : uplink option;
} }
let create ~config ~clients ~nat ?uplink = let create ~config ~clients ~nat ~uplink =
{ {
uplink_connected = Lwt_condition.create (); uplink_connected = Lwt_condition.create ();
uplink_disconnect = Lwt_condition.create (); uplink_disconnect = Lwt_condition.create ();
@ -100,7 +100,7 @@ struct
uplink; uplink;
} }
let update t ~config ?uplink = let update t ~config ~uplink =
t.config <- config; t.config <- config;
t.uplink <- uplink; t.uplink <- uplink;
Lwt.return_unit Lwt.return_unit
@ -518,13 +518,13 @@ struct
currently we delay 1s as Netif.disconnect is non-blocking... (need to fix upstream?) *) currently we delay 1s as Netif.disconnect is non-blocking... (need to fix upstream?) *)
Log.info (fun f -> Log.info (fun f ->
f "disconnecting from our uplink"); f "disconnecting from our uplink");
U.disconnect uplink.udp; U.disconnect uplink.udp >>= fun () ->
I.disconnect uplink.ip; I.disconnect uplink.ip >>= fun () ->
(* mutable fragments : Fragments.Cache.t; *) (* mutable fragments : Fragments.Cache.t; *)
(* interface : interface; *) (* interface : interface; *)
Arp.disconnect uplink.arp; Arp.disconnect uplink.arp >>= fun () ->
UplinkEth.disconnect uplink.eth; UplinkEth.disconnect uplink.eth >>= fun () ->
Netif.disconnect uplink.net; Netif.disconnect uplink.net >>= fun () ->
Lwt_condition.broadcast router.uplink_disconnected (); Lwt_condition.broadcast router.uplink_disconnected ();
Lwt.return_unit Lwt.return_unit
| e -> Lwt.fail e) | e -> Lwt.fail e)
@ -579,7 +579,7 @@ struct
Dao.read_network_config qubesDB >>= fun config -> Dao.read_network_config qubesDB >>= fun config ->
Dao.print_network_config config; Dao.print_network_config config;
connect config >>= fun uplink -> 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_condition.broadcast router.uplink_connected ();
Lwt.return_unit Lwt.return_unit
| None, Some _ -> | None, Some _ ->
@ -588,10 +588,10 @@ struct
Dao.read_network_config qubesDB >>= fun config -> Dao.read_network_config qubesDB >>= fun config ->
Dao.print_network_config config; Dao.print_network_config config;
connect config >>= fun uplink -> 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_condition.broadcast router.uplink_connected ();
Lwt.return_unit Lwt.return_unit
| Some uplink, None -> | Some _, None ->
(* This currently is never triggered :( *) (* This currently is never triggered :( *)
Log.info (fun f -> Log.info (fun f ->
f "TODO: Our netvm disapeared, troubles are coming!%!"); 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" let src = Logs.Src.create "memory_pressure" ~doc:"Memory pressure monitor"
module Log = (val Logs.src_log src : Logs.LOG) module Log = (val Logs.src_log src : Logs.LOG)
let wordsize_in_bytes = Sys.word_size / 8
let fraction_free stats = let fraction_free stats =
let { Xen_os.Memory.free_words; heap_words; _ } = stats in let { Xen_os.Memory.free_words; heap_words; _ } = stats in
float free_words /. float heap_words 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 ~config
~clients ~clients
~nat ~nat
?uplink:None ~uplink:None
in in
let send_dns_query = Dispatcher.send_dns_client_query None in let send_dns_query = Dispatcher.send_dns_client_query None in