store: Use `sendfile' when available.
* guix/store.scm (write-contents)[call-with-binary-input-file]: New procedure. Use `sendfile' instead of `dump' when available. Add `size' parameter. (write-file): Update caller.
This commit is contained in:
parent
b6a64843c6
commit
238f739777
|
@ -234,8 +234,17 @@
|
||||||
(define write-store-path-list write-string-list)
|
(define write-store-path-list write-string-list)
|
||||||
(define read-store-path-list read-string-list)
|
(define read-store-path-list read-string-list)
|
||||||
|
|
||||||
(define (write-contents file p)
|
(define (write-contents file p size)
|
||||||
"Write the contents of FILE to output port P."
|
"Write SIZE bytes from FILE to output port P."
|
||||||
|
(define (call-with-binary-input-file file proc)
|
||||||
|
;; Open FILE as a binary file. This avoids scan-for-encoding, and thus
|
||||||
|
;; avoids any initial buffering.
|
||||||
|
(let ((port (open-file file "rb")))
|
||||||
|
(catch #t (cut proc port)
|
||||||
|
(lambda args
|
||||||
|
(close-port port)
|
||||||
|
(apply throw args)))))
|
||||||
|
|
||||||
(define (dump in size)
|
(define (dump in size)
|
||||||
(define buf-size 65536)
|
(define buf-size 65536)
|
||||||
(define buf (make-bytevector buf-size))
|
(define buf (make-bytevector buf-size))
|
||||||
|
@ -250,13 +259,14 @@
|
||||||
(put-bytevector p buf 0 read)
|
(put-bytevector p buf 0 read)
|
||||||
(loop (- left read))))))))
|
(loop (- left read))))))))
|
||||||
|
|
||||||
(let ((size (stat:size (lstat file))))
|
|
||||||
(write-string "contents" p)
|
(write-string "contents" p)
|
||||||
(write-long-long size p)
|
(write-long-long size p)
|
||||||
(call-with-input-file file
|
(call-with-binary-input-file file
|
||||||
(lambda (p)
|
;; Use `sendfile' when available (Guile 2.0.8+).
|
||||||
(dump p size)))
|
(if (compile-time-value (defined? 'sendfile))
|
||||||
(write-padding size p)))
|
(cut sendfile p <> size 0)
|
||||||
|
(cut dump <> size)))
|
||||||
|
(write-padding size p))
|
||||||
|
|
||||||
(define (write-file f p)
|
(define (write-file f p)
|
||||||
(define %archive-version-1 "nix-archive-1")
|
(define %archive-version-1 "nix-archive-1")
|
||||||
|
@ -274,7 +284,7 @@
|
||||||
(begin
|
(begin
|
||||||
(write-string "executable" p)
|
(write-string "executable" p)
|
||||||
(write-string "" p)))
|
(write-string "" p)))
|
||||||
(write-contents f p))
|
(write-contents f p (stat:size s)))
|
||||||
((directory)
|
((directory)
|
||||||
(write-string "type" p)
|
(write-string "type" p)
|
||||||
(write-string "directory" p)
|
(write-string "directory" p)
|
||||||
|
|
Loading…
Reference in New Issue