ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

graft: Correctly replace references near the end of the scan buffer.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2017-08-24 13:14:47 +02:00
parent 5e60bef980
commit 94e86a6b67
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 46 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
guix/build/graft.scm
View file

@ -164,15 +164,19 @@ (define request-size (expt 2 20)) ; 1 MiB
;; 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)

34
tests/grafts.scm
View file

@ -28,7 +28,9 @@ (define-module (test-grafts)
#: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 @@ (define make-derivation-input
(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)