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.
This commit is contained in:
Ludovic Courtès 2020-12-17 16:19:07 +01:00
parent c7c7f068c1
commit 4f621a2b00
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
6 changed files with 10 additions and 91 deletions

View file

@ -102,7 +102,7 @@ if test "x$GUILD" = "x"; then
fi fi
if test "x$GUILE_EFFECTIVE_VERSION" = "x2.2"; then if test "x$GUILE_EFFECTIVE_VERSION" = "x2.2"; then
PKG_CHECK_MODULES([GUILE], [guile-2.2 >= 2.2.3]) PKG_CHECK_MODULES([GUILE], [guile-2.2 >= 2.2.6])
fi fi
dnl Get CFLAGS and LDFLAGS for libguile. dnl Get CFLAGS and LDFLAGS for libguile.

View file

@ -1317,18 +1317,7 @@ (define* (reference->sexp ref #:optional native?)
reference->sexp (gexp-references exp)))) reference->sexp (gexp-references exp))))
(return (apply (gexp-proc exp) args)))) (return (apply (gexp-proc exp) args))))
(define-syntax-rule (define-syntax-parameter-once name proc) (define-syntax-parameter current-imported-modules
;; Like 'define-syntax-parameter' but ensure the top-level binding for NAME
;; does not get redefined. This works around a race condition in a
;; multi-threaded context with Guile <= 2.2.4: <https://bugs.gnu.org/27476>.
(eval-when (load eval expand compile)
(define name
(if (module-locally-bound? (current-module) 'name)
(module-ref (current-module) 'name)
(make-syntax-transformer 'name 'syntax-parameter
(list proc))))))
(define-syntax-parameter-once current-imported-modules
;; Current list of imported modules. ;; Current list of imported modules.
(identifier-syntax '())) (identifier-syntax '()))
@ -1339,7 +1328,7 @@ (define-syntax-rule (with-imported-modules modules body ...)
(identifier-syntax modules))) (identifier-syntax modules)))
body ...)) body ...))
(define-syntax-parameter-once current-imported-extensions (define-syntax-parameter current-imported-extensions
;; Current list of extensions. ;; Current list of extensions.
(identifier-syntax '())) (identifier-syntax '()))

View file

@ -469,22 +469,13 @@ (define (proxy client backend) ;adapted from (guix ssh)
"Proxy communication between CLIENT and BACKEND until CLIENT closes the "Proxy communication between CLIENT and BACKEND until CLIENT closes the
connection, at which point CLIENT is closed (both CLIENT and BACKEND must be connection, at which point CLIENT is closed (both CLIENT and BACKEND must be
input/output ports.)" input/output ports.)"
(define (select* read write except)
;; This is a workaround for <https://bugs.gnu.org/30365> in Guile < 2.2.4:
;; since 'select' sometimes returns non-empty sets for no good reason,
;; call 'select' a second time with a zero timeout to filter out incorrect
;; replies.
(match (select read write except)
((read write except)
(select read write except 0))))
;; Use buffered ports so that 'get-bytevector-some' returns up to the ;; Use buffered ports so that 'get-bytevector-some' returns up to the
;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>. ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>.
(setvbuf client 'block 65536) (setvbuf client 'block 65536)
(setvbuf backend 'block 65536) (setvbuf backend 'block 65536)
(let loop () (let loop ()
(match (select* (list client backend) '() '()) (match (select (list client backend) '() '())
((reads () ()) ((reads () ())
(when (memq client reads) (when (memq client reads)
(match (get-bytevector-some client) (match (get-bytevector-some client)

View file

@ -274,23 +274,12 @@ (define-syntax name
(_ (_
#'generic-name)))))))))) #'generic-name))))))))))
(define-syntax-rule (define-syntax-parameter-once name proc) (define-syntax-parameter >>=
;; Like 'define-syntax-parameter' but ensure the top-level binding for NAME
;; does not get redefined. This works around a race condition in a
;; multi-threaded context with Guile <= 2.2.4: <https://bugs.gnu.org/27476>.
(eval-when (load eval expand compile)
(define name
(if (module-locally-bound? (current-module) 'name)
(module-ref (current-module) 'name)
(make-syntax-transformer 'name 'syntax-parameter
(list proc))))))
(define-syntax-parameter-once >>=
;; The name 'bind' is already taken, so we choose this (obscure) symbol. ;; The name 'bind' is already taken, so we choose this (obscure) symbol.
(lambda (s) (lambda (s)
(syntax-violation '>>= ">>= (bind) used outside of 'with-monad'" s))) (syntax-violation '>>= ">>= (bind) used outside of 'with-monad'" s)))
(define-syntax-parameter-once return (define-syntax-parameter return
(lambda (s) (lambda (s)
(syntax-violation 'return "return used outside of 'with-monad'" s))) (syntax-violation 'return "return used outside of 'with-monad'" s)))

View file

@ -824,32 +824,6 @@ (define (request-path-components request)
(define %http-write (define %http-write
(@@ (web server http) http-write)) (@@ (web server http) http-write))
(match (list (major-version) (minor-version) (micro-version))
(("2" "2" "5") ;Guile 2.2.5
(let ()
(define %read-line (@ (ice-9 rdelim) %read-line))
(define bad-header (@@ (web http) bad-header))
;; XXX: Work around <https://bugs.gnu.org/36350> by reverting to the
;; definition of 'read-header-line' as found in 2.2.4 and earlier.
(define (read-header-line port)
"Read an HTTP header line and return it without its final CRLF or LF.
Raise a 'bad-header' exception if the line does not end in CRLF or LF,
or if EOF is reached."
(match (%read-line port)
(((? string? line) . #\newline)
;; '%read-line' does not consider #\return a delimiter; so if it's
;; there, remove it. We are more tolerant than the RFC in that we
;; tolerate LF-only endings.
(if (string-suffix? "\r" line)
(string-drop-right line 1)
line))
((line . _) ;EOF or missing delimiter
(bad-header 'read-header-line line))))
(set! (@@ (web http) read-header-line) read-header-line)))
(_ #t))
(define (strip-headers response) (define (strip-headers response)
"Return RESPONSE's headers minus 'Content-Length' and our internal headers." "Return RESPONSE's headers minus 'Content-Length' and our internal headers."
(fold alist-delete (fold alist-delete

View file

@ -37,38 +37,14 @@ (define-module (guix store deduplication)
dump-file/deduplicate dump-file/deduplicate
copy-file/deduplicate)) copy-file/deduplicate))
;; XXX: This port is used as a workaround on Guile <= 2.2.4 where
;; 'port-position' throws to 'out-of-range' when the offset is great than or
;; equal to 2^32: <https://bugs.gnu.org/32161>.
(define (counting-wrapper-port output-port)
"Return two values: an output port that wraps OUTPUT-PORT, and a thunk to
retrieve the number of bytes written to OUTPUT-PORT."
(let ((byte-count 0))
(values (make-custom-binary-output-port "counting-wrapper"
(lambda (bytes offset count)
(put-bytevector output-port bytes
offset count)
(set! byte-count
(+ byte-count count))
count)
(lambda ()
byte-count)
#f
(lambda ()
(close-port output-port)))
(lambda ()
byte-count))))
(define (nar-sha256 file) (define (nar-sha256 file)
"Gives the sha256 hash of a file and the size of the file in nar form." "Gives the sha256 hash of a file and the size of the file in nar form."
(let*-values (((port get-hash) (open-sha256-port)) (let-values (((port get-hash) (open-sha256-port)))
((wrapper get-size) (counting-wrapper-port port))) (write-file file port)
(write-file file wrapper)
(force-output wrapper)
(force-output port) (force-output port)
(let ((hash (get-hash)) (let ((hash (get-hash))
(size (get-size))) (size (port-position port)))
(close-port wrapper) (close-port port)
(values hash size)))) (values hash size))))
(define (tempname-in directory) (define (tempname-in directory)