diff options
Diffstat (limited to 'guix/store.scm')
| -rw-r--r-- | guix/store.scm | 50 |
1 files changed, 39 insertions, 11 deletions
diff --git a/guix/store.scm b/guix/store.scm index 80b36daf93..4d078c5899 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -39,6 +39,9 @@ nix-server-socket &nix-error nix-error? + &nix-connection-error nix-connection-error? + nix-connection-error-file + nix-connection-error-code &nix-protocol-error nix-protocol-error? nix-protocol-error-message nix-protocol-error-status @@ -231,8 +234,19 @@ (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. Disable file name canonicalization to + ;; avoid stat'ing like crazy. + (with-fluids ((%file-port-name-canonicalization #f)) + (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)) @@ -247,13 +261,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") @@ -271,7 +286,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) @@ -373,6 +388,11 @@ (define-condition-type &nix-error &error nix-error?) +(define-condition-type &nix-connection-error &nix-error + nix-connection-error? + (file nix-connection-error-file) + (errno nix-connection-error-code)) + (define-condition-type &nix-protocol-error &nix-error nix-protocol-error? (message nix-protocol-error-message) @@ -392,7 +412,15 @@ operate, should the disk become full. Return a server object." ;; Enlarge the receive buffer. (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024)) - (connect s a) + (catch 'system-error + (cut connect s a) + (lambda args + ;; Translate the error to something user-friendly. + (let ((errno (system-error-errno args))) + (raise (condition (&nix-connection-error + (file file) + (errno errno))))))) + (write-int %worker-magic-1 s) (let ((r (read-int s))) (and (eqv? r %worker-magic-2) |