substitute: Honor the number of columns of the client terminal.

* guix/store.scm (set-build-options): Add #:terminal-columns parameter
and honor it.
* guix/scripts/substitute.scm (client-terminal-columns): New procedure.
(guix-substitute): Use it to parameterize 'current-terminal-columns'.
This commit is contained in:
Ludovic Courtès 2016-04-15 00:10:22 +02:00
parent cc44fbb8d9
commit b0a6a97130
2 changed files with 25 additions and 5 deletions

View File

@ -31,7 +31,8 @@
#:use-module (guix pki) #:use-module (guix pki)
#:use-module ((guix build utils) #:select (mkdir-p dump-port)) #:use-module ((guix build utils) #:select (mkdir-p dump-port))
#:use-module ((guix build download) #:use-module ((guix build download)
#:select (progress-proc uri-abbreviation #:select (current-terminal-columns
progress-proc uri-abbreviation
open-connection-for-uri open-connection-for-uri
close-connection close-connection
store-path-abbreviation byte-count->string)) store-path-abbreviation byte-count->string))
@ -973,6 +974,14 @@ found."
;; daemon. ;; daemon.
'("http://hydra.gnu.org")))) '("http://hydra.gnu.org"))))
(define (client-terminal-columns)
"Return the number of columns in the client's terminal, if it is known, or a
default value."
(or (and=> (or (find-daemon-option "untrusted-terminal-columns")
(find-daemon-option "terminal-columns"))
string->number)
80))
(define (guix-substitute . args) (define (guix-substitute . args)
"Implement the build daemon's substituter protocol." "Implement the build daemon's substituter protocol."
(mkdir-p %narinfo-cache-directory) (mkdir-p %narinfo-cache-directory)
@ -1003,9 +1012,12 @@ found."
(loop (read-line))))))) (loop (read-line)))))))
(("--substitute" store-path destination) (("--substitute" store-path destination)
;; Download STORE-PATH and add store it as a Nar in file DESTINATION. ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
(process-substitution store-path destination ;; Specify the number of columns of the terminal so the progress
#:cache-urls %cache-urls ;; report displays nicely.
#:acl (current-acl))) (parameterize ((current-terminal-columns (client-terminal-columns)))
(process-substitution store-path destination
#:cache-urls %cache-urls
#:acl (current-acl))))
(("--version") (("--version")
(show-version-and-exit "guix substitute")) (show-version-and-exit "guix substitute"))
(("--help") (("--help")

View File

@ -22,6 +22,7 @@
#:use-module (guix serialization) #:use-module (guix serialization)
#:use-module (guix monads) #:use-module (guix monads)
#:autoload (guix base32) (bytevector->base32-string) #:autoload (guix base32) (bytevector->base32-string)
#:autoload (guix build syscalls) (terminal-columns)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -530,7 +531,10 @@ encoding conversion errors."
;; the daemon's settings are used. Otherwise, it ;; the daemon's settings are used. Otherwise, it
;; overrides the daemons settings; see 'guix ;; overrides the daemons settings; see 'guix
;; substitute'. ;; substitute'.
(substitute-urls #f)) (substitute-urls #f)
;; Number of columns in the client's terminal.
(terminal-columns (terminal-columns)))
;; Must be called after `open-connection'. ;; Must be called after `open-connection'.
(define socket (define socket
@ -565,6 +569,10 @@ encoding conversion errors."
,@(if rounds ,@(if rounds
`(("build-repeat" `(("build-repeat"
. ,(number->string (max 0 (1- rounds))))) . ,(number->string (max 0 (1- rounds)))))
'())
,@(if terminal-columns
`(("terminal-columns"
. ,(number->string terminal-columns)))
'())))) '()))))
(send (string-pairs pairs)))) (send (string-pairs pairs))))
(let loop ((done? (process-stderr server))) (let loop ((done? (process-stderr server)))