mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 15:36:20 -05:00
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:
parent
c7c7f068c1
commit
4f621a2b00
6 changed files with 10 additions and 91 deletions
|
@ -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.
|
||||||
|
|
|
@ -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 '()))
|
||||||
|
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in a new issue