diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/gc.scm | 8 | ||||
| -rw-r--r-- | guix/scripts/offload.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/publish.scm | 11 | ||||
| -rwxr-xr-x | guix/scripts/substitute.scm | 14 |
4 files changed, 21 insertions, 16 deletions
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index 221467a108..0a9719d259 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,7 +20,7 @@ #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix store) - #:autoload (guix build syscalls) (statfs) + #:autoload (guix build syscalls) (free-disk-space) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) @@ -184,9 +184,7 @@ Invoke the garbage collector.\n")) (define (ensure-free-space store space) ;; Attempt to have at least SPACE bytes available in STORE. - (let* ((fs (statfs (%store-prefix))) - (free (* (file-system-block-size fs) - (file-system-blocks-available fs)))) + (let ((free (free-disk-space (%store-prefix)))) (if (> free space) (info (G_ "already ~h bytes available on ~a, nothing to do~%") free (%store-prefix)) 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..71f30030b6 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) @@ -872,15 +874,7 @@ DESTINATION as a nar file. Verify the substitute against ACL." (format #t "~a~%" (narinfo-hash narinfo)) (format (current-error-port) - ;; TRANSLATORS: The second part of this message looks like - ;; "(4.1MiB installed)"; it shows the size of the package once - ;; installed. - (G_ "Downloading ~a~:[~*~; (~a installed)~]...~%") - (uri->string uri) - ;; Use the Nar size as an estimate of the installed size. - (narinfo-size narinfo) - (and=> (narinfo-size narinfo) - (cute byte-count->string <>))) + (G_ "Downloading ~a...~%") (uri->string uri)) (let*-values (((raw download-size) ;; Note that Hydra currently generates Nars on the fly ;; and doesn't specify a Content-Length, so @@ -1015,6 +1009,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 |