From 362fc3dc289165b8d17aaa6826a0f0e072e880cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Mon, 15 Jan 2024 10:23:13 +0000 Subject: [PATCH] CA-387699: Fix Protocol_async.with_lock bug spotted by Vincent MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Monadic concurrency libraries can switch away to another 'promise' whenever the bind operator is called. In fact Async will always switch away, but Lwt would only switch away if the promise is blocked (this is probably the origin of the bug). Move the 't.m <- true' next to where we checked that it is false to ensure that we are the only ones holding it. (This is still vulnerable to race conditions with pure OCaml threads, but not with Async promises). Another alternative would be to use Async.Throttle.Sequencer, but this change is a minimal one that could be backported to Yangtze even. Signed-off-by: Edwin Török --- ocaml/message-switch/async/protocol_async.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/ocaml/message-switch/async/protocol_async.ml b/ocaml/message-switch/async/protocol_async.ml index 3575ac268bf..ac0f2e0dfb3 100644 --- a/ocaml/message-switch/async/protocol_async.ml +++ b/ocaml/message-switch/async/protocol_async.ml @@ -81,14 +81,14 @@ module M = struct {m; c} let with_lock t f = - let rec wait state = - if Bool.(t.m = state) then + let rec wait () = + if Bool.(t.m = false) then ( + t.m <- true ; return () - else - Condition.wait t.c >>= fun () -> wait state + ) else + Condition.wait t.c >>= wait in - wait false >>= fun () -> - t.m <- true ; + wait () >>= fun () -> Monitor.protect f ~finally:(fun () -> t.m <- false ; Condition.broadcast t.c () ;