eventlog: Fix racy flushingwip/T18210

Previously no attempt was made to avoid multiple threads writing their
capability-local eventlog buffers to the eventlog writer simultaneously.
This could result in multiple eventlog streams being interleaved. Fix
this by documenting that the EventLogWriter's write() and flush()
functions may be called reentrantly and fix the default writer to
protect its FILE* by a mutex.

Fixes #18210.

3 files changed, 30 insertions, 1 deletions

diff --git a/docs/users_guide/runtime_control.rst b/docs/users_guide/runtime_control.rst
index 6d60eb507e..931710d06f 100644
--- a/docs/users_guide/runtime_control.rst
+++ b/docs/users_guide/runtime_control.rst
@@ -196,11 +196,17 @@ Furthermore GHC lets you specify the way event log data (see :rts-flag:`-l
         Hands buffered event log data to your event log writer. Return true on success.
         Required for a custom :c:type:`EventLogWriter`.
 
+        Note that this function may be called by multiple threads
+        simultaneously.
+
     .. c:member:: void flushEventLog(void)
 
         Flush buffers (if any) of your custom :c:type:`EventLogWriter`. This can
         be ``NULL``.
 
+        Note that this function may be called by multiple threads
+        simultaneously.
+
     .. c:member:: void stopEventLogWriter(void)
 
         Called when event logging is about to stop. This can be ``NULL``.
diff --git a/includes/rts/EventLogWriter.h b/includes/rts/EventLogWriter.h
index 4975b72b07..38a0c06086 100644
--- a/includes/rts/EventLogWriter.h
+++ b/includes/rts/EventLogWriter.h
@@ -24,9 +24,13 @@ typedef struct {
     void (* initEventLogWriter) (void);
 
     // Write a series of events returning true on success.
+    // Note that this may be called by multiple threads simultaneously.
+    // The writer is responsible for concurrency control.
     bool (* writeEventLog) (void *eventlog, size_t eventlog_size);
 
     // Flush possibly existing buffers (may be NULL)
+    // Note that this may be called by multiple threads simultaneously.
+    // The writer is responsible for concurrency control.
     void (* flushEventLog) (void);
 
     // Close an initialized EventLogOutput (may be NULL)
diff --git a/rts/eventlog/EventLogWriter.c b/rts/eventlog/EventLogWriter.c
index b19e617a4c..5387f932eb 100644
--- a/rts/eventlog/EventLogWriter.c
+++ b/rts/eventlog/EventLogWriter.c
@@ -28,6 +28,17 @@ static pid_t event_log_pid = -1;
 // File for logging events
 static FILE *event_log_file = NULL;
 
+#if defined(THREADED_RTS)
+// Protects event_log_file
+static Mutex event_log_mutex;
+
+static void acquire_event_log_lock(void) { ACQUIRE_LOCK(&event_log_mutex); }
+static void release_event_log_lock(void) { RELEASE_LOCK(&event_log_mutex); }
+#else
+static void acquire_event_log_lock(void) {}
+static void release_event_log_lock(void) {}
+#endif
+
 static void initEventLogFileWriter(void);
 static bool writeEventLogFile(void *eventlog, size_t eventlog_size);
 static void flushEventLogFile(void);
@@ -89,6 +100,9 @@ initEventLogFileWriter(void)
     }
 
     stgFree(event_log_filename);
+#if defined(THREADED_RTS)
+    initMutex(&event_log_mutex);
+#endif
 }
 
 static bool
@@ -97,15 +111,17 @@ writeEventLogFile(void *eventlog, size_t eventlog_size)
     unsigned char *begin = eventlog;
     size_t remain = eventlog_size;
 
+    acquire_event_log_lock();
     while (remain > 0) {
         size_t written = fwrite(begin, 1, remain, event_log_file);
         if (written == 0) {
+            release_event_log_lock();
             return false;
         }
         remain -= written;
         begin += written;
     }
-
+    release_event_log_lock();
     return true;
 }
 
@@ -124,6 +140,9 @@ stopEventLogFileWriter(void)
         fclose(event_log_file);
         event_log_file = NULL;
     }
+#if defined(THREADED_RTS)
+    closeMutex(&event_log_mutex);
+#endif
 }
 
 const EventLogWriter FileEventLogWriter = {