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:
Ludovic Courtès 2013-03-22 22:51:41 +01:00
parent b6a64843c6
commit 238f739777
1 changed files with 20 additions and 10 deletions

View File

@ -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)