aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-05-28 16:09:32 +0200
committerLudovic Courtès <ludo@gnu.org>2017-05-28 23:13:39 +0200
commit8902d0f2676a500c785044fff54b8675f96cef6d (patch)
treeb69c8334af7c9c9c5839a6fd00a4f04297632e8a
parentaa401f9ba6410095370ce0c4e5a01c02203a2b9f (diff)
downloadguix-8902d0f2676a500c785044fff54b8675f96cef6d.tar
guix-8902d0f2676a500c785044fff54b8675f96cef6d.tar.gz
scripts: Set thread names.
This allows 'guix publish' threads as well as 'guix substitute' and 'guix offload' processes to be properly labeled in 'top', 'pstree', etc. * guix/workers.scm (worker-thunk): Add #:thread-name parameter and honor it. (make-pool): Likewise. * guix/scripts/publish.scm (http-write): Add calls to 'set-thread-name' in bodies of 'call-with-new-thread'. (guix-publish): Call 'set-thread-name'. Pass #:thread-name to 'make-pool'. * guix/scripts/offload.scm (guix-offload): Call 'set-thread-name'. * guix/scripts/substitute.scm (guix-substitute): Likewise.
-rw-r--r--guix/scripts/offload.scm4
-rw-r--r--guix/scripts/publish.scm11
-rwxr-xr-xguix/scripts/substitute.scm4
-rw-r--r--guix/workers.scm18
4 files changed, 31 insertions, 6 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 74c0c5484c..77b340cff6 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -34,7 +34,8 @@
#:select (nar-error? nar-error-file))
#:use-module (guix nar)
#:use-module (guix utils)
- #:use-module ((guix build syscalls) #:select (fcntl-flock))
+ #:use-module ((guix build syscalls)
+ #:select (fcntl-flock set-thread-name))
#:use-module ((guix build utils) #:select (which mkdir-p))
#:use-module (guix ui)
#:use-module (srfi srfi-1)
@@ -641,6 +642,7 @@ machine."
(let ((max-silent-time (string->number max-silent-time))
(build-timeout (string->number build-timeout))
(print-build-trace? (string=? print-build-trace? "1")))
+ (set-thread-name "guix offload")
(parameterize ((%current-system system))
(let loop ((line (read-line)))
(unless (eof-object? line)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index c306b809a7..c49c0c3e20 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -58,6 +58,7 @@
#:select (with-atomic-file-output compressed-file?))
#:use-module ((guix build utils)
#:select (dump-port mkdir-p find-files))
+ #:use-module ((guix build syscalls) #:select (set-thread-name))
#:export (%public-key
%private-key
@@ -649,6 +650,7 @@ blocking."
;; thread so that the main thread can keep working in the meantime.
(call-with-new-thread
(lambda ()
+ (set-thread-name "publish nar")
(let* ((response (write-response (sans-content-length response)
client))
(port (begin
@@ -670,6 +672,7 @@ blocking."
;; Send a raw file in a separate thread.
(call-with-new-thread
(lambda ()
+ (set-thread-name "publish file")
(catch 'system-error
(lambda ()
(call-with-input-file (utf8->string body)
@@ -858,10 +861,16 @@ consider using the '--user' option!~%")))
(sockaddr:port address))
(when repl-port
(repl:spawn-server (repl:make-tcp-server-socket #:port repl-port)))
+
+ ;; Set the name of the main thread.
+ (set-thread-name "guix publish")
+
(with-store store
(run-publish-server socket store
#:cache cache
- #:pool (and cache (make-pool workers))
+ #:pool (and cache (make-pool workers
+ #:thread-name
+ "publish worker"))
#:nar-path nar-path
#:compression compression
#:narinfo-ttl ttl))))))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 73d4f6e2eb..4ee15ba67d 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -39,6 +39,8 @@
. guix:open-connection-for-uri)
close-connection
store-path-abbreviation byte-count->string))
+ #:use-module ((guix build syscalls)
+ #:select (set-thread-name))
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
@@ -1015,6 +1017,8 @@ default value."
(#f #f)
(locale (false-if-exception (setlocale LC_ALL locale))))
+ (set-thread-name "guix substitute")
+
(with-networking
(with-error-handling ; for signature errors
(match args
diff --git a/guix/workers.scm b/guix/workers.scm
index e3452d249a..846f5e50a9 100644
--- a/guix/workers.scm
+++ b/guix/workers.scm
@@ -23,6 +23,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
+ #:use-module ((guix build syscalls) #:select (set-thread-name))
#:export (pool?
make-pool
pool-enqueue!
@@ -60,7 +61,8 @@
(lambda ()
(lock-mutex mutex))))
-(define (worker-thunk mutex condvar pop-queue)
+(define* (worker-thunk mutex condvar pop-queue
+ #:key (thread-name "guix worker"))
"Return the thunk executed by worker threads."
(define (loop)
(match (pop-queue)
@@ -80,11 +82,18 @@
(loop))
(lambda ()
+ (catch 'system-error
+ (lambda ()
+ (set-thread-name thread-name))
+ (const #f))
+
(with-mutex mutex
(loop))))
-(define* (make-pool #:optional (count (current-processor-count)))
- "Return a pool of COUNT workers."
+(define* (make-pool #:optional (count (current-processor-count))
+ #:key (thread-name "guix worker"))
+ "Return a pool of COUNT workers. Use THREAD-NAME as the name of these
+threads as reported by the operating system."
(let* ((mutex (make-mutex))
(condvar (make-condition-variable))
(queue (make-q))
@@ -93,7 +102,8 @@
(worker-thunk mutex condvar
(lambda ()
(and (not (q-empty? queue))
- (q-pop! queue)))))
+ (q-pop! queue)))
+ #:thread-name thread-name))
1+
0))
(threads (map (lambda (proc)