deduplication: Work around Guile bug in 'seek'.
Fixes <https://bugs.gnu.org/32161>.
Reported by Ricardo Wurmus <rekado@elephly.net>.
This mostly reverts 83099892e0
.
* guix/store/deduplication.scm (counting-wrapper-port): New procedure.
(nar-sha256): Use it.
This commit is contained in:
parent
a2662bfe9c
commit
4f89a8eec6
|
@ -31,14 +31,38 @@
|
||||||
#:export (nar-sha256
|
#:export (nar-sha256
|
||||||
deduplicate))
|
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))
|
||||||
(write-file file port)
|
((wrapper get-size) (counting-wrapper-port port)))
|
||||||
|
(write-file file wrapper)
|
||||||
|
(force-output wrapper)
|
||||||
(force-output port)
|
(force-output port)
|
||||||
(let ((hash (get-hash))
|
(let ((hash (get-hash))
|
||||||
(size (port-position port)))
|
(size (get-size)))
|
||||||
(close-port port)
|
(close-port wrapper)
|
||||||
(values hash size))))
|
(values hash size))))
|
||||||
|
|
||||||
(define (tempname-in directory)
|
(define (tempname-in directory)
|
||||||
|
|
Loading…
Reference in New Issue