eventlog-socket 0.1.0.0 → 0.1.1.0

raw patch · 20 files changed

+4621/−603 lines, 20 filessetup-changednew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +15/−0
• ChangeLog.md +0/−5
• README.md +255/−0
• Setup.hs +1/−0
• cbits/eventlog_socket.c +1133/−539
• cbits/eventlog_socket/control.c +1203/−0
• cbits/eventlog_socket/control.h +58/−0
• cbits/eventlog_socket/debug.h +108/−0
• cbits/eventlog_socket/error.c +68/−0
• cbits/eventlog_socket/error.h +37/−0
• cbits/eventlog_socket/macros.h +18/−0
• cbits/eventlog_socket/poll.h +13/−0
• cbits/eventlog_socket/string.c +28/−0
• cbits/eventlog_socket/string.h +28/−0
• cbits/eventlog_socket/write_buffer.c +54/−0
• cbits/eventlog_socket/write_buffer.h +38/−0
• eventlog-socket.cabal +93/−19
• include/eventlog_socket.h +489/−3
• src/GHC/Eventlog/Socket.hs +0/−37
• src/GHC/Eventlog/Socket.hsc +982/−0

@@ -0,0 +1,15 @@+# Revision history for eventlog-socket++## 0.1.1.0 -- 2026-02-23++* Added high-level API (`startWith` with `EventlogSocketAddr` and `EventlogSocketOpts`).+* Added support for TCP sockets (via `EventlogSocketAddr`).+* Added support for setting the send buffer size (via `EventlogSocketOpts`).+* Added support for reading the configuration from environment variables (`fromEnv` and `startFromEnv`).+* Added public C API.+* Added support for control commands (if compiled with `+control`).+* Added support for custom control commands.++## 0.1.0.0 -- 2023-04-14++* First version. Released on an unsuspecting world.

@@ -1,5 +0,0 @@-# Revision history for eventlog-socket--## 0.1.0.0 -- YYYY-mm-dd--* First version. Released on an unsuspecting world.

@@ -0,0 +1,255 @@+# eventlog-socket++The `eventlog-socket` package supports streaming the GHC eventlog over Unix domain and TCP/IP sockets.+It streams the GHC eventlog in the [standard binary format](https://downloads.haskell.org/ghc/latest/docs/users_guide/eventlog-formats.html), identical to the contents of a binary `.eventlog` file, which can be parsed using [ghc-events](https://hackage.haskell.org/package/ghc-events). Whenever a new client connects, the event header is repeated, which guarantees that the client receives important events such as [`RTS_IDENTIFIER`](https://downloads.haskell.org/ghc/latest/docs/users_guide/eventlog-formats.html#event-type-RTS_IDENTIFIER) and [`WALL_CLOCK_TIME`](https://downloads.haskell.org/ghc/latest/docs/users_guide/eventlog-formats.html#event-type-WALL_CLOCK_TIME).++## Getting Started++To use the code in this repository to profile your own application, follow these steps.++### Add `eventlog-socket` as a dependency++Add `eventlog-socket` to the `build-depends` section for your executable.++```cabal+executable my-app+  ...+  build-depends:+    ...+    , eventlog-socket  >=0.1 && <0.2+    ...+```++### Instrument your application from Haskell++If you want to stream the GHC eventlog over a Unix domain socket, all you have to do is call the `start` function from `GHC.Eventlog.Socket` with the path you'd like it to use for the socket.++```haskell+module Main where++import           Data.Foldable (for_)+import qualified GHC.Eventlog.Socket+import           System.Environment (lookupEnv)++main :: IO ()+main = do+  -- Start eventlog-socket on GHC_EVENTLOG_UNIX_PATH, if set:+  maybeUnixPath <- lookupEnv "GHC_EVENTLOG_UNIX_PATH"+  for_ maybeUnixPath $ \unixPath -> do+    putStrLn "Start eventlog-socket on " <> unixPath+    GHC.Eventlog.Socket.start unixPath++  -- The rest of your application:+  ...+```++If you also want your application to block until the client process connects to the Unix domain socket, you can use `startWait`.++For more detailed configuration options, including TCP/IP sockets, you should use the `startWith` function, which takes a socket address and socket options as its arguments.++> :warning:+> On most platforms, Unix domain socket paths are limited to 107 characters or less.++> :warning:+> <a name="default-writer"></a>If you instrument your application from Haskell, the GHC RTS will start with the default eventlog writer, which is the file writer. This means that your application will write the first few events to a file called `my-app.eventlog`. Usually, this is not an issue, as all initialization events are repeated every time a new client connects to the socket. However, it may give you problems if your application is stored on a read-only filesystem, such as the Nix store. To change the file path, you can use the `-ol` RTS option. To disable the file writer entirely, use the `--null-eventlog-writer` RTS option. If it's important that you capture *all* of the GHC eventlog, you must [instrument your application from C](#instrument-your-application-from-c), so that the GHC RTS is started with the `eventlog-socket` writer.++### Instrument your application from C++The `eventlog-socket` package installs a C header file, `eventlog_socket.h`, which enables you to instrument your application from a C main function. There is one reason you may want to instrument your application from C, which is that you want to capture *all* of the GHC eventlog. If your application is instrumented from Haskell, it loses the first few events. See the note [above](#default-writer).++For an example of an application instrumented from a custom C main, see [`examples/fibber-c-main`](https://github.com/well-typed/eventlog-socket/tree/eventlog-socket-0.1.1.0/examples/fibber-c-main).++### Configure your application to enable the eventlog++To enable the eventlog, you must pass the `-l` RTS option. This can be done either at compile time or at runtime:++- To set the flag at compile time, add the following to the `ghc-options` section for your executable. See [Setting RTS options at compile time](https://downloads.haskell.org/ghc/latest/docs/users_guide/runtime_control.html#rts-opts-compile-time).++  ```cabal+  executable my-app+    ghc-options:+      ...+      -with-rtsopts="-l"+      ...+  ```++- To set the flag at runtime, call you application with explicit RTS options. This requires that the application is compiled with the `-rtsopts` GHC option. See [Setting RTS options on the command line](https://downloads.haskell.org/ghc/latest/docs/users_guide/runtime_control.html#setting-rts-options-on-the-command-line).++  ```sh+  ./my-app +RTS -l -RTS+  ```++## Control Commands++When compiled with the `+control` feature flag, the eventlog socket supports *control commands*. These are messages that can be *written to* the eventlog socket by the client to control the RTS or execute custom control commands.++The `eventlog-socket` package provides three built-in commands:++1. The `startHeapProfiling` control command starts heap profiling.+2. The `stopHeapProfiling` control command stops heap profiling.+3. The `requestHeapCensus` control command requests a single heap profile.++The heap profiling commands require that the RTS is initialised with one of the `-h` options. See [RTS options for heap profiling](https://downloads.haskell.org/ghc/latest/docs/users_guide/profiling.html#rts-options-heap-prof). If any heap profiling option is passed, heap profiling is started by default. To avoid this, pass the `--no-automatic-heap-samples` to the RTS *in addition to* the selected `-h` option, e.g., `./my-app +RTS -hT --no-automatic-heap-samples -RTS`.++The [`eventlog-socket-control`](https://github.com/well-typed/eventlog-socket/tree/eventlog-socket-0.1.1.0/eventlog-socket-control/) package provides utilities for creating control command protocol messages to write to the eventlog socket.+If you want to send control commands from a different programming language, see [Control Command Protocol](#control-command-protocol) for the specification of the binary control command protocol.++### Control Command Protocol++A control command message starts with the magic byte sequence `0xF0` `0x9E` `0x97` `0x8C`, followed by the protocol version, followed by the namespace as a length-prefixed string, followed by the command ID byte. The following is an an ENBF grammar for control command messages:++```ebnf+(* control command protocol version 0 *)++message          = magic protocol-version namespace-len namespace command-id;+magic            = "0xF0" "0x9E" "0x97" "0x8C";+protocol-version = "0x00";+namespace-len    = byte;   (* must be between 0-255 *)+namespace        = {byte}; (* must be exactly namespace-len bytes *)+command-id       = byte;   (* commands are assigned numeric IDs *)+```++The built-in commands live in the `"eventlog-socket"` namespace and are numbered in order starting at 3.++1. The message for `startHeapProfiling` is `\xF0\x9E\x97\x8C\x00\x15eventlog-socket\x03`.+2. The message for `stopHeapProfiling` is `\xF0\x9E\x97\x8C\x00\x15eventlog-socket\x04`.+3. The message for `requestHeapCensus` is `\xF0\x9E\x97\x8C\x00\x15eventlog-socket\x05`.++For example, a simple Python client using the [`socket`](https://docs.python.org/3/library/socket.html) library could request a heap census as follows:++```python+def request_heap_census(sock):+  sock.sendall(b"\xF0\x9E\x97\x8C\x00\x15eventlog-socket\x05")+```++Any unknown control commands or incorrectly formatted messages are ignored, so you can send control commands without worry for crashing your application.++### Custom Control Commands++The `eventlog-socket` package supports custom control commands.+Custom control commands can be registered via both the Haskell and the C API.+Registration is a two-step process:++1.  Register a namespace. This must be a string of between 1 and 255 bytes. By convention, this should be your Haskell package name.+2.  Register each command. This must be a number between 1 and 255. By convention, this should be the first non-zero number that's still available for this namespace.++Commands can be passed some user data at registration time. This is intended to let you defines multiple different commands using the same handler.++For an example of an application instrumented with custom control commands using the Haskell API, see [`examples/custom-command`](https://github.com/well-typed/eventlog-socket/tree/eventlog-socket-0.1.1.0/examples/custom-command/).++For an example of an application instrumented with custom control commands using the C API, see [`examples/custom-command-c-main`](https://github.com/well-typed/eventlog-socket/tree/eventlog-socket-0.1.1.0/examples/custom-command-c-main/).++The following snippet defines the `registerGreeters` function, which registers two commands via the Haskell API:++```haskell+import GHC.Eventlog.Socket++greeter :: String -> IO ()+greeter name =+  putStrLn $ "Hello, " <> name <> "!"++registerGreeters :: IO ()+registerGreeters = do+  myNamespace <- registerNamespace "greeters"+  registerCommand myNamespace (CommandId 1) (greeter "C")+  registerCommand myNamespace (CommandId 2) (greeter "Haskell")+```++The following snippet defines the `register_greeters` function, which registers two equivalent commands via the C API:++```c+#include <stdio.h>+#include <stdlib.h>+#include <eventlog_socket.h>++static void greeter(const EventlogSocketControlNamespace *const namespace,+                       const EventlogSocketControlCommandId command_id,+                       const void *user_data) {+  (void) namespace;+  (void) command_id;+  printf("Hello, %s!", (const char*)user_data);+}++bool register_greeters(void) {+  // Use the name of my Haskell package:+  const char* const my_namespace = "my-app";++  // Allocate space for the namespace object:+  EventlogSocketControlNamespace *namespace = NULL;++  // Try to register the namespace:+  const EventlogSocketStatus namespace_status =+    eventlog_socket_control_register_namespace(+      strlen(my_namespace), my_namespace, &namespace);++  // Handle any errors:+  if (namespace_status.ess_status_code != EVENTLOG_SOCKET_OK) {+    char *errmsg = eventlog_socket_strerror(namespace_status);+    if (errmsg != NULL) {+      fprintf(stderr, "ERROR: %s", errmsg);+      free(errmsg);+    }+    return false;+  }+  // Otherwise, namespace contains a valid object.++  // Use the first available non-zero command ID for greet_c:+  const uint8_t greet_c_id = 1;++  // Allocate data for the greet_c command, if needed:+  static const char * const greet_c_data = "C";++  // Try to register the greet_c command:+  const EventlogSocketStatus greet_c_status =+    eventlog_socket_control_register_command(+      namespace, greet_c_id, greeter, greet_c_data);++  // Handle any errors:+  if (greet_c_status.ess_status_code != EVENTLOG_SOCKET_OK) {+    char *errmsg = eventlog_socket_strerror(greet_c_status);+    if (errmsg != NULL) {+      fprintf(stderr, "ERROR: %s", errmsg);+      free(errmsg);+    }+    return false;+  }+  // Otherwise, the command is registered.++  // Use the next available command ID for greet_haskell:+  const uint8_t greet_haskell_id = 2;++  // Allocate data for the greet_haskell command, if needed:+  static const char * const greet_haskell_data = "Haskell";++  // Try to register the greet_haskell command:+  const EventlogSocketStatus greet_haskell_status =+    eventlog_socket_control_register_command(+      namespace, greet_haskell_id, greeter, greet_haskell_data);++  // Handle any errors:+  if (greet_haskell_status.ess_status_code != EVENTLOG_SOCKET_OK) {+    char *errmsg = eventlog_socket_strerror(greet_haskell_status);+    if (errmsg != NULL) {+      fprintf(stderr, "ERROR: %s", errmsg);+      free(errmsg);+    }+    return false;+  }+  // Otherwise, the command is registered.++  return true;+}+```++## Contributing++The `scripts` directory contains various scripts for contributors to this repository.++The `./scripts/test-haskell.sh` script runs the Haskell test suite, which is located in [`eventlog-socket-tests`](https://github.com/well-typed/eventlog-socket/tree/eventlog-socket-0.1.1.0/eventlog-socket-tests/).++The `./scripts/test-python.sh` scripts runs the Python test suite, which is located in [`eventlog-socket/tests`](https://github.com/well-typed/eventlog-socket/tree/eventlog-socket-0.1.1.0/eventlog-socket/tests).+This test suite is not fully portable, and is primarily intended to be run on Linux machines.++The `./scripts/pre-commit.sh` script runs the pre-commit hooks, which contains various formatters and linters.++The `./scripts/build-doxygen.sh` and `./scripts/build-haddock.sh` scripts build the documentation for the C and Haskell APIs.

@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain

