[kernel] fix log recursion

src/kernel_services/plugin_entry_points/log.ml

@@ -419,7 +419,17 @@ let check_not_yet = ref (fun _evt -> false)
 (* --- Listeners                                                          --- *)
 (* -------------------------------------------------------------------------- *)
 
-let do_fire e f = f e
+let firelock = ref false
+
+let do_fire e f =
+  if !firelock then f e else
+    try
+      firelock := true ;
+      f e ;
+      firelock := false
+    with exn ->
+      firelock := false ;
+      raise exn
 
 let iter_kind ?kind f ems =
   match kind with
@@ -518,7 +528,8 @@ let logwithfinal finally channel
                  if echo && e.echo then
                    do_echo channel.terminal event ;
                  Extlib.may (do_fire event) emitwith;
-                 if fire then List.iter (do_fire event) e.listeners ;
+                 if fire && not !firelock then
+                   List.iter (do_fire event) e.listeners ;
                  Some event
                end
              else None

src/kernel_services/plugin_entry_points/log.mli

@@ -404,6 +404,10 @@ val add_listener : ?plugin:string -> ?kind:kind list -> (event -> unit) -> unit
 (** Register a hook that is called each time an event is
     emitted. Applies to all channel unless specified,
     and all kind of messages unless specified.
+
+    Warning: when executing the listener, all listeners will be
+    temporarily deactivated in order to avoid infinite recursion.
+
     @since Beryllium-20090601-beta1
     @plugin development guide *)