Merge branch 'master' into core-updates

11 files changed, 175 insertions, 285 deletions

diff --git a/guix/build/compile.scm b/guix/build/compile.scm
index 5a1363556a..9e31be93ff 100644
--- a/guix/build/compile.scm
+++ b/guix/build/compile.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -26,28 +26,22 @@
   #:use-module (system base message)
   #:use-module (guix modules)
   #:use-module (guix build utils)
+  #:use-module (language tree-il optimize)
+  #:use-module (language cps optimize)
   #:export (%default-optimizations
             %lightweight-optimizations
             compile-files))
 
 ;;; Commentary:
 ;;;
-;;; Support code to compile Guile code as efficiently as possible (both with
-;;; Guile 2.0 and 2.2).
+;;; Support code to compile Guile code as efficiently as possible (with 2.2).
 ;;;
 ;;; Code:
 
-(cond-expand
-  (guile-2.2 (use-modules (language tree-il optimize)
-                          (language cps optimize)))
-  (else #f))
-
 (define %default-optimizations
   ;; Default optimization options (equivalent to -O2 on Guile 2.2).
-  (cond-expand
-    (guile-2.2 (append (tree-il-default-optimization-options)
-                       (cps-default-optimization-options)))
-    (else '())))
+  (append (tree-il-default-optimization-options)
+          (cps-default-optimization-options)))
 
 (define %lightweight-optimizations
   ;; Lightweight optimizations (like -O0, but with partial evaluation).
@@ -103,8 +97,7 @@
          (report-load file total completed)
          (format debug-port "~%loading '~a'...~%" file)
 
-         (parameterize ((current-warning-port debug-port))
-           (resolve-interface (file-name->module-name file)))
+         (resolve-interface (file-name->module-name file))
 
          (loop files (+ 1 completed)))))))
 
