qubes-mirage-firewall/frameQ.ml
Thomas Leonard e55c304160 Drop frames if the xmit queue gets too long
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).
2017-04-29 12:05:30 +01:00

33 lines
932 B
OCaml

(* Copyright (C) 2016, Thomas Leonard <thomas.leonard@unikernel.com>
See the README file for details. *)
let src = Logs.Src.create "frameQ" ~doc:"Interface output queue"
module Log = (val Logs.src_log src : Logs.LOG)
type t = {
name : string;
mutable items : int;
}
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 =
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
)