@@ -1,539 +1,1133 @@-// For POLLRDHUP-#define _GNU_SOURCE--#include <assert.h>-#include <stdbool.h>-#include <poll.h>-#include <string.h>-#include <stdlib.h>-#include <unistd.h>-#include <sys/types.h>-#include <sys/socket.h>-#include <sys/un.h>-#include <pthread.h>-#include <fcntl.h>--#include <Rts.h>--#include "eventlog_socket.h"--#define LISTEN_BACKLOG 5-#define POLL_LISTEN_TIMEOUT 10000-#define POLL_WRITE_TIMEOUT 1000--#ifndef POLLRDHUP-#define POLLRDHUP POLLHUP-#endif--// logging helper macros:-// - use PRINT_ERR to unconditionally log erroneous situations-// - otherwise use DEBUG_ERR-#define PRINT_ERR(...) fprintf(stderr, "ghc-eventlog-socket: " __VA_ARGS__)-#ifdef NDEBUG-#define DEBUG_ERR(fmt, ...)-#define DEBUG0_ERR(fmt)-#else-#define DEBUG_ERR(fmt, ...) fprintf(stderr, "ghc-eventlog-socket %s: " fmt, __func__, __VA_ARGS__)-#define DEBUG0_ERR(fmt) fprintf(stderr, "ghc-eventlog-socket %s: " fmt, __func__)-#endif--/*********************************************************************************- * data definitions- *********************************************************************************/---struct write_buffer_item {-  uint8_t *orig; // original data pointer (which we free)-  uint8_t *data;-  size_t size; // invariant: size is not zero-  struct write_buffer_item *next;-};--// invariant: head and last are both NULL or both not NULL.-struct write_buffer {-  struct write_buffer_item *head;-  struct write_buffer_item *last;-};--/*********************************************************************************- * globals- *********************************************************************************/--/* This module is concurrent.- * There are two thread(group)s:- * 1. RTS- * 2. worker spawned by open_socket- */--// variables read and written by worker only:-static bool initialized = false;-static int listen_fd = -1;--// concurrency variables-static pthread_t listen_thread;-static pthread_cond_t new_conn_cond;-static pthread_mutex_t mutex;--// variables accessed by both threads.-// their access should be guarded by mutex.-//-// Note: RTS writes client_fd in writer_stop.-static volatile int client_fd = -1;-static struct write_buffer wt = {-  .head = NULL,-  .last = NULL,-};--/*********************************************************************************- * write_buffer- *********************************************************************************/--// push to the back.-void write_buffer_push(struct write_buffer *buf, uint8_t *data, size_t size) {-  DEBUG_ERR("%p, %lu\n", data, size);-  uint8_t *copy = malloc(size);-  memcpy(copy, data, size);--  struct write_buffer_item *item = malloc(sizeof(struct write_buffer_item));-  item->orig = copy;-  item->data = copy;-  item->size = size;-  item->next = NULL;--  struct write_buffer_item *last = buf->last;-  if (last == NULL) {-    assert(buf->head == NULL);--    buf->head = item;-    buf->last = item;-  } else {-    last->next = item;-    buf->last = item;-  }--  DEBUG_ERR("%p %p %p\n", buf, &wt, buf->head);-};--// pop from the front.-void write_buffer_pop(struct write_buffer *buf) {-  struct write_buffer_item *head = buf->head;-  if (head == NULL) {-    // buffer is empty: nothing to do.-    return;-  } else {-    buf->head = head->next;-    if (buf->last == head) {-      buf->last = NULL;-    }-    free(head->orig);-    free(head);-  }-}--// buf itself is not freed.-// it's safe to call write_buffer_free multiple times on the same buf.-void write_buffer_free(struct write_buffer *buf) {-  // not the most effecient implementation,-  // but should be obviously correct.-  while (buf->head) {-    write_buffer_pop(buf);-  }-}--/*********************************************************************************- * EventLogWriter- *********************************************************************************/--static void writer_init(void)-{-  // no-op-}--static void writer_enqueue(uint8_t *data, size_t size) {-  DEBUG_ERR("size: %p %lu\n", data, size);--  // TODO: check the size of the queue-  // if it's too big, we can start dropping blocks.--  // for now, we just push everythinb to the back of the buffer.-  write_buffer_push(&wt, data, size);--  DEBUG_ERR("wt.head = %p\n", wt.head);-}--static bool writer_write(void *eventlog, size_t size)-{-  DEBUG_ERR("size: %lu\n", size);-  pthread_mutex_lock(&mutex);-  int fd = client_fd;-  if (fd < 0) {-    goto exit;-  }--  DEBUG_ERR("client_fd = %d; wt.head = %p\n", fd, wt.head);--  if (wt.head != NULL) {-    // if there is stuff in queue already, we enqueue the current block.-    writer_enqueue(eventlog, size);-  } else {--    // and if there isn't, we can write immediately.-    int ret = write(fd, eventlog, size);-    DEBUG_ERR("write return %d\n", ret);--    if (ret == -1) {-      if (errno == EAGAIN || errno == EWOULDBLOCK) {-        // couldn't write anything, enqueue whole block-        writer_enqueue(eventlog, size);-        goto exit;-      } else if (errno == EPIPE) {-        // connection closed, simply exit-        goto exit;--      } else {-        PRINT_ERR("failed to write: %s\n", strerror(errno));-        goto exit;-      }-    } else {-      // we wrote something-      if (ret >= size) {-        // we wrote everything, nothing to do-        goto exit;-      } else {-        // we wrote only part of the buffer-        writer_enqueue(eventlog + ret, size - ret);-      }-    }-  }--exit:-  pthread_mutex_unlock(&mutex);-  return true;-}--static void writer_flush(void)-{-  // no-op-}--static void writer_stop(void)-{-  pthread_mutex_lock(&mutex);-  if (client_fd >= 0) {-    close(client_fd);-    client_fd = -1;-    write_buffer_free(&wt);-  }-  pthread_mutex_unlock(&mutex);-}--const EventLogWriter socket_writer = {-  .initEventLogWriter = writer_init,-  .writeEventLog = writer_write,-  .flushEventLog = writer_flush,-  .stopEventLogWriter = writer_stop-};--/*********************************************************************************- * Main worker (in own thread)- *********************************************************************************/--static void listen_iteration() {-  DEBUG0_ERR("enter");--  if (listen(listen_fd, LISTEN_BACKLOG) == -1) {-    PRINT_ERR("listen() failed: %s\n", strerror(errno));-    abort();-  }--  struct sockaddr_un remote;-  unsigned int len;--  struct pollfd pfd_accept = {-    .fd = listen_fd,-    .events = POLLIN,-    .revents = 0,-  };--  // poll until we can accept-  while (true) {-    int ret = poll(&pfd_accept, 1, POLL_LISTEN_TIMEOUT);-    if (ret ==  -1) {-      PRINT_ERR("poll() failed: %s\n", strerror(errno));-      return;-    } else if (ret == 0) {-      DEBUG0_ERR("accept poll timed out\n");-    } else {-      // got connection-      break;-    }-  }--  // accept-  int fd = accept(listen_fd, (struct sockaddr *) &remote, &len);-  if (fd == -1) {-    PRINT_ERR("accept failed: %s\n", strerror(errno));-  }--  // set socket into non-blocking mode-  int flags = fcntl(fd, F_GETFL);-  if (flags == -1) {-    PRINT_ERR("fnctl F_GETFL failed: %s\n", strerror(errno));-  }-  if (fcntl(fd, F_SETFL, flags | O_NONBLOCK) == -1) {-    PRINT_ERR("fnctl F_SETFL failed: %s\n", strerror(errno));-  }--  // we stop existing logging-  if (eventLogStatus() == EVENTLOG_RUNNING) {-    endEventLogging();-  }--  // we got client_id now.-  pthread_mutex_lock(&mutex);-  client_fd = fd;-  // Drop lock to allow initial batch of events to be written.-  pthread_mutex_unlock(&mutex);--  // start writing-  startEventLogging(&socket_writer);--  // Announce new connection-  pthread_cond_broadcast(&new_conn_cond);--  // we are done.-}--// nothing to write iteration.-//-// we poll only for whether the connection is closed.-static void nonwrite_iteration(int fd) {-  DEBUG_ERR("(%d)\n", fd);--  // Wait for socket to disconnect-  struct pollfd pfd = {-    .fd = fd,-    .events = POLLRDHUP,-    .revents = 0,-  };--  int ret = poll(&pfd, 1, POLL_WRITE_TIMEOUT);-  if (ret == -1 && errno != EAGAIN) {-    // error-    PRINT_ERR("poll() failed: %s\n", strerror(errno));-    return;-  } else if (ret == 0) {-    // timeout-    return;-  }--  // reset client_fd on RDHUP.-  if (pfd.revents | POLLRDHUP) {-    DEBUG_ERR("(%d) POLLRDHUP\n", fd);--    // reset client_fd-    pthread_mutex_lock(&mutex);-    // note: writer_stop may close the connection as well.-    client_fd = -1;-    write_buffer_free(&wt);-    pthread_mutex_unlock(&mutex);-    return;-  }--  // we don't stop logging,-  // write function will be no-op with negative client_fd-  //-  // Before setting new client_fd we will stop the logging,-  // and restart if afterwards, so the header is written-  // to the new connection.-}--// write iteration.-//-// we poll for both: can we write, and whether the connection is closed.-static void write_iteration(int fd) {-  DEBUG_ERR("(%d)\n", fd);--  // Wait for socket to disconnect-  struct pollfd pfd = {-    .fd = fd,-    .events = POLLOUT | POLLRDHUP,-    .revents = 0,-  };--  int ret = poll(&pfd, 1, POLL_WRITE_TIMEOUT);-  if (ret == -1 && errno != EAGAIN) {-    // error-    PRINT_ERR("poll() failed: %s\n", strerror(errno));-    return;-  } else if (ret == 0) {-    // timeout-    return;-  }--  // reset client_fd on RDHUP.-  if (pfd.revents & POLLHUP) {-    DEBUG_ERR("(%d) POLLRDHUP\n", fd);--    // reset client_fd-    pthread_mutex_lock(&mutex);-    assert(fd == client_fd);-    client_fd = -1;-    write_buffer_free(&wt);-    pthread_mutex_unlock(&mutex);-    return;-  }--  if (pfd.revents & POLLOUT) {-    DEBUG_ERR("(%d) POLLOUT\n", fd);--    pthread_mutex_lock(&mutex);-    while (wt.head) {-      struct write_buffer_item *item = wt.head;-      ret = write(client_fd, item->data, item->size);--      if (ret == -1) {-        if (errno == EAGAIN || errno == EWOULDBLOCK) {-          // couldn't write anything, shouldn't happend.-          // do nothing.-        } else if (errno == EPIPE) {-          client_fd = -1;-          write_buffer_free(&wt);-        } else {-          PRINT_ERR("failed to write: %s\n", strerror(errno));-        }--        // break out of the loop-        break;--      } else {-        // we wrote something-        if (ret >= item->size) {-          // we wrote whole element, try to write next element too-          write_buffer_pop(&wt);-          continue;-        } else {-          item->size -= ret;-          item->data += ret;-          break;-        }-      }-    }-    pthread_mutex_unlock(&mutex);-  }-}--static void iteration() {-  pthread_mutex_lock(&mutex);-  int fd = client_fd;-  bool empty = wt.head == NULL;-  DEBUG_ERR("fd = %d, wt.head = %p\n", fd, wt.head);-  pthread_mutex_unlock(&mutex);--  if (fd != -1) {-    if (empty) {-      nonwrite_iteration(fd);-    } else {-      write_iteration(fd);-    }-  } else {-    listen_iteration();-  }-}--/* Main loop of eventlog-socket own thread:- * Currently it is two states:- * - either we have connection, then we poll for writes (and drop of connection).- * - or we don't have, then we poll for accept.- */-static void *worker(void * _unused)-{-  while (true) {-    iteration();-  }--  return NULL; // unreachable-}--/*********************************************************************************- * Initialization- *********************************************************************************/--static void open_socket(const char *sock_path)-{-  DEBUG_ERR("enter: %s\n", sock_path);--  listen_fd = socket(AF_UNIX, SOCK_STREAM, 0);--  struct sockaddr_un local;-  local.sun_family = AF_UNIX;-  strncpy(local.sun_path, sock_path, sizeof(local.sun_path) - 1);-  unlink(sock_path);-  if (bind(listen_fd, (struct sockaddr *) &local,-           sizeof(struct sockaddr_un)) == -1) {-    PRINT_ERR("failed to bind socket %s: %s\n", sock_path, strerror(errno));-    abort();-  }--  int ret = pthread_create(&listen_thread, NULL, worker, NULL);-  if (ret != 0) {-    PRINT_ERR("failed to spawn thread: %s\n", strerror(ret));-    abort();-  }-}---/*********************************************************************************- * Public interface- *********************************************************************************/--void eventlog_socket_wait(void)-{-  pthread_mutex_lock(&mutex);-  while (client_fd == -1) {-    int ret = pthread_cond_wait(&new_conn_cond, &mutex);-    if (ret != 0) {-      PRINT_ERR("failed to wait on condition variable: %s\n", strerror(ret));-    }-  }-  pthread_mutex_unlock(&mutex);-}--void eventlog_socket_start(const char *sock_path, bool wait)-{-  if (!initialized) {-    pthread_mutex_init(&mutex, NULL);-    pthread_cond_init(&new_conn_cond, NULL);-    initialized = true;-  }--  if (!sock_path)-    return;--  if (eventLogStatus() == EVENTLOG_NOT_SUPPORTED) {-    PRINT_ERR("eventlog is not supported.\n");-    return;-  }--  // we stop existing logging-  if (eventLogStatus() == EVENTLOG_RUNNING) {-    endEventLogging();-  }--  // ... and restart with outer socket writer,-  // which is no-op so far.-  //-  // This trickery is to avoid-  //-  //     printAndClearEventLog: could not flush event log-  //-  // warning messages from showing up in stderr.-  startEventLogging(&socket_writer);--  open_socket(sock_path);-  if (wait) {-    DEBUG_ERR("ghc-eventlog-socket: Waiting for connection to %s...\n", sock_path);-    eventlog_socket_wait();-  }-}-+#include <assert.h>+#include <ctype.h>+#include <errno.h>+#include <fcntl.h>+#include <netdb.h>+#include <pthread.h>+#include <stdbool.h>+#include <stddef.h>+#include <stdint.h>+#include <stdlib.h>+#include <string.h>+#include <sys/socket.h>+#include <sys/types.h>+#include <sys/un.h>+#include <unistd.h>++#include <Rts.h>+#include <rts/prof/Heap.h>++#ifdef EVENTLOG_SOCKET_FEATURE_CONTROL+#include "./eventlog_socket/control.h"+#endif /* EVENTLOG_SOCKET_FEATURE_CONTROL */++#include "./eventlog_socket/debug.h"+#include "./eventlog_socket/error.h"+#include "./eventlog_socket/poll.h"+#include "./eventlog_socket/string.h"+#include "./eventlog_socket/write_buffer.h"+#include "eventlog_socket.h"++#define LISTEN_BACKLOG 5++#ifndef NI_MAXHOST+#define NI_MAXHOST 1025+#endif+#ifndef NI_MAXSERV+#define NI_MAXSERV 32+#endif++/*********************************************************************************+ * globals+ *********************************************************************************/++/* This module is concurrent.+ * There are three thread(group)s:+ * 1. RTS+ * 2. worker spawned by worker_start (this writes to the socket)+ * 3. listener spawned by start_control_receiver (this receives messages on the+ * socket)+ */++// variables read and written by worker only:+static bool g_initialized = false;+static int g_listen_fd = -1;+static const char *g_sock_path = NULL;+static int g_wake_pipe[2] = {-1, -1};++// Worker thread handle.+static pthread_t *g_listen_thread_ptr = NULL;++// Control thread handle.+#ifdef EVENTLOG_SOCKET_FEATURE_CONTROL+static pthread_t *g_control_thread_ptr = NULL;+#endif /* EVENTLOG_SOCKET_FEATURE_CONTROL */++// Condition for new connections.+static pthread_cond_t g_new_conn_cond = PTHREAD_COND_INITIALIZER;++// Global mutex guarding all shared state between RTS threads, the worker+// thread, and the detached control receiver. Only client_fd and wt need+// protection, but using a single mutex ensures we keep their updates+// consistent.+static pthread_mutex_t g_write_buffer_and_client_fd_mutex =+    PTHREAD_MUTEX_INITIALIZER;++// variables accessed by multiple threads and guarded by mutex:+//  * client_fd: written by worker, writer_stop, and control receiver to signal+//    when a client connects/disconnects. The lock ensures the fd value does not+//    change while other threads inspect or write to it.+//  * wt: queue of pending eventlog chunks. RTS writers append while the worker+//    thread consumes; the lock ensures push/pop operations stay consistent.+//+// Note: RTS writes client_fd in writer_stop.+static volatile int g_client_fd = -1;+static WriteBuffer g_write_buffer = {+    .head = NULL,+    .last = NULL,+};++static void cleanup(void) {+  // Remove socket file.+  if (g_sock_path) {+    unlink(g_sock_path);+  }+  // Close the wake pipes.+  if (g_wake_pipe[0] != -1) {+    close(g_wake_pipe[0]);+    g_wake_pipe[0] = -1;+  }+  if (g_wake_pipe[1] != -1) {+    close(g_wake_pipe[1]);+    g_wake_pipe[1] = -1;+  }+  // Stop the control thread.+#ifdef EVENTLOG_SOCKET_FEATURE_CONTROL+  if (g_control_thread_ptr != NULL) {+    DEBUG_DEBUG("%s", "Cancelling control thread.");+    if (pthread_cancel(*g_control_thread_ptr) != 0) {+      DEBUG_ERRNO("pthread_cancel() failed for control thread");+    } else {+      if (pthread_join(*g_control_thread_ptr, NULL) != 0) {+        DEBUG_ERRNO("pthread_join() failed for control thread");+      }+    }+    free((void *)g_control_thread_ptr);+  }++#endif /* EVENTLOG_SOCKET_FEATURE_CONTROL */+  // Stop the worker thread.+  if (g_listen_thread_ptr != NULL) {+    DEBUG_DEBUG("%s", "Cancelling worker thread.");+    if (pthread_cancel(*g_listen_thread_ptr) != 0) {+      DEBUG_ERRNO("pthread_cancel() failed for worker thread");+    } else {+      if (pthread_join(*g_listen_thread_ptr, NULL) != 0) {+        DEBUG_ERRNO("pthread_join() failed for worker thread");+      }+    }+    free((void *)g_listen_thread_ptr);+  }+}++#define EVENTLOG_SOCKET_WORKER_CHUNK_SIZE 32++static void drain_worker_wake(void) {+  if (g_wake_pipe[0] == -1) {+    return;+  }+  uint8_t chunk[EVENTLOG_SOCKET_WORKER_CHUNK_SIZE];+  while (true) {+    const ssize_t success_or_error = read(g_wake_pipe[0], chunk, sizeof(chunk));+    if (success_or_error > 0) {+      continue;+    } else if (success_or_error == 0) {+      break;+    } else if (errno == EINTR) {+      continue;+    } else if (errno == EAGAIN || errno == EWOULDBLOCK) {+      break;+    } else {+      DEBUG_ERRNO("read() failed");+      break;+    }+  }+}++static void wake_worker(void) {+  if (g_wake_pipe[1] == -1) {+    return;+  }++  const uint8_t byte = 1;+  const ssize_t success_or_error = write(g_wake_pipe[1], &byte, sizeof(byte));+  if (success_or_error == -1 && errno != EAGAIN && errno != EWOULDBLOCK) {+    DEBUG_ERRNO("write() failed");+  }+}++/*********************************************************************************+ * EventLogWriter+ *********************************************************************************/++static void writer_init(void) {+  // nothing+}++static void writer_enqueue(uint8_t *data, size_t size) {+  DEBUG_TRACE("size: %p %lu", (void *)data, size);+  bool was_empty = g_write_buffer.head == NULL;++  // TODO: check the size of the queue+  // if it's too big, we can start dropping blocks.++  // for now, we just push everythinb to the back of the buffer.+  write_buffer_push(&g_write_buffer, data, size);++  DEBUG_TRACE("wt.head = %p", (void *)g_write_buffer.head);+  if (was_empty) {+    wake_worker();+  }+}++static bool writer_write(void *eventlog, size_t size) {+  DEBUG_TRACE("size: %lu", size);+  // Serialize against worker/control threads so that client_fd and wt are read+  // atomically with respect to connection establishment/teardown.+  pthread_mutex_lock(&g_write_buffer_and_client_fd_mutex);+  int fd = g_client_fd;+  if (fd < 0) {+    goto exit;+  }++  DEBUG_TRACE("client_fd = %d; wt.head = %p", fd, (void *)g_write_buffer.head);++  if (g_write_buffer.head != NULL) {+    // if there is stuff in queue already, we enqueue the current block.+    writer_enqueue(eventlog, size);+  } else {++    // and if there isn't, we can write immediately.+    const ssize_t num_bytes_written_or_err = write(fd, eventlog, size);+    DEBUG_TRACE("write return %zd", num_bytes_written_or_err);++    if (num_bytes_written_or_err == -1) {+      if (errno == EAGAIN || errno == EWOULDBLOCK) {+        // couldn't write anything, enqueue whole block+        writer_enqueue(eventlog, size);+        goto exit;+      } else if (errno == EPIPE) {+        // connection closed, simply exit+        goto exit;++      } else {+        DEBUG_ERRNO("write() failed");+        goto exit;+      }+    } else {+      // cast from ssize_t to size_t is safe as num_bytes_written_or_err != -1+      const size_t num_bytes_written = num_bytes_written_or_err;+      // we wrote something+      if (num_bytes_written >= size) {+        // we wrote everything, nothing to do+        goto exit;+      } else {+        // we wrote only part of the buffer+        writer_enqueue((uint8_t *)eventlog + num_bytes_written,+                       size - num_bytes_written);+      }+    }+  }++exit:+  pthread_mutex_unlock(&g_write_buffer_and_client_fd_mutex);+  return true;+}++static void writer_flush(void) {+  // no-op+}++static void writer_stop(void) {+  // RTS shutdown path must hold mutex so updates to client_fd/wt stay ordered+  // with the worker thread noticing the disconnect.+  pthread_mutex_lock(&g_write_buffer_and_client_fd_mutex);+  if (g_client_fd >= 0) {+    close(g_client_fd);+    g_client_fd = -1;+    write_buffer_free(&g_write_buffer);+  }+  pthread_mutex_unlock(&g_write_buffer_and_client_fd_mutex);+}++/// @brief The eventlog socket writer.+///+/// @warning It is only safe to pass this value to the GHC RTS *after*+/// `eventlog_socket_init` or `eventlog_socket_start` is called.+static const EventLogWriter SocketEventLogWriter = {+    .initEventLogWriter = writer_init,+    .writeEventLog = writer_write,+    .flushEventLog = writer_flush,+    .stopEventLogWriter = writer_stop};++/*********************************************************************************+ * Main worker (in own thread)+ *********************************************************************************/++static void worker_step_listen(void) {+  bool start_eventlog = false;++  if (listen(g_listen_fd, LISTEN_BACKLOG) == -1) {+    DEBUG_ERRNO("listen() failed");+    abort();+  }++  struct sockaddr_storage remote;+  socklen_t remote_len = sizeof(remote);++  struct pollfd pfds[1] = {{+      .fd = g_listen_fd,+      .events = POLLIN,+      .revents = 0,+  }};++  DEBUG_TRACE("listen_iteration: waiting for accept on fd %d", g_listen_fd);++  // poll until we can accept+  while (true) {+    const int ready_or_error = poll(pfds, 1, POLL_LISTEN_TIMEOUT);+    if (ready_or_error == -1) {+      DEBUG_ERRNO("poll() failed");+      return;+    } else if (ready_or_error == 0) {+      DEBUG_TRACE("%s", "accept poll timed out");+    } else {+      // got connection+      DEBUG_TRACE("%s", "accept poll ready");+      break;+    }+  }++  // accept+  const int client_fd =+      accept(g_listen_fd, (struct sockaddr *)&remote, &remote_len);+  if (client_fd == -1) {+    DEBUG_ERRNO("accept() failed");+    return;+  }+  DEBUG_TRACE("accepted new connection fd=%d", client_fd);++  // set socket into non-blocking mode+  const int flags = fcntl(client_fd, F_GETFL);+  if (flags == -1) {+    DEBUG_ERRNO("fnctl() failed for F_GETFL");+  }+  if (fcntl(client_fd, F_SETFL, flags | O_NONBLOCK) == -1) {+    DEBUG_ERRNO("fnctl() failed for F_SETFL");+  }++  // we stop existing logging so we can replay header on the new connection+  if (eventLogStatus() == EVENTLOG_RUNNING) {+    endEventLogging();+    start_eventlog = true;+  }++  // we got client_id now.+  // Publish new fd under mutex so RTS writers either see the connection along+  // with an empty queue or not at all. Keep the lock held through the condition+  // broadcast so the predicate update stays atomic on every platform.+  pthread_mutex_lock(&g_write_buffer_and_client_fd_mutex);+  DEBUG_TRACE("publishing client_fd=%d (previous=%d)", client_fd, g_client_fd);+  g_client_fd = client_fd;+  pthread_cond_broadcast(&g_new_conn_cond);+  pthread_mutex_unlock(&g_write_buffer_and_client_fd_mutex);++  if (start_eventlog) {+    // start writing+    startEventLogging(&SocketEventLogWriter);+  }++  // we are done.+}++// nothing to write iteration.+//+// we poll only for whether the connection is closed.+static void worker_step_nonwrite(int fd) {+  DEBUG_TRACE("(%d)", fd);++  // Wait for socket to disconnect or for pending data.+  struct pollfd pfds[2];+  pfds[0].fd = fd;+  pfds[0].events = POLLRDHUP;+  pfds[0].revents = 0;+  int nfds = 1;+  if (g_wake_pipe[0] != -1) {+    pfds[1].fd = g_wake_pipe[0];+    pfds[1].events = POLLIN;+    pfds[1].revents = 0;+    nfds = 2;+  }++  const int ready_or_error = poll(pfds, nfds, -1);+  if (ready_or_error == -1) {+    if (errno == EINTR) {+      return;+    }+    DEBUG_ERRNO("poll() failed");+    return;+  }++  if (nfds == 2 && (pfds[1].revents & POLLIN)) {+    drain_worker_wake();+    return;+  }++  if (pfds[0].revents & POLLHUP) {+    DEBUG_TRACE("(%d) POLLRDHUP", fd);++    pthread_mutex_lock(&g_write_buffer_and_client_fd_mutex);+    g_client_fd = -1;+    write_buffer_free(&g_write_buffer);+    pthread_mutex_unlock(&g_write_buffer_and_client_fd_mutex);+    return;+  }+}++// write iteration.+//+// we poll for both: can we write, and whether the connection is closed.+static void worker_step_write(int fd) {+  DEBUG_TRACE("(%d)", fd);++  // Wait for socket to disconnect+  struct pollfd pfds[1] = {{+      .fd = fd,+      .events = POLLOUT | POLLRDHUP,+      .revents = 0,+  }};++  const int num_ready_or_err = poll(pfds, 1, POLL_WRITE_TIMEOUT);+  if (num_ready_or_err == -1 && errno != EAGAIN) {+    // error+    DEBUG_ERRNO("poll() failed");+    return;+  } else if (num_ready_or_err == 0) {+    // timeout+    return;+  }++  // reset client_fd on RDHUP.+  if (pfds[0].revents & POLLHUP) {+    DEBUG_TRACE("(%d) POLLRDHUP", fd);++    // reset client_fd+    // Protect concurrent access to client_fd and wt during teardown.+    pthread_mutex_lock(&g_write_buffer_and_client_fd_mutex);+    assert(fd == g_client_fd);+    g_client_fd = -1;+    write_buffer_free(&g_write_buffer);+    pthread_mutex_unlock(&g_write_buffer_and_client_fd_mutex);+    return;+  }++  if (pfds[0].revents & POLLOUT) {+    DEBUG_TRACE("(%d) POLLOUT", fd);++    // RTS writers also access wt, so consume queued buffers under the mutex.+    pthread_mutex_lock(&g_write_buffer_and_client_fd_mutex);+    while (g_write_buffer.head) {+      WriteBufferItem *item = g_write_buffer.head;+      const ssize_t num_bytes_written_or_err =+          write(g_client_fd, item->data, item->size);++      if (num_bytes_written_or_err == -1) {+        if (errno == EAGAIN || errno == EWOULDBLOCK) {+          // couldn't write anything, shouldn't happen.+          // do nothing.+        } else if (errno == EPIPE) {+          g_client_fd = -1;+          write_buffer_free(&g_write_buffer);+        } else {+          DEBUG_ERRNO("write() failed");+        }++        // break out of the loop+        break;++      } else {+        // cast from ssize_t to size_t is safe as num_bytes_written_or_err != -1+        const size_t num_bytes_written = num_bytes_written_or_err;+        // we wrote something+        if (num_bytes_written >= item->size) {+          // we wrote whole element, try to write next element too+          write_buffer_pop(&g_write_buffer);+          continue;+        } else {+          item->size -= num_bytes_written;+          item->data += num_bytes_written;+          break;+        }+      }+    }+    pthread_mutex_unlock(&g_write_buffer_and_client_fd_mutex);+  }+}++static void worker_step(void) {+  // Snapshot shared state under lock so worker decisions (listen vs write)+  // align with the current connection/queue state.+  pthread_mutex_lock(&g_write_buffer_and_client_fd_mutex);+  const int client = g_client_fd;+  const bool write_buffer_empty = g_write_buffer.head == NULL;+  DEBUG_TRACE("fd = %d, wt.head = %p", client, (void *)g_write_buffer.head);+  pthread_mutex_unlock(&g_write_buffer_and_client_fd_mutex);++  if (client != -1) {+    if (write_buffer_empty) {+      worker_step_nonwrite(client);+    } else {+      worker_step_write(client);+    }+  } else {+    worker_step_listen();+  }+}++/* Main loop of eventlog-socket own thread:+ * Currently it is two states:+ * - either we have connection, then we poll for writes (and drop of+ * connection).+ * - or we don't have, then we poll for accept.+ */+static void *worker_loop(void *arg) {+  (void)arg;+  while (true) {+    worker_step();+  }+  return NULL; // unreachable+}++/// @brief Initialize the Unix domain socket and bind it to the provided path.+///+/// This function does not start any threads; @c worker_start() completes the+/// setup.+///+/// @return See `EventlogSocketStatus`.+///+/// @par Errors+/// @parblock+/// This function may return the following system errors:+/// `EADDRINUSE`, `EADDRNOTAVAIL`, `EAFNOSUPPORT`, `EBADF`, `EDOM`,+/// `EFAULT`, `EINVAL`, `EISCONN`, `ELOOP`, `EMFILE`, `ENAMETOOLONG`, `ENFILE`,+/// `ENOBUFS`, `ENOENT`, `ENOMEM`, `ENOPROTOOPT`, `ENOTDIR`, `ENOTSOCK`,+/// `EPROTONOSUPPORT`, or `EROFS`.+/// @endparblock+static EventlogSocketStatus+worker_socket_init_unix(const EventlogSocketUnixAddr *const unix_addr,+                        const EventlogSocketOpts *const opts) {+  DEBUG_TRACE("init Unix listener: %s", unix_addr->esa_unix_path);++  // Create a socket.+  g_listen_fd = socket(AF_UNIX, SOCK_STREAM, 0);+  if (g_listen_fd == -1) {+    return STATUS_FROM_ERRNO(); // `setsockopt` sets errno.+  }++  // Record the sock_path so it can be unlinked at exit+  g_sock_path = ess_strdup(unix_addr->esa_unix_path);+  if (g_sock_path == NULL) {+    return STATUS_FROM_ERRNO(); // `ess_strdup` sets errno.+  }++  // Set socket receive low water mark.+  if (setsockopt(g_listen_fd, SOL_SOCKET, SO_RCVLOWAT, &(int){1},+                 sizeof(int)) == -1) {+    DEBUG_ERRNO("setsockopt() failed for SO_RCVLOWAT");+    const int setsockopt_errno = errno; // `setsockopt` sets errno.+    close(g_listen_fd);+    g_listen_fd = -1;+    errno = setsockopt_errno;+    return STATUS_FROM_ERRNO();+  }++  // Set socket send buffer size.+  if (opts != NULL && opts->eso_sndbuf > 0) {+    if (setsockopt(g_listen_fd, SOL_SOCKET, SO_SNDBUF, &opts->eso_sndbuf,+                   sizeof(opts->eso_sndbuf)) == -1) {+      DEBUG_ERRNO("setsockopt() failed for SO_SNDBUF");+      const int setsockopt_errno = errno; // `setsockopt` sets errno.+      close(g_listen_fd);+      g_listen_fd = -1;+      errno = setsockopt_errno;+      return STATUS_FROM_ERRNO();+    }+  }++  // Set socket linger.+  if (opts != NULL && opts->eso_linger > 0) {+    const struct linger so_linger = {+        .l_onoff = true,+        .l_linger = opts->eso_linger,+    };+    if (setsockopt(g_listen_fd, SOL_SOCKET, SO_LINGER, &so_linger,+                   sizeof(so_linger)) == -1) {+      DEBUG_ERRNO("setsockopt() failed for SO_LINGER");+      const int setsockopt_errno = errno; // `setsockopt` sets errno.+      close(g_listen_fd);+      g_listen_fd = -1;+      errno = setsockopt_errno;+      return STATUS_FROM_ERRNO();+    }+  }++  struct sockaddr_un local;+  memset(&local, 0, sizeof(local));+  local.sun_family = AF_UNIX;+  strncpy(local.sun_path, unix_addr->esa_unix_path, sizeof(local.sun_path) - 1);+  unlink(unix_addr->esa_unix_path);+  if (bind(g_listen_fd, (struct sockaddr *)&local,+           sizeof(struct sockaddr_un)) == -1) {+    DEBUG_ERRNO("bind() failed");+    return STATUS_FROM_ERRNO(); // `bind` sets errno.+  }+  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}++/// @brief Initialize the TCP/IP socket and bind it to the provided address.+///+/// This function does not start any threads; @c worker_start() completes the+/// setup.+///+/// Either host or port may be NULL, in which case the defaults used by+/// @c getaddrinfo apply.+///+/// @return See `EventlogSocketStatus`.+///+/// @par Errors+/// @parblock+/// This function may return the following system errors:+/// `EADDRINUSE`, `EADDRNOTAVAIL`, `EAFNOSUPPORT`, `EAGAIN`, `EALREADY`,+/// `EBADF`, `EDESTADDRREQ`, `EDOM`, `EFAULT`, `EINPROGRESS`, `EINVAL`, `EIO`,+/// `EISCONN`, `EISDIR`, `ELOOP`, `EMFILE`, `ENAMETOOLONG`, `ENFILE`, `ENOBUFS`,+/// `ENOENT`, `ENOMEM`, `ENOPROTOOPT`, `ENOTDIR`, `ENOTSOCK`, `EOPNOTSUPP`,+/// `EPROTONOSUPPORT`, or `EROFS`.+///+/// This function may return the following @c getaddrinfo errors:+/// `EAI_ADDRFAMILY`, `EAI_AGAIN`, `EAI_BADFLAGS`, `EAI_FAIL`, `EAI_FAMILY`,+/// `EAI_MEMORY`, `EAI_NODATA`, `EAI_NONAME`, `EAI_SERVICE`, `EAI_SOCKTYPE`, or+/// `EAI_SYSTEM`.+/// @endparblock+static EventlogSocketStatus+worker_socket_init_inet(const EventlogSocketInetAddr *const inet_addr,+                        const EventlogSocketOpts *const opts) {+  struct addrinfo hints;+  memset(&hints, 0, sizeof(hints));+  hints.ai_family = AF_UNSPEC;+  hints.ai_socktype = SOCK_STREAM;+  hints.ai_flags = AI_PASSIVE;++  struct addrinfo *res = NULL;+  const int success_or_gai_error = getaddrinfo(+      inet_addr->esa_inet_host, inet_addr->esa_inet_port, &hints, &res);+  if (success_or_gai_error != 0) {+    DEBUG_ERROR("getaddrinfo(\"%s\", \"%s\") failed: %s",+                inet_addr->esa_inet_host, inet_addr->esa_inet_port,+                gai_strerror(success_or_gai_error));+    return STATUS_FROM_GAI_ERROR(success_or_gai_error);+  }++  struct addrinfo *rp;+  for (rp = res; rp != NULL; rp = rp->ai_next) {+    g_listen_fd = socket(rp->ai_family, rp->ai_socktype, rp->ai_protocol);+    if (g_listen_fd == -1) {+      continue;+    }++    // Set socket reuse address.+    if (setsockopt(g_listen_fd, SOL_SOCKET, SO_REUSEADDR, &(int){1},+                   sizeof(int)) != 0) {+      DEBUG_ERRNO("setsockopt() failed for SO_REUSEADDR");+      close(g_listen_fd);+      g_listen_fd = -1;+      continue;+    }++    // set socket send buffer size+    if (opts != NULL && opts->eso_sndbuf > 0) {+      if (setsockopt(g_listen_fd, SOL_SOCKET, SO_SNDBUF, &opts->eso_sndbuf,+                     sizeof(opts->eso_sndbuf)) != 0) {+        DEBUG_ERRNO("setsockopt() failed for SO_SNDBUF");+        close(g_listen_fd);+        g_listen_fd = -1;+        continue;+      }+    }++    if (bind(g_listen_fd, rp->ai_addr, rp->ai_addrlen) == -1) {+      DEBUG_ERRNO("bind() failed");+      close(g_listen_fd);+      g_listen_fd = -1;+      continue;+    } else {+      char hostbuf[NI_MAXHOST];+      char servbuf[NI_MAXSERV];+      if (getnameinfo(rp->ai_addr, rp->ai_addrlen, hostbuf, sizeof(hostbuf),+                      servbuf, sizeof(servbuf),+                      NI_NUMERICHOST | NI_NUMERICSERV) == 0) {+        DEBUG_TRACE("Bound TCP listener to %s:%s", hostbuf, servbuf);+      }+      break; // success+    }+  }++  freeaddrinfo(res);++  if (g_listen_fd == -1) {+    DEBUG_ERROR("%s", "Unable to bind TCP listener");+    errno = EAGAIN;+    return STATUS_FROM_ERRNO();+  }++  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}++/// @brief Initialize the worker thread.+///+/// @return See `EventlogSocketStatus`.+///+/// @par Errors+/// @parblock+/// This function may return the following system errors:+/// `EACCES`, `EAGAIN`, `EBADF`, `EFAULT`, `EINVAL`, `EMFILE`, `ENFILE`,+/// `ENFILE`, or `ENOPKG`.+/// @endparblock+static EventlogSocketStatus worker_init(void) {+  if (!g_initialized) {+    if (pipe(g_wake_pipe) == -1) {+      DEBUG_ERRNO("pipe() failed");+      return STATUS_FROM_ERRNO();+    }+    for (int i = 0; i < 2; i++) {+      const int flags = fcntl(g_wake_pipe[i], F_GETFL, 0);+      if (flags == -1) {+        DEBUG_ERRNO("fcntl() failed for F_GETFL");+        return STATUS_FROM_ERRNO();+      }+      if (fcntl(g_wake_pipe[i], F_SETFL, flags | O_NONBLOCK) == -1) {+        DEBUG_ERRNO("fcntl() failed for F_SETFL");+        return STATUS_FROM_ERRNO();+      }+    }+    atexit(cleanup);+    g_initialized = true;+  }+  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}++/// @brief Start the worker thread.+///+/// @return Upon successful completion, 0 is returned.+///+/// @return On error, one of the following error codes is returned.+///+/// @par Errors+/// @parblock+/// `EAI_ADDRFAMILY`, `EAI_AGAIN`, `EAI_BADFLAGS`, `EAI_FAIL`, `EAI_FAMILY`,+/// `EAI_MEMORY`, `EAI_NODATA`, `EAI_NONAME`, `EAI_SERVICE`, `EAI_SOCKTYPE`, or+/// `EAI_SYSTEM`.+///+/// If `EAI_SYSTEM` is returned, errno is set to one of the following error+/// codes, in addition to any of the system errors that may be produced by+/// `getaddrinfo`:+///+/// `EACCES`, `EADDRINUSE`, `EADDRNOTAVAIL`, `EAFNOSUPPORT`, `EAGAIN`,+/// `EALREADY`, `EBADF`, `EDESTADDRREQ`, `EDOM`, `EFAULT`, `EINPROGRESS`,+/// `EINVAL`, `EIO`, `EISCONN`, `EISDIR`, `ELOOP`, `EMFILE`, `ENAMETOOLONG`,+/// `ENFILE`, `ENOBUFS`, `ENOENT`, `ENOMEM`, `ENOPKG`, `ENOPROTOOPT`, `ENOTDIR`,+/// `ENOTSOCK`, `EOPNOTSUPP`, `EPERM`, `EPROTONOSUPPORT`, or `EROFS`.+/// @endparblock+static EventlogSocketStatus+worker_start(const EventlogSocketAddr *const eventlog_socket_addr,+             const EventlogSocketOpts *const eventlog_socket_opts) {+  DEBUG_TRACE("%s", "Starting worker thread.");+  switch (eventlog_socket_addr->esa_tag) {+  case EVENTLOG_SOCKET_UNIX: {+    RETURN_ON_ERROR(worker_socket_init_unix(+        &eventlog_socket_addr->esa_unix_addr, eventlog_socket_opts));+    break;+  }+  case EVENTLOG_SOCKET_INET: {+    RETURN_ON_ERROR(worker_socket_init_inet(+        &eventlog_socket_addr->esa_inet_addr, eventlog_socket_opts));+    break;+  }+  default: {+    DEBUG_ERROR("%s", "unknown listener kind");+    errno = EINVAL;+    return STATUS_FROM_ERRNO();+  }+  }++  // start the worker thread+  g_listen_thread_ptr = (pthread_t *)malloc(sizeof(pthread_t));+  const int success_or_errno =+      pthread_create(g_listen_thread_ptr, NULL, worker_loop, NULL);+  if (success_or_errno != 0) {+    DEBUG_ERRNO("pthread_create() failed");+    return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+  }+  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}++/*********************************************************************************+ * Internal Helpers+ *********************************************************************************/++/// @brief Get the maximum length of a Unix domain socket path.+static size_t get_unix_path_max(void) {+  const struct sockaddr_un test_unix_path_max;+  return sizeof(test_unix_path_max.sun_path);+}++/*********************************************************************************+ * Public interface+ *********************************************************************************/++/* PUBLIC - see documentation in eventlog_socket.h */+EventlogSocketStatus+eventlog_socket_init(const EventlogSocketAddr *const eventlog_socket_addr,+                     const EventlogSocketOpts *const eventlog_socket_opts) {++  // Initialise worker thread.+  RETURN_ON_ERROR(worker_init());++  // Start worker thread.+  RETURN_ON_ERROR(worker_start(eventlog_socket_addr, eventlog_socket_opts));++  // Start control thread.+#ifdef EVENTLOG_SOCKET_FEATURE_CONTROL+  g_control_thread_ptr = (pthread_t *)malloc(sizeof(pthread_t));+  if (g_control_thread_ptr == NULL) {+    return STATUS_FROM_ERRNO(); // `malloc` sets errno.+  }+  RETURN_ON_ERROR(control_start(g_control_thread_ptr, &g_client_fd,+                                &g_write_buffer_and_client_fd_mutex,+                                &g_new_conn_cond));+#endif /* EVENTLOG_SOCKET_FEATURE_CONTROL */++  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}++/* PUBLIC - see documentation in eventlog_socket.h */+EventlogSocketStatus eventlog_socket_wait(void) {+  // Condition variable pairs with the mutex so reader threads can wait for the+  // worker to publish a connected client_fd atomically.+  {+    const int success_or_errno =+        pthread_mutex_lock(&g_write_buffer_and_client_fd_mutex);+    if (success_or_errno != 0) {+      return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+    }+  }+  DEBUG_TRACE("initial client_fd=%d", g_client_fd);+  while (g_client_fd == -1) {+    DEBUG_TRACE("%s", "blocking for connection");+    const int success_or_errno = pthread_cond_wait(+        &g_new_conn_cond, &g_write_buffer_and_client_fd_mutex);+    if (success_or_errno != 0) {+      return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+    }+    DEBUG_TRACE("woke up, client_fd=%d", g_client_fd);+  }+  DEBUG_TRACE("proceeding with client_fd=%d", g_client_fd);+  const int success_or_errno =+      pthread_mutex_unlock(&g_write_buffer_and_client_fd_mutex);+  if (success_or_errno != 0) {+    return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+  }+  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}++/* PUBLIC - see documentation in eventlog_socket.h */+RtsConfig eventlog_socket_attach_rts_config(RtsConfig rts_config) {+  rts_config.eventlog_writer = &SocketEventLogWriter;+  return rts_config;+}++/* PUBLIC - see documentation in eventlog_socket.h */+EventlogSocketStatus eventlog_socket_signal_ghc_rts_ready(void) {+#ifdef EVENTLOG_SOCKET_FEATURE_CONTROL+  return control_signal_ghc_rts_ready();+#else+  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+#endif /* EVENTLOG_SOCKET_FEATURE_CONTROL */+}++/* PUBLIC - see documentation in eventlog_socket.h */+void eventlog_socket_wrap_hs_main(int argc, char *argv[], RtsConfig rts_config,+                                  StgClosure *main_closure) {+  SchedulerStatus status;+  int exit_status;++  // Set the eventlog socket writer.+  rts_config = eventlog_socket_attach_rts_config(rts_config);++  // Initialize the GHC RTS.+  hs_init_ghc(&argc, &argv, rts_config);++  // Tell the control thread that the GHC RTS is initialised.+  // TODO: print error message+  eventlog_socket_signal_ghc_rts_ready();++  // Evaluate the Haskell main closure.+  {+    Capability *cap = rts_lock();+    rts_evalLazyIO(&cap, main_closure, NULL);+    status = rts_getSchedStatus(cap);+    rts_unlock(cap);+  }++  // Handle the return status.+  switch (status) {+  case Killed:+    errorBelch("main thread exited (uncaught exception)");+    exit_status = EXIT_KILLED;+    break;+  case Interrupted:+    errorBelch("interrupted");+    exit_status = EXIT_INTERRUPTED;+    break;+  case HeapExhausted:+    exit_status = EXIT_HEAPOVERFLOW;+    break;+  case Success:+    exit_status = EXIT_SUCCESS;+    break;+  default:+    barf("main thread completed with invalid status");+  }++  // Shut down the GHC RTS and exit.+  shutdownHaskellAndExit(exit_status, 0 /* !fastExit */);+}++/// @brief Start event logging with `SocketEventLogWriter` and start the control+/// thread.+///+/// @pre The GHC RTS is ready.+///+/// @pre The function `eventlog_socket_init` has been called.+EventlogSocketStatus eventlog_socket_attach(void) {+  // Check if this version of the GHC RTS supports the eventlog.+  if (eventLogStatus() == EVENTLOG_NOT_SUPPORTED) {+    DEBUG_ERROR("%s", "eventlog is not supported.");+    return STATUS_FROM_CODE(EVENTLOG_SOCKET_ERR_RTS_NOSUPPORT);+  }++  // Stop the existing eventlog writer.+  if (eventLogStatus() == EVENTLOG_RUNNING) {+    endEventLogging();+  }++  // Attach the `SocketEventLogWriter` eventlog writer.+  if (!startEventLogging(&SocketEventLogWriter)) {+    return STATUS_FROM_CODE(EVENTLOG_SOCKET_ERR_RTS_FAIL);+  }++  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}++/* PUBLIC - see documentation in eventlog_socket.h */+EventlogSocketStatus+eventlog_socket_start(const EventlogSocketAddr *eventlog_socket_addr,+                      const EventlogSocketOpts *eventlog_socket_opts) {++  // Initialize eventlog_socket.+  RETURN_ON_ERROR(+      eventlog_socket_init(eventlog_socket_addr, eventlog_socket_opts));++  // Attach the eventlog writer to the GHC RTS.+  RETURN_ON_ERROR(eventlog_socket_attach());++  // Signal that the GHC RTS is ready.+  RETURN_ON_ERROR(eventlog_socket_signal_ghc_rts_ready());++  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}++/* PUBLIC - see documentation in eventlog_socket.h */+void eventlog_socket_opts_init(EventlogSocketOpts *eventlog_socket_opts) {+  if (eventlog_socket_opts == NULL) {+    return;+  }+  eventlog_socket_opts->eso_wait = false;+  eventlog_socket_opts->eso_sndbuf = 0;+  eventlog_socket_opts->eso_linger = 0;+}++/* PUBLIC - see documentation in eventlog_socket.h */+void eventlog_socket_addr_free(EventlogSocketAddr *eventlog_socket) {+  if (eventlog_socket == NULL) {+    return;+  }+  switch (eventlog_socket->esa_tag) {+  case EVENTLOG_SOCKET_UNIX:+    if (eventlog_socket->esa_unix_addr.esa_unix_path != NULL) {+      free(eventlog_socket->esa_unix_addr.esa_unix_path);+    }+    break;+  case EVENTLOG_SOCKET_INET:+    if (eventlog_socket->esa_inet_addr.esa_inet_host != NULL) {+      free(eventlog_socket->esa_inet_addr.esa_inet_host);+    }+    if (eventlog_socket->esa_inet_addr.esa_inet_port != NULL) {+      free(eventlog_socket->esa_inet_addr.esa_inet_port);+    }+    break;+  }+}++/* PUBLIC - see documentation in eventlog_socket.h */+void eventlog_socket_opts_free(EventlogSocketOpts *eventlog_socket_opts) {+  (void)eventlog_socket_opts;+  // The `EventlogSocketOpts` may be extended without a breaking change in+  // the package version. Hence, this function is included in case any future+  // version of this type includes malloc'd memory.+}++/* PUBLIC - see documentation in eventlog_socket.h */+EventlogSocketStatus+eventlog_socket_from_env(EventlogSocketAddr *eventlog_socket_addr_out,+                         EventlogSocketOpts *eventlog_socket_opts_out) {++  // Check that eventlog_socket_out is nonnull.+  if (eventlog_socket_addr_out == NULL) {+    errno = EINVAL;+    return STATUS_FROM_ERRNO();+  }++  // Allocate a variable for the return status:+  EventlogSocketStatusCode status_code = EVENTLOG_SOCKET_ERR_ENV_NOADDR;++  // Try to construct a Unix domain socket address:+  char *unix_path = getenv(EVENTLOG_SOCKET_ENV_UNIX_PATH); // NOLINT+  if (unix_path != NULL) {+    // Determine the maximum length of a Unix domain socket path.+    const size_t unix_path_max = get_unix_path_max();++    // Check that unix_path does not exceed the maximum unix_path length:+    const size_t unix_path_len = strlen(unix_path);+    if (unix_path_len > unix_path_max) {+      status_code = EVENTLOG_SOCKET_ERR_ENV_TOOLONG;+    }++    // Write the configuration:+    char *unix_path_copy = ess_strndup(unix_path_len, unix_path);+    if (unix_path_copy == NULL) {+      return STATUS_FROM_ERRNO(); // `ess_strndup` sets errno.+    }+    *eventlog_socket_addr_out = (EventlogSocketAddr){+        .esa_tag = EVENTLOG_SOCKET_UNIX,+        .esa_unix_addr =+            {+                .esa_unix_path = unix_path_copy,+            },+    };++    // Set the status:+    status_code = EVENTLOG_SOCKET_OK;+  }++  // Try to construct a TCP/IP address:+  else {+    char *inet_host = getenv(EVENTLOG_SOCKET_ENV_INET_HOST); // NOLINT+    char *inet_port = getenv(EVENTLOG_SOCKET_ENV_INET_PORT); // NOLINT+    const bool has_inet_host = inet_host != NULL;+    const bool has_inet_port = inet_port != NULL;+    // If either is set, construct a TCP/IP address:+    if (has_inet_host || has_inet_port) {+      // Copy the inet_host:+      char *inet_host_copy = (has_inet_host)+                                 ? ess_strndup(strlen(inet_host), inet_host)+                                 : ess_strndup(0, "");+      if (inet_host_copy == NULL) {+        return STATUS_FROM_ERRNO(); // `ess_strndup` sets errno.+      }+      // Copy the inet_port:+      char *inet_port_copy = (has_inet_port)+                                 ? ess_strndup(strlen(inet_port), inet_port)+                                 : ess_strndup(0, "");+      if (inet_port_copy == NULL) {+        free(inet_host_copy);+        return STATUS_FROM_ERRNO(); // `ess_strndup` sets errno.+      }+      // Write the configuration:+      *eventlog_socket_addr_out =+          (EventlogSocketAddr){.esa_tag = EVENTLOG_SOCKET_INET,+                               .esa_inet_addr = {+                                   .esa_inet_host = inet_host_copy,+                                   .esa_inet_port = inet_port_copy,+                               }};+      // Set the status:+      if (!has_inet_host) {+        status_code = EVENTLOG_SOCKET_ERR_ENV_NOHOST;+      } else if (!has_inet_port) {+        status_code = EVENTLOG_SOCKET_ERR_ENV_NOPORT;+      } else {+        status_code = EVENTLOG_SOCKET_OK;+      }+    }+  }++  // If an output address was provided for the options:+  if (eventlog_socket_opts_out != NULL) {+    eventlog_socket_opts_init(eventlog_socket_opts_out);+    eventlog_socket_opts_out->eso_wait =+        getenv(EVENTLOG_SOCKET_ENV_WAIT) != NULL; // NOLINT+  }+  return STATUS_FROM_CODE(status_code);+}++/* PUBLIC - see documentation in eventlog_socket.h */+const char *eventlog_socket_control_strnamespace(+    EventlogSocketControlNamespace *namespace) {+#ifdef EVENTLOG_SOCKET_FEATURE_CONTROL+  return control_strnamespace(namespace);+#else+  (void)namespace;+  return NULL;+#endif /* EVENTLOG_SOCKET_FEATURE_CONTROL */+}++/* PUBLIC - see documentation in eventlog_socket.h */+EventlogSocketStatus eventlog_socket_control_register_namespace(+    uint8_t namespace_len, const char namespace[namespace_len],+    EventlogSocketControlNamespace **namespace_out) {+#ifdef EVENTLOG_SOCKET_FEATURE_CONTROL+  return control_register_namespace(namespace_len, namespace, namespace_out);+#else+  (void)namespace_len;+  (void)namespace;+  (void)namespace_out;+  return STATUS_FROM_CODE(EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT);+#endif /* EVENTLOG_SOCKET_FEATURE_CONTROL */+}++/* PUBLIC - see documentation in eventlog_socket.h */+EventlogSocketStatus eventlog_socket_control_register_command(+    EventlogSocketControlNamespace *namespace,+    EventlogSocketControlCommandId command_id,+    EventlogSocketControlCommandHandler *command_handler,+    const void *command_data) {+#ifdef EVENTLOG_SOCKET_FEATURE_CONTROL+  return control_register_command(namespace, command_id, command_handler,+                                  command_data);+#else+  (void)namespace;+  (void)command_id;+  (void)command_handler;+  (void)command_data;+  return STATUS_FROM_CODE(EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT);+#endif /* EVENTLOG_SOCKET_FEATURE_CONTROL */+}

