diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm index 13f01fb1e8..681f22238d 100644 --- a/guix/build/download-nar.scm +++ b/guix/build/download-nar.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès +;;; Copyright © 2017, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -93,8 +93,8 @@ (define (download-nar item) "Download and extract the normalized archive for ITEM. Return #t on success, #f otherwise." ;; Let progress reports go through. - (setvbuf (current-error-port) _IONBF) - (setvbuf (current-output-port) _IONBF) + (setvbuf (current-error-port) 'none) + (setvbuf (current-output-port) 'none) (let loop ((urls (urls-for-item item))) (match urls diff --git a/guix/build/download.scm b/guix/build/download.scm index 24b5aa378f..c08221b3b2 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -357,7 +357,7 @@ (define addresses (connect* s (addrinfo:addr ai) timeout) ;; Buffer input and output on this port. - (setvbuf s _IOFBF) + (setvbuf s 'block) ;; If we're using a proxy, make a note of that. (when http-proxy (set-http-proxy-port?! s #t)) s) @@ -401,7 +401,7 @@ (define https? (with-https-proxy (let ((s (open-socket-for-uri uri #:timeout timeout))) ;; Buffer input and output on this port. - (setvbuf s _IOFBF %http-receive-buffer-size) + (setvbuf s 'block %http-receive-buffer-size) (if https? (tls-wrap s (uri-host uri) @@ -777,11 +777,11 @@ (define content-addressed-uris hashes)) content-addressed-mirrors)) - ;; Make this unbuffered so 'progress-report/file' works as expected. _IOLBF + ;; Make this unbuffered so 'progress-report/file' works as expected. 'line ;; means '\n', not '\r', so it's not appropriate here. - (setvbuf (current-output-port) _IONBF) + (setvbuf (current-output-port) 'none) - (setvbuf (current-error-port) _IOLBF) + (setvbuf (current-error-port) 'line) (let try ((uri (append uri content-addressed-uris))) (match uri diff --git a/guix/build/make-bootstrap.scm b/guix/build/make-bootstrap.scm index 43b136248f..48799f7e90 100644 --- a/guix/build/make-bootstrap.scm +++ b/guix/build/make-bootstrap.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2017 Manolis Fragkiskos Ragkousis -;;; Copyright © 2015 Ludovic Courtès +;;; Copyright © 2015, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -67,7 +67,7 @@ (define %libc-object-files-rx "^(crt.*|ld.*|lib(c|m|dl|rt|pthread|nsl|\ util).*\\.so(\\..*)?|lib(machuser|hurduser).so.*|(libc(rt|)|libpthread)\ _nonshared\\.a)$") - (setvbuf (current-output-port) _IOLBF) + (setvbuf (current-output-port) 'line) (let* ((libdir (string-append output "/lib"))) (mkdir-p libdir) (for-each (lambda (file) diff --git a/guix/build/union.scm b/guix/build/union.scm index fff795c4d3..961ac3298b 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2014 Mark H Weaver ;;; Copyright © 2017 Huang Ying ;;; @@ -39,6 +39,19 @@ (define-module (guix build union) ;;; ;;; Code: +;; This code can be used with the bootstrap Guile, which is Guile 2.0, so +;; provide a compatibility layer. +(cond-expand + ((and guile-2 (not guile-2.2)) + (define (setvbuf port mode . rest) + (apply (@ (guile) setvbuf) port + (match mode + ('line _IOLBF) + ('block _IOFBF) + ('none _IONBF)) + rest))) + (else #f)) + (define (files-in-directory dirname) (let ((dir (opendir dirname))) (let loop ((files '())) @@ -179,10 +192,10 @@ (define (add-to-table! file dir) (reverse dirs-with-file)))) table))) - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) + (setvbuf (current-output-port) 'line) + (setvbuf (current-error-port) 'line) (when (file-port? log-port) - (setvbuf log-port _IOLBF)) + (setvbuf log-port 'line)) (union-of-directories output (delete-duplicates inputs))) diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm index 0b8f61c276..8d5adcb8ed 100644 --- a/guix/ftp-client.scm +++ b/guix/ftp-client.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -154,7 +154,7 @@ (define addresses (catch 'system-error (lambda () (connect* s (addrinfo:addr ai) timeout) - (setvbuf s _IOLBF) + (setvbuf s 'line) (let-values (((code message) (%ftp-listen s))) (if (eqv? code 220) (begin @@ -237,7 +237,7 @@ (define* (ftp-list conn #:optional directory #:key timeout) (s (socket (addrinfo:fam ai) (addrinfo:socktype ai) (addrinfo:protocol ai)))) (connect* s (address-with-port (addrinfo:addr ai) port) timeout) - (setvbuf s _IOLBF) + (setvbuf s 'line) (dynamic-wind (lambda () #t) @@ -293,7 +293,7 @@ (define (terminate) (throw 'ftp-error conn "LIST" code message)))) (connect* s (address-with-port (addrinfo:addr ai) port) timeout) - (setvbuf s _IOLBF) + (setvbuf s 'line) (%ftp-command (string-append "RETR " file) 150 (ftp-connection-socket conn)) diff --git a/guix/http-client.scm b/guix/http-client.scm index 07360e6108..067002a79a 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -97,7 +97,7 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t) headers)) (_ headers)))) (unless (or buffered? (not (file-port? port))) - (setvbuf port _IONBF)) + (setvbuf port 'none)) (let*-values (((resp data) (http-get uri #:streaming? #t #:port port #:keep-alive? #t diff --git a/guix/inferior.scm b/guix/inferior.scm index a6e6d2f16e..ba8d00866b 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -389,8 +389,8 @@ (define (select* read write except) ;; Use buffered ports so that 'get-bytevector-some' returns up to the ;; whole buffer like read(2) would--see . - (setvbuf client _IOFBF 65536) - (setvbuf backend _IOFBF 65536) + (setvbuf client 'block 65536) + (setvbuf backend 'block 65536) (let loop () (match (select* (list client backend) '() '()) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 53b1777241..797a76db3f 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2014 Nikita Karetnikov ;;; Copyright © 2018 Kyle Meyer ;;; @@ -219,7 +219,7 @@ (define* (fetch uri #:key (buffered? #t) (timeout? #t)) (set! port (guix:open-connection-for-uri uri #:verify-certificate? #f)) (unless (or buffered? (not (file-port? port))) - (setvbuf port _IONBF))) + (setvbuf port 'none))) (http-fetch uri #:text? #f #:port port #:verify-certificate? #f)))))) (else @@ -567,7 +567,7 @@ (define* (http-multiple-get base-uri proc seed requests verify-certificate?)))) ;; For HTTPS, P is not a file port and does not support 'setvbuf'. (when (file-port? p) - (setvbuf p _IOFBF (expt 2 16))) + (setvbuf p 'block (expt 2 16))) ;; Send REQUESTS, up to a certain number, in a row. ;; XXX: Do our own caching to work around inefficiencies when diff --git a/guix/self.scm b/guix/self.scm index e9a768bc90..a2ae441d42 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2018 Ludovic Courtès +;;; Copyright © 2017, 2018, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -904,8 +904,8 @@ (define (process-directory directory files output) #:report-load report-load #:report-compilation report-compilation))) - (setvbuf (current-output-port) _IONBF) - (setvbuf (current-error-port) _IONBF) + (setvbuf (current-output-port) 'none) + (setvbuf (current-error-port) 'none) (set! %load-path (cons #+module-tree %load-path)) (set! %load-path diff --git a/guix/ssh.scm b/guix/ssh.scm index 1ed8406633..d90cb77be0 100644 --- a/guix/ssh.scm +++ b/guix/ssh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -140,12 +140,12 @@ (define redirect (match (select read write except) ((read write except) (select read write except 0)))))) - (setvbuf stdout _IONBF) + (setvbuf stdout 'none) ;; Use buffered ports so that 'get-bytevector-some' returns up to the ;; whole buffer like read(2) would--see . - (setvbuf stdin _IOFBF 65536) - (setvbuf sock _IOFBF 65536) + (setvbuf stdin 'block 65536) + (setvbuf sock 'block 65536) (connect sock AF_UNIX ,socket-name) @@ -218,7 +218,7 @@ (define (consume-input port) (consume-input (current-input-port)) (list 'protocol-error (nix-protocol-error-message c)))) (with-store store - (setvbuf (current-input-port) _IONBF) + (setvbuf (current-input-port) 'none) (import-paths store (current-input-port)) '(success)))) (lambda args @@ -269,7 +269,7 @@ (define export (write '(exporting)) ;we're ready (force-output) - (setvbuf (current-output-port) _IONBF) + (setvbuf (current-output-port) 'none) (export-paths store files (current-output-port) #:recursive? ,recursive?)))))) diff --git a/guix/store.scm b/guix/store.scm index 1883829231..1f88eb2b33 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -608,7 +608,7 @@ (define buffer (define %newlines ;; Newline characters triggering a flush of 'current-build-output-port'. - ;; Unlike Guile's _IOLBF, we flush upon #\return so that progress reports + ;; Unlike Guile's 'line, we flush upon #\return so that progress reports ;; that use that trick are correctly displayed. (char-set #\newline #\return)) diff --git a/guix/ui.scm b/guix/ui.scm index f542cd3e3f..1e089753e1 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -454,8 +454,8 @@ (define (initialize-guix) ;; notified via an EPIPE later. (sigaction SIGPIPE SIG_IGN) - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF)) + (setvbuf (current-output-port) 'line) + (setvbuf (current-error-port) 'line)) (define* (show-version-and-exit #:optional (command (car (command-line)))) "Display version information for COMMAND and `(exit 0)'." diff --git a/tests/publish.scm b/tests/publish.scm index 79a786e723..097ac036e0 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson -;;; Copyright © 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -63,12 +63,12 @@ (define (http-get-port uri) (let ((socket (open-socket-for-uri uri))) ;; Make sure to use an unbuffered port so that we can then peek at the ;; underlying file descriptor via 'call-with-gzip-input-port'. - (setvbuf socket _IONBF) + (setvbuf socket 'none) (call-with-values (lambda () (http-get uri #:port socket #:streaming? #t)) (lambda (response port) - ;; Don't (setvbuf port _IONBF) because of + ;; Don't (setvbuf port 'none) because of ;; (PORT might be a custom binary input port). port))))