forked from mirage/qubes-mirage-firewall
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathframeQ.ml
32 lines (27 loc) · 932 Bytes
/
frameQ.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
(* Copyright (C) 2016, Thomas Leonard <[email protected]>
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 "Maximum 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
)