@@ -0,0 +1,1203 @@+/// @file      control.c+/// @brief     The control thread.+/// @details   This module defines the control thread, which listens on the+///            eventlog socket and handles incoming control command requests.+///            Control commands can be registered using the public C API.+///            See `eventlog_socket_control_register_namespace`+///            and `eventlog_socket_control_register_command`.+/// @author    Wen Kokke+/// @author    Matthew Pickering+/// @version   0.1.1.0+/// @date      2025-2026+/// @copyright BSD-3-Clause License.+///++#include <assert.h>+#include <errno.h>+#include <fcntl.h>+#include <limits.h>+#include <netdb.h>+#include <pthread.h>+#include <stdbool.h>+#include <stddef.h>+#include <stdint.h>+#include <stdlib.h>+#include <string.h>+#include <sys/socket.h>+#include <sys/types.h>+#include <sys/un.h>+#include <unistd.h>++#include <Rts.h>+#include <rts/prof/Heap.h>++#include "./control.h"+#include "./debug.h"+#include "./error.h"+#include "./poll.h"+#include "eventlog_socket.h"++// CONTROL_MAGIC should be the UTF-8 encoding of some code point between+// U+010000 and U+10FFFF. Let's pick code point U+01E5CC, for Eventlog+// 5oscket Control Command. That's:+//+// Unicode+//+//   0    1    E    5    C    C+//   u    vvvv wwww xxxx yyyy zzzz+//   0    0001 1110 0101 1100 1100+//+// UTF-8+//+//   1111 0uvv 10vv wwww 10xx xxyy 10yy zzzz+//   1111 0000 1001 1110 1001 0111 1000 1100+//   F    0    9    E    9    7    8    C+//+// To validate this, you can use the following Python expression:+//+// chr(0x01E5CC).encode("utf-8")+// => b'\xf0\x9e\x97\x8c'+//++/// @brief The length of the magic bytestring that starts a control protocol+/// message.+///+/// See `g_control_magic`.+#define CONTROL_MAGIC_LEN 4++/// @brief The magic bytestring that starts a control protocol message.+static const uint8_t g_control_magic[CONTROL_MAGIC_LEN] = {+    [0] = 0xF0,+    [1] = 0x9E,+    [2] = 0x97,+    [3] = 0x8C,+};++/// @brief The name of the builtin namespace.+#define BUILTIN_NAMESPACE "eventlog-socket"++/// @brief The ID reserved for the builtin `StartEventLogging` command.+#define BUILTIN_COMMAND_ID_START_EVENT_LOGGING 1++/// @brief The ID reserved for the builtin `EndEventLogging` command.+#define BUILTIN_COMMAND_ID_END_EVENT_LOGGING 2++/// @brief The ID of the builtin `StartHeapProfiling` command.+#define BUILTIN_COMMAND_ID_START_HEAP_PROFILING 3++/// @brief The ID of the builtin `StopHeapProfiling` command.+#define BUILTIN_COMMAND_ID_STOP_HEAP_PROFILING 4++/// @brief The ID of the builtin `RequestHeapCensus` command.+#define BUILTIN_COMMAND_ID_REQUEST_HEAP_CENSUS 5++/******************************************************************************+ * Handlers for Builtin Commands+ ******************************************************************************/++/// @brief Handler for "StartHeapProfiling" command (eventlog-socket::0).+static void control_start_heap_profiling(+    const EventlogSocketControlNamespace *const namespace,+    const EventlogSocketControlCommandId command_id, const void *user_data) {+  (void)namespace;+  (void)command_id;+  (void)user_data;+  startHeapProfTimer();+  DEBUG_DEBUG("%s", "Started heap profiling.");+}++/// @brief Handler for "StopHeapProfiling" command (eventlog-socket::1).+static void control_stop_heap_profiling(+    const EventlogSocketControlNamespace *const namespace,+    const EventlogSocketControlCommandId command_id, const void *user_data) {+  (void)namespace;+  (void)command_id;+  (void)user_data;+  stopHeapProfTimer();+  DEBUG_DEBUG("%s", "Stopped heap profiling.");+}++/// @brief Handler for "RequestHeapCensus" command (eventlog-socket::2).+static void control_request_heap_census(+    const EventlogSocketControlNamespace *const namespace,+    const EventlogSocketControlCommandId command_id, const void *user_data) {+  (void)namespace;+  (void)command_id;+  (void)user_data;+  requestHeapCensus();+  DEBUG_DEBUG("%s", "Requested heap census.");+}++/******************************************************************************+ * Namespace and Command Registry+ ******************************************************************************/++/// @brief An entry in the command registry.+///+/// See `eventlog_socket_control_command`.+typedef struct EventlogSocketControlCommand EventlogSocketControlCommand;++/// @brief An entry in the command registry.+///+/// The command registry is a linked-list of `EventlogSocketControlCommand`+/// values. Each `EventlogSocketControlCommand` entry should have a stable+/// address. Once `EventlogSocketControlNamespace::command_registry` or+/// `EventlogSocketControlCommand::next` are assigned a nonnull value, they+/// must never change.+struct EventlogSocketControlCommand {+  /// The user-provided command ID.+  const EventlogSocketControlCommandId command_id;+  /// The user-provided command handler.+  EventlogSocketControlCommandHandler *const command_handler;+  /// The user-provided data for the command handler.+  const void *command_data;+  /// The pointer to the next entry in the command registry.+  EventlogSocketControlCommand *next;+};++/// @brief An entry in the namespace registry.+///+/// See `eventlog_socket_control_namespace`.+typedef struct EventlogSocketControlNamespace EventlogSocketControlNamespace;++/// @brief An entry in the namespace registry.+///+/// The namespace registry is a linked-list of+/// `eventlog_socket_control_namespace` values. Each+/// `EventlogSocketControlCommand` entry should have a stable address. Once+/// `g_control_namespace_registry` or `eventlog_socket_control_namespace::next`+/// are assigned a nonnull value, they must never change.+struct EventlogSocketControlNamespace {+  /// The length of the user-provided namespace.+  const uint8_t namespace_len;+  /// The user-provided namespace.+  ///+  /// This must be a null-terminated string of length `namespace_len + 1`+  /// (including the null byte).+  const char *const namespace;+  /// The pointer to the next entry in the namespace registry.+  EventlogSocketControlNamespace *next;+  /// The pointer to the first entry in the command registry for this namespace.+  EventlogSocketControlCommand *command_registry;+};++/// @brief The global namespace registry.+///+/// See `eventlog_socket_control_namespace`.+///+/// This is initialised with the builtin namespace and the builtin commands.+EventlogSocketControlNamespace g_control_namespace_registry = {+    .namespace = BUILTIN_NAMESPACE,+    .namespace_len = strlen(BUILTIN_NAMESPACE),+    .next = NULL,+    .command_registry =+        &(EventlogSocketControlCommand){+            .command_id = BUILTIN_COMMAND_ID_START_HEAP_PROFILING,+            .command_handler = control_start_heap_profiling,+            .command_data = NULL,+            .next =+                &(EventlogSocketControlCommand){+                    .command_id = BUILTIN_COMMAND_ID_STOP_HEAP_PROFILING,+                    .command_handler = control_stop_heap_profiling,+                    .command_data = NULL,+                    .next =+                        &(EventlogSocketControlCommand){+                            .command_id =+                                BUILTIN_COMMAND_ID_REQUEST_HEAP_CENSUS,+                            .command_handler = control_request_heap_census,+                            .command_data = NULL,+                            .next = NULL,+                        },+                },+        },+};++/// @brief The mutex that guards the global namespace registry.+///+/// See `g_control_namespace_registry`.+pthread_mutex_t g_control_namespace_registry_mutex = PTHREAD_MUTEX_INITIALIZER;++/// @brief Check if the given entry in the namespace registry matches a given+/// name.+///+/// @pre namespace_entry != NULL+bool control_namespace_store_match(+    const EventlogSocketControlNamespace *const namespace_entry,+    const size_t namespace_len, const char namespace[namespace_len]) {+  // if namespace_entry == NULL, then...+  if (namespace_entry == NULL) {+    // ...that's definitely not a match...+    return false;+  }+  // otherwise, compare the longest valid prefix of the namespaces...+  const size_t min_namespace_len =+      namespace_len < namespace_entry->namespace_len+          ? namespace_len+          : namespace_entry->namespace_len;+  const int namespace_cmp =+      strncmp(namespace, namespace_entry->namespace, min_namespace_len);+  return namespace_cmp == 0;+}++/// @brief Resolve a namespace by name.+///+/// @return If the namespace is found, this function returns a stable pointer to+/// it. Otherwise, it returns NULL. The returned pointer should not be freed.+const EventlogSocketControlNamespace *+control_namespace_store_resolve(const size_t namespace_len,+                                const char namespace[namespace_len]) {++  // Acquire a lock on g_control_namespace_registry.+  pthread_mutex_lock(&g_control_namespace_registry_mutex);++  // Initialise the namespace_entry pointer.+  EventlogSocketControlNamespace *namespace_entry =+      &g_control_namespace_registry;++  while (namespace_entry != NULL) {+    // Is this the namespace you are looking for?+    if (control_namespace_store_match(namespace_entry, namespace_len,+                                      namespace)) {+      // Release the lock on g_control_namespace_registry.+      pthread_mutex_unlock(&g_control_namespace_registry_mutex);+      return namespace_entry;+    }+    // Otherwise, continue with the next namespace_entry.+    namespace_entry = namespace_entry->next;+  }+  // Release the lock on g_control_namespace_registry.+  pthread_mutex_unlock(&g_control_namespace_registry_mutex);+  return false;+}++/* HIDDEN - see documentation in control.h */+HIDDEN const char *+control_strnamespace(EventlogSocketControlNamespace *namespace) {+  return namespace == NULL ? NULL : namespace->namespace;+}++/* HIDDEN - see documentation in control.h */+HIDDEN EventlogSocketStatus control_register_namespace(+    const uint8_t namespace_len, const char namespace[namespace_len],+    EventlogSocketControlNamespace **namespace_out) {++  // Check if namespace_out is NULL.+  if (namespace_out == NULL) {+    errno = EINVAL;+    return STATUS_FROM_ERRNO();+  }++  // Acquire the lock on g_control_namespace_registry.+  {+    const int success_or_errno =+        pthread_mutex_lock(&g_control_namespace_registry_mutex);+    if (success_or_errno != 0) {+      return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+    }+  }++  // Initialise the namespace_entry pointer.+  EventlogSocketControlNamespace *namespace_entry =+      &g_control_namespace_registry;++  // Is the requested namespace already registered?+  do {+    // Is this the namespace you are trying to register?+    if (control_namespace_store_match(namespace_entry, namespace_len,+                                      namespace)) {+      // If so, return false.+      pthread_mutex_unlock(&g_control_namespace_registry_mutex);+      return STATUS_FROM_CODE(EVENTLOG_SOCKET_ERR_CTL_EXISTS);+    }+    // Is this the last namespace_entry?+    if (namespace_entry->next == NULL) {+      // If so, stop.+      break;+    }+    // Otherwise, continue with the next entry.+    namespace_entry = namespace_entry->next;+  } while (true);++  // Register the requested namespace.+  assert(namespace_entry != NULL);+  assert(namespace_entry->next == NULL);+  char *const next_namespace = malloc(namespace_len + 1);+  strncpy(next_namespace, namespace, namespace_len);+  next_namespace[namespace_len] = '\0';+  const EventlogSocketControlNamespace next = (EventlogSocketControlNamespace){+      .namespace_len = namespace_len,+      .namespace = next_namespace,+      .next = NULL,+  };+  namespace_entry->next = malloc(sizeof(EventlogSocketControlNamespace));+  memcpy(namespace_entry->next, &next, sizeof(EventlogSocketControlNamespace));+  DEBUG_DEBUG("Registered namespace %.*s", (int)namespace_len, namespace);++  // Release the lock on g_control_namespace_registry.+  {+    const int success_or_errno =+        pthread_mutex_unlock(&g_control_namespace_registry_mutex);+    if (success_or_errno != 0) {+      return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+    }+  }++  // Return the namespace entry.+  *namespace_out = namespace_entry->next;+  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}++/* HIDDEN - see documentation in control.h */+HIDDEN EventlogSocketStatus+control_register_command(EventlogSocketControlNamespace *const namespace,+                         const EventlogSocketControlCommandId command_id,+                         EventlogSocketControlCommandHandler command_handler,+                         const void *command_data) {++  // Check if namespace is NULL.+  if (namespace == NULL) {+    errno = EINVAL;+    return STATUS_FROM_ERRNO();+  }++  // Check if namespace is the builtin namespace.+  if (namespace == &g_control_namespace_registry) {+    errno = EINVAL;+    return STATUS_FROM_ERRNO();+  }++  DEBUG_TRACE("Received request to register command 0x%02x in namespace %.*s",+              command_id, namespace->namespace_len, namespace->namespace);++  // Acquire the lock on g_control_namespace_registry.+  {+    const int success_or_errno =+        pthread_mutex_lock(&g_control_namespace_registry_mutex);+    if (success_or_errno != 0) {+      return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+    }+  }++  // Create the data for the new command_entry.+  const EventlogSocketControlCommand next = (EventlogSocketControlCommand){+      .command_id = command_id,+      .command_handler = command_handler,+      .command_data = command_data,+      .next = NULL,+  };++  // Initialise the command_entry pointer.+  EventlogSocketControlCommand *command_entry;++  // If there are no commands in the command_store, then...+  if (namespace->command_registry == NULL) {+    // Allocate memory for the new command_entry.+    namespace->command_registry = malloc(sizeof(EventlogSocketControlCommand));+    command_entry = namespace->command_registry;+    if (command_entry == NULL) {+      pthread_mutex_unlock(&g_control_namespace_registry_mutex);+      return STATUS_FROM_ERRNO();+    }+  }+  // Otherwise, traverse the command_store to the last position...+  else {+    do {+      // Initialise the command_entry with the head of the command_store.+      command_entry = namespace->command_registry;++      // Is the requested namespace already registered?+      if (command_entry->command_id == command_id) {+        DEBUG_ERROR("Command 0x%02x already registered for namespace %p.",+                    command_id, (void *)namespace);+        // If so, fail.+        pthread_mutex_unlock(&g_control_namespace_registry_mutex);+        return STATUS_FROM_CODE(EVENTLOG_SOCKET_ERR_CTL_EXISTS);+      }+    } while (command_entry->next != NULL);+    assert(command_entry != NULL);+    assert(command_entry->next == NULL);++    // Allocate memory for the new command_entry.+    command_entry->next = malloc(sizeof(EventlogSocketControlCommand));+    command_entry = command_entry->next;+    if (command_entry == NULL) {+      pthread_mutex_unlock(&g_control_namespace_registry_mutex);+      return STATUS_FROM_ERRNO();+    }+  }+  // Write the data for the new command_entry.+  DEBUG_TRACE("Registered command 0x%02x in namespace %.*s", command_id,+              namespace->namespace_len, namespace->namespace);+  memcpy(command_entry, &next, sizeof(EventlogSocketControlCommand));++  // Release the lock on g_control_namespace_registry.+  {+    const int success_or_errno =+        pthread_mutex_unlock(&g_control_namespace_registry_mutex);+    if (success_or_errno != 0) {+      return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+    }+  }+  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}++/// @brief Call a command by namespace and ID.+static bool+control_command_handle(const EventlogSocketControlNamespace *const namespace,+                       const EventlogSocketControlCommandId command_id) {++  assert(namespace != NULL);++  DEBUG_TRACE("Handle command 0x%02x in namespace %.*s", command_id,+              namespace->namespace_len, namespace->namespace);++  // Acquire the lock on g_control_namespace_registry.+  {+    const int success_or_errno =+        pthread_mutex_lock(&g_control_namespace_registry_mutex);+    if (success_or_errno != 0) {+      return false;+    }+  }++  // Traverse the command_registry to find the command....+  {+    EventlogSocketControlCommand *command_entry = namespace->command_registry;+    while (command_entry != NULL) {+      // If this is the command we're looking for, then...+      if (command_entry->command_id == command_id) {+        // ...call the command handler...+        assert(command_entry->command_handler != NULL);+        command_entry->command_handler(namespace, command_id,+                                       command_entry->command_data);+        // ...release the lock on g_control_namespace_registry...+        pthread_mutex_unlock(&g_control_namespace_registry_mutex);+        // ...and return true.+        return true;+      }+      // Otherwise, continue with the next command...+      command_entry = command_entry->next;+    }+  }+  // If the command was not found, then...+  // ...log an error...+  DEBUG_ERROR("Could not resolve command 0x%02x in namespace %.*s", command_id,+              namespace->namespace_len, namespace->namespace);+  // ...release the lock on g_control_namespace_registry...+  {+    const int success_or_errno =+        pthread_mutex_unlock(&g_control_namespace_registry_mutex);+    if (success_or_errno != 0) {+      return false;+    }+  }+  // ...and return false.+  return false;+}++/******************************************************************************+ * Waiting for the GHC RTS+ ******************************************************************************/++/// @brief A global variable that tracks whether the GHC RTS is ready.+static volatile bool g_ghc_rts_ready = false;++/// @brief The condition on which to wait for the signal that the GHC RTS is+/// ready.+static pthread_cond_t g_ghc_rts_ready_cond = PTHREAD_COND_INITIALIZER;++/// @brief The mutex that corresponds to `g_ghc_rts_ready_cond`.+static pthread_mutex_t g_ghc_rts_ready_mutex = PTHREAD_MUTEX_INITIALIZER;++/// @brief Wait for the signal that the GHC RTS is ready.+static void control_wait_ghc_rts_ready(void) {+  DEBUG_DEBUG("%s", "Waiting for signal that GHC RTS is ready.");+  pthread_mutex_lock(&g_ghc_rts_ready_mutex);+  while (!g_ghc_rts_ready) {+    pthread_cond_wait(&g_ghc_rts_ready_cond, &g_ghc_rts_ready_mutex);+  }+  pthread_mutex_unlock(&g_ghc_rts_ready_mutex);+}++/* HIDDEN - see documentation in control.h */+HIDDEN EventlogSocketStatus control_signal_ghc_rts_ready(void) {+  DEBUG_DEBUG("%s", "Sending signal that GHC RTS is ready.");+  {+    const int success_or_errno = pthread_mutex_lock(&g_ghc_rts_ready_mutex);+    if (success_or_errno != 0) {+      return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+    }+  }+  if (!g_ghc_rts_ready) {+    g_ghc_rts_ready = true;+    const int success_or_errno = pthread_cond_broadcast(&g_ghc_rts_ready_cond);+    if (success_or_errno != 0) {+      return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+    }+  }+  {+    const int success_or_errno = pthread_mutex_unlock(&g_ghc_rts_ready_mutex);+    if (success_or_errno != 0) {+      return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+    }+  }+  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}++/******************************************************************************+ * Command Parser+ ******************************************************************************/++/// @brief The tag for the command parser state.+///+/// See `ControlCommandParserState`.+typedef enum ControlCommandParserStateTag {+  /// The command parser is expecting some byte from the magic bytestring.+  ///+  /// See `g_control_magic`.+  CONTROL_COMMAND_PARSER_STATE_MAGIC,+  /// The command parser is expecting the protocol version.+  CONTROL_COMMAND_PARSER_STATE_PROTOCOL_VERSION,+  /// The command parser is expecting the namespace string length.+  CONTROL_COMMAND_PARSER_STATE_NAMESPACE_LEN,+  /// The command parser is expecting some byte from the namespace string.+  CONTROL_COMMAND_PARSER_STATE_NAMESPACE,+  /// The command parser is expecting the command ID.+  CONTROL_COMMAND_PARSER_STATE_COMMAND_ID,+} ControlCommandParserStateTag;++/// @brief Show a value of type `ControlCommandParserStateTag` as a+/// string.+const char *ControlCommandParserStateag_show(ControlCommandParserStateTag tag) {+  switch (tag) {+  case CONTROL_COMMAND_PARSER_STATE_MAGIC:+    return "CONTROL_COMMAND_PARSER_STATE_MAGIC";+  case CONTROL_COMMAND_PARSER_STATE_PROTOCOL_VERSION:+    return "CONTROL_COMMAND_PARSER_STATE_PROTOCOL_VERSION";+  case CONTROL_COMMAND_PARSER_STATE_NAMESPACE_LEN:+    return "CONTROL_COMMAND_PARSER_STATE_NAMESPACE_LEN";+  case CONTROL_COMMAND_PARSER_STATE_NAMESPACE:+    return "CONTROL_COMMAND_PARSER_STATE_NAMESPACE";+  case CONTROL_COMMAND_PARSER_STATE_COMMAND_ID:+    return "CONTROL_COMMAND_PARSER_STATE_COMMAND_ID";+  }+}++/// @brief The command parser state.+typedef struct {+  /// The tag that determines which member of the union is set.+  ControlCommandParserStateTag tag;++  /// The untagged command parser state. The value of `tag` determines which+  /// member is set.+  ///+  /// - `CONTROL_COMMAND_PARSER_STATE_MAGIC`:+  ///   * Must set `header_pos`.+  ///+  /// - `CONTROL_COMMAND_PARSER_STATE_PROTOCOL_VERSION`:+  ///   * Must set *no member*.+  ///+  /// - `CONTROL_COMMAND_PARSER_STATE_NAMESPACE_LEN`:+  ///   * Must set *no member*.+  ///+  /// - `CONTROL_COMMAND_PARSER_STATE_NAMESPACE`:+  ///   * Must set `namespace_buffer_len`.+  ///   * Must set `namespace_buffer_pos`.+  ///   * Must set `namespace_buffer`.+  ///+  /// - `CONTROL_COMMAND_PARSER_STATE_COMMAND`:+  ///   * Must set `namespace`.+  ///+  union {+    /// The position of the next header byte.+    ///+    /// @invariant `header_pos < CONTROL_MAGIC_LEN`+    uint8_t header_pos;++    struct {+      /// The expected length of the namespace string.+      ///+      /// @invariant `namespace_buffer_len > 0`+      uint8_t namespace_buffer_len;+      /// The position of the next namespace string byte.+      ///+      /// @invariant `namespace_buffer_pos < namespace_buffer_len`+      uint8_t namespace_buffer_pos;+      /// The buffer for the namespace string.+      ///+      /// @invariant `sizeof(namespace_buffer) == namespace_buffer_len`+      char *namespace_buffer;+    };++    /// The resolved namespace for the command.+    const EventlogSocketControlNamespace *namespace;+  };+} ControlCommandParserState;++/// @brief The global command parser state.+ControlCommandParserState g_control_command_parser_state = {+    .tag = CONTROL_COMMAND_PARSER_STATE_MAGIC,+    .header_pos = 0,+};++/// @brief Move the command parser to a new state.+///+/// This function frees any resources held by the current state, changes the+/// state tag, and initialises the new state. This function should not be used+/// for state changes *within* the same tag, as it will overwrite the previous+/// state.+///+/// If this function is used to *reset* the state, e.g., after a protocol error,+/// then a pointer to the current byte may be provided as the second argument.+/// This function will attempt to parse this byte as the first byte of the magic+/// bytestring.+///+/// If the target tag is  `CONTROL_COMMAND_PARSER_STATE_NAMESPACE` state, then a+/// pointer to the namespace length may be provided as the second argument. This+/// function will use this byte to initialise the new state.+static void+control_command_parser_enter_state(const ControlCommandParserStateTag tag,+                                   const uint8_t *const data) {+  DEBUG_TRACE(+      "%s -> %s",+      ControlCommandParserStateag_show(g_control_command_parser_state.tag),+      ControlCommandParserStateag_show(tag));++  // this should only be called when restarting or moving to a different+  // state...+  assert(tag == CONTROL_COMMAND_PARSER_STATE_MAGIC ||+         g_control_command_parser_state.tag != tag);++  // if the parser is leaving CONTROL_COMMAND_PARSER_STATE_NAMESPACE, then...+  if (g_control_command_parser_state.tag ==+      CONTROL_COMMAND_PARSER_STATE_NAMESPACE) {+    // ...free the namespace buffer...+    free(g_control_command_parser_state.namespace_buffer);+  }++  // update the control state tag...+  g_control_command_parser_state.tag = tag;++  // initialise the control state appropriately...+  switch (tag) {+  case CONTROL_COMMAND_PARSER_STATE_MAGIC: {+    // if restarting, handle current_byte...+    if (tag == CONTROL_COMMAND_PARSER_STATE_MAGIC && data != NULL &&+        *data == g_control_magic[0]) {+      // ...start at the second header byte...+      g_control_command_parser_state.header_pos = 1;+    } else {+      // ...start at the first header byte...+      g_control_command_parser_state.header_pos = 0;+    }+    break;+  }+  case CONTROL_COMMAND_PARSER_STATE_PROTOCOL_VERSION: {+    assert(data == NULL);+    break;+  }+  case CONTROL_COMMAND_PARSER_STATE_NAMESPACE_LEN: {+    assert(data == NULL);+    break;+  }+  case CONTROL_COMMAND_PARSER_STATE_NAMESPACE: {+    assert(data != NULL);+    const size_t namespace_len = *data;+    g_control_command_parser_state.namespace_buffer_len = namespace_len;+    g_control_command_parser_state.namespace_buffer_pos = 0;+    // allocate space for the namespace, with one additional byte to ensure+    // that the string is always null-terminated in memory.+    g_control_command_parser_state.namespace_buffer = malloc(namespace_len + 1);+    g_control_command_parser_state.namespace_buffer[namespace_len] = '\0';+    break;+  }+  case CONTROL_COMMAND_PARSER_STATE_COMMAND_ID: {+    assert(data == NULL);+    break;+  }+  }+}++/// @brief Parse a chunk.+///+/// This is the incremental command parser. It parses a chunk of bytes and+/// updates the command parser state.+static void+control_command_parser_handle_chunk(const size_t chunk_size,+                                    const uint8_t chunk[chunk_size]) {+  DEBUG_DEBUG("Received chunk of size %zd.", chunk_size);+  // iterate over the bytes in the chunk...+  for (size_t chunk_index = 0; chunk_index < chunk_size; ++chunk_index) {+    // get the next byte from the chunk...+    const uint8_t current_byte = chunk[chunk_index];+    switch (g_control_command_parser_state.tag) {+    // the parser is currently reading the header...+    case CONTROL_COMMAND_PARSER_STATE_MAGIC: {+      // invariant: header_pos should be a valid index into control_magic+      assert(0 <= g_control_command_parser_state.header_pos);+      assert(g_control_command_parser_state.header_pos < CONTROL_MAGIC_LEN);+      const uint8_t expected_byte =+          g_control_magic[g_control_command_parser_state.header_pos];+      // if the next byte is the expected byte...+      if (current_byte == expected_byte) {+        DEBUG_DEBUG("Matched control_magic byte %d",+                    g_control_command_parser_state.header_pos);+        // ...move on the the next state...+        ++g_control_command_parser_state.header_pos;+        // if header_pos moves out of control_magic...+        if (g_control_command_parser_state.header_pos >= CONTROL_MAGIC_LEN) {+          // ...continue reading the namespace length...+          control_command_parser_enter_state(+              CONTROL_COMMAND_PARSER_STATE_PROTOCOL_VERSION, NULL);+        }+        // ...continue processing with the _next_ byte...+        continue;+      }+      // if the next byte is not the expected byte...+      else {+        // ...there has been a protocol error...+        // ...restart with the _current_ byte...+        control_command_parser_enter_state(CONTROL_COMMAND_PARSER_STATE_MAGIC,+                                           &current_byte);+        // ...continue processing with the _next_ byte...+        continue;+      }+    }+    // the parser is currently reading the protocol version...+    case CONTROL_COMMAND_PARSER_STATE_PROTOCOL_VERSION: {+      DEBUG_DEBUG("Matched protocol version byte %d", current_byte);+      // if the message version matches the protocol version...+      if (current_byte == EVENTLOG_SOCKET_CONTROL_PROTOCOL_VERSION) {+        // ...then we should be able to parse the message...+        // ...continue processing with the _next_ byte...+        control_command_parser_enter_state(+            CONTROL_COMMAND_PARSER_STATE_NAMESPACE_LEN, NULL);+        continue;+      } else {+        // ...otherwise, let's not try and parse this message...+        // ...restart with the _current_ byte...+        control_command_parser_enter_state(CONTROL_COMMAND_PARSER_STATE_MAGIC,+                                           &current_byte);+      }+    }+    // the parser is currently reading the namespace length...+    case CONTROL_COMMAND_PARSER_STATE_NAMESPACE_LEN: {+      // if current_byte == 0, then...+      if (current_byte == 0) {+        // ...there has been a protocol error...+        // todo: enforce this in the register function+        // todo: write an error to the eventlog+        DEBUG_ERROR("%s", "Received namespace length 0");+        // ...restart with the _current_ byte...+        control_command_parser_enter_state(CONTROL_COMMAND_PARSER_STATE_MAGIC,+                                           &current_byte);+        continue;+      } else {+        DEBUG_DEBUG("Matched namespace_len byte %d", current_byte);+        // otherwise, accept the namespace length and move to the next state...+        control_command_parser_enter_state(+            CONTROL_COMMAND_PARSER_STATE_NAMESPACE, &current_byte);+        continue;+      }+    }+    case CONTROL_COMMAND_PARSER_STATE_NAMESPACE: {+      // calculate the number of bytes still required for the namespace.+      // note: subtraction is safe due to the invariant on namespace_buffer_pos.+      assert(g_control_command_parser_state.namespace_buffer_len > 0);+      assert(g_control_command_parser_state.namespace_buffer_pos <+             g_control_command_parser_state.namespace_buffer_len);+      const uint8_t required_bytes_for_namespace =+          g_control_command_parser_state.namespace_buffer_len -+          g_control_command_parser_state.namespace_buffer_pos;+      assert(required_bytes_for_namespace > 0);++      // calculate the number of bytes still available in the chunk.+      // note: subtraction is safe due to the loop invariant.+      assert(chunk_index < chunk_size);+      const uint8_t remaining_bytes_in_chunk = chunk_size - chunk_index;+      assert(remaining_bytes_in_chunk > 0);++      // calculate the number of bytes that are available to be copied to the+      // namespace buffer.+      const uint8_t available_bytes =+          remaining_bytes_in_chunk < required_bytes_for_namespace+              ? remaining_bytes_in_chunk+              : required_bytes_for_namespace;+      assert(available_bytes > 0);++      // copy all available bytes to the namespace buffer.+      void *cpy_dest = g_control_command_parser_state.namespace_buffer ++                       g_control_command_parser_state.namespace_buffer_pos;+      const void *cpy_src = chunk + chunk_index;+      memcpy(cpy_dest, cpy_src, available_bytes);+      // move namespace_buffer_pos.+      g_control_command_parser_state.namespace_buffer_pos += available_bytes;++      // if the namespace is incomplete, then...+      if (g_control_command_parser_state.namespace_buffer_pos <+          g_control_command_parser_state.namespace_buffer_len) {+        // move chunk_index by the number of copied bytes less one,+        // because the chunk_index will be updated when we reenter the for loop.+        // note: the subtraction is safe because available_bytes > 0+        chunk_index += available_bytes - 1;+        // ...continue processing with the _next_ byte...+        continue;+      }++      // otherwise, the namespace is complete...+      // note: this relies on the fact that the string is null-terminated!+      DEBUG_DEBUG("Matched namespace %.*s",+                  g_control_command_parser_state.namespace_buffer_len,+                  g_control_command_parser_state.namespace_buffer);++      // ...try to resolve the namespace...+      const EventlogSocketControlNamespace *namespace =+          control_namespace_store_resolve(+              g_control_command_parser_state.namespace_buffer_len,+              g_control_command_parser_state.namespace_buffer);+      // if the namespace was successfully resolved, then...+      if (namespace != NULL) {+        DEBUG_DEBUG("Resolved namespace %.*s",+                    g_control_command_parser_state.namespace_buffer_len,+                    g_control_command_parser_state.namespace_buffer);+        // move chunk_index by the number of copied bytes less one,+        // because the chunk_index will be updated when we reenter the for loop.+        // note: the subtraction is safe because available_bytes > 0+        chunk_index += available_bytes - 1;+        // ...move to the next state...+        control_command_parser_enter_state(+            CONTROL_COMMAND_PARSER_STATE_COMMAND_ID, NULL);+        g_control_command_parser_state.namespace = namespace;+        // ...continue processing with the _next_ byte...+        continue;+      }++      // otherwise, the namespace was not successfully resolved...+      else {+        // ...there has been a protocol error...+        // note: If the socket is noisy and happens to produce the sequence+        //       of control_magic bytes, the subsequent byte is interpreted+        //       as namespace_len and the parser unconditionally consumes the+        //       next namespace_len bytes. It then fails _at this point_, when+        //       it fails to resolve the namespace.+        //+        //       If we continue from the current byte onwards, that means that+        //       we skip namespace_len bytes, which may have a valid command.+        //+        //       However, I don't think it's unreasonable to assume that the+        //       common case is a message with an unregistered namespace.+        //       In this case, it'd be reasonable to continue from the current+        //       byte onwards, or – ideally – skip the command_id byte and+        //       continue from _there on_.+        //+        //       In order to distinguish between noise and an unregistered+        //       namespace, it may help to require that the namespace bytes+        //       are separated from the command ID with a null byte.+        //       While noise _could_ produce that pattern, it's vastly less+        //       likely that random noise or messages from another protocol+        //       would produce:+        //+        //         <control_magic bytes>+        //           + <namespace_len byte>+        //           + <namespace_len number of bytes>+        //           + '\0'+        //+        // todo: write an error to the eventlog+        DEBUG_ERROR("unknown namespace %.*s",+                    g_control_command_parser_state.namespace_buffer_len,+                    g_control_command_parser_state.namespace_buffer);+        // ...restart with the _current_ byte...+        control_command_parser_enter_state(CONTROL_COMMAND_PARSER_STATE_MAGIC,+                                           &current_byte);+        // ...continue processing with the _next_ byte...+        continue;+      }+    }+    case CONTROL_COMMAND_PARSER_STATE_COMMAND_ID: {+      DEBUG_DEBUG("Matched command_id byte 0x%02x", current_byte);+      // Handle the command.+      control_command_handle(g_control_command_parser_state.namespace,+                             current_byte);+      // ...restart _without_ the current byte...+      control_command_parser_enter_state(CONTROL_COMMAND_PARSER_STATE_MAGIC,+                                         NULL);+      // ...continue processing with the _next_ byte...+      continue;+    }+    }+  }+}++/******************************************************************************+ * Control Thread+ ******************************************************************************/++/// @brief The control thread reads chunks of this size from the eventlog+/// socket.+#define CHUNK_SIZE 256++/// @brief A volatile view of the eventlog socket file descriptor.+///+/// This file descriptor is *not* managed by the control thread.+static const volatile int *g_control_fd_ptr = NULL;++/// @brief A pointer to the mutex that guards the eventlog socket file+/// descriptor.+///+/// See `g_control_fd_ptr`.+static pthread_mutex_t *g_control_fd_mutex_ptr = NULL;++/// @brief A pointer to the condition used to signal a new connection on the+/// eventlog socket file descriptor.+///+/// This condition should be used with `g_control_fd_mutex_ptr`.+static pthread_cond_t *g_new_conn_cond_ptr = NULL;++/// @brief A stable view the eventlog socket file descriptor.+///+/// See `g_control_fd_ptr`.+static int g_control_fd = -1;++/// Reset the control thread state when the connection changes.+///+/// @param new_control_fd The new eventlog socket file descriptor. May be `-1`.+static void control_fd_reset_to(const int new_control_fd) {+  DEBUG_DEBUG("%s", "Resetting control server state.");+  // Reset eventlog socket file descriptor.+  g_control_fd = new_control_fd;+  // Reset parser state.+  control_command_parser_enter_state(CONTROL_COMMAND_PARSER_STATE_MAGIC, NULL);+}++/// @brief Wait for a new connection.+///+/// @pre The caller must have a lock on `g_control_fd_mutex_ptr`.+/// @post The caller will have a lock on `g_control_fd_mutex_ptr`.+static void control_fd_wait_for_connection(void) {+  DEBUG_DEBUG("%s", "Waiting to be notified of new connection.");+  pthread_cond_wait(g_new_conn_cond_ptr, g_control_fd_mutex_ptr);+}++static void *control_loop(void *arg) {+  (void)arg;++  assert(g_control_fd_ptr != NULL);+  assert(g_control_fd_mutex_ptr != NULL);+  assert(g_new_conn_cond_ptr != NULL);++  // Allocate memory for chunks:+  uint8_t *const chunk = malloc(CHUNK_SIZE);++  // Wait for the GHC RTS to become ready.+  control_wait_ghc_rts_ready();++  /* BEGIN: The main control loop. */+  while (true) {+    DEBUG_TRACE("%s", "Starting new control iteration.");++    /* BEGIN: Wake up. */+    // At the start of each control iteration, we update the eventlog socket+    // file descriptor.++    // Acquire the lock on the connection file description.+    pthread_mutex_lock(g_control_fd_mutex_ptr);++    // Read current connection file description.+    const int new_control_fd = *g_control_fd_ptr;+    if (g_control_fd != new_control_fd) {+      DEBUG_TRACE("Old connection fd: %d", g_control_fd);+      DEBUG_TRACE("New connection fd: %d", new_control_fd);+    }++    // If there WAS NO connection and there IS NO connection, then...+    if (g_control_fd == -1 && new_control_fd == -1) {+      DEBUG_TRACE("%s", "There WAS NO connection and there IS NO connection.");+      // ...wait to be notified of a new connection...+      control_fd_wait_for_connection();+      // ...release the lock...+      pthread_mutex_unlock(g_control_fd_mutex_ptr);+      // ...and re-enter the loop.+      continue;+    }++    // If there WAS NO connection but there IS A connection, then...+    else if (g_control_fd == -1 && new_control_fd != -1) {+      DEBUG_TRACE("%s", "There WAS NO connection but there IS A connection.");+      // ...DON'T wait to be notified of a new connection...+      // ...we may we have already missed the signal...+      // ...reset the control server state...+      control_fd_reset_to(new_control_fd);+      // ...continue to try to handle a command.+    }++    // If there WAS A connection but there IS NO connection, then...+    else if (g_control_fd != -1 && new_control_fd == -1) {+      DEBUG_TRACE("%s", "There WAS A connection but there IS NO connection.");+      // ...reset the control server state...+      control_fd_reset_to(new_control_fd);+      // ...wait to be notified of a new connection...+      control_fd_wait_for_connection();+      // ...release the lock...+      pthread_mutex_unlock(g_control_fd_mutex_ptr);+      // ...and re-enter the loop.+      continue;+    }++    // If there WAS A connection and there IS A connection, then...+    else if (g_control_fd != -1 && new_control_fd != -1) {+      // If it is A DIFFERENT connection, then...+      if (g_control_fd != new_control_fd) {+        DEBUG_TRACE(+            "%s",+            "There WAS A connection and there IS A DIFFERENT connection.");+        // ...DON'T wait to be notified of a new connection...+        // ...we may we have already missed the signal...+        // ...reset the control server state...+        control_fd_reset_to(new_control_fd);+        // ...continue to try to handle a command.+      }+      // If it is THE SAME connection, then...+      else {+        // ...continue to try to handle a command.+        DEBUG_TRACE("%s",+                    "There WAS A connection and there IS THE SAME connection.");+        // ...continue to try to handle a command.+      }+    }++    // These conditions should be covering, so throw an error otherwise.+    else {+      assert(false);+    }++    // Release the lock on the connection file description.+    pthread_mutex_unlock(g_control_fd_mutex_ptr);++    // Check that g_control_fd is up-to-date:+    assert(g_control_fd == new_control_fd);+    /* END: Wake up. */++    /* BEGIN: Wait for input. */+    // The eventlog socket is marked as non-blocking. If we try to receive+    // data, the `recv` function returns immediately. This works, but causes+    // us to go through the control loop *very* quickly. Instead, we wait for+    // input data.++    // note: POLLHUP and POLLRDHUP are output only and are ignored input.+    struct pollfd pfds[1] = {{+        .fd = g_control_fd,+        .events = POLLIN,+        .revents = 0,+    }};+    const int ready_or_error = poll(pfds, 1, POLL_LISTEN_TIMEOUT);+    // if ready_or_error is -1, an error occurred...+    if (ready_or_error == -1) {+      // if errno is EINTR, the receive was interrupted...+      if (errno == EINTR) {+        goto onexit;+      }+      // if errno is anything else, there is some other error...+      else {+        DEBUG_ERRNO("poll() failed");+        continue;+      }+    }+    // if ready_or_error is 0, the call to poll timed out...+    else if (ready_or_error == 0) {+      DEBUG_TRACE("%s", "poll() timed out");+      continue;+    }+    // otherwise ready_or_error is 1, and the file descriptor is+    // ready_or_error...+    else {+      assert(ready_or_error == 1); // poll invariant: ready_or_error <= |pfds|+      const int revents = pfds[0].revents;+      // if either of the POLLERR, POLLHUP, or POLLNVAL bits are set,+      // the file descriptor is closed...+      // note: in the case of POLLHUP there may still be buffered input,+      //       so this condition should be checked _after_ POLLIN.+      if ((revents & POLLNVAL) || (revents & POLLHUP) || (revents & POLLERR)) {+        // todo: wait for a new connection...+        DEBUG_TRACE("Connection on fd %d closed.", g_control_fd);+        continue;+      }+      // otherwise, the POLLIN bit should be set...+      assert(revents & POLLIN);+      // ...so the file descriptor is ready with input...+      // ...continue with the main loop...+    }+    /* END: Wait for input. */++    /* BEGIN: Handle up to one chunk of input. */+    // Once we know that there is some input, we read and handle one chunk.++    // read a chunk:+    const ssize_t chunk_size_or_error =+        recv(g_control_fd, chunk, CHUNK_SIZE, 0);+    // if num_bytes_or_error == -1, an error occurred...+    if (chunk_size_or_error == -1) {+      // if errno is EINTR, the receive was interrupted...+      if (errno == EINTR) {+        goto onexit;+      }+      // if errno is EGAIN or EWOULDBLOCK, recv timed out...+      else if (errno == EAGAIN || errno == EWOULDBLOCK) {+        DEBUG_TRACE("%s", "recv() timed out or was interrupted.");+        // note: the socket should have SO_RCVTIMEO set.+        continue;+      }+      // if errno is anything else, there is some other error...+      else {+        DEBUG_ERRNO("recv() failed");+        continue;+      }+    }+    // if num_bytes_or_error == 0, the connection was closed...+    else if (chunk_size_or_error == 0) {+      DEBUG_TRACE("%s", "recv() failed: the connection was closed.");+      // todo: wait for a new connection...+      DEBUG_TRACE("Connection on fd %d closed.", g_control_fd);+      continue;+    }+    // otherwise, handle the received chunk...+    else {+      DEBUG_TRACE("recv() read %zd bytes", chunk_size_or_error);+      assert(chunk_size_or_error > 0);+      control_command_parser_handle_chunk(chunk_size_or_error, chunk);+    }+    /* END: Handle up to one chunk of input. */+  }+  /* END: The main control loop. */+  goto onexit;++onexit:+  free(chunk);+  return NULL;+}++/* HIDDEN - see documentation in control.h */+HIDDEN EventlogSocketStatus control_start(+    pthread_t *const control_thread, const volatile int *const control_fd_ptr,+    pthread_mutex_t *const control_fd_mutex_ptr,+    pthread_cond_t *const new_conn_cond_ptr) {+  DEBUG_DEBUG("%s", "Starting control thread.");+  g_control_fd_ptr = control_fd_ptr;+  g_control_fd_mutex_ptr = control_fd_mutex_ptr;+  g_new_conn_cond_ptr = new_conn_cond_ptr;+  {+    const int success_or_errno =+        pthread_create(control_thread, NULL, control_loop, NULL);+    if (success_or_errno != 0) {+      DEBUG_ERRNO("pthread_create() failed");+      return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+    }+  }+  {+    const int success_or_errno = pthread_detach(*control_thread);+    if (success_or_errno != 0) {+      DEBUG_ERRNO("pthread_detach() failed");+      return STATUS_FROM_PTHREAD_ERROR(success_or_errno);+    }+  }+  return STATUS_FROM_CODE(EVENTLOG_SOCKET_OK);+}

