summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-12-17 16:19:07 +0100
committerLudovic Courtès <ludo@gnu.org>2020-12-19 23:25:01 +0100
commit4f621a2b003e85d480999e4d0630e9dc3de85bc3 (patch)
tree8e5dda8866dcae4887560e32dae15e1a02267457
parentc7c7f068c15e419aaf5ef616516aa5ad4e55c2fa (diff)
maint: Require Guile >= 2.2.6.
* configure.ac: For Guile 2.2, require 2.2.6 or later. * guix/gexp.scm (define-syntax-parameter-once): Remove. Use 'define-syntax-parameter' instead. * guix/mnoads.scm: Likewise. * guix/inferior.scm (proxy)[select*]: Remove. * guix/scripts/publish.scm <top level>: Remove replacement for (@@ (web http) read-header-line). * guix/store/deduplication.scm (counting-wrapper-port): Remove. (nar-sha256): Call 'port-position' on PORT to compute SIZE.
-rw-r--r--configure.ac2
-rw-r--r--guix/gexp.scm15
-rw-r--r--guix/inferior.scm11
-rw-r--r--guix/monads.scm15
-rw-r--r--guix/scripts/publish.scm26
-rw-r--r--guix/store/deduplication.scm32
6 files changed, 10 insertions, 91 deletions
diff --git a/configure.ac b/configure.ac
index a5bdf24e939..afb449950ff 100644
--- a/configure.ac
+++ b/configure.ac
@@ -102,7 +102,7 @@ if test "x$GUILD" = "x"; then
102fi 102fi
103 103
104if test "x$GUILE_EFFECTIVE_VERSION" = "x2.2"; then 104if test "x$GUILE_EFFECTIVE_VERSION" = "x2.2"; then
105 PKG_CHECK_MODULES([GUILE], [guile-2.2 >= 2.2.3]) 105 PKG_CHECK_MODULES([GUILE], [guile-2.2 >= 2.2.6])
106fi 106fi
107 107
108dnl Get CFLAGS and LDFLAGS for libguile. 108dnl Get CFLAGS and LDFLAGS for libguile.
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 051831238ea..764c89a1873 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1317,18 +1317,7 @@ and in the current monad setting (system type, etc.)"
1317 reference->sexp (gexp-references exp)))) 1317 reference->sexp (gexp-references exp))))
1318 (return (apply (gexp-proc exp) args)))) 1318 (return (apply (gexp-proc exp) args))))
1319 1319
1320(define-syntax-rule (define-syntax-parameter-once name proc) 1320(define-syntax-parameter current-imported-modules
1321 ;; Like 'define-syntax-parameter' but ensure the top-level binding for NAME
1322 ;; does not get redefined. This works around a race condition in a
1323 ;; multi-threaded context with Guile <= 2.2.4: <https://bugs.gnu.org/27476>.
1324 (eval-when (load eval expand compile)
1325 (define name
1326 (if (module-locally-bound? (current-module) 'name)
1327 (module-ref (current-module) 'name)
1328 (make-syntax-transformer 'name 'syntax-parameter
1329 (list proc))))))
1330
1331(define-syntax-parameter-once current-imported-modules
1332 ;; Current list of imported modules. 1321 ;; Current list of imported modules.
1333 (identifier-syntax '())) 1322 (identifier-syntax '()))
1334 1323
@@ -1339,7 +1328,7 @@ environment."
1339 (identifier-syntax modules))) 1328 (identifier-syntax modules)))
1340 body ...)) 1329 body ...))
1341 1330
1342(define-syntax-parameter-once current-imported-extensions 1331(define-syntax-parameter current-imported-extensions
1343 ;; Current list of extensions. 1332 ;; Current list of extensions.
1344 (identifier-syntax '())) 1333 (identifier-syntax '()))
1345 1334
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 77820872b35..2fe91beaabe 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -469,22 +469,13 @@ is similar to the sexp returned by 'package-provenance' for regular packages."
469 "Proxy communication between CLIENT and BACKEND until CLIENT closes the 469 "Proxy communication between CLIENT and BACKEND until CLIENT closes the
470connection, at which point CLIENT is closed (both CLIENT and BACKEND must be 470connection, at which point CLIENT is closed (both CLIENT and BACKEND must be
471input/output ports.)" 471input/output ports.)"
472 (define (select* read write except)
473 ;; This is a workaround for <https://bugs.gnu.org/30365> in Guile < 2.2.4:
474 ;; since 'select' sometimes returns non-empty sets for no good reason,
475 ;; call 'select' a second time with a zero timeout to filter out incorrect
476 ;; replies.
477 (match (select read write except)
478 ((read write except)
479 (select read write except 0))))
480
481 ;; Use buffered ports so that 'get-bytevector-some' returns up to the 472 ;; Use buffered ports so that 'get-bytevector-some' returns up to the
482 ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>. 473 ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>.
483 (setvbuf client 'block 65536) 474 (setvbuf client 'block 65536)
484 (setvbuf backend 'block 65536) 475 (setvbuf backend 'block 65536)
485 476
486 (let loop () 477 (let loop ()
487 (match (select* (list client backend) '() '()) 478 (match (select (list client backend) '() '())
488 ((reads () ()) 479 ((reads () ())
489 (when (memq client reads) 480 (when (memq client reads)
490 (match (get-bytevector-some client) 481 (match (get-bytevector-some client)
diff --git a/guix/monads.scm b/guix/monads.scm
index 6924471345a..6ae616aca93 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -274,23 +274,12 @@ more optimizations."
274 (_ 274 (_
275 #'generic-name)))))))))) 275 #'generic-name))))))))))
276 276
277(define-syntax-rule (define-syntax-parameter-once name proc) 277(define-syntax-parameter >>=
278 ;; Like 'define-syntax-parameter' but ensure the top-level binding for NAME
279 ;; does not get redefined. This works around a race condition in a
280 ;; multi-threaded context with Guile <= 2.2.4: <https://bugs.gnu.org/27476>.
281 (eval-when (load eval expand compile)
282 (define name
283 (if (module-locally-bound? (current-module) 'name)
284 (module-ref (current-module) 'name)
285 (make-syntax-transformer 'name 'syntax-parameter
286 (list proc))))))
287
288(define-syntax-parameter-once >>=
289 ;; The name 'bind' is already taken, so we choose this (obscure) symbol. 278 ;; The name 'bind' is already taken, so we choose this (obscure) symbol.
290 (lambda (s) 279 (lambda (s)
291 (syntax-violation '>>= ">>= (bind) used outside of 'with-monad'" s))) 280 (syntax-violation '>>= ">>= (bind) used outside of 'with-monad'" s)))
292 281
293(define-syntax-parameter-once return 282(define-syntax-parameter return
294 (lambda (s) 283 (lambda (s)
295 (syntax-violation 'return "return used outside of 'with-monad'" s))) 284 (syntax-violation 'return "return used outside of 'with-monad'" s)))
296 285
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index c31cef31818..5a865c838d6 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -824,32 +824,6 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
824(define %http-write 824(define %http-write
825 (@@ (web server http) http-write)) 825 (@@ (web server http) http-write))
826 826
827(match (list (major-version) (minor-version) (micro-version))
828 (("2" "2" "5") ;Guile 2.2.5
829 (let ()
830 (define %read-line (@ (ice-9 rdelim) %read-line))
831 (define bad-header (@@ (web http) bad-header))
832
833 ;; XXX: Work around <https://bugs.gnu.org/36350> by reverting to the
834 ;; definition of 'read-header-line' as found in 2.2.4 and earlier.
835 (define (read-header-line port)
836 "Read an HTTP header line and return it without its final CRLF or LF.
837Raise a 'bad-header' exception if the line does not end in CRLF or LF,
838or if EOF is reached."
839 (match (%read-line port)
840 (((? string? line) . #\newline)
841 ;; '%read-line' does not consider #\return a delimiter; so if it's
842 ;; there, remove it. We are more tolerant than the RFC in that we
843 ;; tolerate LF-only endings.
844 (if (string-suffix? "\r" line)
845 (string-drop-right line 1)
846 line))
847 ((line . _) ;EOF or missing delimiter
848 (bad-header 'read-header-line line))))
849
850 (set! (@@ (web http) read-header-line) read-header-line)))
851 (_ #t))
852
853(define (strip-headers response) 827(define (strip-headers response)
854 "Return RESPONSE's headers minus 'Content-Length' and our internal headers." 828 "Return RESPONSE's headers minus 'Content-Length' and our internal headers."
855 (fold alist-delete 829 (fold alist-delete
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index a72a43bf79b..cd9660174cf 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -37,38 +37,14 @@
37 dump-file/deduplicate 37 dump-file/deduplicate
38 copy-file/deduplicate)) 38 copy-file/deduplicate))
39 39
40;; XXX: This port is used as a workaround on Guile <= 2.2.4 where
41;; 'port-position' throws to 'out-of-range' when the offset is great than or
42;; equal to 2^32: <https://bugs.gnu.org/32161>.
43(define (counting-wrapper-port output-port)
44 "Return two values: an output port that wraps OUTPUT-PORT, and a thunk to
45retrieve the number of bytes written to OUTPUT-PORT."
46 (let ((byte-count 0))
47 (values (make-custom-binary-output-port "counting-wrapper"
48 (lambda (bytes offset count)
49 (put-bytevector output-port bytes
50 offset count)
51 (set! byte-count
52 (+ byte-count count))
53 count)
54 (lambda ()
55 byte-count)
56 #f
57 (lambda ()
58 (close-port output-port)))
59 (lambda ()
60 byte-count))))
61
62(define (nar-sha256 file) 40(define (nar-sha256 file)
63 "Gives the sha256 hash of a file and the size of the file in nar form." 41 "Gives the sha256 hash of a file and the size of the file in nar form."
64 (let*-values (((port get-hash) (open-sha256-port)) 42 (let-values (((port get-hash) (open-sha256-port)))
65 ((wrapper get-size) (counting-wrapper-port port))) 43 (write-file file port)
66 (write-file file wrapper)
67 (force-output wrapper)
68 (force-output port) 44 (force-output port)
69 (let ((hash (get-hash)) 45 (let ((hash (get-hash))
70 (size (get-size))) 46 (size (port-position port)))
71 (close-port wrapper) 47 (close-port port)
72 (values hash size)))) 48 (values hash size))))
73 49
74(define (tempname-in directory) 50(define (tempname-in directory)