summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2017-06-20 00:25:59 -0400
committerMark H Weaver <mhw@netris.org>2017-06-20 00:25:59 -0400
commit9815739e9bc5de4a4fbcc710221c2cee377664d4 (patch)
treecbbbc05fff4acdfdb05d9b1e5ae5f5eea6fdefbd /guix
parente46e9573855d5ee4f71db0ce77159bbc636330c1 (diff)
parent16b0f205cf03eb94ef228d763d94718342027117 (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/texlive.scm4
-rw-r--r--guix/store.scm63
2 files changed, 61 insertions, 6 deletions
diff --git a/guix/build-system/texlive.scm b/guix/build-system/texlive.scm
index d4085ea7e8..0357c47a47 100644
--- a/guix/build-system/texlive.scm
+++ b/guix/build-system/texlive.scm
@@ -40,8 +40,8 @@
;; Code:
;; These variables specify the SVN tag and the matching SVN revision.
-(define %texlive-tag "texlive-2017.0")
-(define %texlive-revision 44445)
+(define %texlive-tag "texlive-2017.1")
+(define %texlive-revision 44591)
(define (texlive-ref component id)
"Return a <svn-reference> object for the package ID, which is part of the
diff --git a/guix/store.scm b/guix/store.scm
index 2acab6b1a3..b584caa073 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -322,12 +322,16 @@
(define-record-type <nix-server>
(%make-nix-server socket major minor
+ buffer flush
ats-cache atts-cache)
nix-server?
(socket nix-server-socket)
(major nix-server-major-version)
(minor nix-server-minor-version)
+ (buffer nix-server-output-port) ;output port
+ (flush nix-server-flush-output) ;thunk
+
;; Caches. We keep them per-connection, because store paths build
;; during the session are temporary GC roots kept for the duration of
;; the session.
@@ -481,7 +485,11 @@ for this connection will be pinned. Return a server object."
(&nix-connection-error (file (or port uri))
(errno EPROTO))
(&message (message "build daemon handshake failed"))))))
- (let ((port (or port (connect-to-daemon uri))))
+ (let*-values (((port)
+ (or port (connect-to-daemon uri)))
+ ((output flush)
+ (buffering-output-port port
+ (make-bytevector 8192))))
(write-int %worker-magic-1 port)
(let ((r (read-int port)))
(and (eqv? r %worker-magic-2)
@@ -499,12 +507,18 @@ for this connection will be pinned. Return a server object."
(let ((conn (%make-nix-server port
(protocol-major v)
(protocol-minor v)
+ output flush
(make-hash-table 100)
(make-hash-table 100))))
(let loop ((done? (process-stderr conn)))
(or done? (process-stderr conn)))
conn)))))))))
+(define (write-buffered-output server)
+ "Flush SERVER's output port."
+ (force-output (nix-server-output-port server))
+ ((nix-server-flush-output server)))
+
(define (close-connection server)
"Close the connection to SERVER."
(close (nix-server-socket server)))
@@ -718,6 +732,44 @@ encoding conversion errors."
(let loop ((done? (process-stderr server)))
(or done? (process-stderr server)))))
+(define (buffering-output-port port buffer)
+ "Return two value: an output port wrapped around PORT that uses BUFFER (a
+bytevector) as its internal buffer, and a thunk to flush this output port."
+ ;; Note: In Guile 2.2.2, custom binary output ports already have their own
+ ;; 4K internal buffer.
+ (define size
+ (bytevector-length buffer))
+
+ (define total 0)
+
+ (define (flush)
+ (put-bytevector port buffer 0 total)
+ (set! total 0))
+
+ (define (write bv offset count)
+ (if (zero? count) ;end of file
+ (flush)
+ (let loop ((offset offset)
+ (count count)
+ (written 0))
+ (cond ((= total size)
+ (flush)
+ (loop offset count written))
+ ((zero? count)
+ written)
+ (else
+ (let ((to-copy (min count (- size total))))
+ (bytevector-copy! bv offset buffer total to-copy)
+ (set! total (+ total to-copy))
+ (loop (+ offset to-copy) (- count to-copy)
+ (+ written to-copy))))))))
+
+ ;; Note: We need to return FLUSH because the custom binary port has no way
+ ;; to be notified of a 'force-output' call on itself.
+ (values (make-custom-binary-output-port "buffering-output-port"
+ write #f #f flush)
+ flush))
+
(define %rpc-calls
;; Mapping from RPC names (symbols) to invocation counts.
(make-hash-table))
@@ -755,11 +807,14 @@ encoding conversion errors."
((_ (name (type arg) ...) docstring return ...)
(lambda (server arg ...)
docstring
- (let ((s (nix-server-socket server)))
+ (let* ((s (nix-server-socket server))
+ (buffered (nix-server-output-port server)))
(record-operation 'name)
- (write-int (operation-id name) s)
- (write-arg type arg s)
+ (write-int (operation-id name) buffered)
+ (write-arg type arg buffered)
...
+ (write-buffered-output server)
+
;; Loop until the server is done sending error output.
(let loop ((done? (process-stderr server)))
(or done? (loop (process-stderr server))))