@@ -0,0 +1,58 @@+#ifndef EVENTLOG_SOCKET_CONTROL_H+#define EVENTLOG_SOCKET_CONTROL_H++#include <pthread.h>+#include <stdbool.h>++#include "./macros.h"+#include "eventlog_socket.h"++/// @brief Start the control thread.+///+/// @param control_thread+///   The function writes the thread handle to this location.+/// @param control_fd_ptr+///   The control thread reads the eventlog socket file descriptor from this+///   pointer. It should be nonnull.+/// @param control_fd_mutex_ptr+///   The control thread uses this mutex to guard its reads of `control_fd_ptr`.+///   All other accesses of the memory location pointed to by `control_fd_ptr`+///   should also be guarded using this mutex. Should be nonnull.+/// @param new_conn_cond_ptr+///   The control thread uses this condition together with+///   `control_fd_mutex_ptr` to wait for changes in `control_fd_ptr`.+///+/// @return Upon successful completion, 0 is returned.+///+/// @return On error, On error, -1 is returned, errno is set to indicate the+/// error.+///+/// @par Errors+/// @parblock+/// `EAGAIN`, `EINVAL`, `EPERM`, or `ESRCH`.+/// @endparblock+HIDDEN EventlogSocketStatus control_start(pthread_t *control_thread,+                                          const volatile int *control_fd_ptr,+                                          pthread_mutex_t *control_fd_mutex_ptr,+                                          pthread_cond_t *new_conn_cond_ptr);++/// @see eventlog_socket_signal_ghc_rts_ready+HIDDEN EventlogSocketStatus control_signal_ghc_rts_ready(void);++/// @see eventlog_socket_control_strnamespace+HIDDEN const char *+control_strnamespace(EventlogSocketControlNamespace *namespace);++/// @see eventlog_socket_control_register_namespace+HIDDEN EventlogSocketStatus control_register_namespace(+    uint8_t namespace_len, const char namespace[namespace_len],+    EventlogSocketControlNamespace **namespace_out);++/// @see eventlog_socket_control_register_command+HIDDEN EventlogSocketStatus+control_register_command(EventlogSocketControlNamespace *namespace,+                         EventlogSocketControlCommandId command_id,+                         EventlogSocketControlCommandHandler command_handler,+                         const void *command_data);++#endif /* EVENTLOG_SOCKET_CONTROL_H */

