summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-01-07 10:57:18 +0100
committerLudovic Courtès <ludo@gnu.org>2019-01-09 14:47:53 +0100
commit76832d3420594c8b5feaf7682b84b5481a49a076 (patch)
tree262f1f36a3773710cf02106f094982004d497921
parentc3d9bca48a95a535a26eda38707dcd9798400ff3 (diff)
Remove most uses of the _IO*F constants.
These constants, for use with 'setvbuf', were deprecated in Guile 2.2 and disappeared in Guile 3.0. Here we keep these constants in build-side code where removing them is not feasible. * guix/build/download-nar.scm (download-nar): Adjust 'setvbuf' calls to the Guile 2.2+ API. * guix/build/download.scm (open-socket-for-uri): Likewise. (open-connection-for-uri, url-fetch): Likewise. * guix/build/make-bootstrap.scm (make-stripped-libc): Likewise. * guix/build/union.scm (setvbuf) [guile-2.0]: New conditional wrapper. (union-build): Adjust to new API. * guix/ftp-client.scm (ftp-open, ftp-list, ftp-retr): Likewise. * guix/http-client.scm (http-fetch): Likewise. * guix/inferior.scm (proxy): Likewise. * guix/scripts/substitute.scm (fetch, http-multiple-get): Likewise. * guix/self.scm (compiled-modules): Likewise. * guix/ssh.scm (remote-daemon-channel, store-import-channel) (store-export-channel): Likewise. * guix/ui.scm (initialize-guix): Likewise. * tests/publish.scm (http-get-port): Likewise. * guix/store.scm (%newlines): Adjust comment.
-rw-r--r--guix/build/download-nar.scm6
-rw-r--r--guix/build/download.scm10
-rw-r--r--guix/build/make-bootstrap.scm4
-rw-r--r--guix/build/union.scm21
-rw-r--r--guix/ftp-client.scm8
-rw-r--r--guix/http-client.scm2
-rw-r--r--guix/inferior.scm4
-rwxr-xr-xguix/scripts/substitute.scm6
-rw-r--r--guix/self.scm6
-rw-r--r--guix/ssh.scm12
-rw-r--r--guix/store.scm2
-rw-r--r--guix/ui.scm4
-rw-r--r--tests/publish.scm6
13 files changed, 52 insertions, 39 deletions
diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm
index 13f01fb1e85..681f22238de 100644
--- a/guix/build/download-nar.scm
+++ b/guix/build/download-nar.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2017, 2019 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -93,8 +93,8 @@ ITEM."
93 "Download and extract the normalized archive for ITEM. Return #t on 93 "Download and extract the normalized archive for ITEM. Return #t on
94success, #f otherwise." 94success, #f otherwise."
95 ;; Let progress reports go through. 95 ;; Let progress reports go through.
96 (setvbuf (current-error-port) _IONBF) 96 (setvbuf (current-error-port) 'none)
97 (setvbuf (current-output-port) _IONBF) 97 (setvbuf (current-output-port) 'none)
98 98
99 (let loop ((urls (urls-for-item item))) 99 (let loop ((urls (urls-for-item item)))
100 (match urls 100 (match urls
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 24b5aa378ff..c08221b3b2e 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -357,7 +357,7 @@ ETIMEDOUT error is raised."
357 (connect* s (addrinfo:addr ai) timeout) 357 (connect* s (addrinfo:addr ai) timeout)
358 358
359 ;; Buffer input and output on this port. 359 ;; Buffer input and output on this port.
360 (setvbuf s _IOFBF) 360 (setvbuf s 'block)
361 ;; If we're using a proxy, make a note of that. 361 ;; If we're using a proxy, make a note of that.
362 (when http-proxy (set-http-proxy-port?! s #t)) 362 (when http-proxy (set-http-proxy-port?! s #t))
363 s) 363 s)
@@ -401,7 +401,7 @@ VERIFY-CERTIFICATE? is true, verify HTTPS server certificates."
401 (with-https-proxy 401 (with-https-proxy
402 (let ((s (open-socket-for-uri uri #:timeout timeout))) 402 (let ((s (open-socket-for-uri uri #:timeout timeout)))
403 ;; Buffer input and output on this port. 403 ;; Buffer input and output on this port.
404 (setvbuf s _IOFBF %http-receive-buffer-size) 404 (setvbuf s 'block %http-receive-buffer-size)
405 405
406 (if https? 406 (if https?
407 (tls-wrap s (uri-host uri) 407 (tls-wrap s (uri-host uri)
@@ -777,11 +777,11 @@ otherwise simply ignore them."
777 hashes)) 777 hashes))
778 content-addressed-mirrors)) 778 content-addressed-mirrors))
779 779
780 ;; Make this unbuffered so 'progress-report/file' works as expected. _IOLBF 780 ;; Make this unbuffered so 'progress-report/file' works as expected. 'line
781 ;; means '\n', not '\r', so it's not appropriate here. 781 ;; means '\n', not '\r', so it's not appropriate here.
782 (setvbuf (current-output-port) _IONBF) 782 (setvbuf (current-output-port) 'none)
783 783
784 (setvbuf (current-error-port) _IOLBF) 784 (setvbuf (current-error-port) 'line)
785 785
786 (let try ((uri (append uri content-addressed-uris))) 786 (let try ((uri (append uri content-addressed-uris)))
787 (match uri 787 (match uri
diff --git a/guix/build/make-bootstrap.scm b/guix/build/make-bootstrap.scm
index 43b136248fa..48799f7e906 100644
--- a/guix/build/make-bootstrap.scm
+++ b/guix/build/make-bootstrap.scm
@@ -1,6 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2015, 2017 Manolis Fragkiskos Ragkousis <manolis837@gmail.com> 2;;; Copyright © 2015, 2017 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
3;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> 3;;; Copyright © 2015, 2019 Ludovic Courtès <ludo@gnu.org>
4;;; 4;;;
5;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
6;;; 6;;;
@@ -67,7 +67,7 @@ when producing a bootstrap libc."
67util).*\\.so(\\..*)?|lib(machuser|hurduser).so.*|(libc(rt|)|libpthread)\ 67util).*\\.so(\\..*)?|lib(machuser|hurduser).so.*|(libc(rt|)|libpthread)\
68_nonshared\\.a)$") 68_nonshared\\.a)$")
69 69
70 (setvbuf (current-output-port) _IOLBF) 70 (setvbuf (current-output-port) 'line)
71 (let* ((libdir (string-append output "/lib"))) 71 (let* ((libdir (string-append output "/lib")))
72 (mkdir-p libdir) 72 (mkdir-p libdir)
73 (for-each (lambda (file) 73 (for-each (lambda (file)
diff --git a/guix/build/union.scm b/guix/build/union.scm
index fff795c4d37..961ac3298bc 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> 3;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
4;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com> 4;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
5;;; 5;;;
@@ -39,6 +39,19 @@
39;;; 39;;;
40;;; Code: 40;;; Code:
41 41
42;; This code can be used with the bootstrap Guile, which is Guile 2.0, so
43;; provide a compatibility layer.
44(cond-expand
45 ((and guile-2 (not guile-2.2))
46 (define (setvbuf port mode . rest)
47 (apply (@ (guile) setvbuf) port
48 (match mode
49 ('line _IOLBF)
50 ('block _IOFBF)
51 ('none _IONBF))
52 rest)))
53 (else #f))
54
42(define (files-in-directory dirname) 55(define (files-in-directory dirname)
43 (let ((dir (opendir dirname))) 56 (let ((dir (opendir dirname)))
44 (let loop ((files '())) 57 (let loop ((files '()))
@@ -179,10 +192,10 @@ returns #f, skip the faulty file altogether."
179 (reverse dirs-with-file)))) 192 (reverse dirs-with-file))))
180 table))) 193 table)))
181 194
182 (setvbuf (current-output-port) _IOLBF) 195 (setvbuf (current-output-port) 'line)
183 (setvbuf (current-error-port) _IOLBF) 196 (setvbuf (current-error-port) 'line)
184 (when (file-port? log-port) 197 (when (file-port? log-port)
185 (setvbuf log-port _IOLBF)) 198 (setvbuf log-port 'line))
186 199
187 (union-of-directories output (delete-duplicates inputs))) 200 (union-of-directories output (delete-duplicates inputs)))
188 201
diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm
index 0b8f61c2765..8d5adcb8ed6 100644
--- a/guix/ftp-client.scm
+++ b/guix/ftp-client.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -154,7 +154,7 @@ TIMEOUT, an ETIMEDOUT error is raised."
154 (catch 'system-error 154 (catch 'system-error
155 (lambda () 155 (lambda ()
156 (connect* s (addrinfo:addr ai) timeout) 156 (connect* s (addrinfo:addr ai) timeout)
157 (setvbuf s _IOLBF) 157 (setvbuf s 'line)
158 (let-values (((code message) (%ftp-listen s))) 158 (let-values (((code message) (%ftp-listen s)))
159 (if (eqv? code 220) 159 (if (eqv? code 220)
160 (begin 160 (begin
@@ -237,7 +237,7 @@ TIMEOUT, an ETIMEDOUT error is raised."
237 (s (socket (addrinfo:fam ai) (addrinfo:socktype ai) 237 (s (socket (addrinfo:fam ai) (addrinfo:socktype ai)
238 (addrinfo:protocol ai)))) 238 (addrinfo:protocol ai))))
239 (connect* s (address-with-port (addrinfo:addr ai) port) timeout) 239 (connect* s (address-with-port (addrinfo:addr ai) port) timeout)
240 (setvbuf s _IOLBF) 240 (setvbuf s 'line)
241 241
242 (dynamic-wind 242 (dynamic-wind
243 (lambda () #t) 243 (lambda () #t)
@@ -293,7 +293,7 @@ must be closed before CONN can be used for other purposes."
293 (throw 'ftp-error conn "LIST" code message)))) 293 (throw 'ftp-error conn "LIST" code message))))
294 294
295 (connect* s (address-with-port (addrinfo:addr ai) port) timeout) 295 (connect* s (address-with-port (addrinfo:addr ai) port) timeout)
296 (setvbuf s _IOLBF) 296 (setvbuf s 'line)
297 297
298 (%ftp-command (string-append "RETR " file) 298 (%ftp-command (string-append "RETR " file)
299 150 (ftp-connection-socket conn)) 299 150 (ftp-connection-socket conn))
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 07360e61080..067002a79ab 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -97,7 +97,7 @@ Raise an '&http-get-error' condition if downloading fails."
97 headers)) 97 headers))
98 (_ headers)))) 98 (_ headers))))
99 (unless (or buffered? (not (file-port? port))) 99 (unless (or buffered? (not (file-port? port)))
100 (setvbuf port _IONBF)) 100 (setvbuf port 'none))
101 (let*-values (((resp data) 101 (let*-values (((resp data)
102 (http-get uri #:streaming? #t #:port port 102 (http-get uri #:streaming? #t #:port port
103 #:keep-alive? #t 103 #:keep-alive? #t
diff --git a/guix/inferior.scm b/guix/inferior.scm
index a6e6d2f16e2..ba8d00866b3 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -389,8 +389,8 @@ input/output ports.)"
389 389
390 ;; Use buffered ports so that 'get-bytevector-some' returns up to the 390 ;; Use buffered ports so that 'get-bytevector-some' returns up to the
391 ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>. 391 ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>.
392 (setvbuf client _IOFBF 65536) 392 (setvbuf client 'block 65536)
393 (setvbuf backend _IOFBF 65536) 393 (setvbuf backend 'block 65536)
394 394
395 (let loop () 395 (let loop ()
396 (match (select* (list client backend) '() '()) 396 (match (select* (list client backend) '() '())
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 53b17772410..797a76db3fd 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> 3;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
4;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> 4;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
5;;; 5;;;
@@ -219,7 +219,7 @@ provide."
219 (set! port (guix:open-connection-for-uri 219 (set! port (guix:open-connection-for-uri
220 uri #:verify-certificate? #f)) 220 uri #:verify-certificate? #f))
221 (unless (or buffered? (not (file-port? port))) 221 (unless (or buffered? (not (file-port? port)))
222 (setvbuf port _IONBF))) 222 (setvbuf port 'none)))
223 (http-fetch uri #:text? #f #:port port 223 (http-fetch uri #:text? #f #:port port
224 #:verify-certificate? #f)))))) 224 #:verify-certificate? #f))))))
225 (else 225 (else
@@ -567,7 +567,7 @@ initial connection on which HTTP requests are sent."
567 verify-certificate?)))) 567 verify-certificate?))))
568 ;; For HTTPS, P is not a file port and does not support 'setvbuf'. 568 ;; For HTTPS, P is not a file port and does not support 'setvbuf'.
569 (when (file-port? p) 569 (when (file-port? p)
570 (setvbuf p _IOFBF (expt 2 16))) 570 (setvbuf p 'block (expt 2 16)))
571 571
572 ;; Send REQUESTS, up to a certain number, in a row. 572 ;; Send REQUESTS, up to a certain number, in a row.
573 ;; XXX: Do our own caching to work around inefficiencies when 573 ;; XXX: Do our own caching to work around inefficiencies when
diff --git a/guix/self.scm b/guix/self.scm
index e9a768bc90f..a2ae441d42d 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -904,8 +904,8 @@ containing MODULE-FILES and possibly other files as well."
904 #:report-load report-load 904 #:report-load report-load
905 #:report-compilation report-compilation))) 905 #:report-compilation report-compilation)))
906 906
907 (setvbuf (current-output-port) _IONBF) 907 (setvbuf (current-output-port) 'none)
908 (setvbuf (current-error-port) _IONBF) 908 (setvbuf (current-error-port) 'none)
909 909
910 (set! %load-path (cons #+module-tree %load-path)) 910 (set! %load-path (cons #+module-tree %load-path))
911 (set! %load-path 911 (set! %load-path
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 1ed84066336..d90cb77be04 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -140,12 +140,12 @@ right away."
140 (match (select read write except) 140 (match (select read write except)
141 ((read write except) 141 ((read write except)
142 (select read write except 0)))))) 142 (select read write except 0))))))
143 (setvbuf stdout _IONBF) 143 (setvbuf stdout 'none)
144 144
145 ;; Use buffered ports so that 'get-bytevector-some' returns up to the 145 ;; Use buffered ports so that 'get-bytevector-some' returns up to the
146 ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>. 146 ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>.
147 (setvbuf stdin _IOFBF 65536) 147 (setvbuf stdin 'block 65536)
148 (setvbuf sock _IOFBF 65536) 148 (setvbuf sock 'block 65536)
149 149
150 (connect sock AF_UNIX ,socket-name) 150 (connect sock AF_UNIX ,socket-name)
151 151
@@ -218,7 +218,7 @@ can be written."
218 (consume-input (current-input-port)) 218 (consume-input (current-input-port))
219 (list 'protocol-error (nix-protocol-error-message c)))) 219 (list 'protocol-error (nix-protocol-error-message c))))
220 (with-store store 220 (with-store store
221 (setvbuf (current-input-port) _IONBF) 221 (setvbuf (current-input-port) 'none)
222 (import-paths store (current-input-port)) 222 (import-paths store (current-input-port))
223 '(success)))) 223 '(success))))
224 (lambda args 224 (lambda args
@@ -269,7 +269,7 @@ be read. When RECURSIVE? is true, the closure of FILES is exported."
269 (write '(exporting)) ;we're ready 269 (write '(exporting)) ;we're ready
270 (force-output) 270 (force-output)
271 271
272 (setvbuf (current-output-port) _IONBF) 272 (setvbuf (current-output-port) 'none)
273 (export-paths store files (current-output-port) 273 (export-paths store files (current-output-port)
274 #:recursive? ,recursive?)))))) 274 #:recursive? ,recursive?))))))
275 275
diff --git a/guix/store.scm b/guix/store.scm
index 18838292313..1f88eb2b33f 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -608,7 +608,7 @@ to OUT, using chunks of BUFFER-SIZE bytes."
608 608
609(define %newlines 609(define %newlines
610 ;; Newline characters triggering a flush of 'current-build-output-port'. 610 ;; Newline characters triggering a flush of 'current-build-output-port'.
611 ;; Unlike Guile's _IOLBF, we flush upon #\return so that progress reports 611 ;; Unlike Guile's 'line, we flush upon #\return so that progress reports
612 ;; that use that trick are correctly displayed. 612 ;; that use that trick are correctly displayed.
613 (char-set #\newline #\return)) 613 (char-set #\newline #\return))
614 614
diff --git a/guix/ui.scm b/guix/ui.scm
index f542cd3e3f9..1e089753e1d 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -454,8 +454,8 @@ See the \"Application Setup\" section in the manual, for more info.\n")))))
454 ;; notified via an EPIPE later. 454 ;; notified via an EPIPE later.
455 (sigaction SIGPIPE SIG_IGN) 455 (sigaction SIGPIPE SIG_IGN)
456 456
457 (setvbuf (current-output-port) _IOLBF) 457 (setvbuf (current-output-port) 'line)
458 (setvbuf (current-error-port) _IOLBF)) 458 (setvbuf (current-error-port) 'line))
459 459
460(define* (show-version-and-exit #:optional (command (car (command-line)))) 460(define* (show-version-and-exit #:optional (command (car (command-line))))
461 "Display version information for COMMAND and `(exit 0)'." 461 "Display version information for COMMAND and `(exit 0)'."
diff --git a/tests/publish.scm b/tests/publish.scm
index 79a786e723d..097ac036e0b 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -1,6 +1,6 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2015 David Thompson <davet@gnu.org> 2;;; Copyright © 2015 David Thompson <davet@gnu.org>
3;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> 3;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
4;;; 4;;;
5;;; This file is part of GNU Guix. 5;;; This file is part of GNU Guix.
6;;; 6;;;
@@ -63,12 +63,12 @@
63 (let ((socket (open-socket-for-uri uri))) 63 (let ((socket (open-socket-for-uri uri)))
64 ;; Make sure to use an unbuffered port so that we can then peek at the 64 ;; Make sure to use an unbuffered port so that we can then peek at the
65 ;; underlying file descriptor via 'call-with-gzip-input-port'. 65 ;; underlying file descriptor via 'call-with-gzip-input-port'.
66 (setvbuf socket _IONBF) 66 (setvbuf socket 'none)
67 (call-with-values 67 (call-with-values
68 (lambda () 68 (lambda ()
69 (http-get uri #:port socket #:streaming? #t)) 69 (http-get uri #:port socket #:streaming? #t))
70 (lambda (response port) 70 (lambda (response port)
71 ;; Don't (setvbuf port _IONBF) because of <http://bugs.gnu.org/19610> 71 ;; Don't (setvbuf port 'none) because of <http://bugs.gnu.org/19610>
72 ;; (PORT might be a custom binary input port). 72 ;; (PORT might be a custom binary input port).
73 port)))) 73 port))))
74 74