Merge branch 'master' into core-updates

14 files changed, 319 insertions, 121 deletions

diff --git a/guix/import/json.scm b/guix/import/json.scm
index 4f96a513df..81ea5e7b31 100644
--- a/guix/import/json.scm
+++ b/guix/import/json.scm
@@ -47,4 +47,5 @@ the query."
 (define (json-fetch-alist url)
   "Return an alist representation of the JSON resource URL, or #f if URL
 returns 403 or 404."
-  (hash-table->alist (json-fetch url)))
+  (and=> (json-fetch url)
+         hash-table->alist))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 669ebe04e5..89e92ea2ba 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -28,7 +28,8 @@
   #:use-module ((guix config) #:select (%state-directory))
   #:use-module ((guix utils) #:hide (package-name->name+version))
   #:use-module ((guix build utils)
-                #:select (package-name->name+version))
+                #:select (package-name->name+version mkdir-p))
+  #:use-module (guix i18n)
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix derivations)
@@ -127,6 +128,7 @@
             %user-profile-directory
             %profile-directory
             %current-profile
+            ensure-profile-directory
             canonicalize-profile
             user-friendly-profile))
 
@@ -1249,7 +1251,7 @@ the entries in MANIFEST."
   (define config.scm
     (scheme-file "config.scm"
                  #~(begin
-                     (define-module (guix config)
+                     (define-module #$'(guix config) ;placate Geiser
                        #:export (%libz))
 
                      (define %libz
@@ -1610,28 +1612,73 @@ because the NUMBER is zero.)"
   ;; coexist with Nix profiles.
   (string-append %profile-directory "/guix-profile"))
 
-(define (canonicalize-profile profile)
-  "If PROFILE is %USER-PROFILE-DIRECTORY, return %CURRENT-PROFILE.  Otherwise
-return PROFILE unchanged.  The goal is to treat '-p ~/.guix-profile' as if
-'-p' was omitted."                           ; see <http://bugs.gnu.org/17939>
+(define (ensure-profile-directory)
+  "Attempt to create /…/profiles/per-user/$USER if needed."
+  (let ((s (stat %profile-directory #f)))
+    (unless (and s (eq? 'directory (stat:type s)))
+      (catch 'system-error
+        (lambda ()
+          (mkdir-p %profile-directory))
+        (lambda args
+          ;; Often, we cannot create %PROFILE-DIRECTORY because its
+          ;; parent directory is root-owned and we're running
+          ;; unprivileged.
+          (raise (condition
+                  (&message
+                   (message
+                    (format #f
+                            (G_ "while creating directory `~a': ~a")
+                            %profile-directory
+                            (strerror (system-error-errno args)))))
+                  (&fix-hint
+                   (hint
+                    (format #f (G_ "Please create the @file{~a} directory, \
+with you as the owner.")
+                            %profile-directory))))))))
+
+    ;; Bail out if it's not owned by the user.
+    (unless (or (not s) (= (stat:uid s) (getuid)))
+      (raise (condition
+              (&message
+               (message
+                (format #f (G_ "directory `~a' is not owned by you")
+                        %profile-directory)))
+              (&fix-hint
+               (hint
+                (format #f (G_ "Please change the owner of @file{~a} \
+to user ~s.")
+                        %profile-directory (or (getenv "USER")
+                                               (getenv "LOGNAME")
+                                               (getuid))))))))))
 
-  ;; Trim trailing slashes so that the basename comparison below works as
-  ;; intended.
+(define (canonicalize-profile profile)
+  "If PROFILE points to a profile in %PROFILE-DIRECTORY, return that.
+Otherwise return PROFILE unchanged.  The goal is to treat '-p ~/.guix-profile'
+as if '-p' was omitted."  ; see <http://bugs.gnu.org/17939>
+  ;; Trim trailing slashes so 'readlink' can do its job.
   (let ((profile (string-trim-right profile #\/)))
-    (if (and %user-profile-directory
-             (string=? (canonicalize-path (dirname profile))
-                       (dirname %user-profile-directory))
-             (string=? (basename profile) (basename %user-profile-directory)))
-        %current-profile
-        profile)))
+    (catch 'system-error
+      (lambda ()
+        (let ((target (readlink profile)))
+          (if (string=? (dirname target) %profile-directory)
+              target
+              profile)))
+      (const profile))))
+
+(define %known-shorthand-profiles
+  ;; Known shorthand forms for profiles that the user manipulates.
+  (list (string-append (config-directory #:ensure? #f) "/current")
+        %user-profile-directory))
 
 (define (user-friendly-profile profile)
-  "Return either ~/.guix-profile if that's what PROFILE refers to, directly or
-indirectly, or PROFILE."
-  (if (and %user-profile-directory
-           (false-if-exception
-            (string=? (readlink %user-profile-directory) profile)))
-      %user-profile-directory
+  "Return either ~/.guix-profile or ~/.config/guix/current if that's what
+PROFILE refers to, directly or indirectly, or PROFILE."
+  (or (find (lambda (shorthand)
+              (and shorthand
+                   (let ((target (false-if-exception
+                                  (readlink shorthand))))
+                     (and target (string=? target profile)))))
+            %known-shorthand-profiles)
       profile))
 
 ;;; profiles.scm ends here
diff --git a/guix/scripts.scm b/guix/scripts.scm
index 4cbbbeb96f..98751bc812 100644
--- a/guix/scripts.scm
+++ b/guix/scripts.scm
@@ -26,6 +26,7 @@
   #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (guix derivations)
+  #:use-module ((guix profiles) #:select (%profile-directory))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-37)
@@ -169,8 +170,7 @@ Show what and how will/would be built."
 
     (define age
       (match (false-if-not-found
-              (lstat (string-append (config-directory #:ensure? #f)
-                                    "/current")))
+              (lstat (string-append %profile-directory "/current-guix")))
         (#f    #f)
         (stat  (- (time-second (current-time time-utc))
                   (stat:mtime stat)))))
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 5a6ba62bc3..13978abb77 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -395,6 +395,8 @@ options handled by 'set-build-options-from-command-line', and listed in
                      #:print-build-trace (assoc-ref opts 'print-build-trace?)
                      #:print-extended-build-trace?
                      (assoc-ref opts 'print-extended-build-trace?)
+                     #:multiplexed-build-output?
+                     (assoc-ref opts 'multiplexed-build-output?)
                      #:verbosity (assoc-ref opts 'verbosity)))
 
 (define set-build-options-from-command-line*
@@ -505,6 +507,7 @@ options handled by 'set-build-options-from-command-line', and listed in
     (build-hook? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
+    (multiplexed-build-output? . #t)
     (verbosity . 0)))
 
 (define (show-help)
@@ -623,7 +626,7 @@ must be one of 'package', 'all', or 'transitive'~%")
   "Read the arguments from OPTS and return a list of high-level objects to
 build---packages, gexps, derivations, and so on."
   (define (validate-type x)
-    (unless (or (package? x) (derivation? x) (gexp? x) (procedure? x))
+    (unless (or (derivation? x) (file-like? x) (gexp? x) (procedure? x))
       (leave (G_ "~s: not something we can build~%") x)))
 
   (define (ensure-list x)
@@ -700,6 +703,10 @@ package '~a' has no source~%")
                               (set-guile-for-build (default-guile))
                               (proc))
                             #:system system)))
+                   ((? file-like? obj)
+                    (list (run-with-store store
+                            (lower-object obj system
+                                          #:target (assoc-ref opts 'target)))))
                    ((? gexp? gexp)
                     (list (run-with-store store
                             (mbegin %store-monad
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index c1a20fe26c..e59502076c 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -158,4 +158,4 @@ in the format specified by FMT."
         (#f
          (display-checkout-info format))
         (profile
-         (display-profile-info profile format))))))
+         (display-profile-info (canonicalize-profile profile) format))))))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 9fc7edcd36..5965e3426e 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -176,6 +176,7 @@ COMMAND or an interactive shell in that environment.\n"))
     (graft? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
+    (multiplexed-build-output? . #t)
     (verbosity . 0)))
 
 (define (tag-package-arg opts arg)
diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm
index 30ae6d4342..794fb710cd 100644
--- a/guix/scripts/import/cran.scm
+++ b/guix/scripts/import/cran.scm
@@ -47,6 +47,8 @@ Import and convert the CRAN package for PACKAGE-NAME.\n"))
   (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
+  -r, --recursive        import packages recursively"))
+  (display (G_ "
   -V, --version          display version information and exit"))
   (newline)
   (show-bug-report-information))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 163f5b1dc1..fb3c50521d 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -541,6 +541,7 @@ please email '~a'~%")
     (graft? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
+    (multiplexed-build-output? . #t)
     (verbosity . 0)
     (symlinks . ())
     (compressor . ,(first %compressors))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 93a77915fe..5d146b8427 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -68,50 +68,14 @@
 
 (define (ensure-default-profile)
   "Ensure the default profile symlink and directory exist and are writable."
-
-  (define (rtfm)
-    (format (current-error-port)
-            (G_ "Try \"info '(guix) Invoking guix package'\" for \
-more information.~%"))
-    (exit 1))
+  (ensure-profile-directory)
 
   ;; Create ~/.guix-profile if it doesn't exist yet.
   (when (and %user-profile-directory
              %current-profile
              (not (false-if-exception
                    (lstat %user-profile-directory))))
-    (symlink %current-profile %user-profile-directory))
-
-  (let ((s (stat %profile-directory #f)))
-    ;; Attempt to create /…/profiles/per-user/$USER if needed.
-    (unless (and s (eq? 'directory (stat:type s)))
-      (catch 'system-error
-        (lambda ()
-          (mkdir-p %profile-directory))
-        (lambda args
-          ;; Often, we cannot create %PROFILE-DIRECTORY because its
-          ;; parent directory is root-owned and we're running
-          ;; unprivileged.
-          (format (current-error-port)
-                  (G_ "error: while creating directory `~a': ~a~%")
-                  %profile-directory
-                  (strerror (system-error-errno args)))
-          (format (current-error-port)
-                  (G_ "Please create the `~a' directory, with you as the owner.~%")
-                  %profile-directory)
-          (rtfm))))
-
-    ;; Bail out if it's not owned by the user.
-    (unless (or (not s) (= (stat:uid s) (getuid)))
-      (format (current-error-port)
-              (G_ "error: directory `~a' is not owned by you~%")
-              %profile-directory)
-      (format (current-error-port)
-              (G_ "Please change the owner of `~a' to user ~s.~%")
-              %profile-directory (or (getenv "USER")
-                                     (getenv "LOGNAME")
-                                     (getuid)))
-      (rtfm))))
+    (symlink %current-profile %user-profile-directory)))
 
 (define (delete-generations store profile generations)
   "Delete GENERATIONS from PROFILE.
@@ -332,7 +296,8 @@ ENTRIES, a list of manifest entries, in the context of PROFILE."
     (substitutes? . #t)
     (build-hook? . #t)
     (print-build-trace? . #t)
-    (print-extended-build-trace? . #t)))
+    (print-extended-build-trace? . #t)
+    (multiplexed-build-output? . #t)))
 
 (define (show-help)
   (display (G_ "Usage: guix package [OPTION]...
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 803f7cf142..188237aa90 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -64,6 +64,7 @@
     (build-hook? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
+    (multiplexed-build-output? . #t)
     (graft? . #t)
     (verbosity . 0)))
 
@@ -227,6 +228,60 @@ Download and deploy the latest version of Guix.\n"))
 
 
 ;;;
+;;; Profile.
+;;;
+
+(define %current-profile
+  ;; The "real" profile under /var/guix.
+  (string-append %profile-directory "/current-guix"))
+
+(define %user-profile-directory
+  ;; The user-friendly name of %CURRENT-PROFILE.
+  (string-append (config-directory #:ensure? #f) "/current"))
+
+(define (migrate-generations profile directory)
+  "Migrate the generations of PROFILE to DIRECTORY."
+  (format (current-error-port)
+          (G_ "Migrating profile generations to '~a'...~%")
+          %profile-directory)
+  (let ((current (generation-number profile)))
+    (for-each (lambda (generation)
+                (let ((source (generation-file-name profile generation))
+                      (target (string-append directory "/current-guix-"
+                                             (number->string generation)
+                                             "-link")))
+                  ;; Note: Don't use 'rename-file' as SOURCE and TARGET might
+                  ;; live on different file systems.
+                  (symlink (readlink source) target)
+                  (delete-file source)))
+              (profile-generations profile))
+    (symlink (string-append "current-guix-"
+                            (number->string current) "-link")
+             (string-append directory "/current-guix"))))
+
+(define (ensure-default-profile)
+  (ensure-profile-directory)
+
+  ;; In 0.15.0+ we'd create ~/.config/guix/current-[0-9]*-link symlinks.  Move
+  ;; them to %PROFILE-DIRECTORY.
+  (unless (string=? %profile-directory
+                    (dirname (canonicalize-profile %user-profile-directory)))
+    (migrate-generations %user-profile-directory %profile-directory))
+
+  ;; Make sure ~/.config/guix/current points to /var/guix/profiles/….
+  (let ((link %user-profile-directory))
+    (unless (equal? (false-if-exception (readlink link))
+                    %current-profile)
+      (catch 'system-error
+        (lambda ()
+          (false-if-exception (delete-file link))
+          (symlink %current-profile link))
+        (lambda args
+          (leave (G_ "while creating symlink '~a': ~a~%")
+                 link (strerror (system-error-errno args))))))))
+
+
+;;;
 ;;; Queries.
 ;;;
 
@@ -341,11 +396,8 @@ and ALIST2 differ, display HEADING upfront."
   (display-new/upgraded-packages (package-alist gen1)
                                  (package-alist gen2)))
 
-(define (process-query opts)
-  "Process any query specified by OPTS."
-  (define profile
-    (string-append (config-directory) "/current"))
-
+(define (process-query opts profile)
+  "Process any query on PROFILE specified by OPTS."
   (match (assoc-ref opts 'query)
     (('list-generations pattern)
      (define (list-generations profile numbers)
@@ -441,11 +493,10 @@ Use '~/.config/guix/channels.scm' instead."))
                                           (list %default-options)))
             (cache    (string-append (cache-directory) "/pull"))
             (channels (channel-list opts))
-            (profile  (or (assoc-ref opts 'profile)
-                          (string-append (config-directory) "/current"))))
-
+            (profile  (or (assoc-ref opts 'profile) %current-profile)))
+       (ensure-default-profile)
        (cond ((assoc-ref opts 'query)
-              (process-query opts))
+              (process-query opts profile))
              ((assoc-ref opts 'dry-run?)
               #t)                                 ;XXX: not very useful
              (else
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index f9d6b9e5b6..f9af38b7c5 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -1082,6 +1082,7 @@ Some ACTIONS support additional ARGS.\n"))
     (build-hook? . #t)
     (print-build-trace? . #t)
     (print-extended-build-trace? . #t)
+    (multiplexed-build-output? . #t)
     (graft? . #t)
     (verbosity . 0)
     (file-system-type . "ext4")
diff --git a/guix/self.scm b/guix/self.scm
index 733c4a2cc9..3e29c9a42a 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -904,7 +904,11 @@ is not supported."
         version))
 
   (define guile
-    (guile-for-build guile-version))
+    ;; When PULL-VERSION >= 1, produce a self-contained Guix and use Guile 2.2
+    ;; unconditionally.
+    (guile-for-build (if (>= pull-version 1)
+                         "2.2"
+                         guile-version)))
 
   (mbegin %store-monad
     (set-guile-for-build guile)
@@ -913,7 +917,8 @@ is not supported."
                                #:name (string-append "guix-"
                                                      (shorten version))
                                #:pull-version pull-version
-                               #:guile-version guile-version
+                               #:guile-version (if (>= pull-version 1)
+                                                   "2.2" guile-version)
                                #:guile-for-build guile)))
       (if guix
           (lower-object guix)
diff --git a/guix/status.scm b/guix/status.scm
index c6956066fd..ffa9d9e93c 100644
--- a/guix/status.scm
+++ b/guix/status.scm
@@ -34,6 +34,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 binary-ports)
+  #:autoload   (ice-9 rdelim) (read-string)
   #:use-module (rnrs bytevectors)
   #:use-module ((system foreign)
                 #:select (bytevector->pointer pointer->bytevector))
@@ -115,7 +116,10 @@
     (string=? item (download-item download))))
 
 (define* (compute-status event status
-                         #:key (current-time current-time))
+                         #:key
+                         (current-time current-time)
+                         (derivation-path->output-path
+                          derivation-path->output-path))
   "Given EVENT, a tuple like (build-started \"/gnu/store/...-foo.drv\" ...),
 compute a new status based on STATUS."
   (match event
@@ -141,8 +145,7 @@ compute a new status based on STATUS."
       (inherit status)
       (building (remove (lambda (drv)
                           (equal? (false-if-exception
-                                   (derivation->output-path
-                                    (read-derivation-from-file drv)))
+                                   (derivation-path->output-path drv))
                                   item))
                         (build-status-building status)))
       (downloading (cons (download item uri #:size size
@@ -218,6 +221,12 @@ build traces\" such as \"@ download-progress\" traces."
   (and (current-store-protocol-version)
        (>= (current-store-protocol-version) #x162)))
 
+(define (multiplexed-output-supported?)
+  "Return true if the daemon supports \"multiplexed output\"--i.e., \"@
+build-log\" traces."
+  (and (current-store-protocol-version)
+       (>= (current-store-protocol-version) #x163)))
+
 (define spin!
   (let ((steps (circular-list "\\" "|" "/" "-")))
     (lambda (port)
@@ -312,14 +321,16 @@ addition to build events."
         (lambda (line)
           (spin! port))))
 
-  (display "\r" port)                             ;erase the spinner
+  (unless print-log?
+    (display "\r" port))                          ;erase the spinner
   (match event
     (('build-started drv . _)
      (format port (info (G_ "building ~a...")) drv)
      (newline port))
     (('build-succeeded drv . _)
-     (format port (success (G_ "successfully built ~a")) drv)
-     (newline port)
+     (when (or print-log? (not (extended-build-trace-supported?)))
+       (format port (success (G_ "successfully built ~a")) drv)
+       (newline port))
      (match (build-status-building status)
        (() #t)
        (ongoing                                   ;when max-jobs > 1
@@ -382,21 +393,28 @@ addition to build events."
   expected hash: ~a
   actual hash:   ~a~%"))
              expected actual))
-    (('build-log line)
-     ;; TODO: Better distinguish daemon messages and build log lines.
-     (cond ((string-prefix? "substitute: " line)
-            ;; The daemon prefixes early messages coming with 'guix
-            ;; substitute' with "substitute:".  These are useful ("updating
-            ;; substitutes from URL"), so let them through.
-            (format port line)
-            (force-output port))
-           ((string-prefix? "waiting for locks" line)
-            ;; This is when a derivation is already being built and we're just
-            ;; waiting for the build to complete.
-            (display (info (string-trim-right line)) port)
-            (newline))
-           (else
-            (print-log-line line))))
+    (('build-log pid line)
+     (if (multiplexed-output-supported?)
+         (if (not pid)
+             (begin
+               ;; LINE comes from the daemon, not from builders.  Let it
+               ;; through.
+               (display line port)
+               (force-output port))
+             (print-log-line line))
+         (cond ((string-prefix? "substitute: " line)
+                ;; The daemon prefixes early messages coming with 'guix
+                ;; substitute' with "substitute:".  These are useful ("updating
+                ;; substitutes from URL"), so let them through.
+                (display line port)
+                (force-output port))
+               ((string-prefix? "waiting for locks" line)
+                ;; This is when a derivation is already being built and we're just
+                ;; waiting for the build to complete.
+                (display (info (string-trim-right line)) port)
+                (newline))
+               (else
+                (print-log-line line)))))
     (_
      event)))
 
@@ -426,8 +444,43 @@ ON-CHANGE can display the build status, build events, etc."
 ;;; Build port.
 ;;;
 
-(define %newline
-  (char-set #\return #\newline))
+(define (maybe-utf8->string bv)
+  "Attempt to decode BV as UTF-8 string and return it.  Gracefully handle the
+case where BV does not contain only valid UTF-8."
+  (catch 'decoding-error
+    (lambda ()
+      (utf8->string bv))
+    (lambda _
+      ;; This is the sledgehammer but it's the only safe way we have to
+      ;; properly handle this.  It's expensive but it's rarely needed.
+      (let ((port (open-bytevector-input-port bv)))
+        (set-port-encoding! port "UTF-8")
+        (set-port-conversion-strategy! port 'substitute)
+        (let ((str (read-string port)))
+          (close-port port)
+          str)))))
+
+(define (bytevector-index bv number offset count)
+  "Search for NUMBER in BV starting from OFFSET and reading up to COUNT bytes;
+return the offset where NUMBER first occurs or #f if it could not be found."
+  (let loop ((offset offset)
+             (count count))
+    (cond ((zero? count) #f)
+          ((= (bytevector-u8-ref bv offset) number) offset)
+          (else (loop (+ 1 offset) (- count 1))))))
+
+(define (split-lines str)
+  "Split STR into lines in a way that preserves newline characters."
+  (let loop ((str str)
+             (result '()))
+    (if (string-null? str)
+        (reverse result)
+        (match (string-index str #\newline)
+          (#f
+           (loop "" (cons str result)))
+          (index
+           (loop (string-drop str (+ index 1))
+                 (cons (string-take str (+ index 1)) result)))))))
 
 (define* (build-event-output-port proc #:optional (seed (build-status)))
   "Return an output port for use as 'current-build-output-port' that calls
@@ -449,33 +502,83 @@ The second return value is a thunk to retrieve the current state."
     ;; Current state for PROC.
     seed)
 
+  ;; When true, this represents the current state while reading a
+  ;; "@ build-log" trace: the current builder PID, the previously-read
+  ;; bytevectors, and the number of bytes that remain to be read.
+  (define %build-output-pid #f)
+  (define %build-output '())
+  (define %build-output-left #f)
+
   (define (process-line line)
-    (if (string-prefix? "@ " line)
-        (match (string-tokenize (string-drop line 2))
-          (((= string->symbol event-name) args ...)
-           (set! %state
-             (proc (cons event-name args)
-                   %state))))
-        (set! %state (proc (list 'build-log line)
-                           %state))))
+    (cond ((string-prefix? "@ " line)
+           (match (string-tokenize (string-drop line 2))
+             (("build-log" (= string->number pid) (= string->number len))
+              (set! %build-output-pid pid)
+              (set! %build-output '())
+              (set! %build-output-left len))
+             (((= string->symbol event-name) args ...)
+              (set! %state
+                (proc (cons event-name args)
+                      %state)))))
+          (else
+           (set! %state (proc (list 'build-log #f line)
+                              %state)))))
+
+  (define (process-build-output pid output)
+    ;; Transform OUTPUT in 'build-log' events or download events as generated
+    ;; by extended build traces.
+    (define (line->event line)
+      (match (and (string-prefix? "@ " line)
+                  (string-tokenize (string-drop line 2)))
+        ((type . args)
+         (if (or (string-prefix? "download-" type)
+                 (string=? "build-remote" type))
+             (cons (string->symbol type) args)
+             `(build-log ,pid ,line)))
+        (_
+         `(build-log ,pid ,line))))
+
+    (let* ((lines  (split-lines output))
+           (events (map line->event lines)))
+      (set! %state (fold proc %state events))))
 
   (define (bytevector-range bv offset count)
     (let ((ptr (bytevector->pointer bv offset)))
       (pointer->bytevector ptr count)))
 
   (define (write! bv offset count)
-    (let loop ((str (utf8->string (bytevector-range bv offset count))))
-      (match (string-index str %newline)
-        ((? integer? cr)
-         (let ((tail (string-take str (+ 1 cr))))
-           (process-line (string-concatenate-reverse
-                          (cons tail %fragments)))
-           (set! %fragments '())
-           (loop (string-drop str (+ 1 cr)))))
-        (#f
-         (unless (string-null? str)
-           (set! %fragments (cons str %fragments)))
-         count))))
+    (if %build-output-pid
+        (let ((keep (min count %build-output-left)))
+          (set! %build-output
+            (let ((bv* (make-bytevector keep)))
+              (bytevector-copy! bv offset bv* 0 keep)
+              (cons bv* %build-output)))
+          (set! %build-output-left
+            (- %build-output-left keep))
+
+          (when (zero? %build-output-left)
+            (process-build-output %build-output-pid
+                                  (string-concatenate-reverse
+                                   (map maybe-utf8->string %build-output))) ;XXX
+            (set! %build-output '())
+            (set! %build-output-pid #f))
+          keep)
+        (match (bytevector-index bv (char->integer #\newline)
+                                 offset count)
+          ((? integer? cr)
+           (let* ((tail (maybe-utf8->string
+                         (bytevector-range bv offset (- cr -1 offset))))
+                  (line (string-concatenate-reverse
+                         (cons tail %fragments))))
+             (process-line line)
+             (set! %fragments '())
+             (- cr -1 offset)))
+          (#f
+           (unless (zero? count)
+             (let ((str (maybe-utf8->string
+                         (bytevector-range bv offset count))))
+               (set! %fragments (cons str %fragments))))
+           count))))
 
   (define port
     (make-custom-binary-output-port "filtering-input-port"
@@ -485,8 +588,9 @@ The second return value is a thunk to retrieve the current state."
 
   ;; The build port actually receives Unicode strings.
   (set-port-encoding! port "UTF-8")
-  (setvbuf port (cond-expand (guile-2.2 'line) (else _IOLBF)))
-
+  (cond-expand
+    ((and guile-2 (not guile-2.2)) #t)
+    (else (setvbuf port 'line)))
   (values port (lambda () %state)))
 
 (define (call-with-status-report on-event thunk)
diff --git a/guix/store.scm b/guix/store.scm
index 8b35fc8d7a..b1bdbf3813 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -155,7 +155,7 @@
             derivation-log-file
             log-file))
 
-(define %protocol-version #x162)
+(define %protocol-version #x163)
 
 (define %worker-magic-1 #x6e697863)               ; "nixc"
 (define %worker-magic-2 #x6478696f)               ; "dxio"
@@ -709,6 +709,15 @@ encoding conversion errors."
                             ;; disabled by default.
                             print-extended-build-trace?
 
+                            ;; When true, the daemon prefixes builder output
+                            ;; with "@ build-log" traces so we can
+                            ;; distinguish it from daemon output, and we can
+                            ;; distinguish each builder's output
+                            ;; (PRINT-BUILD-TRACE must be true as well.)  The
+                            ;; latter is particularly useful when
+                            ;; MAX-BUILD-JOBS > 1.
+                            multiplexed-build-output?
+
                             build-cores
                             (use-substitutes? #t)
 
@@ -757,6 +766,10 @@ encoding conversion errors."
                            `(("print-extended-build-trace"
                               . ,(if print-extended-build-trace? "1" "0")))
                            '())
+                     ,@(if multiplexed-build-output?
+                           `(("multiplexed-build-output"
+                              . ,(if multiplexed-build-output? "true" "false")))
+                           '())
                      ,@(if timeout
                            `(("build-timeout" . ,(number->string timeout)))
                            '())