@@ -0,0 +1,108 @@+#ifndef EVENTLOG_SOCKET_DEBUG_H+#define EVENTLOG_SOCKET_DEBUG_H++#include <errno.h>+#include <stdio.h>++#ifdef DEBUG_COLOR /* Colorize with ANSI escape sequences. */++#define DEBUG_COLOR_RED "[31m"+#define DEBUG_COLOR_GREEN "[32m"+#define DEBUG_COLOR_YELLOW "[33m"+#define DEBUG_COLOR_BLUE "[34m"+#define DEBUG_COLOR_PURPLE "[35m"+#define DEBUG_COLOR_RESET "[m"++#else++#define DEBUG_COLOR_RED ""+#define DEBUG_COLOR_GREEN ""+#define DEBUG_COLOR_YELLOW ""+#define DEBUG_COLOR_BLUE ""+#define DEBUG_COLOR_PURPLE ""+#define DEBUG_COLOR_RESET ""++#endif /* DEBUG_COLOR */++#define DEBUG_VERBOSITY_QUIET 0+#define DEBUG_VERBOSITY_ERROR 1+#define DEBUG_VERBOSITY_WARN 2+#define DEBUG_VERBOSITY_INFO 3+#define DEBUG_VERBOSITY_DEBUG 4+#define DEBUG_VERBOSITY_TRACE 5++#ifdef DEBUG_VERBOSITY+#else+#ifdef DEBUG+#define DEBUG_VERBOSITY DEBUG_VERBOSITY_DEBUG+#else+#define DEBUG_VERBOSITY DEBUG_VERBOSITY_ERROR+#endif /* DEBUG */+#endif /* DEBUG_VERBOSITY */++#define DEBUG_TRACE(fmt, ...)                                                  \+  do {                                                                         \+    if (DEBUG_VERBOSITY >= DEBUG_VERBOSITY_TRACE) {                            \+      const int errno_old = errno;                                             \+      fprintf(stderr,                                                          \+              DEBUG_COLOR_PURPLE "TRACE[%s|%d|%s]: " DEBUG_COLOR_RESET fmt     \+                                 "\n",                                         \+              __FILE__, __LINE__, __func__, __VA_ARGS__);                      \+      errno = errno_old;                                                       \+    }                                                                          \+  } while (0)++#define DEBUG_DEBUG(fmt, ...)                                                  \+  do {                                                                         \+    if (DEBUG_VERBOSITY >= DEBUG_VERBOSITY_DEBUG) {                            \+      const int errno_old = errno;                                             \+      fprintf(stderr,                                                          \+              DEBUG_COLOR_BLUE "DEBUG[%s|%d|%s]: " DEBUG_COLOR_RESET fmt "\n", \+              __FILE__, __LINE__, __func__, __VA_ARGS__);                      \+      errno = errno_old;                                                       \+    }                                                                          \+  } while (0)++#define DEBUG_INFO(fmt, ...)                                                   \+  do {                                                                         \+    if (DEBUG_VERBOSITY >= DEBUG_VERBOSITY_INFO) {                             \+      const int errno_old = errno;                                             \+      fprintf(stderr,                                                          \+              DEBUG_COLOR_YELLOW "INFO[%s|%d|%s]: " DEBUG_COLOR_RESET fmt      \+                                 "\n",                                         \+              __FILE__, __LINE__, __func__, __VA_ARGS__);                      \+      errno = errno_old;                                                       \+    }                                                                          \+  } while (0)++#define DEBUG_WARN(fmt, ...)                                                   \+  do {                                                                         \+    if (DEBUG_VERBOSITY >= DEBUG_VERBOSITY_WARN) {                             \+      const int errno_old = errno;                                             \+      fprintf(stderr,                                                          \+              DEBUG_COLOR_YELLOW "WARN[%s|%d|%s]: " DEBUG_COLOR_RESET fmt      \+                                 "\n",                                         \+              __FILE__, __LINE__, __func__, __VA_ARGS__);                      \+      errno = errno_old;                                                       \+    }                                                                          \+  } while (0)++#define DEBUG_ERROR(fmt, ...)                                                  \+  do {                                                                         \+    if (DEBUG_VERBOSITY >= DEBUG_VERBOSITY_ERROR) {                            \+      const int errno_old = errno;                                             \+      fprintf(stderr,                                                          \+              DEBUG_COLOR_RED "ERROR[%s|%d|%s]: " DEBUG_COLOR_RESET fmt "\n",  \+              __FILE__, __LINE__, __func__, __VA_ARGS__);                      \+      errno = errno_old;                                                       \+    }                                                                          \+  } while (0)++#define DEBUG_ERRNO(msg)                                                       \+  do {                                                                         \+    if (DEBUG_VERBOSITY >= DEBUG_VERBOSITY_ERROR) {                            \+      perror(DEBUG_COLOR_RED "ERROR: " DEBUG_COLOR_RESET msg);                 \+    }                                                                          \+  } while (0)++#endif /* EVENTLOG_SOCKET_DEBUG_H */

