summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-08-24 13:14:47 +0200
committerLudovic Courtès <ludo@gnu.org>2017-08-24 23:55:51 +0200
commit94e86a6b67c7a02f5f11358743f3b9f11997059c (patch)
tree11a28c7422f0fcb366b4d263a4d635f693c83ee0
parent5e60bef9802e448924f889d34d95a249b008652c (diff)
graft: Correctly replace references near the end of the scan buffer.
Fixes <http://bugs.gnu.org/28212>. Reported by Leo Famulari <leo@famulari.name>. * guix/build/graft.scm (replace-store-references): When I >= END, check whether WRITTEN > END and call 'get-bytevector-n!' when it is. * tests/grafts.scm (buffer-size): New variable. ("replace-store-references, <http://bugs.gnu.org/28212>"): New test.
-rw-r--r--guix/build/graft.scm22
-rw-r--r--tests/grafts.scm34
2 files changed, 46 insertions, 10 deletions
diff --git a/guix/build/graft.scm b/guix/build/graft.scm
index 16df169ec7..3dce486adf 100644
--- a/guix/build/graft.scm
+++ b/guix/build/graft.scm
@@ -164,15 +164,19 @@ bytevectors to the same value."
;; not to unget bytes that have already been written, because
;; that would cause them to be written again from the next
;; buffer. In practice, this case occurs when a replacement is
- ;; made near the end of the buffer.
- (let* ((unwritten (- end written))
- (unget-size (if (= end request-size)
- (min hash-length unwritten)
- 0))
- (write-size (- unwritten unget-size)))
- (put-bytevector output buffer written write-size)
- (unget-bytevector input buffer (+ written write-size)
- unget-size)
+ ;; made near or beyond the end of the buffer. When REPLACEMENT
+ ;; went beyond END, we consume the extra bytes from INPUT.
+ (begin
+ (if (> written end)
+ (get-bytevector-n! input buffer 0 (- written end))
+ (let* ((unwritten (- end written))
+ (unget-size (if (= end request-size)
+ (min hash-length unwritten)
+ 0))
+ (write-size (- unwritten unget-size)))
+ (put-bytevector output buffer written write-size)
+ (unget-bytevector input buffer (+ written write-size)
+ unget-size)))
(loop)))))))))
(define (rename-matching-files directory mapping)
diff --git a/tests/grafts.scm b/tests/grafts.scm
index 08f05c0f75..abb074d628 100644
--- a/tests/grafts.scm
+++ b/tests/grafts.scm
@@ -28,7 +28,9 @@
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-64)
- #:use-module (rnrs io ports))
+ #:use-module (rnrs bytevectors)
+ #:use-module (rnrs io ports)
+ #:use-module (ice-9 vlist))
(define %store
(open-connection-for-tests))
@@ -442,4 +444,34 @@
(and (file-exists? (string-append out "/p2/replacement"))
(file-exists? (string-append out "/p2/p1/replacement")))))))
+(define buffer-size
+ ;; Must be equal to REQUEST-SIZE in 'replace-store-references'.
+ (expt 2 20))
+
+(test-equal "replace-store-references, <http://bugs.gnu.org/28212>"
+ (string-append (make-string (- buffer-size 47) #\a)
+ "/gnu/store/" (make-string 32 #\8)
+ "-SoMeTHiNG"
+ (list->string (map integer->char (iota 77 33))))
+
+ ;; Create input data where the right-hand-size of the dash ("-something"
+ ;; here) goes beyond the end of the internal buffer of
+ ;; 'replace-store-references'.
+ (let* ((content (string-append (make-string (- buffer-size 47) #\a)
+ "/gnu/store/" (make-string 32 #\7)
+ "-something"
+ (list->string
+ (map integer->char (iota 77 33)))))
+ (replacement (alist->vhash
+ `((,(make-string 32 #\7)
+ . ,(string->utf8 (string-append
+ (make-string 32 #\8)
+ "-SoMeTHiNG")))))))
+ (call-with-output-string
+ (lambda (output)
+ ((@@ (guix build graft) replace-store-references)
+ (open-input-string content) output
+ replacement
+ "/gnu/store")))))
+
(test-end)