deduplication: Work around Guile bug in 'seek'.

Fixes <https://bugs.gnu.org/32161>.
Reported by Ricardo Wurmus <rekado@elephly.net>.

This mostly reverts 83099892e0cf0d9c59f5e1a0774331026e48baa8.

* guix/store/deduplication.scm (counting-wrapper-port): New procedure.
(nar-sha256): Use it.

1 files changed, 28 insertions, 4 deletions

diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index 8234819f14..8c19d7309e 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)