diff options
| -rw-r--r-- | guix/scripts/offload.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/publish.scm | 11 | ||||
| -rwxr-xr-x | guix/scripts/substitute.scm | 4 | ||||
| -rw-r--r-- | guix/workers.scm | 18 |
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) |