├── .github └── workflows │ ├── haskell-ci.yml │ └── simple.yml ├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.mkd ├── Setup.hs ├── cabal.project ├── cbits └── eventlog_socket.c ├── eventlog-socket.cabal ├── include └── eventlog_socket.h └── src └── GHC └── Eventlog └── Socket.hs /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'eventlog-socket.cabal' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.16 12 | # 13 | # REGENDATA ("0.16",["github","eventlog-socket.cabal"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | - push 18 | - pull_request 19 | jobs: 20 | linux: 21 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 22 | runs-on: ubuntu-20.04 23 | timeout-minutes: 24 | 60 25 | container: 26 | image: buildpack-deps:bionic 27 | continue-on-error: ${{ matrix.allow-failure }} 28 | strategy: 29 | matrix: 30 | include: 31 | - compiler: ghc-9.6.1 32 | compilerKind: ghc 33 | compilerVersion: 9.6.1 34 | setup-method: ghcup 35 | allow-failure: false 36 | - compiler: ghc-9.4.4 37 | compilerKind: ghc 38 | compilerVersion: 9.4.4 39 | setup-method: ghcup 40 | allow-failure: false 41 | - compiler: ghc-9.2.7 42 | compilerKind: ghc 43 | compilerVersion: 9.2.7 44 | setup-method: ghcup 45 | allow-failure: false 46 | - compiler: ghc-9.0.2 47 | compilerKind: ghc 48 | compilerVersion: 9.0.2 49 | setup-method: ghcup 50 | allow-failure: false 51 | - compiler: ghc-8.10.7 52 | compilerKind: ghc 53 | compilerVersion: 8.10.7 54 | setup-method: ghcup 55 | allow-failure: false 56 | fail-fast: false 57 | steps: 58 | - name: apt 59 | run: | 60 | apt-get update 61 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 62 | mkdir -p "$HOME/.ghcup/bin" 63 | curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" 64 | chmod a+x "$HOME/.ghcup/bin/ghcup" 65 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 66 | "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 67 | env: 68 | HCKIND: ${{ matrix.compilerKind }} 69 | HCNAME: ${{ matrix.compiler }} 70 | HCVER: ${{ matrix.compilerVersion }} 71 | - name: Set PATH and environment variables 72 | run: | 73 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 74 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 75 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 76 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 77 | HCDIR=/opt/$HCKIND/$HCVER 78 | HC=$HOME/.ghcup/bin/$HCKIND-$HCVER 79 | echo "HC=$HC" >> "$GITHUB_ENV" 80 | echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" 81 | echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" 82 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 83 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 84 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 85 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 86 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 87 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 88 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 89 | echo "GHCJSARITH=0" >> "$GITHUB_ENV" 90 | env: 91 | HCKIND: ${{ matrix.compilerKind }} 92 | HCNAME: ${{ matrix.compiler }} 93 | HCVER: ${{ matrix.compilerVersion }} 94 | - name: env 95 | run: | 96 | env 97 | - name: write cabal config 98 | run: | 99 | mkdir -p $CABAL_DIR 100 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 133 | echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - 134 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 135 | rm -f cabal-plan.xz 136 | chmod a+x $HOME/.cabal/bin/cabal-plan 137 | cabal-plan --version 138 | - name: checkout 139 | uses: actions/checkout@v3 140 | with: 141 | path: source 142 | - name: initial cabal.project for sdist 143 | run: | 144 | touch cabal.project 145 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 146 | cat cabal.project 147 | - name: sdist 148 | run: | 149 | mkdir -p sdist 150 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 151 | - name: unpack 152 | run: | 153 | mkdir -p unpacked 154 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 155 | - name: generate cabal.project 156 | run: | 157 | PKGDIR_eventlog_socket="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/eventlog-socket-[0-9.]*')" 158 | echo "PKGDIR_eventlog_socket=${PKGDIR_eventlog_socket}" >> "$GITHUB_ENV" 159 | rm -f cabal.project cabal.project.local 160 | touch cabal.project 161 | touch cabal.project.local 162 | echo "packages: ${PKGDIR_eventlog_socket}" >> cabal.project 163 | echo "package eventlog-socket" >> cabal.project 164 | echo " ghc-options: -Werror=missing-methods" >> cabal.project 165 | cat >> cabal.project <> cabal.project.local 168 | cat cabal.project 169 | cat cabal.project.local 170 | - name: dump install plan 171 | run: | 172 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 173 | cabal-plan 174 | - name: restore cache 175 | uses: actions/cache/restore@v3 176 | with: 177 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 178 | path: ~/.cabal/store 179 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 180 | - name: install dependencies 181 | run: | 182 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 183 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 184 | - name: build w/o tests 185 | run: | 186 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 187 | - name: build 188 | run: | 189 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 190 | - name: cabal check 191 | run: | 192 | cd ${PKGDIR_eventlog_socket} || false 193 | ${CABAL} -vnormal check 194 | - name: haddock 195 | run: | 196 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 197 | - name: unconstrained build 198 | run: | 199 | rm -f cabal.project.local 200 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 201 | - name: save cache 202 | uses: actions/cache/save@v3 203 | if: always() 204 | with: 205 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 206 | path: ~/.cabal/store 207 | -------------------------------------------------------------------------------- /.github/workflows/simple.yml: -------------------------------------------------------------------------------- 1 | name: Simple 2 | on: 3 | push: 4 | branches: 5 | - master 6 | pull_request: 7 | branches: 8 | - master 9 | 10 | jobs: 11 | native: 12 | name: "Simple: GHC ${{ matrix.ghc }} on ${{ matrix.os }}" 13 | runs-on: ${{ matrix.os }} 14 | strategy: 15 | matrix: 16 | os: [macos-latest] 17 | ghc: ['9.4.4', '9.6.1'] 18 | fail-fast: false 19 | timeout-minutes: 20 | 60 21 | steps: 22 | - name: Set git to use LF 23 | run: | 24 | git config --global core.autocrlf false 25 | git config --global core.eol lf 26 | - name: Set up Haskell 27 | id: setup-haskell 28 | uses: haskell/actions/setup@v1 29 | with: 30 | ghc-version: ${{ matrix.ghc }} 31 | cabal-version: '3.8.1.0' 32 | 33 | - name: Checkout 34 | uses: actions/checkout@v3.0.2 35 | 36 | - name: Cache 37 | uses: actions/cache@v2.1.3 38 | with: 39 | path: ${{ steps.setup-haskell.outputs.cabal-store }} 40 | key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }} 41 | restore-keys: ${{ runner.os }}-${{ matrix.ghc }}- 42 | 43 | - name: Build 44 | run: cabal build all --enable-tests 45 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle 2 | .vscode 3 | cabal.project.local 4 | eventlog_socket.o 5 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for eventlog-socket 2 | 3 | ## 0.1.0.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2018, Ben Gamari 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Ben Gamari nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.mkd: -------------------------------------------------------------------------------- 1 | # eventlog-socket 2 | 3 | A library to send GHC's eventlog stream over a Unix domain socket. 4 | 5 | In your application 6 | 7 | ```cabal 8 | executable MyProgram 9 | ... 10 | build-depends: eventlog-socket 11 | ghc-options: -eventlog 12 | ``` 13 | 14 | ```haskell 15 | import qualified GHC.Eventlog.Socket 16 | 17 | main :: IO () 18 | main = do 19 | ... 20 | GHC.Eventlog.Socket.start "/tmp/my-program.eventlog.sock" 21 | ... 22 | ``` 23 | 24 | ``` 25 | $ ./MyProgram +RTS -l & 26 | $ nc -U /tmp/my-program.eventlog.sock > my-program.eventlog 27 | ``` 28 | 29 | 30 | This is a prototype to play around with the possibility of using the eventlog 31 | for realtime profiling and performance analysis. There are still numerous open questions: 32 | 33 | * access control? 34 | * support only Unix domain sockets or also tcp/ip? 35 | * do we want to support multiple consumers? 36 | * what should happen when a consumer disconnects? we could either 37 | * currently we just pause the eventlog until a new consumer shows up 38 | * close the socket and stop streaming 39 | * pause the program until a new consumer shows up 40 | * kill the program 41 | 42 | ## Development 43 | 44 | As the most code is C using following line will speedup development 45 | considerably (change your GHC installation path accordingly): 46 | 47 | ``` 48 | gcc -c -Iinclude -I/opt/ghc/9.0.1/lib/ghc-9.0.1/include -o eventlog_socket.o cbits/eventlog_socket.c 49 | gcc -c -Iinclude -I/opt/ghc/9.2.0.20210821/lib/ghc-9.2.0.20210821/include -o eventlog_socket.o cbits/eventlog_socket.c 50 | ``` 51 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | -------------------------------------------------------------------------------- /cbits/eventlog_socket.c: -------------------------------------------------------------------------------- 1 | // For POLLRDHUP 2 | #define _GNU_SOURCE 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | 16 | #include 17 | 18 | #include "eventlog_socket.h" 19 | 20 | #define LISTEN_BACKLOG 5 21 | #define POLL_LISTEN_TIMEOUT 10000 22 | #define POLL_WRITE_TIMEOUT 1000 23 | 24 | #ifndef POLLRDHUP 25 | #define POLLRDHUP POLLHUP 26 | #endif 27 | 28 | // logging helper macros: 29 | // - use PRINT_ERR to unconditionally log erroneous situations 30 | // - otherwise use DEBUG_ERR 31 | #define PRINT_ERR(...) fprintf(stderr, "ghc-eventlog-socket: " __VA_ARGS__) 32 | #ifdef NDEBUG 33 | #define DEBUG_ERR(fmt, ...) 34 | #define DEBUG0_ERR(fmt) 35 | #else 36 | #define DEBUG_ERR(fmt, ...) fprintf(stderr, "ghc-eventlog-socket %s: " fmt, __func__, __VA_ARGS__) 37 | #define DEBUG0_ERR(fmt) fprintf(stderr, "ghc-eventlog-socket %s: " fmt, __func__) 38 | #endif 39 | 40 | /********************************************************************************* 41 | * data definitions 42 | *********************************************************************************/ 43 | 44 | 45 | struct write_buffer_item { 46 | uint8_t *orig; // original data pointer (which we free) 47 | uint8_t *data; 48 | size_t size; // invariant: size is not zero 49 | struct write_buffer_item *next; 50 | }; 51 | 52 | // invariant: head and last are both NULL or both not NULL. 53 | struct write_buffer { 54 | struct write_buffer_item *head; 55 | struct write_buffer_item *last; 56 | }; 57 | 58 | /********************************************************************************* 59 | * globals 60 | *********************************************************************************/ 61 | 62 | /* This module is concurrent. 63 | * There are two thread(group)s: 64 | * 1. RTS 65 | * 2. worker spawned by open_socket 66 | */ 67 | 68 | // variables read and written by worker only: 69 | static bool initialized = false; 70 | static int listen_fd = -1; 71 | 72 | // concurrency variables 73 | static pthread_t listen_thread; 74 | static pthread_cond_t new_conn_cond; 75 | static pthread_mutex_t mutex; 76 | 77 | // variables accessed by both threads. 78 | // their access should be guarded by mutex. 79 | // 80 | // Note: RTS writes client_fd in writer_stop. 81 | static volatile int client_fd = -1; 82 | static struct write_buffer wt = { 83 | .head = NULL, 84 | .last = NULL, 85 | }; 86 | 87 | /********************************************************************************* 88 | * write_buffer 89 | *********************************************************************************/ 90 | 91 | // push to the back. 92 | void write_buffer_push(struct write_buffer *buf, uint8_t *data, size_t size) { 93 | DEBUG_ERR("%p, %lu\n", data, size); 94 | uint8_t *copy = malloc(size); 95 | memcpy(copy, data, size); 96 | 97 | struct write_buffer_item *item = malloc(sizeof(struct write_buffer_item)); 98 | item->orig = copy; 99 | item->data = copy; 100 | item->size = size; 101 | item->next = NULL; 102 | 103 | struct write_buffer_item *last = buf->last; 104 | if (last == NULL) { 105 | assert(buf->head == NULL); 106 | 107 | buf->head = item; 108 | buf->last = item; 109 | } else { 110 | last->next = item; 111 | buf->last = item; 112 | } 113 | 114 | DEBUG_ERR("%p %p %p\n", buf, &wt, buf->head); 115 | }; 116 | 117 | // pop from the front. 118 | void write_buffer_pop(struct write_buffer *buf) { 119 | struct write_buffer_item *head = buf->head; 120 | if (head == NULL) { 121 | // buffer is empty: nothing to do. 122 | return; 123 | } else { 124 | buf->head = head->next; 125 | if (buf->last == head) { 126 | buf->last = NULL; 127 | } 128 | free(head->orig); 129 | free(head); 130 | } 131 | } 132 | 133 | // buf itself is not freed. 134 | // it's safe to call write_buffer_free multiple times on the same buf. 135 | void write_buffer_free(struct write_buffer *buf) { 136 | // not the most effecient implementation, 137 | // but should be obviously correct. 138 | while (buf->head) { 139 | write_buffer_pop(buf); 140 | } 141 | } 142 | 143 | /********************************************************************************* 144 | * EventLogWriter 145 | *********************************************************************************/ 146 | 147 | static void writer_init(void) 148 | { 149 | // no-op 150 | } 151 | 152 | static void writer_enqueue(uint8_t *data, size_t size) { 153 | DEBUG_ERR("size: %p %lu\n", data, size); 154 | 155 | // TODO: check the size of the queue 156 | // if it's too big, we can start dropping blocks. 157 | 158 | // for now, we just push everythinb to the back of the buffer. 159 | write_buffer_push(&wt, data, size); 160 | 161 | DEBUG_ERR("wt.head = %p\n", wt.head); 162 | } 163 | 164 | static bool writer_write(void *eventlog, size_t size) 165 | { 166 | DEBUG_ERR("size: %lu\n", size); 167 | pthread_mutex_lock(&mutex); 168 | int fd = client_fd; 169 | if (fd < 0) { 170 | goto exit; 171 | } 172 | 173 | DEBUG_ERR("client_fd = %d; wt.head = %p\n", fd, wt.head); 174 | 175 | if (wt.head != NULL) { 176 | // if there is stuff in queue already, we enqueue the current block. 177 | writer_enqueue(eventlog, size); 178 | } else { 179 | 180 | // and if there isn't, we can write immediately. 181 | int ret = write(fd, eventlog, size); 182 | DEBUG_ERR("write return %d\n", ret); 183 | 184 | if (ret == -1) { 185 | if (errno == EAGAIN || errno == EWOULDBLOCK) { 186 | // couldn't write anything, enqueue whole block 187 | writer_enqueue(eventlog, size); 188 | goto exit; 189 | } else if (errno == EPIPE) { 190 | // connection closed, simply exit 191 | goto exit; 192 | 193 | } else { 194 | PRINT_ERR("failed to write: %s\n", strerror(errno)); 195 | goto exit; 196 | } 197 | } else { 198 | // we wrote something 199 | if (ret >= size) { 200 | // we wrote everything, nothing to do 201 | goto exit; 202 | } else { 203 | // we wrote only part of the buffer 204 | writer_enqueue(eventlog + ret, size - ret); 205 | } 206 | } 207 | } 208 | 209 | exit: 210 | pthread_mutex_unlock(&mutex); 211 | return true; 212 | } 213 | 214 | static void writer_flush(void) 215 | { 216 | // no-op 217 | } 218 | 219 | static void writer_stop(void) 220 | { 221 | pthread_mutex_lock(&mutex); 222 | if (client_fd >= 0) { 223 | close(client_fd); 224 | client_fd = -1; 225 | write_buffer_free(&wt); 226 | } 227 | pthread_mutex_unlock(&mutex); 228 | } 229 | 230 | const EventLogWriter socket_writer = { 231 | .initEventLogWriter = writer_init, 232 | .writeEventLog = writer_write, 233 | .flushEventLog = writer_flush, 234 | .stopEventLogWriter = writer_stop 235 | }; 236 | 237 | /********************************************************************************* 238 | * Main worker (in own thread) 239 | *********************************************************************************/ 240 | 241 | static void listen_iteration() { 242 | DEBUG0_ERR("enter"); 243 | 244 | if (listen(listen_fd, LISTEN_BACKLOG) == -1) { 245 | PRINT_ERR("listen() failed: %s\n", strerror(errno)); 246 | abort(); 247 | } 248 | 249 | struct sockaddr_un remote; 250 | unsigned int len; 251 | 252 | struct pollfd pfd_accept = { 253 | .fd = listen_fd, 254 | .events = POLLIN, 255 | .revents = 0, 256 | }; 257 | 258 | // poll until we can accept 259 | while (true) { 260 | int ret = poll(&pfd_accept, 1, POLL_LISTEN_TIMEOUT); 261 | if (ret == -1) { 262 | PRINT_ERR("poll() failed: %s\n", strerror(errno)); 263 | return; 264 | } else if (ret == 0) { 265 | DEBUG0_ERR("accept poll timed out\n"); 266 | } else { 267 | // got connection 268 | break; 269 | } 270 | } 271 | 272 | // accept 273 | int fd = accept(listen_fd, (struct sockaddr *) &remote, &len); 274 | if (fd == -1) { 275 | PRINT_ERR("accept failed: %s\n", strerror(errno)); 276 | } 277 | 278 | // set socket into non-blocking mode 279 | int flags = fcntl(fd, F_GETFL); 280 | if (flags == -1) { 281 | PRINT_ERR("fnctl F_GETFL failed: %s\n", strerror(errno)); 282 | } 283 | if (fcntl(fd, F_SETFL, flags | O_NONBLOCK) == -1) { 284 | PRINT_ERR("fnctl F_SETFL failed: %s\n", strerror(errno)); 285 | } 286 | 287 | // we stop existing logging 288 | if (eventLogStatus() == EVENTLOG_RUNNING) { 289 | endEventLogging(); 290 | } 291 | 292 | // we got client_id now. 293 | pthread_mutex_lock(&mutex); 294 | client_fd = fd; 295 | // Drop lock to allow initial batch of events to be written. 296 | pthread_mutex_unlock(&mutex); 297 | 298 | // start writing 299 | startEventLogging(&socket_writer); 300 | 301 | // Announce new connection 302 | pthread_cond_broadcast(&new_conn_cond); 303 | 304 | // we are done. 305 | } 306 | 307 | // nothing to write iteration. 308 | // 309 | // we poll only for whether the connection is closed. 310 | static void nonwrite_iteration(int fd) { 311 | DEBUG_ERR("(%d)\n", fd); 312 | 313 | // Wait for socket to disconnect 314 | struct pollfd pfd = { 315 | .fd = fd, 316 | .events = POLLRDHUP, 317 | .revents = 0, 318 | }; 319 | 320 | int ret = poll(&pfd, 1, POLL_WRITE_TIMEOUT); 321 | if (ret == -1 && errno != EAGAIN) { 322 | // error 323 | PRINT_ERR("poll() failed: %s\n", strerror(errno)); 324 | return; 325 | } else if (ret == 0) { 326 | // timeout 327 | return; 328 | } 329 | 330 | // reset client_fd on RDHUP. 331 | if (pfd.revents | POLLRDHUP) { 332 | DEBUG_ERR("(%d) POLLRDHUP\n", fd); 333 | 334 | // reset client_fd 335 | pthread_mutex_lock(&mutex); 336 | // note: writer_stop may close the connection as well. 337 | client_fd = -1; 338 | write_buffer_free(&wt); 339 | pthread_mutex_unlock(&mutex); 340 | return; 341 | } 342 | 343 | // we don't stop logging, 344 | // write function will be no-op with negative client_fd 345 | // 346 | // Before setting new client_fd we will stop the logging, 347 | // and restart if afterwards, so the header is written 348 | // to the new connection. 349 | } 350 | 351 | // write iteration. 352 | // 353 | // we poll for both: can we write, and whether the connection is closed. 354 | static void write_iteration(int fd) { 355 | DEBUG_ERR("(%d)\n", fd); 356 | 357 | // Wait for socket to disconnect 358 | struct pollfd pfd = { 359 | .fd = fd, 360 | .events = POLLOUT | POLLRDHUP, 361 | .revents = 0, 362 | }; 363 | 364 | int ret = poll(&pfd, 1, POLL_WRITE_TIMEOUT); 365 | if (ret == -1 && errno != EAGAIN) { 366 | // error 367 | PRINT_ERR("poll() failed: %s\n", strerror(errno)); 368 | return; 369 | } else if (ret == 0) { 370 | // timeout 371 | return; 372 | } 373 | 374 | // reset client_fd on RDHUP. 375 | if (pfd.revents & POLLHUP) { 376 | DEBUG_ERR("(%d) POLLRDHUP\n", fd); 377 | 378 | // reset client_fd 379 | pthread_mutex_lock(&mutex); 380 | assert(fd == client_fd); 381 | client_fd = -1; 382 | write_buffer_free(&wt); 383 | pthread_mutex_unlock(&mutex); 384 | return; 385 | } 386 | 387 | if (pfd.revents & POLLOUT) { 388 | DEBUG_ERR("(%d) POLLOUT\n", fd); 389 | 390 | pthread_mutex_lock(&mutex); 391 | while (wt.head) { 392 | struct write_buffer_item *item = wt.head; 393 | ret = write(client_fd, item->data, item->size); 394 | 395 | if (ret == -1) { 396 | if (errno == EAGAIN || errno == EWOULDBLOCK) { 397 | // couldn't write anything, shouldn't happend. 398 | // do nothing. 399 | } else if (errno == EPIPE) { 400 | client_fd = -1; 401 | write_buffer_free(&wt); 402 | } else { 403 | PRINT_ERR("failed to write: %s\n", strerror(errno)); 404 | } 405 | 406 | // break out of the loop 407 | break; 408 | 409 | } else { 410 | // we wrote something 411 | if (ret >= item->size) { 412 | // we wrote whole element, try to write next element too 413 | write_buffer_pop(&wt); 414 | continue; 415 | } else { 416 | item->size -= ret; 417 | item->data += ret; 418 | break; 419 | } 420 | } 421 | } 422 | pthread_mutex_unlock(&mutex); 423 | } 424 | } 425 | 426 | static void iteration() { 427 | pthread_mutex_lock(&mutex); 428 | int fd = client_fd; 429 | bool empty = wt.head == NULL; 430 | DEBUG_ERR("fd = %d, wt.head = %p\n", fd, wt.head); 431 | pthread_mutex_unlock(&mutex); 432 | 433 | if (fd != -1) { 434 | if (empty) { 435 | nonwrite_iteration(fd); 436 | } else { 437 | write_iteration(fd); 438 | } 439 | } else { 440 | listen_iteration(); 441 | } 442 | } 443 | 444 | /* Main loop of eventlog-socket own thread: 445 | * Currently it is two states: 446 | * - either we have connection, then we poll for writes (and drop of connection). 447 | * - or we don't have, then we poll for accept. 448 | */ 449 | static void *worker(void * _unused) 450 | { 451 | while (true) { 452 | iteration(); 453 | } 454 | 455 | return NULL; // unreachable 456 | } 457 | 458 | /********************************************************************************* 459 | * Initialization 460 | *********************************************************************************/ 461 | 462 | static void open_socket(const char *sock_path) 463 | { 464 | DEBUG_ERR("enter: %s\n", sock_path); 465 | 466 | listen_fd = socket(AF_UNIX, SOCK_STREAM, 0); 467 | 468 | struct sockaddr_un local; 469 | local.sun_family = AF_UNIX; 470 | strncpy(local.sun_path, sock_path, sizeof(local.sun_path) - 1); 471 | unlink(sock_path); 472 | if (bind(listen_fd, (struct sockaddr *) &local, 473 | sizeof(struct sockaddr_un)) == -1) { 474 | PRINT_ERR("failed to bind socket %s: %s\n", sock_path, strerror(errno)); 475 | abort(); 476 | } 477 | 478 | int ret = pthread_create(&listen_thread, NULL, worker, NULL); 479 | if (ret != 0) { 480 | PRINT_ERR("failed to spawn thread: %s\n", strerror(ret)); 481 | abort(); 482 | } 483 | } 484 | 485 | 486 | /********************************************************************************* 487 | * Public interface 488 | *********************************************************************************/ 489 | 490 | void eventlog_socket_wait(void) 491 | { 492 | pthread_mutex_lock(&mutex); 493 | while (client_fd == -1) { 494 | int ret = pthread_cond_wait(&new_conn_cond, &mutex); 495 | if (ret != 0) { 496 | PRINT_ERR("failed to wait on condition variable: %s\n", strerror(ret)); 497 | } 498 | } 499 | pthread_mutex_unlock(&mutex); 500 | } 501 | 502 | void eventlog_socket_start(const char *sock_path, bool wait) 503 | { 504 | if (!initialized) { 505 | pthread_mutex_init(&mutex, NULL); 506 | pthread_cond_init(&new_conn_cond, NULL); 507 | initialized = true; 508 | } 509 | 510 | if (!sock_path) 511 | return; 512 | 513 | if (eventLogStatus() == EVENTLOG_NOT_SUPPORTED) { 514 | PRINT_ERR("eventlog is not supported.\n"); 515 | return; 516 | } 517 | 518 | // we stop existing logging 519 | if (eventLogStatus() == EVENTLOG_RUNNING) { 520 | endEventLogging(); 521 | } 522 | 523 | // ... and restart with outer socket writer, 524 | // which is no-op so far. 525 | // 526 | // This trickery is to avoid 527 | // 528 | // printAndClearEventLog: could not flush event log 529 | // 530 | // warning messages from showing up in stderr. 531 | startEventLogging(&socket_writer); 532 | 533 | open_socket(sock_path); 534 | if (wait) { 535 | DEBUG_ERR("ghc-eventlog-socket: Waiting for connection to %s...\n", sock_path); 536 | eventlog_socket_wait(); 537 | } 538 | } 539 | 540 | -------------------------------------------------------------------------------- /eventlog-socket.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 2.2 2 | name: eventlog-socket 3 | version: 0.1.0.0 4 | synopsis: Stream GHC eventlog events to external processes 5 | description: Stream GHC eventlog events to external processes. 6 | license: BSD-3-Clause 7 | license-file: LICENSE 8 | author: Ben Gamari 9 | maintainer: ben@smart-cactus.org 10 | copyright: (c) 2018 Ben Gamari 11 | category: System 12 | build-type: Simple 13 | Tested-With: GHC ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.4 || ==9.6.1 14 | extra-source-files: 15 | ChangeLog.md 16 | include/eventlog_socket.h 17 | 18 | source-repository head 19 | type: git 20 | location: https://github.com/bgamari/ghc-eventlog-socket.git 21 | 22 | library 23 | exposed-modules: GHC.Eventlog.Socket 24 | other-extensions: CApiFFI 25 | 26 | -- Use base lower bound as proxy for GHC >= 8.10 27 | build-depends: base >=4.14 && <5 28 | hs-source-dirs: src 29 | default-language: Haskell2010 30 | c-sources: cbits/eventlog_socket.c 31 | include-dirs: include/ 32 | 33 | -- comment me out while debugging 34 | -- https://github.com/haskell/cabal/issues/7635 35 | cc-options: -DNDEBUG=1 36 | -------------------------------------------------------------------------------- /include/eventlog_socket.h: -------------------------------------------------------------------------------- 1 | #ifndef EVENGLOG_SOCKET_H 2 | #define EVENGLOG_SOCKET_H 3 | 4 | void eventlog_socket_wait(void); 5 | void eventlog_socket_start(const char *sock_path, bool wait); 6 | 7 | #endif 8 | -------------------------------------------------------------------------------- /src/GHC/Eventlog/Socket.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CApiFFI #-} 2 | 3 | -- | 4 | -- Stream GHC eventlog events to external processes. 5 | module GHC.Eventlog.Socket ( 6 | startWait, 7 | start, 8 | wait, 9 | ) where 10 | 11 | import Foreign.C 12 | import Foreign.Ptr 13 | 14 | -- | Start listening for eventlog connections, blocking until a client connects. 15 | startWait :: FilePath -- ^ File path to the unix domain socket to create. 16 | -> IO () 17 | startWait = c_start' True 18 | 19 | -- | Start listening for eventlog connections. 20 | start :: FilePath -- ^ File path to the unix domain socket to create. 21 | -> IO () 22 | start = c_start' False 23 | 24 | -- | Wait (block) until a client connects. 25 | wait :: IO () 26 | wait = c_wait 27 | 28 | c_start' :: Bool -> FilePath -> IO () 29 | c_start' block socketPath = 30 | withCString socketPath $ \socketPathCString -> 31 | c_start socketPathCString block 32 | 33 | foreign import capi safe "eventlog_socket.h eventlog_socket_start" 34 | c_start :: CString -> Bool -> IO () 35 | 36 | foreign import capi safe "eventlog_socket.h eventlog_socket_wait" 37 | c_wait :: IO () 38 | --------------------------------------------------------------------------------