@@ -0,0 +1,68 @@+#include <netdb.h>+#include <string.h>++#include "./string.h"+#include "eventlog_socket.h"++#define STRERROR_BUFLEN_INIT 1024++/* PUBLIC - see documentation in eventlog_socket.h */+char *eventlog_socket_strerror(EventlogSocketStatus status) {+  switch (status.ess_status_code) {+  case EVENTLOG_SOCKET_OK: {+    break;+  }+  case EVENTLOG_SOCKET_ERR_RTS_NOSUPPORT: {+    return ess_strdup("The GHC RTS does not support the eventlog.");+  }+  case EVENTLOG_SOCKET_ERR_RTS_FAIL: {+    return ess_strdup("The GHC RTS could not start the eventlog writer.");+  }+  case EVENTLOG_SOCKET_ERR_ENV_NOADDR: {+    return ess_strdup("No socket address was found in the environment.");+  }+  case EVENTLOG_SOCKET_ERR_ENV_TOOLONG: {+    return ess_strdup("The Unix domain socket path found was too long.");+  }+  case EVENTLOG_SOCKET_ERR_ENV_NOHOST: {+    return ess_strdup(+        "A TCP/IP port number was found, but no host name was found.");+  }+  case EVENTLOG_SOCKET_ERR_ENV_NOPORT: {+    return ess_strdup(+        "A TCP/IP host name was found, but no port number was found.");+  }+  case EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT: {+    return ess_strdup(+        "This binary was compiled without support for control commands.");+  }+  case EVENTLOG_SOCKET_ERR_CTL_EXISTS: {+    return ess_strdup(+        "The requested namespace or command ID is already in use.");+  }+  case EVENTLOG_SOCKET_ERR_GAI: {+    return ess_strdup(gai_strerror(status.ess_error_code));+  }+  case EVENTLOG_SOCKET_ERR_SYS: {+    size_t buflen = STRERROR_BUFLEN_INIT;+    char *strerrbuf = strerrbuf = malloc(buflen);+    if (strerrbuf == NULL) {+      return NULL; // `malloc` sets errno.+    }+    while (strerror_r(status.ess_error_code, strerrbuf, buflen) == -1 &&+           errno == ERANGE) {+      // Double the buffer size and try again.+      buflen *= 2;+      char *strerrbuf_new = realloc(strerrbuf, buflen);+      if (strerrbuf_new == NULL) {+        free(strerrbuf);+        return NULL; // `realloc` sets errno.+      }+      strerrbuf = strerrbuf_new;+    }+    return strerrbuf;+  }+  }+  errno = EINVAL;+  return NULL;+}

@@ -0,0 +1,37 @@+#ifndef EVENTLOG_SOCKET_ERR_H+#define EVENTLOG_SOCKET_ERR_H++#include "./debug.h"++/// @brief Construct a status from an `EventlogSocketStatusCode` status code.+#define STATUS_FROM_CODE(status_code)                                          \+  ((EventlogSocketStatus){.ess_status_code = (status_code),                    \+                          .ess_error_code = 0})++/// @brief Construct a status from `errno`.+#define STATUS_FROM_ERRNO()                                                    \+  ((EventlogSocketStatus){.ess_status_code = EVENTLOG_SOCKET_ERR_SYS,          \+                          .ess_error_code = errno})++/// @brief Construct a status from a `pthread.h` error code.+#define STATUS_FROM_PTHREAD_ERROR(pthread_errno)                               \+  ((EventlogSocketStatus){.ess_status_code = EVENTLOG_SOCKET_ERR_SYS,          \+                          .ess_error_code = (pthread_errno)})++/// @brief Construct a status from a `getaddrinfo` error code.+#define STATUS_FROM_GAI_ERROR(gai_error)                                       \+  ((EventlogSocketStatus){.ess_status_code = EVENTLOG_SOCKET_ERR_GAI,          \+                          .ess_error_code = (gai_error)})++/// @brief If the @p expr returns an error status, immediately return it.+#define RETURN_ON_ERROR(expr)                                                  \+  do {                                                                         \+    const EventlogSocketStatus status = (expr);                                \+    if (status.ess_status_code != EVENTLOG_SOCKET_OK) {                        \+      char *strerr = eventlog_socket_strerror(status);                         \+      DEBUG_ERROR("%s", strerr);                                               \+      return status;                                                           \+    }                                                                          \+  } while (0)++#endif /* EVENTLOG_SOCKET_ERR_H */

@@ -0,0 +1,18 @@+#ifndef EVENTLOG_SOCKET_MACROS_H+#define EVENTLOG_SOCKET_MACROS_H++#include <stdlib.h>++// Portable macro for marking definitions as hidden.+#ifndef HIDDEN+#ifdef __has_attribute+#if __has_attribute(visibility)+#define HIDDEN __attribute__((visibility("hidden")))+#endif+#endif+#ifndef HIDDEN+#define HIDDEN ((void)0)+#endif+#endif++#endif /* EVENTLOG_SOCKET_MACROS_H */

@@ -0,0 +1,13 @@+#ifndef EVENTLOG_SOCKET_POLL_H+#define EVENTLOG_SOCKET_POLL_H++#include <poll.h>++#define POLL_LISTEN_TIMEOUT 10000+#define POLL_WRITE_TIMEOUT 1000++#ifndef POLLRDHUP+#define POLLRDHUP POLLHUP+#endif++#endif /* EVENTLOG_SOCKET_POLL_H */

@@ -0,0 +1,28 @@+#include "./string.h"++HIDDEN char *ess_strdup(const char *const str) {+  if (str == NULL) {+    errno = EINVAL;+    return NULL;+  }+  char *str_dup = malloc(strlen(str) + 1);+  if (str_dup == NULL) {+    return NULL; // `malloc` sets errno.+  }+  strcpy(str_dup, str);+  return str_dup;+}++HIDDEN char *ess_strndup(const size_t str_len, const char str[str_len + 1]) {+  if (str == NULL) {+    errno = EINVAL;+    return NULL;+  }+  char *str_dup = malloc(str_len + 1);+  if (str_dup == NULL) {+    return NULL; // `malloc` sets errno.+  }+  strncpy(str_dup, str, str_len);+  str_dup[str_len] = '\0';+  return str_dup;+}

@@ -0,0 +1,28 @@+#ifndef EVENTLOG_SOCKET_STRING_H+#define EVENTLOG_SOCKET_STRING_H++#include <errno.h>+#include <stdlib.h>+#include <string.h>++#include "./macros.h"++/// @brief Copy the @p str into allocated memory.+///+/// @return Upon successful completion, a pointer to an allocated copy of @p str+/// is returned.+///+/// @return On error, a null pointer is returned and errno is set to indicate+/// the error.+HIDDEN char *ess_strdup(const char *str);++/// @brief Copy the first @p str_len bytes of @p str into allocated memory.+///+/// @return Upon successful completion, a pointer to an allocated copy of a+/// null-terminated copy of the first @p str_len bytes of @p str is returned.+///+/// @return On error, a null pointer is returned and errno is set to indicate+/// the error.+HIDDEN char *ess_strndup(size_t str_len, const char str[str_len + 1]);++#endif /* EVENTLOG_SOCKET_STRING_H */

@@ -0,0 +1,54 @@+#include <assert.h>+#include <stdlib.h>+#include <string.h>++#include "./debug.h"+#include "./write_buffer.h"++void HIDDEN write_buffer_push(WriteBuffer *wb, uint8_t *data, size_t size) {+  DEBUG_TRACE("%p, %lu\n", (void *)data, size);+  uint8_t *copy = malloc(size);+  memcpy(copy, data, size);++  WriteBufferItem *item = malloc(sizeof(WriteBufferItem));+  item->orig = copy;+  item->data = copy;+  item->size = size;+  item->next = NULL;++  WriteBufferItem *last = wb->last;+  if (last == NULL) {+    assert(wb->head == NULL);++    wb->head = item;+    wb->last = item;+  } else {+    last->next = item;+    wb->last = item;+  }++  DEBUG_TRACE("%p %p\n", (void *)wb, (void *)wb->head);+}++void HIDDEN write_buffer_pop(WriteBuffer *wb) {+  WriteBufferItem *head = wb->head;+  if (head == NULL) {+    // buffer is empty: nothing to do.+    return;+  } else {+    wb->head = head->next;+    if (wb->last == head) {+      wb->last = NULL;+    }+    free(head->orig);+    free(head);+  }+}++void HIDDEN write_buffer_free(WriteBuffer *wb) {+  // not the most efficient implementation,+  // but should be obviously correct.+  while (wb->head) {+    write_buffer_pop(wb);+  }+}

@@ -0,0 +1,38 @@+#ifndef EVENTLOG_SOCKET_WRITE_BUFFER_H+#define EVENTLOG_SOCKET_WRITE_BUFFER_H++#include <stddef.h>+#include <stdint.h>++#include "./macros.h"++typedef struct WriteBuffer WriteBuffer;+typedef struct WriteBufferItem WriteBufferItem;++// invariant: head and last are both NULL or both not NULL.+struct WriteBuffer {+  WriteBufferItem *head;+  WriteBufferItem *last;+};++struct WriteBufferItem {+  uint8_t *orig; // original data pointer (which we free)+  uint8_t *data;+  size_t size; // invariant: size is not zero+  WriteBufferItem *next;+};++// push to the back.+// Caller must serialize externally (writer_write/write_iteration hold mutex)+// so that head/last invariants stay intact.+void HIDDEN write_buffer_push(WriteBuffer *wb, uint8_t *data, size_t size);++// pop from the front.+// Requires the same external synchronization as write_buffer_push.+void HIDDEN write_buffer_pop(WriteBuffer *wb);++// buf itself is not freed.+// it's safe to call write_buffer_free multiple times on the same buf.+void HIDDEN write_buffer_free(WriteBuffer *wb);++#endif /* EVENTLOG_SOCKET_WRITE_BUFFER_H */

@@ -1,35 +1,109 @@ cabal-version:      2.2 name:               eventlog-socket-version:            0.1.0.0-synopsis:           Stream GHC eventlog events to external processes-description:        Stream GHC eventlog events to external processes.+version:            0.1.1.0+synopsis:           Stream GHC eventlog events to external processes.+description:+  The @eventlog-socket@ package lets you stream the GHC eventlog over a socket in realtime.+  This package exports both a Haskell API (from "GHC.Eventlog.Socket") and a C API (from [@eventlog_socket.h@](./docs/c/index.html)).+  For most uses, the Haskell API is sufficient.+  However, if you want to instrument your application from a C main or install custom command handlers you need the C API.+ license:            BSD-3-Clause license-file:       LICENSE-author:             Ben Gamari-maintainer:         ben@smart-cactus.org-copyright:          (c) 2018 Ben Gamari+author:             Eventlog Socket Contributors+maintainer:         wen@well-typed.com+copyright:          (c) 2018-2026 Well-Typed category:           System build-type:         Simple-Tested-With: GHC ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.4 || ==9.6.1+tested-with:+  GHC ==9.2.8+   || ==9.4.8+   || ==9.6.7+   || ==9.8.4+   || ==9.10.2+   || ==9.12.2+ extra-source-files:-  ChangeLog.md+  cbits/eventlog_socket/control.c+  cbits/eventlog_socket/control.h+  cbits/eventlog_socket/debug.h+  cbits/eventlog_socket/error.c+  cbits/eventlog_socket/error.h+  cbits/eventlog_socket/macros.h+  cbits/eventlog_socket/poll.h+  cbits/eventlog_socket/string.c+  cbits/eventlog_socket/string.h+  cbits/eventlog_socket/write_buffer.c+  cbits/eventlog_socket/write_buffer.h+  cbits/eventlog_socket.c   include/eventlog_socket.h +extra-doc-files:+  CHANGELOG.md+  README.md+ source-repository head   type:     git-  location: https://github.com/bgamari/ghc-eventlog-socket.git+  location: https://github.com/well-typed/eventlog-socket.git+  subdir:   eventlog-socket +source-repository this+  type:     git+  location: https://github.com/well-typed/eventlog-socket.git+  tag:      eventlog-socket-0.1.1.0+  subdir:   eventlog-socket++flag debug+  description: Enable debug logging.+  default:     False+  manual:      True++flag control+  description: Enable control commands.+  default:     False+  manual:      True++flag optimise-heavily+  description: Pass @-O2@ to the C compiler.+  default:     False+  manual:      True+ library-  exposed-modules:  GHC.Eventlog.Socket-  other-extensions: CApiFFI+  exposed-modules:    GHC.Eventlog.Socket+  other-extensions:+    CApiFFI+    GeneralizedNewtypeDeriving+    PatternSynonyms+    TypeApplications    -- Use base lower bound as proxy for GHC >= 8.10-  build-depends:    base >=4.14 && <5-  hs-source-dirs:   src-  default-language: Haskell2010-  c-sources:        cbits/eventlog_socket.c-  include-dirs:     include/+  build-depends:      base >=4.14 && <5+  build-tool-depends: hsc2hs:hsc2hs+  hs-source-dirs:     src+  cc-options:         -std=c11 -D_POSIX_C_SOURCE=200112L+  default-language:   Haskell2010+  default-extensions: LambdaCase+  c-sources:+    cbits/eventlog_socket/error.c+    cbits/eventlog_socket/string.c+    cbits/eventlog_socket/write_buffer.c+    cbits/eventlog_socket.c -  -- comment me out while debugging-  -- https://github.com/haskell/cabal/issues/7635-  cc-options:      -DNDEBUG=1+  include-dirs:       include+  install-includes:   eventlog_socket.h++  if flag(debug)+    -- 2025-12-17:+    -- cpp-options are not passed to C code, see:+    -- https://github.com/haskell/cabal/issues/7635+    cc-options: -DDEBUG=1++  if flag(control)+    -- 2025-12-17:+    -- cpp-options are not passed to C code, see:+    -- https://github.com/haskell/cabal/issues/7635+    cc-options: -DEVENTLOG_SOCKET_FEATURE_CONTROL=1+    c-sources:  cbits/eventlog_socket/control.c++  if flag(optimise-heavily)+    cc-options: -O2

