From b3733bca21de607fd7a70319e66e3ff49996a974 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 15 Feb 2021 18:52:44 +0000
Subject: Avoid some threads and locks when running on the hurd

I've see the process hang on the hurd, and I think this might help.
---
 guix-build-coordinator/agent-messaging/http.scm |  4 +++-
 guix-build-coordinator/agent.scm                | 29 +++++++++++++------------
 guix-build-coordinator/utils.scm                | 10 ++++++++-
 3 files changed, 27 insertions(+), 16 deletions(-)

(limited to 'guix-build-coordinator')

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 27e2419..1f2df0a 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -85,7 +85,9 @@
                     (string-drop agent-path 1))))))
 
 (define (with-request-mutex thunk)
-  (monitor (thunk)))
+  (if (running-on-the-hurd?)
+      (thunk)
+      (monitor (thunk))))
 
 (define (default-log level . components)
   (apply log-msg level components))
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index d970a24..ed2adb2 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -210,20 +210,21 @@
          (process-job-with-queue job-args))
        (vector->list (assoc-ref details "builds")))
 
-      (call-with-new-thread
-       (lambda ()
-         (sigaction SIGUSR1
-           (lambda _
-             (display-info)))
-
-         (while #t (sleep 100000))))
-
-      (call-with-new-thread
-       (lambda ()
-         (let loop ((line (get-line (current-input-port))))
-           (unless (eof-object? line)
-             (display-info)
-             (loop (get-line (current-input-port)))))))
+      (unless (running-on-the-hurd?)
+        (call-with-new-thread
+         (lambda ()
+           (sigaction SIGUSR1
+             (lambda _
+               (display-info)))
+
+           (while #t (sleep 100000))))
+
+        (call-with-new-thread
+         (lambda ()
+           (let loop ((line (get-line (current-input-port))))
+             (unless (eof-object? line)
+               (display-info)
+               (loop (get-line (current-input-port))))))))
 
       (while #t
         (let ((current-threads (count-threads))
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index 20cf007..e29be18 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -54,7 +54,9 @@
 
             with-timeout
 
-            get-load-average))
+            get-load-average
+
+            running-on-the-hurd?))
 
 (eval-when (eval load compile)
   (begin
@@ -803,3 +805,9 @@ again."
              ((= period 5) 5min)
              ((= period 15) 15min))))))
       #f))
+
+(define (running-on-the-hurd?)
+  (let ((cached-system #f))
+    (unless cached-system
+      (set! cached-system (utsname:sysname (uname))))
+    (string=? cached-system "GNU")))
-- 
cgit v1.2.3