@@ -164,37 +157,38 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
 
     ;; Exit as soon as something goes wrong.
     (exit-on-exception
-     (with-fluids ((*current-warning-prefix* ""))
-       (with-target host
-         (lambda ()
-           (let ((relative (relative-file source-directory file)))
-             (compile-file file
-                           #:output-file (string-append build-directory "/"
-                                                        (scm->go relative))
-                           #:opts (append warning-options
-                                          (optimization-options relative))))))))
+     (with-target host
+       (lambda ()
+         (let ((relative (relative-file source-directory file)))
+           (compile-file file
+                         #:output-file (string-append build-directory "/"
+                                                      (scm->go relative))
+                         #:opts (append warning-options
+                                        (optimization-options relative)))))))
     (with-mutex progress-lock
       (set! completed (+ 1 completed))))
 
   (with-augmented-search-path %load-path source-directory
     (with-augmented-search-path %load-compiled-path build-directory
-      ;; FIXME: To work around <https://bugs.gnu.org/15602>, we first load all
-      ;; of FILES.
-      (load-files source-directory files
-                  #:report-load report-load
-                  #:debug-port debug-port)
-
-      ;; Make sure compilation related modules are loaded before starting to
-      ;; compile files in parallel.
-      (compile #f)
-
-      ;; XXX: Don't use too many workers to work around the insane memory
-      ;; requirements of the compiler in Guile 2.2.2:
-      ;; <https://lists.gnu.org/archive/html/guile-devel/2017-05/msg00033.html>.
-      (n-par-for-each (min workers 8) build files)
-
-      (unless (zero? total)
-        (report-compilation #f total total)))))
+      (with-fluids ((*current-warning-prefix* ""))
+
+        ;; FIXME: To work around <https://bugs.gnu.org/15602>, we first load all
+        ;; of FILES.
+        (load-files source-directory files
+                    #:report-load report-load
+                    #:debug-port debug-port)
+
+        ;; Make sure compilation related modules are loaded before starting to
+        ;; compile files in parallel.
+        (compile #f)
+
+        ;; XXX: Don't use too many workers to work around the insane memory
+        ;; requirements of the compiler in Guile 2.2.2:
+        ;; <https://lists.gnu.org/archive/html/guile-devel/2017-05/msg00033.html>.
+        (n-par-for-each (min workers 8) build files)
+
+        (unless (zero? total)
+          (report-compilation #f total total))))))
 
 (eval-when (eval load)
   (when (and (string=? "2" (major-version))
diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm
index 13f01fb1e8..681f22238d 100644
--- a/guix/build/download-nar.scm
+++ b/guix/build/download-nar.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -93,8 +93,8 @@ ITEM."
   "Download and extract the normalized archive for ITEM.  Return #t on
 success, #f otherwise."
   ;; Let progress reports go through.
-  (setvbuf (current-error-port) _IONBF)
-  (setvbuf (current-output-port) _IONBF)
+  (setvbuf (current-error-port) 'none)
+  (setvbuf (current-output-port) 'none)
 
   (let loop ((urls (urls-for-item item)))
     (match urls
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 54163849a2..c08221b3b2 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
@@ -314,9 +314,7 @@ host name without trailing dot."
 
       ;; Write HTTP requests line by line rather than byte by byte:
       ;; <https://bugs.gnu.org/22966>.  This is possible with Guile >= 2.2.
-      (cond-expand
-        (guile-2.2 (setvbuf record 'line))
-        (else #f))
+      (setvbuf record 'line)
 
       record)))
 
@@ -359,7 +357,7 @@ ETIMEDOUT error is raised."
           (connect* s (addrinfo:addr ai) timeout)
 
           ;; Buffer input and output on this port.
-          (setvbuf s _IOFBF)
+          (setvbuf s 'block)
           ;; If we're using a proxy, make a note of that.
           (when http-proxy (set-http-proxy-port?! s #t))
           s)
@@ -403,7 +401,7 @@ VERIFY-CERTIFICATE? is true, verify HTTPS server certificates."
     (with-https-proxy
      (let ((s (open-socket-for-uri uri #:timeout timeout)))
        ;; Buffer input and output on this port.
-       (setvbuf s _IOFBF %http-receive-buffer-size)
+       (setvbuf s 'block %http-receive-buffer-size)
 
        (if https?
            (tls-wrap s (uri-host uri)
@@ -506,18 +504,6 @@ port if PORT is a TLS session record port."
   (module-set! (resolve-module '(web http))
                'parse-rfc-822-date parse-rfc-822-date))
 
-;; XXX: Work around <http://bugs.gnu.org/19840>, present in Guile
-;; up to 2.0.11.
-(unless (or (> (string->number (major-version)) 2)
-            (> (string->number (minor-version)) 0)
-            (> (string->number (micro-version)) 11))
-  (let ((var (module-variable (resolve-module '(web http))
-                              'declare-relative-uri-header!)))
-    ;; If 'declare-relative-uri-header!' doesn't exist, forget it.
-    (when (and var (variable-bound? var))
-      (let ((declare-relative-uri-header! (variable-ref var)))
-        (declare-relative-uri-header! "Location")))))
-
 ;; XXX: Work around broken proxy handling on Guile 2.2 <= 2.2.2, fixed in
 ;; Guile commits 7d0d9e2c25c1e872cfc7d14ab5139915f1813d56 and
 ;; 6ad28ae3bc6a6d9e95ab7d70510d12c97673a143.  See bug report at
@@ -791,11 +777,11 @@ otherwise simply ignore them."
                               hashes))
                 content-addressed-mirrors))
 
-  ;; Make this unbuffered so 'progress-report/file' works as expected.  _IOLBF
+  ;; Make this unbuffered so 'progress-report/file' works as expected.  'line
   ;; means '\n', not '\r', so it's not appropriate here.
-  (setvbuf (current-output-port) _IONBF)
+  (setvbuf (current-output-port) 'none)
 
-  (setvbuf (current-error-port) _IOLBF)
+  (setvbuf (current-error-port) 'line)
 
   (let try ((uri (append uri content-addressed-uris)))
     (match uri
diff --git a/guix/build/dune-build-system.scm b/guix/build/dune-build-system.scm
index fcc2d6567d..00b0c7c406 100644
--- a/guix/build/dune-build-system.scm
+++ b/guix/build/dune-build-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
+;;; Copyright © 2019 Gabriel Hondet <gabrielhondet@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -49,7 +50,8 @@
   "Install the given package."
   (let ((out (assoc-ref outputs "out"))
         (program (if jbuild? "jbuilder" "dune")))
-    (invoke program install-target "--prefix" out))
+    (invoke program install-target "--prefix" out "--libdir"
+            (string-append out "/lib/ocaml/site-lib")))
   #t)
 
 (define %standard-phases
diff --git a/guix/build/git.scm b/guix/build/git.scm
index 2d1700a9b9..669e38cd32 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,6 +18,8 @@
 
 (define-module (guix build git)
   #:use-module (guix build utils)
+  #:use-module (srfi srfi-34)
+  #:use-module (ice-9 format)
   #:export (git-fetch))
 
 ;;; Commentary:
@@ -39,31 +41,39 @@ recursively.  Return #t on success, #f otherwise."
 
   (mkdir-p directory)
 
-  (with-directory-excursion directory
-    (invoke git-command "init")
-    (invoke git-command "remote" "add" "origin" url)
-    (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit))
-        (invoke git-command "checkout" "FETCH_HEAD")
-        (begin
-          (setvbuf (current-output-port) 'line)
-          (format #t "Failed to do a shallow fetch; retrying a full fetch...~%")
-          (invoke git-command "fetch" "origin")
-          (invoke git-command "checkout" commit)))
-    (when recursive?
-      ;; Now is the time to fetch sub-modules.
-      (unless (zero? (system* git-command "submodule" "update"
-                                          "--init" "--recursive"))
-        (error "failed to fetch sub-modules" url))
+  (guard (c ((invoke-error? c)
+             (format (current-error-port)
+                     "git-fetch: '~a~{ ~a~}' failed with exit code ~a~%"
+                     (invoke-error-program c)
+                     (invoke-error-arguments c)
+                     (or (invoke-error-exit-status c) ;XXX: not quite accurate
+                         (invoke-error-stop-signal c)
+                         (invoke-error-term-signal c)))
+             (delete-file-recursively directory)
+             #f))
+    (with-directory-excursion directory
+      (invoke git-command "init")
+      (invoke git-command "remote" "add" "origin" url)
+      (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit))
+          (invoke git-command "checkout" "FETCH_HEAD")
+          (begin
+            (setvbuf (current-output-port) 'line)
+            (format #t "Failed to do a shallow fetch; retrying a full fetch...~%")
+            (invoke git-command "fetch" "origin")
+            (invoke git-command "checkout" commit)))
+      (when recursive?
+        ;; Now is the time to fetch sub-modules.
+        (invoke git-command "submodule" "update" "--init" "--recursive")
 
-      ;; In sub-modules, '.git' is a flat file, not a directory,
-      ;; so we can use 'find-files' here.
-      (for-each delete-file-recursively
-                (find-files directory "^\\.git$")))
+        ;; In sub-modules, '.git' is a flat file, not a directory,
+        ;; so we can use 'find-files' here.
+        (for-each delete-file-recursively
+                  (find-files directory "^\\.git$")))
 
       ;; The contents of '.git' vary as a function of the current
       ;; status of the Git repo.  Since we want a fixed output, this
       ;; directory needs to be taken out.
       (delete-file-recursively ".git")
-      #t))
+      #t)))
 
 ;;; git.scm ends here
diff --git a/guix/build/make-bootstrap.scm b/guix/build/make-bootstrap.scm
index 0c7b4ac6fd..e5ef1d6d2b 100644
--- a/guix/build/make-bootstrap.scm
+++ b/guix/build/make-bootstrap.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2017 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -101,7 +101,7 @@ when producing a bootstrap libc."
 util).*\\.so(\\..*)?|lib(machuser|hurduser).so.*|(libc(rt|)|libpthread)\
 _nonshared\\.a)$")
 
-  (setvbuf (current-output-port) _IOLBF)
+  (setvbuf (current-output-port) 'line)
   (let* ((libdir (string-append output "/lib")))
     (mkdir-p libdir)
     (for-each (lambda (file)
diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index 0c23cd300e..1dc7976879 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -67,8 +67,14 @@ user-friendly name of the profile is, for instance ~/.guix-profile rather than
 (define (build-etc/profile output search-paths)
   "Build the 'OUTPUT/etc/profile' shell file containing environment variable
 definitions for all the SEARCH-PATHS."
-  (mkdir-p (string-append output "/etc"))
-  (call-with-output-file (string-append output "/etc/profile")
+  (define file
+    (string-append output "/etc/profile"))
+
+  (mkdir-p (dirname file))
+  (when (file-exists? file)
+    (delete-file file))
+
+  (call-with-output-file file
     (lambda (port)
       ;; The use of $GUIX_PROFILE described below is not great.  Another
       ;; option would have been to use "$1" and have users run:
@@ -144,13 +150,22 @@ instead make DIRECTORY a \"real\" directory containing symlinks."
 create symlinks.  Write MANIFEST, an sexp, to OUTPUT/manifest.  Create
 OUTPUT/etc/profile with Bash definitions for -all the variables listed in
 SEARCH-PATHS."
+  (define manifest-file
+    (string-append output "/manifest"))
+
   ;; Make the symlinks.
   (union-build output inputs
                #:symlink symlink
                #:log-port (%make-void-port "w"))
 
+  ;; If one of the INPUTS provides a '/manifest' file, delete it.  That can
+  ;; happen if MANIFEST contains something such as a Guix instance, which is
+  ;; ultimately built as a profile.
+  (when (file-exists? manifest-file)
+    (delete-file manifest-file))
+
   ;; Store meta-data.
-  (call-with-output-file (string-append output "/manifest")
+  (call-with-output-file manifest-file
     (lambda (p)
       (pretty-print manifest p)))
 
diff --git a/guix/build/pull.scm b/guix/build/pull.scm
deleted file mode 100644
index a011e366f6..0000000000
--- a/guix/build/pull.scm
+++ /dev/null
@@ -1,154 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (guix build pull)
-  #:use-module (guix modules)
-  #:use-module (guix build utils)
-  #:use-module (guix build compile)
-  #:use-module (ice-9 ftw)
-  #:use-module (ice-9 match)
-  #:use-module (ice-9 format)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
-  #:use-module (srfi srfi-26)
-  #:use-module (srfi srfi-34)
-  #:export (build-guix))
-
-;;; Commentary:
-;;;
-;;; Helpers for the 'guix pull' command to unpack and build Guix.
-;;;
-;;; Code:
-
-(define (has-all-its-dependencies? file)
-  "Return true if the dependencies of the module defined in FILE are
-available, false otherwise."
-  (let ((module (call-with-input-file file
-                  (lambda (port)
-                    (match (read port)
-                      (('define-module name _ ...)
-                       name))))))
-    ;; If one of the dependencies of MODULE is missing, we get a
-    ;; '&missing-dependency-error'.
-    (guard (c ((missing-dependency-error? c) #f))
-      (source-module-closure (list module) #:select? (const #t)))))
-
-(define (all-scheme-files directory)
-  "Return a sorted list of Scheme files found in DIRECTORY."
-  ;; Load guix/ modules before gnu/ modules to get somewhat steadier
-  ;; progress reporting.
-  (sort (filter (cut string-suffix? ".scm" <>)
-                (find-files directory "\\.scm"))
-        (let ((guix (string-append directory "/guix"))
-              (gnu  (string-append directory "/gnu")))
-          (lambda (a b)
-            (or (and (string-prefix? guix a)
-                     (string-prefix? gnu  b))
-                (string<? a b))))))
-
-
-(define* (build-guix out source
-                     #:key
-                     system
-                     storedir localstatedir sysconfdir sbindir
-
-                     (package-name "GNU Guix")
-                     (package-version "0")
-                     (bug-report-address "bug-guix@gnu.org")
-                     (home-page-url "https://gnu.org/s/guix")
-
-                     libgcrypt zlib gzip bzip2 xz
-
-                     (debug-port (%make-void-port "w"))
-                     (log-port (current-error-port)))
-  "Build and install Guix in directory OUT using SOURCE, a directory
-containing the source code.  Write any debugging output to DEBUG-PORT."
-  (setvbuf (current-output-port) _IOLBF)
-  (setvbuf (current-error-port) _IOLBF)
-
-  (with-directory-excursion source
-    (format #t "copying and compiling to '~a' with Guile ~a...~%"
-            out (version))
-
-    ;; Copy everything under guix/ and gnu/ plus {guix,gnu}.scm.
-    (copy-recursively "guix" (string-append out "/guix")
-                      #:log debug-port)
-    (copy-recursively "gnu" (string-append out "/gnu")
-                      #:log debug-port)
-    (copy-file "guix.scm" (string-append out "/guix.scm"))
-    (copy-file "gnu.scm" (string-append out "/gnu.scm"))
-
-    ;; Instantiate a (guix config) module that preserves the original
-    ;; settings.
-    (copy-file "guix/config.scm.in"
-               (string-append out "/guix/config.scm"))
-    (substitute* (string-append out "/guix/config.scm")
-      (("@PACKAGE_NAME@") package-name)
-      (("@PACKAGE_VERSION@") package-version)
-      (("@PACKAGE_BUGREPORT@") bug-report-address)
-      (("@PACKAGE_URL@") home-page-url)
-      (("@storedir@") storedir)
-      (("@guix_localstatedir@") localstatedir)
-      (("@guix_sysconfdir@") sysconfdir)
-      (("@guix_sbindir@") sbindir)
-      (("@guix_system@") system)
-      (("@LIBGCRYPT@") (string-append libgcrypt "/lib/libgcrypt"))
-      (("@LIBZ@") (string-append zlib "/lib/libz"))
-      (("@GZIP@") (string-append gzip "/bin/gzip"))
-      (("@BZIP2@") (string-append bzip2 "/bin/bzip2"))
-      (("@XZ@") (string-append xz "/bin/xz"))
-      (("@NIX_INSTANTIATE@") "nix-instantiate"))  ;for (guix import nix)
-
-    ;; Augment the search path so Scheme code can be compiled.
-    (set! %load-path (cons out %load-path))
-    (set! %load-compiled-path (cons out %load-compiled-path))
-
-    ;; Compile the .scm files.  Hide warnings.
-    (parameterize ((current-warning-port (%make-void-port "w")))
-      ;; Filter out files depending on Guile-SSH when Guile-SSH is missing.
-      (let ((files (filter has-all-its-dependencies?
-                           (all-scheme-files out))))
-        (compile-files out out files
-
-                       #:workers (parallel-job-count)
-
-                       ;; Disable warnings.
-                       #:warning-options '()
-
-                       #:report-load
-                       (lambda (file total completed)
-                         (display #\cr log-port)
-                         (format log-port
-                                 "loading...\t~5,1f% of ~d files" ;FIXME: i18n
-                                 (* 100. (/ completed total)) total)
-                         (force-output log-port)
-                         (format debug-port "~%loading '~a'...~%" file))
-
-                       #:report-compilation
-                       (lambda (file total completed)
-                         (display #\cr log-port)
-                         (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n
-                                 (* 100. (/ completed total)) total)
-                         (force-output log-port)
-                         (format debug-port "~%compiling '~a'...~%" file))))))
-
-  (newline)
-  #t)
-
-;;; pull.scm ends here
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 56a689f667..66d63a2931 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -73,6 +73,7 @@
             file-system-mount-flags
             statfs
             free-disk-space
+            device-in-use?
 
             processes
             mkdtemp!
@@ -684,6 +685,32 @@ mounted at FILE."
 (define AT_NO_AUTOMOUNT     #x800)
 (define AT_EMPTY_PATH       #x1000)
 
+(define-syntax BLKRRPART                         ;<sys/mount.h>
+  (identifier-syntax #x125F))
+
+(define* (device-in-use? device)
+  "Return #t if the block DEVICE is in use, #f otherwise. This is inspired
+from fdisk_device_is_used function of util-linux. This is particulary useful
+for devices that do not appear in /proc/self/mounts like overlayfs lowerdir
+backend device."
+  (let*-values (((fd)      (open-fdes device O_RDONLY))
+                ((ret err) (%ioctl fd BLKRRPART %null-pointer)))
+    (close-fdes fd)
+    (cond
+     ((= ret 0)
+      #f)
+     ((= err EBUSY)
+      #t)
+     ((= err EINVAL)
+      ;; We get EINVAL for devices that have the GENHD_FL_NO_PART_SCAN flag
+      ;; set in the kernel, in particular loopback devices, though we do seem
+      ;; to get it for SCSI storage (/dev/sr0) on QEMU.
+      #f)
+     (else
+      (throw 'system-error "ioctl" "~A"
+             (list (strerror err))
+             (list err))))))
+
 
 ;;;
 ;;; Containers.
@@ -699,39 +726,31 @@ mounted at FILE."
 (define CLONE_NEWPID         #x20000000)
 (define CLONE_NEWNET         #x40000000)
 
-(cond-expand
-  (guile-2.2
-   (define %set-automatic-finalization-enabled?!
-     ;; When using a statically-linked Guile, for instance in the initrd, we
-     ;; cannot resolve this symbol, but most of the time we don't need it
-     ;; anyway.  Thus, delay it.
-     (let ((proc (delay
-                   (pointer->procedure int
-                                       (dynamic-func
-                                        "scm_set_automatic_finalization_enabled"
-                                        (dynamic-link))
-                                       (list int)))))
-       (lambda (enabled?)
-         "Switch on or off automatic finalization in a separate thread.
+(define %set-automatic-finalization-enabled?!
+  ;; When using a statically-linked Guile, for instance in the initrd, we
+  ;; cannot resolve this symbol, but most of the time we don't need it
+  ;; anyway.  Thus, delay it.
+  (let ((proc (delay
+                (pointer->procedure int
+                                    (dynamic-func
+                                     "scm_set_automatic_finalization_enabled"
+                                     (dynamic-link))
+                                    (list int)))))
+    (lambda (enabled?)
+      "Switch on or off automatic finalization in a separate thread.
 Turning finalization off shuts down the finalization thread as a side effect."
-         (->bool ((force proc) (if enabled? 1 0))))))
-
-   (define-syntax-rule (without-automatic-finalization exp)
-     "Turn off automatic finalization within the dynamic extent of EXP."
-     (let ((enabled? #t))
-       (dynamic-wind
-         (lambda ()
-           (set! enabled? (%set-automatic-finalization-enabled?! #f)))
-         (lambda ()
-           exp)
-         (lambda ()
-           (%set-automatic-finalization-enabled?! enabled?))))))
-
-  (else
-   (define-syntax-rule (without-automatic-finalization exp)
-     ;; Nothing to do here: Guile 2.0 does not have a separate finalization
-     ;; thread.
-     exp)))
+      (->bool ((force proc) (if enabled? 1 0))))))
+
+(define-syntax-rule (without-automatic-finalization exp)
+  "Turn off automatic finalization within the dynamic extent of EXP."
+  (let ((enabled? #t))
+    (dynamic-wind
+      (lambda ()
+        (set! enabled? (%set-automatic-finalization-enabled?! #f)))
+      (lambda ()
+        exp)
+      (lambda ()
+        (%set-automatic-finalization-enabled?! enabled?)))))
 
 ;; The libc interface to sys_clone is not useful for Scheme programs, so the
 ;; low-level system call is wrapped instead.  The 'syscall' function is
diff --git a/guix/build/texlive-build-system.scm b/guix/build/texlive-build-system.scm
index 1c393ecd9d..841c631dae 100644
--- a/guix/build/texlive-build-system.scm
+++ b/guix/build/texlive-build-system.scm
@@ -35,7 +35,7 @@
 
 (define (compile-with-latex format file)
   (invoke format
-          "-interaction=batchmode"
+          "-interaction=nonstopmode"
           "-output-directory=build"
           (string-append "&" format)
           file))
@@ -60,7 +60,12 @@
       (("^TEXMF = .*")
        "TEXMF = $TEXMFROOT/share/texmf-dist\n"))
     (setenv "TEXMFCNF" (dirname texmf.cnf))
-    (setenv "TEXMF" (string-append out "/share/texmf-dist")))
+    (setenv "TEXMF" (string-append out "/share/texmf-dist"))
+
+    ;; Don't truncate lines.
+    (setenv "error_line" "254") ; must be less than 255
+    (setenv "half_error_line" "238") ; must be less than error_line - 15
+    (setenv "max_print_line" "1000"))
   (mkdir "build")
   #t)
 
diff --git a/guix/build/union.scm b/guix/build/union.scm
index fff795c4d3..961ac3298b 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
 ;;;
@@ -39,6 +39,19 @@
 ;;;
 ;;; Code:
 
+;; This code can be used with the bootstrap Guile, which is Guile 2.0, so
+;; provide a compatibility layer.
+(cond-expand
+  ((and guile-2 (not guile-2.2))
+   (define (setvbuf port mode . rest)
+     (apply (@ (guile) setvbuf) port
+            (match mode
+              ('line _IOLBF)
+              ('block _IOFBF)
+              ('none _IONBF))
+            rest)))
+  (else #f))
+
 (define (files-in-directory dirname)
   (let ((dir (opendir dirname)))
     (let loop ((files '()))
@@ -179,10 +192,10 @@ returns #f, skip the faulty file altogether."
                                    (reverse dirs-with-file))))
                      table)))
 
-  (setvbuf (current-output-port) _IOLBF)
-  (setvbuf (current-error-port) _IOLBF)
+  (setvbuf (current-output-port) 'line)
+  (setvbuf (current-error-port) 'line)
   (when (file-port? log-port)
-    (setvbuf log-port _IOLBF))
+    (setvbuf log-port 'line))
 
   (union-of-directories output (delete-duplicates inputs)))