@@ -1,7 +1,493 @@+/// @file eventlog_socket.h #ifndef EVENGLOG_SOCKET_H #define EVENGLOG_SOCKET_H -void eventlog_socket_wait(void);-void eventlog_socket_start(const char *sock_path, bool wait);+/// @mainpage+/// This is the documentation for the @c eventlog-socket C API. For most uses,+/// the Haskell API is sufficient. However, if you want to start+/// @c eventlog-socket from a C main function, you need the C API.+///+/// If you instrument your application with @c eventlog-socket using the+/// Haskell API, then the RTS is started with the default file writer, which+/// means that the first few events are written to a file instead of the+/// eventlog socket. To avoid this, you can instrument your application using+/// the C API. See `eventlog_socket_init` and `eventlog_socket_wrap_hs_main`.+///+/// If you want to register custom commands via the C API, see+/// `eventlog_socket_control_register_namespace` and+/// `eventlog_socket_control_register_command`.+///+/// The main entry point for the C API is eventlog_socket.h. This file is+/// installed as part of the @c eventlog-socket package and should be available+/// from the C bits of your Haskell package. -#endif+#include <Rts.h>+#include <rts/EventLogWriter.h>++#include <stdbool.h>+#include <stdint.h>++/******************************************************************************+ * Error Types+ ******************************************************************************/++typedef enum EventlogSocketStatusCode {+  /// @brief The operation completed successfully.+  EVENTLOG_SOCKET_OK = 0,+  /// @brief The GHC RTS does not support the eventlog.+  EVENTLOG_SOCKET_ERR_RTS_NOSUPPORT,+  /// @brief The GHC RTS failed to start the eventlog writer.+  EVENTLOG_SOCKET_ERR_RTS_FAIL,+  /// @brief Configuration via the environment could not find an address.+  EVENTLOG_SOCKET_ERR_ENV_NOADDR,+  /// @brief Configuration via the environment found a Unix domain socket path+  /// that is too long.+  EVENTLOG_SOCKET_ERR_ENV_TOOLONG,+  /// @brief Configuration via the environment found a TCP/IP port number but no+  /// host name.+  EVENTLOG_SOCKET_ERR_ENV_NOHOST,+  /// @brief Configuration via the environment found a TCP/IP host name but no+  /// port number.+  EVENTLOG_SOCKET_ERR_ENV_NOPORT,+  /// @brief The binary was compiled without support for control commands.+  EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT,+  /// @brief The namespace or command ID is already registered.+  EVENTLOG_SOCKET_ERR_CTL_EXISTS,+  /// @brief An error occurred in `getaddrinfo`; the @c error_code member is set+  /// to indicate the error.+  EVENTLOG_SOCKET_ERR_GAI,+  /// @brief A system error occurred; the @c error_code member is set to+  /// indicate the error.+  EVENTLOG_SOCKET_ERR_SYS,+} EventlogSocketStatusCode;++typedef struct EventlogSocketStatus {+  /// @brief The eventlog socket error code.+  const EventlogSocketStatusCode ess_status_code;+  /// @brief An error code returned by `getaddrinfo` or the system call, if any.+  const int ess_error_code;+} EventlogSocketStatus;++/// @brief Return a string that describese the status.+///+/// @return Upon successful completion, a buffer containing a string that+/// describes the @p status is returned. This buffer is allocated with @c malloc+/// and must be freed with @c free.+///+/// @return On error, @c NULL is returned and @c errno is set to indicate the+/// error.+char *eventlog_socket_strerror(EventlogSocketStatus status);++/******************************************************************************+ * Eventlog Writer+ ******************************************************************************/++/// @brief The address family of the eventlog socket.+///+/// Used as the tag for the tagged union `EventlogSocketAddr`.+typedef enum EventlogSocketTag {+  /// @brief A Unix domain socket address.+  EVENTLOG_SOCKET_UNIX,+  /// @brief A TCP/IP address.+  EVENTLOG_SOCKET_INET,+} EventlogSocketTag;++/// @brief The address for a Unix domain socket.+typedef struct EventlogSocketUnixAddr {+  /// The path to the Unix domain socket.+  char *esa_unix_path;+} EventlogSocketUnixAddr;++/// @brief The address for a TCP/IPv4 socket.+typedef struct EventlogSocketInetAddr {+  /// The host name.+  char *esa_inet_host;+  /// The port number.+  char *esa_inet_port;+} EventlogSocketInetAddr;++/// @brief The options for an eventlog socket.+typedef struct EventlogSocketOpts {+  /// @brief Whether or not to wait for a client to connect.+  bool eso_wait;+  /// @brief The size of the socket send buffer.+  ///+  /// See the documentation for `SO_SNDBUF` in `socket.h`.+  int eso_sndbuf;+  /// @brief The number of seconds to linger.+  int eso_linger;+} EventlogSocketOpts;++/// @brief The address for an eventlog socket.+typedef struct EventlogSocketAddr {+  /// @brief The address family.+  ///+  /// @invariant If `esa_tag` is `EVENTLOG_SOCKET_UNIX`, then `esa_unix_addr` is+  /// set.+  /// @invariant If `esa_tag` is `EVENTLOG_SOCKET_INET`, then `esa_inet_addr` is+  /// set.+  EventlogSocketTag esa_tag;+  union {+    /// @brief The address for a Unix domain socket.+    EventlogSocketUnixAddr esa_unix_addr;+    /// @brief The address for a TCP/IPv4 socket.+    EventlogSocketInetAddr esa_inet_addr;+  };+} EventlogSocketAddr;++/// @brief Free any memory allocated by the members of the `EventlogSocketAddr`+/// value.+void eventlog_socket_addr_free(EventlogSocketAddr *eventlog_socket);++/// @brief Initialise the `EventlogSocketOpts` object with the default options.+void eventlog_socket_opts_init(EventlogSocketOpts *eventlog_socket_opts);++/// @brief Free any memory allocated by the members of the `EventlogSocketOpts`+/// value.+void eventlog_socket_opts_free(EventlogSocketOpts *opts);++/// @brief+/// The name of the environment variable used by `eventlog_socket_from_env`+/// to determine the path to the Unix domain socket.+#define EVENTLOG_SOCKET_ENV_UNIX_PATH "GHC_EVENTLOG_UNIX_PATH"++/// @brief+/// The name of the environment variable used by `eventlog_socket_from_env`+/// to determine the host name for a TCP/IPv4 socket.+#define EVENTLOG_SOCKET_ENV_INET_HOST "GHC_EVENTLOG_INET_HOST"++/// @brief+/// The name of the environment variable used by `eventlog_socket_from_env`+/// to determine the port number for a TCP/IPv4 socket.+#define EVENTLOG_SOCKET_ENV_INET_PORT "GHC_EVENTLOG_INET_PORT"++/// @brief+/// The name of the environment variable used by `eventlog_socket_from_env`+/// to determine whether or not to wait.+#define EVENTLOG_SOCKET_ENV_WAIT "GHC_EVENTLOG_WAIT"++/// @brief Start the eventlog socket writer.+///+/// Use this when you install the eventlog socket writer *after* the GHC RTS has+/// started. This is equivalent to `eventlog_socket_init` followed by+/// evaluating the main closure with `eventlog_socket_wrap_hs_main`.+/// This is primarily intended to be called from Haskell.+/// To install the eventlog socket writer *before* the GHC RTS has started, use+/// `eventlog_socket_init` and `eventlog_socket_wrap_hs_main`.+///+/// @pre The GHC RTS is initialized.+///+/// @pre The argument `eventlog_socket_addr` is nonnull.+EventlogSocketStatus+eventlog_socket_start(const EventlogSocketAddr *eventlog_socket_addr,+                      const EventlogSocketOpts *eventlog_socket_opts);++/// @brief Read the eventlog socket address and options from the environment.+///+/// @par MT-Unsafe+///+/// @return Upon successful completion, the status code `EVENTLOG_SOCKET_OK` is+/// returned  A valid object is written to @p eventlog_socket_addr_out, which+/// must be freed using `eventlog_socket_addr_free`. If @p+/// eventlog_socket_opts_out was nonnull, then a valid object is written to @p+/// eventlog_socket_opts_out, which must be freed using+/// `eventlog_socket_opts_free`.+///+/// @return If no socket address is found, the status code+/// `EVENTLOG_SOCKET_ERR_ENV_NOADDR` is returned and the content of+/// @p eventlog_socket_addr_out and @p eventlog_socket_opts_out are unchanged.+///+/// @return If an invalid address is found, one of+/// `EVENTLOG_SOCKET_ERR_ENV_TOOLONG`, `EVENTLOG_SOCKET_ERR_ENV_NOHOST`, or+/// `EVENTLOG_SOCKET_ERR_ENV_NOPORT` is returned. A valid object is written to+/// @p eventlog_socket_addr_out, which must be freed using+/// `eventlog_socket_addr_free`. If @p eventlog_socket_opts_out was nonnull,+/// then a valid object is written to @p eventlog_socket_opts_out, which must be+/// freed using `eventlog_socket_opts_free`. These objects is for use in error+/// messages only, and should not be passed to `eventlog_socket_init` or+/// `eventlog_socket_start`.+///+/// @return If any other status is returned, the contents of+/// @p eventlog_socket_addr_out and @p eventlog_socket_opts_out are unchanged.+///+/// @par Examples+/// @parblock+/// The following function initialises eventlog socket using a socket address+/// and options from the environment.+/// @code{.c}+/// EventlogSocketFromEnvStatus init_from_env(void) {+///+///   // Read the socket address and options from the environment.+///   EventlogSocketAddr eventlog_socket_addr = {0};+///   EventlogSocketOpts eventlog_socket_opts = {0};+///   const EventlogSocketFromEnvStatus status =+///       eventlog_socket_from_env(&eventlog_socket_addr,+///       &eventlog_socket_opts);+///+///   // Handle the return status.+///   switch (status) {+///   case EVENTLOG_SOCKET_FROM_ENV_OK:+///     // Initialise eventlog socket.+///     eventlog_socket_init(&eventlog_socket_addr, &eventlog_socket_opts);+///     break;+///   case EVENTLOG_SOCKET_FROM_ENV_NONE:+///     return status; // Skip free.+///   case EVENTLOG_SOCKET_FROM_ENV_UNIX_PATH_TOO_LONG:+///     fprintf(stderr, "Error: value of %s (%s) is too long\n",+///             EVENTLOG_SOCKET_ENV_UNIX_PATH,+///             eventlog_socket_addr.esa_unix_addr.esa_unix_path);+///     break;+///   case EVENTLOG_SOCKET_FROM_ENV_INET_HOST_MISSING:+///     fprintf(stderr, "Error: no value given for %s\n",+///             EVENTLOG_SOCKET_ENV_INET_HOST);+///     break;+///   case EVENTLOG_SOCKET_FROM_ENV_INET_PORT_MISSING:+///     fprintf(stderr, "Error: no value given for %s\n",+///             EVENTLOG_SOCKET_ENV_INET_PORT);+///     break;+///   case EVENTLOG_SOCKET_FROM_ENV_SYSTEM:+///   }+///+///   // Free the memory held by socket address and options.+///   eventlog_socket_addr_free(&eventlog_socket_addr);+///   eventlog_socket_opts_free(&eventlog_socket_opts);+///+///   return status;+/// }+/// @endcode+/// @endparblock+EventlogSocketStatus+eventlog_socket_from_env(EventlogSocketAddr *eventlog_socket_addr_out,+                         EventlogSocketOpts *eventlog_socket_opts_out);++/// @brief Initialise the eventlog socket.+///+/// Use this when you install the eventlog socket writer *before* the GHC RTS+/// has started. This is primarily intended to be called from a C main function.+/// To install the eventlog socket writer *after* the GHC RTS has started, use+/// `eventlog_socket_start`.+///+/// @return See `EventlogSocketStatus`.+///+/// @par Errors+/// @parblock+/// This function may return the following system errors:+/// `EACCES`, `EADDRINUSE`, `EADDRNOTAVAIL`, `EAFNOSUPPORT`, `EAGAIN`,+/// `EALREADY`, `EBADF`, `EDESTADDRREQ`, `EDOM`, `EFAULT`, `EINPROGRESS`,+/// `EINVAL`, `EIO`, `EISCONN`, `EISDIR`, `ELOOP`, `EMFILE`, `ENAMETOOLONG`,+/// `ENFILE`, `ENOBUFS`, `ENOENT`, `ENOMEM`, `ENOPKG`, `ENOPROTOOPT`, `ENOTDIR`,+/// `ENOTSOCK`, `EOPNOTSUPP`, `EPERM`, `EPROTONOSUPPORT`, or `EROFS`.+///+/// This function may return the following `getaddrinfo` errors:+/// `EAI_ADDRFAMILY`, `EAI_AGAIN`, `EAI_BADFLAGS`, `EAI_FAIL`, `EAI_FAMILY`,+/// `EAI_MEMORY`, `EAI_NODATA`, `EAI_NONAME`, `EAI_SERVICE`, `EAI_SOCKTYPE`, or+/// `EAI_SYSTEM`.+/// @endparblock+///+/// @par Examples+/// @parblock+/// The following function initialises eventlog socket from a C main function.+/// @code{.c}+/// #include <Rts.h>+/// #include <eventlog_socket.h>+/// #include <netdb.h>+/// #include <stdlib.h>+///+/// // Define the eventlog Unix domain socket path.+/// #define MY_EVENTLOG_SOCKET "/tmp/my_eventlog.socket"+///+/// // Get the closure for the Haskell main.+/// extern StgClosure ZCMain_main_closure;+///+/// int main(int argc, char* argv[]) {+///+///  // Create a GHC RTS configuration object.+///  RtsConfig rts_config = {0};+///  memcpy(&rts_config, &defaultRtsConfig, sizeof(RtsConfig));+///  rts_config.rts_opts_enabled = RtsOptsAll; // Enable all RTS options.+///  rts_config.rts_opts = "-l";               // Enable binary eventlog.+///+///   // Initialise eventlog socket using the default options.+///   EventlogSocketAddr eventlog_socket_addr = {+///     .esa_tag = EVENTLOG_SOCKET_UNIX,+///     .esa_unix_addr = {+///       .esa_unix_path = MY_EVENTLOG_SOCKET,+///     }};+///   const int success_or_eaino =+///     eventlog_socket_init(&eventlog_socket_addr, NULL);+///   if (success_or_eaino != 0) {+///     fprintf(stderr, "eventlog_socket_init() failed: %s",+///             gai_strerror(success_or_eaino));+///   }+///+///   // Evaluate the close for the Haskell main.+///   return eventlog_socket_wrap_hs_main(argc, argv, rts_config,+///                                       &ZCMain_main_closure);+/// }+/// @endcode+/// @endparblock+EventlogSocketStatus+eventlog_socket_init(const EventlogSocketAddr *eventlog_socket_addr,+                     const EventlogSocketOpts *eventlog_socket_opts);++/// @brief Evaluate the Haskell main closure using the eventlog socket writer.+///+/// Use this when you install the eventlog socket writer *before* the GHC RTS+/// has started. This is primarily intended to be called from a C main function.+/// To install the eventlog socket writer *after* the GHC RTS has started, use+/// `eventlog_socket_start`.+///+/// This function attaches the `SocketEventLogWriter` to the @p rts_config,+/// initializes the GHC RTS and calls `eventlog_socket_signal_ghc_rts_ready`,+/// and finally evaluates the Haskell main closure.+///+/// If your needs are more fine-grained, you can use `SocketEventLogWriter`,+/// `eventlog_socket_signal_ghc_rts_ready`, and the GHC RTS API directly.+///+/// @pre The eventlog socket was successfully initialised using+/// `eventlog_socket_init`.+///+/// @par Examples+/// @parblock+/// See `eventlog_socket_init`.+/// @endparblock+void eventlog_socket_wrap_hs_main(int argc, char *argv[], RtsConfig rts_config,+                                  StgClosure *main_closure);++/// @brief Attaches the global `EventLogWriter` object to an @c RtsConfig.+///+/// @note You do not need to call this function if you're starting eventlog+/// socket using the Haskell API, via `eventlog_socket_start`, or via+/// `eventlog_socket_wrap_hs_main`.+RtsConfig eventlog_socket_attach_rts_config(RtsConfig rts_config);++/// @brief Signal that the GHC RTS is ready.+///+/// Since control command handlers may call function from the GHC RTS API, no+/// control commands are executed until the GHC RTS is ready.+///+/// @pre The GHC RTS is initialized.+///+/// @note You do not need to call this function if you're starting eventlog+/// socket using the Haskell API, via `eventlog_socket_start`, or via+/// `eventlog_socket_wrap_hs_main`.+///+/// @return Upon successful completion, 0 is returned.+///+/// @return On error, On error, -1 is returned, errno is set to indicate the+/// error.+///+/// @par Errors+/// @parblock+/// `EAGAIN`, `EBUSY`, `EDEADLK`, `EINVAL`, `ENOTRECOVERABLE`, `EOWNERDEAD`, or+/// `EPERM`.+/// @endparblock+EventlogSocketStatus eventlog_socket_signal_ghc_rts_ready(void);++/// @brief Wait for a client to connect to the eventlog socket.+///+/// @pre The eventlog socket was successfully initialised using+/// `eventlog_socket_init` or `eventlog_socket_start`.+///+/// @note If the eventlog socket is initialised with+/// `EventlogSocketOpts.eso_wait` set to `true`, then `eventlog_socket_wait` is+/// called automatically.+///+/// @return Upon successful completion, 0 is returned.+///+/// @return On error, On error, -1 is returned, errno is set to indicate the+/// error.+///+/// @par Errors+/// @parblock+/// `EAGAIN`, `EBUSY`, `EDEADLK`, `EINVAL`, `ENOTRECOVERABLE`, `EOWNERDEAD`, or+/// `EPERM`.+/// @endparblock+EventlogSocketStatus eventlog_socket_wait(void);++/******************************************************************************+ * Control Commands+ ******************************************************************************/++/// @brief The version of the eventlog-socket control command protocol+/// implemented by this version of the library.+#define EVENTLOG_SOCKET_CONTROL_PROTOCOL_VERSION 0++/// @brief A control command namespace.+///+/// See `eventlog_socket_control_register_namespace`.+typedef struct EventlogSocketControlNamespace EventlogSocketControlNamespace;++/// @brief A control command ID.+///+/// Individual commands are identified by numbers (0-255).+typedef uint8_t EventlogSocketControlCommandId;++/// @brief A control command handler.+///+/// This function is called when the corresponding control command message is+/// received on the eventlog socket. The `command_data` parameter will contain+/// the pointer provided to `eventlog_socket_control_register_command`.+typedef void EventlogSocketControlCommandHandler(+    const EventlogSocketControlNamespace *const namespace,+    const EventlogSocketControlCommandId command_id, const void *command_data);++/// @brief Get the name of a registered namespace.+///+/// @return Upon successful completion, this function returns an allocated+/// string with the namespace name.+///+/// @return If @p namespace is @c NULL, this function returns @c NULL.+///+/// @return If the binary was compiled without control support, this function+/// returns @c NULL.+const char *+eventlog_socket_control_strnamespace(EventlogSocketControlNamespace *namespace);++/// @brief Register a new namespace.+///+/// @return Upon successful completion, this function registers a new namespace,+/// writes a pointer to it to @p namespace_out, and returns a status with code+/// @c EVENTLOG_SOCKET_OK.+///+/// @return If the given namespace is already registered, this function returns+/// a status with code @c EVENTLOG_SOCKET_ERR_CTL_EXISTS and the object pointer+/// to by @p namespace_out is unchanged.+///+/// @return If @p namespace_out is @c NULL, this function returns a status with+/// code @c EVENTLOG_SOCKET_ERR_SYS and error code @c EINVAL.+///+/// @return If the binary was compiled without control support, this function+/// returns a status with code @c EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT.+EventlogSocketStatus eventlog_socket_control_register_namespace(+    uint8_t namespace_len, const char namespace[namespace_len + 1],+    EventlogSocketControlNamespace **namespace_out);++/// @brief Register a new command.+///+/// @return Upon successful completion, this function registers the command and+/// returns a status with code @c EVENTLOG_SOCKET_OK.+///+/// @return If the given command is already registered, this function returns+/// a status with code @c EVENTLOG_SOCKET_ERR_CTL_EXISTS.+///+/// @return If @p namespace is @c NULL, this function returns a status with+/// code @c EVENTLOG_SOCKET_ERR_SYS and error code @c EINVAL.+///+/// @return If @p namespace is the builtin namespace, this function returns a+/// status with code @c EVENTLOG_SOCKET_ERR_SYS and error code @c EINVAL.+///+/// @return If a system error occurs, this function returns a status with code+/// @c EVENTLOG_SOCKET_ERR_SYS and the error code set to indicate the error.+///+/// @return If the binary was compiled without control support, this function+/// returns a status with code @c EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT.+///+/// @note The @p command_handler should not use the functions from this header.+EventlogSocketStatus eventlog_socket_control_register_command(+    EventlogSocketControlNamespace *namespace,+    EventlogSocketControlCommandId command_id,+    EventlogSocketControlCommandHandler *command_handler,+    const void *command_data);++#endif /* EVENGLOG_SOCKET_H */

