From 8902d0f2676a500c785044fff54b8675f96cef6d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 28 May 2017 16:09:32 +0200
Subject: 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.
---
 guix/scripts/publish.scm | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

(limited to 'guix/scripts/publish.scm')

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))))))
-- 
cgit v1.2.3