aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-03-22 22:51:41 +0100
committerLudovic Courtès <ludo@gnu.org>2013-03-22 23:15:34 +0100
commit238f739777f3634c3a987d834519d692216027d0 (patch)
tree03f9bedd786cacf62afc6b4c6f2286d075ff9b57
parentb6a64843c6d651903bf6bee4cd029f5ac48c0858 (diff)
downloadguix-238f739777f3634c3a987d834519d692216027d0.tar
guix-238f739777f3634c3a987d834519d692216027d0.tar.gz
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.
-rw-r--r--guix/store.scm30
1 files changed, 20 insertions, 10 deletions
diff --git a/guix/store.scm b/guix/store.scm
index eaf1cd544f..688ddbe714 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -234,8 +234,17 @@
(define write-store-path-list write-string-list)
(define read-store-path-list read-string-list)
-(define (write-contents file p)
- "Write the contents of FILE to output port P."
+(define (write-contents file p size)
+ "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 buf-size 65536)
(define buf (make-bytevector buf-size))
@@ -250,13 +259,14 @@
(put-bytevector p buf 0 read)
(loop (- left read))))))))
- (let ((size (stat:size (lstat file))))
- (write-string "contents" p)
- (write-long-long size p)
- (call-with-input-file file
- (lambda (p)
- (dump p size)))
- (write-padding size p)))
+ (write-string "contents" p)
+ (write-long-long size p)
+ (call-with-binary-input-file file
+ ;; Use `sendfile' when available (Guile 2.0.8+).
+ (if (compile-time-value (defined? 'sendfile))
+ (cut sendfile p <> size 0)
+ (cut dump <> size)))
+ (write-padding size p))
(define (write-file f p)
(define %archive-version-1 "nix-archive-1")
@@ -274,7 +284,7 @@
(begin
(write-string "executable" p)
(write-string "" p)))
- (write-contents f p))
+ (write-contents f p (stat:size s)))
((directory)
(write-string "type" p)
(write-string "directory" p)