@@ -1,37 +0,0 @@-{-# LANGUAGE CApiFFI #-}---- |--- Stream GHC eventlog events to external processes.-module GHC.Eventlog.Socket (-    startWait,-    start,-    wait,-) where--import Foreign.C-import Foreign.Ptr---- | Start listening for eventlog connections, blocking until a client connects.-startWait :: FilePath  -- ^ File path to the unix domain socket to create.-          -> IO ()-startWait = c_start' True---- | Start listening for eventlog connections.-start :: FilePath      -- ^ File path to the unix domain socket to create.-      -> IO ()-start = c_start' False---- | Wait (block) until a client connects.-wait :: IO ()-wait = c_wait--c_start' :: Bool -> FilePath -> IO ()-c_start' block socketPath =-    withCString socketPath $ \socketPathCString ->-    c_start socketPathCString block--foreign import capi safe "eventlog_socket.h eventlog_socket_start"-    c_start :: CString -> Bool -> IO ()--foreign import capi safe "eventlog_socket.h eventlog_socket_wait"-    c_wait :: IO ()

@@ -0,0 +1,982 @@+{-|+Module      : GHC.Eventlog.Socket+Description : Haskell API for @eventlog-socket@.+Stability   : experimental+Portability : POSIX++This module exports the Haskell API for @eventlog-socket@.++To start streaming GHC eventlog events to a socket, use `startWith` with a [socket address](#t:EventlogSocketAddr) and [options](#t:EventlogSocketOpts).+For instance, the following code starts @eventlog-socket@ configured to wait for a connection and then stream events to @\/tmp\/my_app.sock@.++@+let addr = `EventlogSocketUnixAddr` "\/tmp\/my_app.sock"+let opts = `defaultEventlogSocketOpts` {`esoWait` = True}+`startWith` addr opts+@++To register custom control commands, use `registerNamespace` and `registerCommand`.+For instance, the following code registers the namespace @"ping"@ with one command at ID 1 that prints "Ping!" when called.++@+pingNamespace <- `registerNamespace` "ping"+let pingId = v`CommandId` 1+let pingHandler = putStrLn "Ping!"+`registerCommand` pingNamespace pingId pingHandler+@+-}++{-# LANGUAGE CApiFFI #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeApplications #-}++module GHC.Eventlog.Socket (+    -- * High-level API #high_level_api#+    startWith,++    -- ** Configuration types #configuration_types#+    EventlogSocketAddr (..),+    EventlogSocketOpts (esoWait, esoSndbuf, esoLinger),+    defaultEventlogSocketOpts,++    -- ** Configuration via environment #configuration_via_environment#+    startFromEnv,+    fromEnv,+    EventlogSocketAddrError(..),++    -- ** Control commands #control_commands#+    Namespace,+    CommandId(..),+    CommandHandler,+    namespaceName,+    registerNamespace,+    registerCommand,+    EventlogSocketControlError(..),++    -- * Legacy API #legacy_api#+    startWait,+    start,+    wait,+) where++import Control.Exception (Exception (..), assert, bracket, bracket_, bracketOnError, throwIO)+import Control.Monad((<=<), when)+import Data.Foldable (traverse_)+import Data.Function ((&))+import Data.Int (Int32)+import Data.Maybe (fromMaybe)+import Data.Void (Void)+import Data.Word (Word8, Word32)+import Foreign.C (CBool (..))+import Foreign.C.String (CString, peekCString, withCString, withCStringLen)+import Foreign.Ptr (FunPtr, freeHaskellFunPtr, Ptr, castPtr, nullPtr, plusPtr)+import Foreign.Storable (Storable (..))+import Foreign.Marshal.Alloc (alloca, allocaBytes, free)+import Foreign.Marshal.Utils (fromBool, toBool, with)+import GHC.Enum (toEnumError)+import System.IO.Unsafe (unsafePerformIO)++#include <eventlog_socket.h>+#include <string.h>++--------------------------------------------------------------------------------+-- High-level API+--------------------------------------------------------------------------------++{- |+Start an @eventlog-socket@ writer using the given socket address and options.++@since 0.1.1.0+-}+startWith ::+    EventlogSocketAddr ->+    EventlogSocketOpts ->+    IO ()+startWith esa eso =+    allocaBytes #{size EventlogSocketStatus} $ \essPtr -> do+        withEventlogSocketAddr esa $ \esaPtr ->+            withEventlogSocketOpts eso $ \esoPtr ->+                eventlog_socket_start essPtr esaPtr esoPtr+        status <- peekEventlogSocketStatus essPtr++        -- If the status is an error, throw a user error.+        when (essStatusCode status /= EVENTLOG_SOCKET_OK) $ do+            strPtr <- eventlog_socket_strerror essPtr+            str <- peekNullableCString strPtr+            throwIO $ userError str++--------------------------------------------------------------------------------+-- Configuration types++{- |+A type representing the supported eventlog socket modes.++@since 0.1.1.0+-}+data+    {-# CTYPE "eventlog_socket.h" "EventlogSocketAddr" #-}+    EventlogSocketAddr = EventlogSocketUnixAddr+        { esaUnixPath :: FilePath+        -- ^ Unix socket path, e.g., @"\/tmp\/ghc_eventlog.sock"@.+        --+        --         __Warning:__ Unix domain socket paths are often limited to 107 characters or less.+        }+    | EventlogSocketInetAddr+        { esaInetHost :: String+        -- ^ TCP host or interface, e.g. @"127.0.0.1"@.+        , esaInetPort :: String+        -- ^ TCP port, e.g., @"4242"@.+        }+    deriving (Eq, Show)++{- |+The socket options for @eventlog-socket@.++To construct an instance of the socket options, use `defaultEventlogSocketOpts` and the fields.+For instance:++@+myEventlogSocketOpts :: EventlogSocketOpts+myEventlogSocketOpts = defaultEventlogSocketOpts+    { esoWait = True+    }+@++The following socket options are available:++[@`esoWait` :: `Bool`@ #v:esoWait#]:+Whether or not to wait for a client to connect.++[@`esoSndbuf` ~ `Foreign.C.Types.CInt`@ #v:esoSndbuf#]:+    The size of the socket send buffer.++    See the documentation for @SO_SNDBUF@ in @socket.h@.++[@`esoLinger` ~ `Foreign.C.Types.CInt`@ #v:esoLinger#]:+    The number of seconds to linger on shutdown.++    See the documentation for @SO_LINGER@ in @socket.h@.++@since 0.1.1.0+-}+data+    {-# CTYPE "eventlog_socket.h" "EventlogSocketOpts" #-}+    EventlogSocketOpts = EventlogSocketOpts+        { esoWait :: Bool+        , esoSndbuf :: Maybe #{type int}+        , esoLinger :: Maybe #{type int}+        }+    deriving (Eq, Show)++{- |+The default socket options for @eventlog-socket@.++See t`EventlogSocketOpts`.++@since 0.1.1.0+-}+defaultEventlogSocketOpts :: EventlogSocketOpts+defaultEventlogSocketOpts =+    unsafePerformIO $+        allocaBytes #{size EventlogSocketOpts} $ \esoPtr ->+            bracket_+                (eventlog_socket_opts_init esoPtr)+                (eventlog_socket_opts_free esoPtr)+                (peekEventlogSocketOpts esoPtr)++--------------------------------------------------------------------------------+-- Configuration via environment++{- |+Read the eventlog socket configuration from the environment.+If this succeeds, start an @eventlog-socket@ writer with that configuration.++@since 0.1.1.0+-}+startFromEnv :: IO ()+startFromEnv = fromEnv >>= traverse_ (uncurry startWith)++{- |+Read the eventlog socket configuration from the environment.++@since 0.1.1.0+-}+fromEnv ::+    IO (Maybe (EventlogSocketAddr, EventlogSocketOpts))+fromEnv =+    allocaBytes #{size EventlogSocketAddr} $ \esaPtr ->+    allocaBytes #{size EventlogSocketOpts} $ \esoPtr -> do+        let tryGet =+                allocaBytes #{size EventlogSocketStatus} $ \essPtr -> do+                    eventlog_socket_from_env essPtr esaPtr esoPtr+                    peekEventlogSocketStatus essPtr+        let shouldFree status =+                elem (essStatusCode status) $+                    [ EVENTLOG_SOCKET_OK+                    , EVENTLOG_SOCKET_ERR_ENV_TOOLONG+                    , EVENTLOG_SOCKET_ERR_ENV_NOHOST+                    , EVENTLOG_SOCKET_ERR_ENV_NOPORT+                    ]+        let maybeFree status =+                when (shouldFree status) $ do+                    eventlog_socket_addr_free esaPtr+                    eventlog_socket_opts_free esoPtr+        let maybePeek status+                | essStatusCode status == EVENTLOG_SOCKET_OK = do+                    esa <- peekEventlogSocketAddr esaPtr+                    eso <- peekEventlogSocketOpts esoPtr+                    pure $ Just (esa, eso)+                | essStatusCode status == EVENTLOG_SOCKET_ERR_ENV_NOADDR = do+                    pure Nothing+                | essStatusCode status == EVENTLOG_SOCKET_ERR_ENV_TOOLONG = do+                    esa <- peekEventlogSocketAddr esaPtr+                    throwIO $ EventlogSocketAddrUnixPathTooLong (esaUnixPath esa)+                | essStatusCode status == EVENTLOG_SOCKET_ERR_ENV_NOHOST = do+                    esa <- peekEventlogSocketAddr esaPtr+                    throwIO $ EventlogSocketAddrInetHostMissing (esaInetPort esa)+                | essStatusCode status == EVENTLOG_SOCKET_ERR_ENV_NOPORT = do+                    esa <- peekEventlogSocketAddr esaPtr+                    throwIO $ EventlogSocketAddrInetHostMissing (esaInetHost esa)+                | otherwise =+                    withEventlogSocketStatus status $ \essPtr -> do+                        strPtr <- eventlog_socket_strerror essPtr+                        str <- peekNullableCString strPtr+                        throwIO $ userError str++        bracket tryGet maybeFree maybePeek+++--------------------------------------------------------------------------------+-- Environment variables++eventlogSocketEnvUnixPath :: String+eventlogSocketEnvUnixPath = #{const_str EVENTLOG_SOCKET_ENV_UNIX_PATH}++eventlogSocketEnvInetHost :: String+eventlogSocketEnvInetHost = #{const_str EVENTLOG_SOCKET_ENV_INET_HOST}++eventlogSocketEnvInetPort :: String+eventlogSocketEnvInetPort = #{const_str EVENTLOG_SOCKET_ENV_INET_PORT}++eventlogSocketEnvWait :: String+eventlogSocketEnvWait = #{const_str EVENTLOG_SOCKET_ENV_WAIT}++--------------------------------------------------------------------------------+-- Errors++{- |+The type of exceptions thrown by `fromEnv`.+-}+data EventlogSocketAddrError+    = EventlogSocketAddrUnixPathTooLong FilePath+      -- ^ The found Unix domain socket path was too long.+    | EventlogSocketAddrInetHostMissing String+      -- ^ No TCP/IP port number was found, but no host name was found.+    | EventlogSocketAddrInetPortMissing String+      -- ^ A TCP/IP host name was found, but no port number was found.+    deriving (Eq, Show)++instance Exception EventlogSocketAddrError where+    displayException = \case+        EventlogSocketAddrUnixPathTooLong esaUnixPath ->+            "Unix domain socket paths are limited to 107 characters. "+                <> "Found path with "+                <> show (length esaUnixPath)+                <> " characters:\n"+                <> esaUnixPath+        EventlogSocketAddrInetHostMissing esaInetPort ->+            "The port number "+                <> eventlogSocketEnvInetPort+                <> " was set to "+                <> esaInetPort+                <> ", but the host name "+                <> eventlogSocketEnvInetHost+                <> " was not set."+        EventlogSocketAddrInetPortMissing esaInetHost ->+            "The host name  "+                <> eventlogSocketEnvInetHost+                <> " was set to "+                <> esaInetHost+                <> ", but the port number "+                <> eventlogSocketEnvInetPort+                <> " was not set."++--------------------------------------------------------------------------------+-- Control Commands API+--------------------------------------------------------------------------------++{- |+The type of namespaces.++Namespaces are opaque and can only be obtained using `registerNamespace`.++@since 0.1.1.0+-}+newtype+    {-# CTYPE "eventlog_socket.h" "EventlogSocketControlNamespace" #-}+    Namespace = Namespace (Ptr Namespace)++{- |+Get the `String` name for the given t`Namespace`.++@since 0.1.1.0+-}+namespaceName :: Namespace -> IO String+namespaceName (Namespace namespacePtr) = do+    peekNullableCString =<< eventlog_socket_control_strnamespace namespacePtr++{- |+The type of command IDs.++Command IDs must be non-zero integers between 1 and 255.++@since 0.1.1.0+-}+newtype+    {-# CTYPE "eventlog_socket.h" "EventlogSocketControlCommandId" #-}+    CommandId = CommandId #{type EventlogSocketControlCommandId}+    deriving (Eq, Show)++{- |+The type of command handlers.++The command handler is evaluated once each time the control socket receives a request for the associated command.++__Warning__: The command handler /must not/ call back into the @eventlog-socket@ API.++@since 0.1.1.0+-}+type CommandHandler = IO ()++{- |+Register an @eventlog-socket@ control namespace with the given name and returns an opaque t`Namespace` object.++To avoid conflicts, the namespace should use the name of the Haskell package that registers the commands.++If the size of the given name exceeds 255 bytes, this function throws v`EventlogSocketControlNamespaceTooLong`.++If a namespace is already registered under the given name, this function throws v`EventlogSocketControlNamespaceExists`.++If the binary was built without support for control commands, this function throws v`EventlogSocketControlUnsupported`.++__Warning__: Namespaces cannot be unregistered and will be kept in memory until program exit.++@since 0.1.1.0+-}+registerNamespace ::+    -- | The name for the namespace.+    String ->+    IO Namespace+registerNamespace namespace =+    alloca @(Ptr Namespace) $ \namespaceOut -> do+        -- Try to register the namespace:+        status <-+            -- Allocate space for the return status:+            allocaBytes #{size EventlogSocketStatus} $ \essPtr ->+                withCStringLen namespace $ \(namespacePtr, namespaceLen) -> do++                    -- Check the namespace length:+                    let maxNamespaceLen = fromIntegral (maxBound :: #{type uint8_t})+                    when (namespaceLen > maxNamespaceLen) $+                        throwIO $+                            EventlogSocketControlNamespaceTooLong+                                namespace+                                namespaceLen+                                maxNamespaceLen++                    -- Try to register the namespace:+                    eventlog_socket_control_register_namespace+                        essPtr+                        (fromIntegral namespaceLen)+                        namespacePtr+                        namespaceOut++                    -- Marshal the return status:+                    peekEventlogSocketStatus essPtr++        -- Handle the return status:+        case essStatusCode status of+            -- The return status is OK, marshal and return the namespace.+            EVENTLOG_SOCKET_OK -> Namespace <$> peek namespaceOut++            -- The binary was compiled without support for the control server.+            EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT -> throwIO EventlogSocketControlUnsupported++            -- The namespace was already registered.+            EVENTLOG_SOCKET_ERR_CTL_EXISTS -> throwIO $ EventlogSocketControlNamespaceExists namespace++            -- The remaining errors are all system errors:+            _otherwise ->+                withEventlogSocketStatus status $ \essPtr -> do+                    strPtr <- eventlog_socket_strerror essPtr+                    str <- peekNullableCString strPtr+                    throwIO $ userError str++{- |+Register an @eventlog-socket@ control command with the given ID and handler in the given namespace.++If a command is already registered under the given ID in the given namespace, this function throws v`EventlogSocketControlCommandExists`.++If the binary was built without support for control commands, this function throws v`EventlogSocketControlUnsupported`.++__Warning__: Commands cannot be unregistered and will be kept in memory until program exit.++@since 0.1.1.0+-}+registerCommand ::+    -- | The namespace.+    Namespace ->+    -- | The command ID.+    CommandId ->+    -- | The command handler.+    CommandHandler ->+    IO ()+registerCommand (Namespace namespacePtr) commandId commandHandler = do+    -- Wrap the Haskell command handler for the C API+    let c_commandHandler namespacePtr' commandId' commandDataPtr =+            assert (namespacePtr == namespacePtr') $+            assert (commandId == commandId') $+            assert (commandDataPtr == nullPtr) $+            commandHandler++    -- Allocate a C function pointer for the command handler:+    --+    -- NOTE: This function pointer is only deallocated if registration fails.+    bracketOnError (makeCommandHandlerFunPtr c_commandHandler) freeHaskellFunPtr $ \c_commandHandlerPtr -> do++        -- Try to register the command:+        status <-+            -- Allocate space for the return status:+            allocaBytes #{size EventlogSocketStatus} $ \essPtr -> do++                -- Try to register the command:+                eventlog_socket_control_register_command+                    essPtr+                    namespacePtr+                    commandId+                    c_commandHandlerPtr+                    nullPtr++                -- Marshal the return status:+                peekEventlogSocketStatus essPtr++        -- Handle the return status:+        case essStatusCode status of+            -- The return status is OK.+            EVENTLOG_SOCKET_OK -> pure ()++            -- The binary was compiled without support for the control server.+            EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT ->+                throwIO EventlogSocketControlUnsupported++            -- The namespace was already registered.+            EVENTLOG_SOCKET_ERR_CTL_EXISTS -> do+                namespace <- namespaceName (Namespace namespacePtr)+                throwIO $ EventlogSocketControlCommandExists namespace commandId++            -- The remaining errors are all system errors:+            _otherwise ->+                withEventlogSocketStatus status $ \essPtr -> do+                    strPtr <- eventlog_socket_strerror essPtr+                    str <- peekNullableCString strPtr+                    throwIO $ userError str++--------------------------------------------------------------------------------+-- Errors++{- |+The type of exceptions thrown by `registerNamespace` and `registerCommand`.++@since 0.1.1.0+-}+data EventlogSocketControlError+  = EventlogSocketControlNamespaceTooLong+        -- | The requested name for the namespace.+        String+        -- | The size of the requested name in bytes.+        Int+        -- | The maximum size in bytes.+        Int+  | EventlogSocketControlNamespaceExists+        -- | The requested name for the namespace.+        String+  | EventlogSocketControlCommandExists+        -- | The name for the namespace.+        String+        -- | The requested ID for the command.+        CommandId+  | EventlogSocketControlUnsupported+  deriving (Eq, Show)++instance Exception EventlogSocketControlError where+    displayException = \case+        EventlogSocketControlNamespaceTooLong namespace namespaceLen maxNamespaceLen ->+            "The name '"+                <> namespace+                <> "' was "+                <> show namespaceLen+                <> " bytes. The maximum length is "+                <> show maxNamespaceLen+                <> " bytes."+        EventlogSocketControlNamespaceExists namespace ->+            "The name '"+                <> namespace+                <> "' is already registered."+        EventlogSocketControlCommandExists namespace (CommandId commandId) ->+            "The ID "+                <> show commandId+                <> " is already registered for "+                <> namespace+                <> "."+        EventlogSocketControlUnsupported ->+            "The binary was built without support for control commands."++--------------------------------------------------------------------------------+-- Legacy API+--------------------------------------------------------------------------------++{- |+Start an @eventlog-socket@ writer on the given Unix domain socket path and wait.++@since 0.1.0.0+-}+startWait :: FilePath -> IO ()+startWait unixPath = do+    let addr = EventlogSocketUnixAddr unixPath+    let opts = defaultEventlogSocketOpts{esoWait = True}+    startWith addr opts++{- |+Start an @eventlog-socket@ writer on the given Unix domain socket path.++@since 0.1.0.0+-}+start :: FilePath -> IO ()+start unixPath = do+    let addr = EventlogSocketUnixAddr unixPath+    let opts = defaultEventlogSocketOpts{esoWait = False}+    startWith addr opts++{- |+Wait for another process to connect to the eventlog socket.++@since 0.1.0.0+-}+wait :: IO ()+wait = eventlog_socket_wait++--------------------------------------------------------------------------------+-- Low-level API+--------------------------------------------------------------------------------++--------------------------------------------------------------------------------+-- Low-level foreign types++{- |+The address family of the eventlog socket.++Used as the tag for the C tagged union @EventlogSocketAddr@.+-}+newtype+    {-# CTYPE "eventlog_socket.h" "EventlogSocketTag" #-}+    EventlogSocketTag = EventlogSocketTag+        { unEventlogSocketTag :: #{type EventlogSocketTag}+        }+        deriving (Eq, Show, Storable)++{- |+The tag for a Unix domain socket address.+-}+pattern EVENTLOG_SOCKET_UNIX :: EventlogSocketTag+pattern EVENTLOG_SOCKET_UNIX = EventlogSocketTag #{const EVENTLOG_SOCKET_UNIX}++{- |+The tag for a TCP/IP socket address.+-}+pattern EVENTLOG_SOCKET_INET :: EventlogSocketTag+pattern EVENTLOG_SOCKET_INET = EventlogSocketTag #{const EVENTLOG_SOCKET_INET}++{-# COMPLETE+    EVENTLOG_SOCKET_UNIX,+    EVENTLOG_SOCKET_INET #-}++{- |+The status codes used by the @eventlog-socket@ library.+-}+newtype+    {-# CTYPE "eventlog_socket.h" "EventlogSocketStatusCode" #-}+    EventlogSocketStatusCode = EventlogSocketStatusCode+        { unEventlogSocketStatusCode :: #{type EventlogSocketStatusCode}+        }+        deriving (Eq, Show, Storable)++pattern EVENTLOG_SOCKET_OK :: EventlogSocketStatusCode+pattern EVENTLOG_SOCKET_OK = EventlogSocketStatusCode #{const EVENTLOG_SOCKET_OK}++pattern EVENTLOG_SOCKET_ERR_RTS_NOSUPPORT :: EventlogSocketStatusCode+pattern EVENTLOG_SOCKET_ERR_RTS_NOSUPPORT = EventlogSocketStatusCode #{const EVENTLOG_SOCKET_ERR_RTS_NOSUPPORT}++pattern EVENTLOG_SOCKET_ERR_RTS_FAIL :: EventlogSocketStatusCode+pattern EVENTLOG_SOCKET_ERR_RTS_FAIL = EventlogSocketStatusCode #{const EVENTLOG_SOCKET_ERR_RTS_FAIL}++pattern EVENTLOG_SOCKET_ERR_ENV_NOADDR :: EventlogSocketStatusCode+pattern EVENTLOG_SOCKET_ERR_ENV_NOADDR = EventlogSocketStatusCode #{const EVENTLOG_SOCKET_ERR_ENV_NOADDR}++pattern EVENTLOG_SOCKET_ERR_ENV_TOOLONG :: EventlogSocketStatusCode+pattern EVENTLOG_SOCKET_ERR_ENV_TOOLONG = EventlogSocketStatusCode #{const EVENTLOG_SOCKET_ERR_ENV_TOOLONG}++pattern EVENTLOG_SOCKET_ERR_ENV_NOHOST :: EventlogSocketStatusCode+pattern EVENTLOG_SOCKET_ERR_ENV_NOHOST = EventlogSocketStatusCode #{const EVENTLOG_SOCKET_ERR_ENV_NOHOST}++pattern EVENTLOG_SOCKET_ERR_ENV_NOPORT :: EventlogSocketStatusCode+pattern EVENTLOG_SOCKET_ERR_ENV_NOPORT = EventlogSocketStatusCode #{const EVENTLOG_SOCKET_ERR_ENV_NOPORT}++pattern EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT :: EventlogSocketStatusCode+pattern EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT = EventlogSocketStatusCode #{const EVENTLOG_SOCKET_ERR_CTL_NOSUPPORT}++pattern EVENTLOG_SOCKET_ERR_CTL_EXISTS :: EventlogSocketStatusCode+pattern EVENTLOG_SOCKET_ERR_CTL_EXISTS = EventlogSocketStatusCode #{const EVENTLOG_SOCKET_ERR_CTL_EXISTS}++pattern EVENTLOG_SOCKET_ERR_GAI :: EventlogSocketStatusCode+pattern EVENTLOG_SOCKET_ERR_GAI = EventlogSocketStatusCode #{const EVENTLOG_SOCKET_ERR_GAI}++pattern EVENTLOG_SOCKET_ERR_SYS :: EventlogSocketStatusCode+pattern EVENTLOG_SOCKET_ERR_SYS = EventlogSocketStatusCode #{const EVENTLOG_SOCKET_ERR_SYS}++{-# COMPLETE+    EVENTLOG_SOCKET_OK,+    EVENTLOG_SOCKET_ERR_RTS_NOSUPPORT,+    EVENTLOG_SOCKET_ERR_RTS_FAIL,+    EVENTLOG_SOCKET_ERR_ENV_NOADDR,+    EVENTLOG_SOCKET_ERR_ENV_TOOLONG,+    EVENTLOG_SOCKET_ERR_ENV_NOHOST,+    EVENTLOG_SOCKET_ERR_ENV_NOPORT,+    EVENTLOG_SOCKET_ERR_CTL_EXISTS,+    EVENTLOG_SOCKET_ERR_GAI,+    EVENTLOG_SOCKET_ERR_SYS #-}++{- |+The status used by the @eventlog-socket@ library.+-}+data+    {-# CTYPE "eventlog_socket.h" "EventlogSocketStatus" #-}+    EventlogSocketStatus = EventlogSocketStatus+        { essStatusCode :: !EventlogSocketStatusCode+        , essErrorCode :: !( #{type int} )+        }+    deriving (Eq, Show)++--------------------------------------------------------------------------------+-- Marshalling from foreign types++{- |+Marshal an `EventlogSocketAddr` from C.+-}+peekEventlogSocketAddr ::+    Ptr EventlogSocketAddr ->+    IO EventlogSocketAddr+peekEventlogSocketAddr esaPtr = do+    #{peek EventlogSocketAddr, esa_tag} esaPtr >>= \case+        EVENTLOG_SOCKET_UNIX -> do+            esaUnixPath <-+                peekNullableCString <=< peek+                    $ esaPtr+                    & #{ptr EventlogSocketAddr, esa_unix_addr}+                    & #{ptr EventlogSocketUnixAddr, esa_unix_path}+            pure EventlogSocketUnixAddr+                { esaUnixPath = esaUnixPath+                }+        EVENTLOG_SOCKET_INET -> do+            esaInetHost <-+                peekNullableCString <=< peek+                    $ esaPtr+                    & #{ptr EventlogSocketAddr, esa_inet_addr}+                    & #{ptr EventlogSocketInetAddr, esa_inet_host}+            esaInetPort <-+                peekNullableCString <=< peek+                    $ esaPtr+                    & #{ptr EventlogSocketAddr, esa_inet_addr}+                    & #{ptr EventlogSocketInetAddr, esa_inet_port}+            pure EventlogSocketInetAddr+                { esaInetHost = esaInetHost+                , esaInetPort = esaInetPort+                }++{- |+Marshal an `EventlogSocketAddr` to C.+-}+withEventlogSocketAddr ::+    EventlogSocketAddr ->+    (Ptr EventlogSocketAddr -> IO a) ->+    IO a+withEventlogSocketAddr esa action =+    case esa of+        EventlogSocketUnixAddr{esaUnixPath = esaUnixPath} ->+            allocaBytes #{size EventlogSocketAddr} $ \esaPtr -> do+                #{poke EventlogSocketAddr, esa_tag} esaPtr EVENTLOG_SOCKET_UNIX+                withCString esaUnixPath $ \esaUnixPathCString -> do+                    flip poke esaUnixPathCString+                        $ esaPtr+                        & #{ptr EventlogSocketAddr, esa_unix_addr}+                        & #{ptr EventlogSocketUnixAddr, esa_unix_path}+                    action esaPtr+        EventlogSocketInetAddr{esaInetHost = esaInetHost, esaInetPort = esaInetPort} ->+            allocaBytes #{size EventlogSocketAddr} $ \esaPtr -> do+                #{poke EventlogSocketAddr, esa_tag} esaPtr EVENTLOG_SOCKET_INET+                withCString esaInetHost $ \esaInetHostCString -> do+                    flip poke esaInetHostCString+                        $ esaPtr+                        & #{ptr EventlogSocketAddr, esa_inet_addr}+                        & #{ptr EventlogSocketInetAddr, esa_inet_host}+                    withCString esaInetPort $ \esaInetPortCString -> do+                        flip poke esaInetPortCString+                            $ esaPtr+                            & #{ptr EventlogSocketAddr, esa_inet_addr}+                            & #{ptr EventlogSocketInetAddr, esa_inet_port}+                        action esaPtr++{- |+Marshal an t`EventlogSocketOpts` from C.+-}+peekEventlogSocketOpts ::+    Ptr EventlogSocketOpts ->+    IO EventlogSocketOpts+peekEventlogSocketOpts esoPtr = do+    esoWait <- toBool . CBool <$> #{peek EventlogSocketOpts, eso_wait} esoPtr+    esoSndbuf <- #{peek EventlogSocketOpts, eso_sndbuf} esoPtr+    esoLinger <- #{peek EventlogSocketOpts, eso_linger} esoPtr+    pure EventlogSocketOpts+        { esoWait = esoWait+        , esoSndbuf =+            if esoSndbuf <= 0 then Nothing else Just esoSndbuf+        , esoLinger =+            if esoLinger <= 0 then Nothing else Just esoLinger+        }++{- |+Marshal an t`EventlogSocketOpts` to C.+-}+withEventlogSocketOpts ::+    EventlogSocketOpts ->+    (Ptr EventlogSocketOpts -> IO a) ->+    IO a+withEventlogSocketOpts eso action =+    allocaBytes #{size EventlogSocketOpts} $ \esoPtr -> do+        #{poke EventlogSocketOpts, eso_wait} esoPtr . CBool . fromBool $ esoWait eso+        #{poke EventlogSocketOpts, eso_sndbuf} esoPtr . fromMaybe 0 $ esoSndbuf eso+        #{poke EventlogSocketOpts, eso_linger} esoPtr . fromMaybe 0 $ esoLinger eso+        action esoPtr++{- |+Marshal an t`EventlogSocketStatus` from C.+-}+peekEventlogSocketStatus ::+    Ptr EventlogSocketStatus ->+    IO EventlogSocketStatus+peekEventlogSocketStatus essPtr = do+    essStatusCode <-+        #{peek EventlogSocketStatus, ess_status_code} essPtr+    essErrorCode <-+        if essStatusCode `elem` [EVENTLOG_SOCKET_ERR_GAI, EVENTLOG_SOCKET_ERR_SYS]+            then #{peek EventlogSocketStatus, ess_error_code} essPtr+            else pure 0+    pure EventlogSocketStatus+        { essStatusCode = essStatusCode+        , essErrorCode = essErrorCode+        }++{- |+Marshal an t`EventlogSocketStatus` to C.+-}+withEventlogSocketStatus ::+    EventlogSocketStatus ->+    (Ptr EventlogSocketStatus -> IO a) ->+    IO a+withEventlogSocketStatus ess action =+    allocaBytes #{size EventlogSocketStatus} $ \essPtr -> do+        #{poke EventlogSocketStatus, ess_status_code} essPtr $ essStatusCode ess+        #{poke EventlogSocketStatus, ess_error_code} essPtr $ essErrorCode ess+        action essPtr++{- |+Variant of `peekCString` that checks for `nullPtr`.+-}+peekNullableCString :: CString -> IO String+peekNullableCString charPtr+    | charPtr == nullPtr = pure ""+    | otherwise = peekCString charPtr++--------------------------------------------------------------------------------+-- Foreign imports+--------------------------------------------------------------------------------++--------------------------------------------------------------------------------+-- eventlog_socket_addr_free++foreign import capi safe "eventlog_socket.h eventlog_socket_addr_free"+    eventlog_socket_addr_free ::+        Ptr EventlogSocketAddr ->+        IO ()++--------------------------------------------------------------------------------+-- eventlog_socket_opts_init++foreign import capi safe "eventlog_socket.h eventlog_socket_opts_init"+    eventlog_socket_opts_init ::+        Ptr EventlogSocketOpts ->+        IO ()++--------------------------------------------------------------------------------+-- eventlog_socket_opts_free++foreign import capi safe "eventlog_socket.h eventlog_socket_opts_free"+    eventlog_socket_opts_free ::+        Ptr EventlogSocketOpts ->+        IO ()++--------------------------------------------------------------------------------+-- eventlog_socket_start++foreign import capi safe "GHC/Eventlog/Socket_hsc.h _wrap_eventlog_socket_start"+    eventlog_socket_start ::+        Ptr EventlogSocketStatus ->+        Ptr EventlogSocketAddr ->+        Ptr EventlogSocketOpts ->+        IO ()++#{def+  void _wrap_eventlog_socket_start(+    EventlogSocketStatus *eventlog_socket_status,+    EventlogSocketAddr *eventlog_socket_addr,+    EventlogSocketOpts *eventlog_socket_opts+  )+  {+    const EventlogSocketStatus status = eventlog_socket_start(+      eventlog_socket_addr,+      eventlog_socket_opts+    );+    memcpy(eventlog_socket_status, &status, sizeof(EventlogSocketStatus));+  }+}++--------------------------------------------------------------------------------+-- eventlog_socket_from_env++foreign import capi safe "GHC/Eventlog/Socket_hsc.h _wrap_eventlog_socket_from_env"+    eventlog_socket_from_env ::+        Ptr EventlogSocketStatus ->+        Ptr EventlogSocketAddr ->+        Ptr EventlogSocketOpts ->+        IO ()++#{def+  void _wrap_eventlog_socket_from_env(+    EventlogSocketStatus *eventlog_socket_status,+    EventlogSocketAddr *eventlog_socket_addr,+    EventlogSocketOpts *eventlog_socket_opts+  )+  {+    const EventlogSocketStatus status = eventlog_socket_from_env(+      eventlog_socket_addr,+      eventlog_socket_opts+    );+    memcpy(eventlog_socket_status, &status, sizeof(EventlogSocketStatus));+  }+}++--------------------------------------------------------------------------------+-- eventlog_socket_wait++foreign import capi safe "eventlog_socket.h eventlog_socket_wait"+    eventlog_socket_wait :: IO ()++--------------------------------------------------------------------------------+-- eventlog_socket_strerror++foreign import capi safe "GHC/Eventlog/Socket_hsc.h _wrap_eventlog_socket_strerror"+    eventlog_socket_strerror ::+        Ptr EventlogSocketStatus ->+        IO CString++#{def+  char *_wrap_eventlog_socket_strerror(+    EventlogSocketStatus *eventlog_socket_status+  )+  {+    return eventlog_socket_strerror(*eventlog_socket_status);+  }+}++--------------------------------------------------------------------------------+-- eventlog_socket_control_strnamespace++-- NOTE: This uses `ccall` rather than `capi` because the underlying function+--       returns a `const char*` and `ConstPtr` wasn't added until GHC 9.6.1.++foreign import ccall safe "eventlog_socket.h eventlog_socket_control_strnamespace"+    eventlog_socket_control_strnamespace ::+        Ptr Namespace ->+        IO CString++--------------------------------------------------------------------------------+-- eventlog_socket_control_register_namespace++foreign import capi safe "GHC/Eventlog/Socket_hsc.h _wrap_eventlog_socket_control_register_namespace"+    eventlog_socket_control_register_namespace ::+        Ptr EventlogSocketStatus ->+        ( #{type uint8_t} ) ->+        CString ->+        Ptr (Ptr Namespace) ->+        IO ()++#{def+  void _wrap_eventlog_socket_control_register_namespace(+    EventlogSocketStatus *eventlog_socket_status,+    uint8_t eventlog_socket_namespace_len,+    char eventlog_socket_namespace[eventlog_socket_namespace_len],+    EventlogSocketControlNamespace **eventlog_socket_namespace_out+  ) {+    const EventlogSocketStatus status = eventlog_socket_control_register_namespace(+      eventlog_socket_namespace_len,+      eventlog_socket_namespace,+      eventlog_socket_namespace_out+    );+    memcpy(eventlog_socket_status, &status, sizeof(EventlogSocketStatus));+  }+}++--------------------------------------------------------------------------------+-- eventlog_socket_control_register_command++foreign import capi safe "GHC/Eventlog/Socket_hsc.h _wrap_eventlog_socket_control_register_command"+    eventlog_socket_control_register_command ::+        Ptr EventlogSocketStatus ->+        Ptr Namespace ->+        CommandId ->+        FunPtr (Ptr Namespace -> CommandId -> Ptr a -> IO ()) ->+        Ptr a ->+        IO ()++foreign import ccall "wrapper"+    makeCommandHandlerFunPtr ::+        (Ptr Namespace -> CommandId -> Ptr a -> IO ()) ->+        IO (FunPtr (Ptr Namespace -> CommandId -> Ptr a -> IO ()))++#{def+  void _wrap_eventlog_socket_control_register_command(+    EventlogSocketStatus *eventlog_socket_status,+    EventlogSocketControlNamespace *eventlog_socket_namespace,+    EventlogSocketControlCommandId eventlog_socket_command_id,+    EventlogSocketControlCommandHandler eventlog_socket_command_handler,+    const void *eventlog_socket_command_data+  ) {+    const EventlogSocketStatus status = eventlog_socket_control_register_command(+      eventlog_socket_namespace,+      eventlog_socket_command_id,+      eventlog_socket_command_handler,+      eventlog_socket_command_data+    );+    memcpy(eventlog_socket_status, &status, sizeof(EventlogSocketStatus));+  }+}