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

Drop frames if the xmit queue gets too long

Browse Source 
With lots of VMs updating, the firewall quit with:

    2017-04-23 20:47:52 -00:00: INF [frameQ] Queue length for 10.137.3.11: incr to 474
    2017-04-23 20:47:52 -00:00: INF [memory_pressure] Writing meminfo: free 2648 / 17504 kB (15.13 %)
    [...]
    Fatal error: out of memory.

The firewall will now drop frames when more than 10 are queued (note
that queuing only starts once the network driver's transmit buffer is
already full).
This commit is contained in:
Thomas Leonard 2017-04-29 11:42:31 +01:00
parent 445b1711cb
commit e55c304160
2 changed files with 20 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
frameQ.ml
View File

@ -10,16 +10,23 @@ type t = {
}
let create name = { name; items = 0 }
(* Note: the queue is only used if we already filled the transmit buffer. *)
let max_qlen = 10
let send q fn =
(* TODO: drop if queue too long *)
let sent = fn () in
if Lwt.state sent = Lwt.Sleep then (
q.items <- q.items + 1;
Log.info (fun f -> f "Queue length for %s: incr to %d" q.name q.items);
Lwt.on_termination sent (fun () ->
q.items <- q.items - 1;
Log.info (fun f -> f "Queue length for %s: decr to %d" q.name q.items);
)
);
sent
if q.items = max_qlen then (
Log.warn (fun f -> f "Maximim queue length exceeded for %s: dropping frame" q.name);
Lwt.return_unit
) else (
let sent = fn () in
if Lwt.state sent = Lwt.Sleep then (
q.items <- q.items + 1;
Log.info (fun f -> f "Queue length for %s: incr to %d" q.name q.items);
Lwt.on_termination sent (fun () ->
q.items <- q.items - 1;
Log.info (fun f -> f "Queue length for %s: decr to %d" q.name q.items);
)
);
sent
)

2
frameQ.mli
View File

@ -8,7 +8,7 @@ type t
val create : string -> t
(** [create name] is a new empty queue. [name] is used in log messages. *)
val send : t -> (unit -> 'a Lwt.t) -> 'a Lwt.t
val send : t -> (unit -> unit Lwt.t) -> unit Lwt.t
(** [send t fn] checks that the queue isn't overloaded and calls [fn ()] if it's OK.
The item is considered to be queued until the result of [fn] has resolved.
In the case of mirage-net-xen's [writev], this happens when the frame has been