[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/02: deduplication: Work around Guile bug in 'seek'.
From: |
Ludovic Courtès |
Subject: |
01/02: deduplication: Work around Guile bug in 'seek'. |
Date: |
Fri, 20 Jul 2018 09:02:08 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 4f89a8eec69491b925f084381ea4de37527c9310
Author: Ludovic Courtès <address@hidden>
Date: Fri Jul 20 13:49:50 2018 +0200
deduplication: Work around Guile bug in 'seek'.
Fixes <https://bugs.gnu.org/32161>.
Reported by Ricardo Wurmus <address@hidden>.
This mostly reverts 83099892e0cf0d9c59f5e1a0774331026e48baa8.
* guix/store/deduplication.scm (counting-wrapper-port): New procedure.
(nar-sha256): Use it.
---
guix/store/deduplication.scm | 32 ++++++++++++++++++++++++++++----
1 file changed, 28 insertions(+), 4 deletions(-)
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index 8234819..8c19d73 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -31,14 +31,38 @@
#:export (nar-sha256
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)
"Gives the sha256 hash of a file and the size of the file in nar form."
- (let-values (((port get-hash) (open-sha256-port)))
- (write-file file port)
+ (let*-values (((port get-hash) (open-sha256-port))
+ ((wrapper get-size) (counting-wrapper-port port)))
+ (write-file file wrapper)
+ (force-output wrapper)
(force-output port)
(let ((hash (get-hash))
- (size (port-position port)))
- (close-port port)
+ (size (get-size)))
+ (close-port wrapper)
(values hash size))))
(define (tempname-in directory)