Merge branch 'master' into core-updates

18 files changed, 359 insertions, 192 deletions

diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm
index 7d363a18a5..06ed14b89f 100644
--- a/guix/build/cargo-build-system.scm
+++ b/guix/build/cargo-build-system.scm
@@ -134,22 +134,12 @@ directory = '" port)
   ;; upgrading the compiler for example.
   (setenv "RUSTFLAGS" "--cap-lints allow")
   (setenv "CC" (string-append (assoc-ref inputs "gcc") "/bin/gcc"))
-  #t)
 
-;; The Cargo.lock file tells the build system which crates are required for
-;; building and hardcodes their version and checksum.  In order to build with
-;; the inputs we provide, we need to recreate the file with our inputs.
-(define* (update-cargo-lock #:key
-                            (vendor-dir "guix-vendor")
-                            #:allow-other-keys)
-  "Regenerate the Cargo.lock file with the current build inputs."
+  ;; We don't use the Cargo.lock file to determine the package versions we use
+  ;; during building, and in any case if one is not present it is created
+  ;; during the 'build phase by cargo.
   (when (file-exists? "Cargo.lock")
-    (begin
-      ;; Unfortunately we can't generate a Cargo.lock file until the checksums
-      ;; are generated, so we have an extra round of generate-all-checksums here.
-      (generate-all-checksums vendor-dir)
-      (delete-file "Cargo.lock")
-      (invoke "cargo" "generate-lockfile")))
+    (delete-file "Cargo.lock"))
   #t)
 
 ;; After the 'patch-generated-file-shebangs phase any vendored crates who have
@@ -203,7 +193,6 @@ directory = '" port)
     (replace 'build build)
     (replace 'check check)
     (replace 'install install)
-    (add-after 'configure 'update-cargo-lock update-cargo-lock)
     (add-after 'patch-generated-file-shebangs 'patch-cargo-checksums patch-cargo-checksums)))
 
 (define* (cargo-build #:key inputs (phases %standard-phases)
diff --git a/guix/build/make-bootstrap.scm b/guix/build/make-bootstrap.scm
index 0d29338ce3..e5ef1d6d2b 100644
--- a/guix/build/make-bootstrap.scm
+++ b/guix/build/make-bootstrap.scm
@@ -47,6 +47,7 @@ bootstrap libc."
                 (install-file (pk 'src (string-append kernel-headers "/include/linux/" file))
                               (pk 'dest (string-append incdir "/linux"))))
               '(
+                "a.out.h"               ; for 2.2.5
                 "atalk.h"               ; for 2.2.5
                 "errno.h"
                 "falloc.h"
diff --git a/guix/diagnostics.scm b/guix/diagnostics.scm
index 380cfbb613..6c0753aef4 100644
--- a/guix/diagnostics.scm
+++ b/guix/diagnostics.scm
@@ -71,7 +71,12 @@ is a trivial format string."
 (define* (%highlight-argument arg #:optional (port (guix-warning-port)))
   "Highlight ARG, a format string argument, if PORT supports colors."
   (cond ((string? arg)
-         (highlight arg port))
+         ;; If ARG contains white space, don't highlight it, on the grounds
+         ;; that it may be a complete message in its own, like those produced
+         ;; by 'guix lint.
+         (if (string-any char-set:whitespace arg)
+             arg
+             (highlight arg port)))
         ((symbol? arg)
          (highlight (symbol->string arg) port))
         (else arg)))
diff --git a/guix/docker.scm b/guix/docker.scm
index c598a073f6..757bdeb458 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -28,11 +28,13 @@
                           invoke))
   #:use-module (gnu build install)
   #:use-module (json)                             ;guile-json
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module ((texinfo string-utils)
                 #:select (escape-special-chars))
   #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:export (build-docker-image))
 
@@ -99,21 +101,18 @@
   '("--sort=name" "--mtime=@1"
     "--owner=root:0" "--group=root:0"))
 
-(define symlink-source
+(define directive-file
+  ;; Return the file or directory created by a 'evaluate-populate-directive'
+  ;; directive.
   (match-lambda
     ((source '-> target)
-     (string-trim source #\/))))
-
-(define (topmost-component file)
-  "Return the topmost component of FILE.  For instance, if FILE is \"/a/b/c\",
-return \"a\"."
-  (match (string-tokenize file (char-set-complement (char-set #\/)))
-    ((first rest ...)
-     first)))
+     (string-trim source #\/))
+    (('directory name _ ...)
+     (string-trim name #\/))))
 
 (define* (build-docker-image image paths prefix
                              #:key
-                             (symlinks '())
+                             (extra-files '())
                              (transformations '())
                              (system (utsname:machine (uname)))
                              database
@@ -133,8 +132,9 @@ entry point in the Docker image JSON structure.
 ENVIRONMENT must be a list of name/value pairs.  It specifies the environment
 variables that must be defined in the resulting image.
 
-SYMLINKS must be a list of (SOURCE -> TARGET) tuples describing symlinks to be
-created in the image, where each TARGET is relative to PREFIX.
+EXTRA-FILES must be a list of directives for 'evaluate-populate-directive'
+describing non-store files that must be created in the image.
+
 TRANSFORMATIONS must be a list of (OLD -> NEW) tuples describing how to
 transform the PATHS.  Any path in PATHS that begins with OLD will be rewritten
 in the Docker image so that it begins with NEW instead.  If a path is a
@@ -199,25 +199,27 @@ SRFI-19 time-utc object, as the creation time in metadata."
         (with-output-to-file "json"
           (lambda () (scm->json (image-description id time))))
 
-        ;; Create SYMLINKS.
-        (for-each (match-lambda
-                    ((source '-> target)
-                     (let ((source (string-trim source #\/)))
-                       (mkdir-p (dirname source))
-                       (symlink (string-append prefix "/" target)
-                                source))))
-                  symlinks)
+        ;; Create a directory for the non-store files that need to go into the
+        ;; archive.
+        (mkdir "extra")
+
+        (with-directory-excursion "extra"
+          ;; Create non-store files.
+          (for-each (cut evaluate-populate-directive <> "./")
+                    extra-files)
 
-        (when database
-          ;; Initialize /var/guix, assuming PREFIX points to a profile.
-          (install-database-and-gc-roots "." database prefix))
+          (when database
+            ;; Initialize /var/guix, assuming PREFIX points to a profile.
+            (install-database-and-gc-roots "." database prefix))
+
+          (apply invoke "tar" "-cf" "../layer.tar"
+                 `(,@transformation-options
+                   ,@%tar-determinism-options
+                   ,@paths
+                   ,@(scandir "."
+                              (lambda (file)
+                                (not (member file '("." ".."))))))))
 
-        (apply invoke "tar" "-cf" "layer.tar"
-               `(,@transformation-options
-                 ,@%tar-determinism-options
-                 ,@paths
-                 ,@(if database '("var") '())
-                 ,@(map symlink-source symlinks)))
         ;; It is possible for "/" to show up in the archive, especially when
         ;; applying transformations.  For example, the transformation
         ;; "s,^/a,," will (perhaps surprisingly) cause GNU tar to transform
@@ -231,13 +233,7 @@ SRFI-19 time-utc object, as the creation time in metadata."
           (lambda ()
             (system* "tar" "--delete" "/" "-f" "layer.tar")))
 
-        (for-each delete-file-recursively
-                  (map (compose topmost-component symlink-source)
-                       symlinks))
-
-        ;; Delete /var/guix.
-        (when database
-          (delete-file-recursively "var")))
+        (delete-file-recursively "extra"))
 
       (with-output-to-file "config.json"
         (lambda ()
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 8f84681d46..c62bb8ad0f 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -139,8 +139,11 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                 ;; As a last resort, attempt to download from Software Heritage.
                 ;; XXX: Currently recursive checkouts are not supported.
                 (and (not recursive?)
-                     (swh-download (getenv "git url") (getenv "git commit")
-                                   #$output)))))))
+                     (begin
+                       (format (current-error-port)
+                               "Trying to download from Software Heritage...~%")
+                       (swh-download (getenv "git url") (getenv "git commit")
+                                     #$output))))))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "git-checkout") build
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 9c964701b1..51c7ea7b2f 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -24,6 +24,7 @@
   #:use-module ((ice-9 rdelim) #:select (read-string read-line))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (ice-9 receive)
@@ -32,11 +33,13 @@
   #:use-module (guix http-client)
   #:use-module (gcrypt hash)
   #:use-module (guix store)
+  #:use-module ((guix serialization) #:select (write-file))
   #:use-module (guix base32)
   #:use-module ((guix download) #:select (download-to-store))
   #:use-module (guix import utils)
   #:use-module ((guix build utils) #:select (find-files))
   #:use-module (guix utils)
+  #:use-module (guix git)
   #:use-module ((guix build-system r) #:select (cran-uri bioconductor-uri))
   #:use-module (guix upstream)
   #:use-module (guix packages)
@@ -166,11 +169,25 @@ bioconductor package NAME, or #F if the package is unknown."
                (bioconductor-packages-list type))
          (cut assoc-ref <> "Version")))
 
+;; XXX taken from (guix scripts hash)
+(define (vcs-file? file stat)
+  (case (stat:type stat)
+    ((directory)
+     (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
+    ((regular)
+     ;; Git sub-modules have a '.git' file that is a regular text file.
+     (string=? (basename file) ".git"))
+    (else
+     #f)))
+
 ;; Little helper to download URLs only once.
 (define download
   (memoize
-   (lambda (url)
-     (with-store store (download-to-store store url)))))
+   (lambda* (url #:optional git)
+     (with-store store
+       (if git
+           (latest-repository-commit store url)
+           (download-to-store store url))))))
 
 (define (fetch-description repository name)
   "Return an alist of the contents of the DESCRIPTION file for the R package
@@ -211,7 +228,18 @@ from ~s: ~a (~s)~%"
                                                 (string-append dir "/DESCRIPTION") read-string))
                         (lambda (meta)
                           (if (boolean? type) meta
-                              (cons `(bioconductor-type . ,type) meta))))))))))))
+                              (cons `(bioconductor-type . ,type) meta))))))))))
+    ((git)
+     ;; Download the git repository at "NAME"
+     (call-with-values
+         (lambda () (download name #t))
+       (lambda (dir commit)
+         (and=> (description->alist (with-input-from-file
+                                        (string-append dir "/DESCRIPTION") read-string))
+                (lambda (meta)
+                  (cons* `(git . ,name)
+                         `(git-commit . ,commit)
+                         meta))))))))
 
 (define (listify meta field)
   "Look up FIELD in the alist META.  If FIELD contains a comma-separated
@@ -256,7 +284,7 @@ empty list when the FIELD cannot be found."
 
 (define cran-guix-name (cut guix-name "r-" <>))
 
-(define (needs-fortran? tarball)
+(define (tarball-needs-fortran? tarball)
   "Check if the TARBALL contains Fortran source files."
   (define (check pattern)
     (parameterize ((current-error-port (%make-void-port "rw+"))
@@ -266,69 +294,127 @@ empty list when the FIELD cannot be found."
       (check "*.f95")
       (check "*.f")))
 
+(define (directory-needs-fortran? dir)
+  "Check if the directory DIR contains Fortran source files."
+  (match (find-files dir "\\.f(90|95)?")
+    (() #f)
+    (_ #t)))
+
+(define (needs-fortran? thing tarball?)
+  "Check if the THING contains Fortran source files."
+  (if tarball?
+      (tarball-needs-fortran? thing)
+      (directory-needs-fortran? thing)))
+
+(define (files-match-pattern? directory regexp . file-patterns)
+  "Return #T if any of the files matching FILE-PATTERNS in the DIRECTORY match
+the given REGEXP."
+  (let ((pattern (make-regexp regexp)))
+    (any (lambda (file)
+           (call-with-input-file file
+             (lambda (port)
+               (let loop ()
+                 (let ((line (read-line port)))
+                   (cond
+                    ((eof-object? line) #f)
+                    ((regexp-exec pattern line) #t)
+                    (else (loop))))))))
+         (apply find-files directory file-patterns))))
+
 (define (tarball-files-match-pattern? tarball regexp . file-patterns)
   "Return #T if any of the files represented by FILE-PATTERNS in the TARBALL
 match the given REGEXP."
   (call-with-temporary-directory
    (lambda (dir)
-     (let ((pattern (make-regexp regexp)))
-       (parameterize ((current-error-port (%make-void-port "rw+")))
-         (apply system* "tar"
-                "xf" tarball "-C" dir
-                `("--wildcards" ,@file-patterns)))
-       (any (lambda (file)
-              (call-with-input-file file
-                (lambda (port)
-                  (let loop ()
-                    (let ((line (read-line port)))
-                      (cond
-                       ((eof-object? line) #f)
-                       ((regexp-exec pattern line) #t)
-                       (else (loop))))))))
-            (find-files dir))))))
-
-(define (needs-zlib? tarball)
+     (parameterize ((current-error-port (%make-void-port "rw+")))
+       (apply system* "tar"
+              "xf" tarball "-C" dir
+              `("--wildcards" ,@file-patterns)))
+     (files-match-pattern? dir regexp))))
+
+(define (directory-needs-zlib? dir)
+  "Return #T if any of the Makevars files in the src directory DIR contain a
+zlib linker flag."
+  (files-match-pattern? dir "-lz" "(Makevars.*|configure.*)"))
+
+(define (tarball-needs-zlib? tarball)
   "Return #T if any of the Makevars files in the src directory of the TARBALL
 contain a zlib linker flag."
   (tarball-files-match-pattern?
    tarball "-lz"
    "*/src/Makevars*" "*/src/configure*" "*/configure*"))
 
-(define (needs-pkg-config? tarball)
+(define (needs-zlib? thing tarball?)
+  "Check if the THING contains files indicating a dependency on zlib."
+  (if tarball?
+      (tarball-needs-zlib? thing)
+      (directory-needs-zlib? thing)))
+
+(define (directory-needs-pkg-config? dir)
+  "Return #T if any of the Makevars files in the src directory DIR reference
+the pkg-config tool."
+  (files-match-pattern? dir "pkg-config"
+                        "(Makevars.*|configure.*)"))
+
+(define (tarball-needs-pkg-config? tarball)
   "Return #T if any of the Makevars files in the src directory of the TARBALL
 reference the pkg-config tool."
   (tarball-files-match-pattern?
    tarball "pkg-config"
    "*/src/Makevars*" "*/src/configure*" "*/configure*"))
 
+(define (needs-pkg-config? thing tarball?)
+  "Check if the THING contains files indicating a dependency on pkg-config."
+  (if tarball?
+      (tarball-needs-pkg-config? thing)
+      (directory-needs-pkg-config? thing)))
+
+;; XXX adapted from (guix scripts hash)
+(define (file-hash file select? recursive?)
+  ;; Compute the hash of FILE.
+  (if recursive?
+      (let-values (((port get-hash) (open-sha256-port)))
+        (write-file file port #:select? select?)
+        (force-output port)
+        (get-hash))
+      (call-with-input-file file port-sha256)))
+
 (define (description->package repository meta)
   "Return the `package' s-expression for an R package published on REPOSITORY
 from the alist META, which was derived from the R package's DESCRIPTION file."
   (let* ((base-url   (case repository
                        ((cran)         %cran-url)
-                       ((bioconductor) %bioconductor-url)))
+                       ((bioconductor) %bioconductor-url)
+                       ((git)          #f)))
          (uri-helper (case repository
                        ((cran)         cran-uri)
-                       ((bioconductor) bioconductor-uri)))
+                       ((bioconductor) bioconductor-uri)
+                       ((git)          #f)))
          (name       (assoc-ref meta "Package"))
          (synopsis   (assoc-ref meta "Title"))
          (version    (assoc-ref meta "Version"))
          (license    (string->license (assoc-ref meta "License")))
          ;; Some packages have multiple home pages.  Some have none.
-         (home-page  (match (listify meta "URL")
-                       ((url rest ...) url)
-                       (_ (string-append base-url name))))
-         (source-url (match (apply uri-helper name version
-                                   (case repository
-                                     ((bioconductor)
-                                      (list (assoc-ref meta 'bioconductor-type)))
-                                     (else '())))
-                       ((url rest ...) url)
-                       ((? string? url) url)
-                       (_ #f)))
-         (tarball    (download source-url))
+         (home-page  (case repository
+                       ((git) (assoc-ref meta 'git))
+                       (else (match (listify meta "URL")
+                               ((url rest ...) url)
+                               (_ (string-append base-url name))))))
+         (source-url (case repository
+                       ((git) (assoc-ref meta 'git))
+                       (else
+                        (match (apply uri-helper name version
+                                      (case repository
+                                        ((bioconductor)
+                                         (list (assoc-ref meta 'bioconductor-type)))
+                                        (else '())))
+                          ((url rest ...) url)
+                          ((? string? url) url)
+                          (_ #f)))))
+         (git?       (assoc-ref meta 'git))
+         (source     (download source-url git?))
          (sysdepends (append
-                      (if (needs-zlib? tarball) '("zlib") '())
+                      (if (needs-zlib? source (not git?)) '("zlib") '())
                       (filter (lambda (name)
                                 (not (member name invalid-packages)))
                               (map string-downcase (listify meta "SystemRequirements")))))
@@ -339,41 +425,67 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
                                          (listify meta "Imports")
                                          (listify meta "LinkingTo")
                                          (delete "R"
-                                                 (listify meta "Depends"))))))
+                                                 (listify meta "Depends")))))
+         (package
+           `(package
+              (name ,(cran-guix-name name))
+              (version ,(case repository
+                          ((git)
+                           `(git-version ,version revision commit))
+                          (else version)))
+              (source (origin
+                        (method ,(if git?
+                                     'git-fetch
+                                     'url-fetch))
+                        (uri ,(case repository
+                                ((git)
+                                 `(git-reference
+                                   (url ,(assoc-ref meta 'git))
+                                   (commit commit)))
+                                (else
+                                 `(,(procedure-name uri-helper) ,name version
+                                   ,@(or (and=> (assoc-ref meta 'bioconductor-type)
+                                                (lambda (type)
+                                                  (list (list 'quote type))))
+                                         '())))))
+                        ,@(if git?
+                              '((file-name (git-file-name name version)))
+                              '())
+                        (sha256
+                         (base32
+                          ,(bytevector->nix-base32-string
+                            (case repository
+                              ((git)
+                               (file-hash source (negate vcs-file?) #t))
+                              (else (file-sha256 source))))))))
+              ,@(if (not (and git?
+                              (equal? (string-append "r-" name)
+                                      (cran-guix-name name))))
+                    `((properties ,`(,'quasiquote ((,'upstream-name . ,name)))))
+                    '())
+              (build-system r-build-system)
+              ,@(maybe-inputs sysdepends)
+              ,@(maybe-inputs (map cran-guix-name propagate) 'propagated-inputs)
+              ,@(maybe-inputs
+                 `(,@(if (needs-fortran? source (not git?))
+                         '("gfortran") '())
+                   ,@(if (needs-pkg-config? source (not git?))
+                         '("pkg-config") '()))
+                 'native-inputs)
+              (home-page ,(if (string-null? home-page)
+                              (string-append base-url name)
+                              home-page))
+              (synopsis ,synopsis)
+              (description ,(beautify-description (or (assoc-ref meta "Description")
+                                                      "")))
+              (license ,license))))
     (values
-     `(package
-        (name ,(cran-guix-name name))
-        (version ,version)
-        (source (origin
-                  (method url-fetch)
-                  (uri (,(procedure-name uri-helper) ,name version
-                        ,@(or (and=> (assoc-ref meta 'bioconductor-type)
-                                     (lambda (type)
-                                       (list (list 'quote type))))
-                              '())))
-                  (sha256
-                   (base32
-                    ,(bytevector->nix-base32-string (file-sha256 tarball))))))
-        ,@(if (not (equal? (string-append "r-" name)
-                           (cran-guix-name name)))
-              `((properties ,`(,'quasiquote ((,'upstream-name . ,name)))))
-              '())
-        (build-system r-build-system)
-        ,@(maybe-inputs sysdepends)
-        ,@(maybe-inputs (map cran-guix-name propagate) 'propagated-inputs)
-        ,@(maybe-inputs
-           `(,@(if (needs-fortran? tarball)
-                   '("gfortran") '())
-             ,@(if (needs-pkg-config? tarball)
-                   '("pkg-config") '()))
-           'native-inputs)
-        (home-page ,(if (string-null? home-page)
-                        (string-append base-url name)
-                        home-page))
-        (synopsis ,synopsis)
-        (description ,(beautify-description (or (assoc-ref meta "Description")
-                                                "")))
-        (license ,license))
+     (case repository
+       ((git)
+        `(let ((commit ,(assoc-ref meta 'git-commit))
+               (revision "1"))
+           ,package))
+       (else package))
      propagate)))
 
 (define cran->guix-package
diff --git a/guix/import/github.scm b/guix/import/github.scm
index fa23fa4c06..55e1f72a42 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -49,7 +49,7 @@ false if none is recognized"
   (define (updated-url url)
     (if (string-prefix? "https://github.com/" url)
         (let ((ext     (or (find-extension url) ""))
-              (name    (package-name old-package))
+              (name    (package-upstream-name old-package))
               (version (package-version old-package))
               (prefix  (string-append "https://github.com/"
                                       (github-user-slash-repository url)))
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 2a3b7341fb..252875eeab 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2012, 2013, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
-;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
 ;;;
@@ -252,6 +252,9 @@ package definition."
   (match guix-package
     (('package ('name (? string? name)) _ ...)
      `(define-public ,(string->symbol name)
+        ,guix-package))
+    (('let anything ('package ('name (? string? name)) _ ...))
+     `(define-public ,(string->symbol name)
         ,guix-package))))
 
 (define (build-system-modules)
diff --git a/guix/lint.scm b/guix/lint.scm
index 7a2bf5a347..212ff70d54 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -1008,8 +1008,8 @@ the NIST server non-fatal."
 (define (check-for-updates package)
   "Check if there is an update available for PACKAGE."
   (match (with-networking-fail-safe
-          (G_ "while retrieving upstream info for '~a'")
-          (list (package-name package))
+          (format #f (G_ "while retrieving upstream info for '~a'")
+                  (package-name package))
           #f
           (package-latest-release* package (force %updaters)))
     ((? upstream-source? source)
diff --git a/guix/packages.scm b/guix/packages.scm
index ac965acd2f..d9eeee15a2 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -801,7 +801,8 @@ dependencies are known to build on SYSTEM."
 
 (define (bag-transitive-host-inputs bag)
   "Same as 'package-transitive-target-inputs', but applied to a bag."
-  (transitive-inputs (bag-host-inputs bag)))
+  (parameterize ((%current-target-system (bag-target bag)))
+    (transitive-inputs (bag-host-inputs bag))))
 
 (define (bag-transitive-target-inputs bag)
   "Return the \"target inputs\" of BAG, recursively."
diff --git a/guix/remote.scm b/guix/remote.scm
index d0c3d04a25..c00585de74 100644
--- a/guix/remote.scm
+++ b/guix/remote.scm
@@ -27,6 +27,7 @@
   #:use-module (guix derivations)
   #:use-module (guix utils)
   #:use-module (ssh popen)
+  #:use-module (ssh channel)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
@@ -68,10 +69,13 @@ BECOME-COMMAND is given, use that to invoke the remote Guile REPL."
 
   (let ((pipe (apply open-remote-pipe* session OPEN_READ repl-command)))
     (when (eof-object? (peek-char pipe))
-      (raise (condition
-              (&message
-               (message (format #f (G_ "failed to run '~{~a~^ ~}'")
-                                repl-command))))))
+      (let ((status (channel-get-exit-status pipe)))
+        (close-port pipe)
+        (raise (condition
+                (&message
+                 (message (format #f (G_ "remote command '~{~a~^ ~}' failed \
+with status ~a")
+                                  repl-command status)))))))
     pipe))
 
 (define* (%remote-eval lowered session #:optional become-command)
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 6a67985c8b..329de41143 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -94,7 +94,7 @@ Perform the deployment specified by FILE.\n"))
                         (machine-display-name machine))
                   (parameterize ((%graft? (assq-ref opts 'graft?)))
                     (guard (c ((message-condition? c)
-                               (report-error (G_ "failed to deploy ~a: '~a'~%")
+                               (report-error (G_ "failed to deploy ~a: ~a~%")
                                              (machine-display-name machine)
                                              (condition-message c)))
                               ((deploy-error? c)
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 0b326e1049..c6cc93fad8 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -113,7 +114,8 @@ Run IMPORTER with ARGS.\n"))
                         (pretty-print expr (newline-rewriting-port
                                             (current-output-port))))))
            (match (apply (resolve-importer importer) args)
-             ((and expr ('package _ ...))
+             ((and expr (or ('package _ ...)
+                            ('let _ ...)))
               (print expr))
              ((? list? expressions)
               (for-each (lambda (expr)
diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm
index 794fb710cd..b6592f78a9 100644
--- a/guix/scripts/import/cran.scm
+++ b/guix/scripts/import/cran.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2015, 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +22,7 @@
   #:use-module (guix utils)
   #:use-module (guix scripts)
   #:use-module (guix import cran)
+  #:use-module (guix import utils)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -96,11 +97,7 @@ Import and convert the CRAN package for PACKAGE-NAME.\n"))
       ((package-name)
        (if (assoc-ref opts 'recursive)
            ;; Recursive import
-           (map (match-lambda
-                  ((and ('package ('name name) . rest) pkg)
-                   `(define-public ,(string->symbol name)
-                      ,pkg))
-                  (_ #f))
+           (map package->definition
                 (reverse
                  (stream->list
                   (cran-recursive-import package-name
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index ee1c826d2e..1668d02992 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -46,9 +46,9 @@
    (lambda (lint-warning)
      (let ((package (lint-warning-package lint-warning))
            (loc     (lint-warning-location lint-warning)))
-       (warning loc (G_ "~a@~a: ~a~%")
-                (package-name package) (package-version package)
-                (lint-warning-message lint-warning))))
+       (info loc (G_ "~a@~a: ~a~%")
+             (package-name package) (package-version package)
+             (lint-warning-message lint-warning))))
    warnings))
 
 (define (run-checkers package checkers)
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index f0cf593814..de5b3fc0ff 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -490,7 +490,8 @@ the image."
         #~(begin
             (use-modules (guix docker) (guix build store-copy)
                          (guix profiles) (guix search-paths)
-                         (srfi srfi-19) (ice-9 match))
+                         (srfi srfi-1) (srfi srfi-19)
+                         (ice-9 match))
 
             (define environment
               (map (match-lambda
@@ -499,6 +500,23 @@ the image."
                             value)))
                    (profile-search-paths #$profile)))
 
+            (define symlink->directives
+              ;; Return "populate directives" to make the given symlink and its
+              ;; parent directories.
+              (match-lambda
+                ((source '-> target)
+                 (let ((target (string-append #$profile "/" target))
+                       (parent (dirname source)))
+                   `((directory ,parent)
+                     (,source -> ,target))))))
+
+            (define directives
+              ;; Create a /tmp directory, as some programs expect it, and
+              ;; create SYMLINKS.
+              `((directory "/tmp" ,(getuid) ,(getgid) #o1777)
+                ,@(append-map symlink->directives '#$symlinks)))
+
+
             (setenv "PATH" (string-append #$archiver "/bin"))
 
             (build-docker-image #$output
@@ -513,7 +531,7 @@ the image."
                                 #$(and entry-point
                                        #~(list (string-append #$profile "/"
                                                               #$entry-point)))
-                                #:symlinks '#$symlinks
+                                #:extra-files directives
                                 #:compressor '#$(compressor-command compressor)
                                 #:creation-time (make-time time-utc 0 1))))))
 
@@ -611,8 +629,13 @@ please email '~a'~%")
 ;;;
 
 (define* (wrapped-package package
-                          #:optional (compiler (c-compiler))
+                          #:optional
+                          (output* "out")
+                          (compiler (c-compiler))
                           #:key proot?)
+  "Return the OUTPUT of PACKAGE with its binaries wrapped such that they are
+relocatable.  When PROOT? is true, include PRoot in the result and use it as a
+last resort for relocation."
   (define runner
     (local-file (search-auxiliary-file "run-in-namespace.c")))
 
@@ -629,6 +652,14 @@ please email '~a'~%")
                        (ice-9 ftw)
                        (ice-9 match))
 
+          (define input
+            ;; The OUTPUT* output of PACKAGE.
+            (ungexp package output*))
+
+          (define target
+            ;; The output we are producing.
+            (ungexp output output*))
+
           (define (strip-store-prefix file)
             ;; Given a file name like "/gnu/store/…-foo-1.2/bin/foo", return
             ;; "/bin/foo".
@@ -648,7 +679,7 @@ please email '~a'~%")
               (("@STORE_DIRECTORY@") (%store-directory)))
 
             (let* ((base   (strip-store-prefix program))
-                   (result (string-append #$output "/" base))
+                   (result (string-append target "/" base))
                    (proot  #$(and proot?
                                   #~(string-drop
                                      #$(file-append (proot) "/bin/proot")
@@ -667,18 +698,18 @@ please email '~a'~%")
 
           ;; Link the top-level files of PACKAGE so that search paths are
           ;; properly defined in PROFILE/etc/profile.
-          (mkdir #$output)
+          (mkdir target)
           (for-each (lambda (file)
                       (unless (member file '("." ".." "bin" "sbin" "libexec"))
-                        (let ((file* (string-append #$package "/" file)))
-                          (symlink (relative-file-name #$output file*)
-                                   (string-append #$output "/" file)))))
-                    (scandir #$package))
+                        (let ((file* (string-append input "/" file)))
+                          (symlink (relative-file-name target file*)
+                                   (string-append target "/" file)))))
+                    (scandir input))
 
           (for-each build-wrapper
-                    (append (find-files #$(file-append package "/bin"))
-                            (find-files #$(file-append package "/sbin"))
-                            (find-files #$(file-append package "/libexec")))))))
+                    (append (find-files (string-append input "/bin"))
+                            (find-files (string-append input "/sbin"))
+                            (find-files (string-append input "/libexec")))))))
 
   (computed-file (string-append
                   (cond ((package? package)
@@ -691,14 +722,18 @@ please email '~a'~%")
                   "R")
                  build))
 
+(define (wrapped-manifest-entry entry . args)
+  (manifest-entry
+    (inherit entry)
+    (item (apply wrapped-package
+                 (manifest-entry-item entry)
+                 (manifest-entry-output entry)
+                 args))))
+
 (define (map-manifest-entries proc manifest)
   "Apply PROC to all the entries of MANIFEST and return a new manifest."
   (make-manifest
-   (map (lambda (entry)
-          (manifest-entry
-            (inherit entry)
-            (item (proc (manifest-entry-item entry)))))
-        (manifest-entries manifest))))
+   (map proc (manifest-entries manifest))))
 
 
 ;;;
@@ -960,7 +995,7 @@ Create a bundle of PACKAGE.\n"))
                                 ;; 'glibc-bootstrap' lacks 'libc.a'.
                                 (if relocatable?
                                     (map-manifest-entries
-                                     (cut wrapped-package <> #:proot? proot?)
+                                     (cut wrapped-manifest-entry <> #:proot? proot?)
                                      manifest)
                                     manifest)))
                  (pack-format (assoc-ref opts 'format))
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 7bc499a2fe..b6b55bdfcb 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -106,14 +106,14 @@ given, use that to invoke the remote Guile REPL."
   (let* ((repl-command (append (or become-command '())
                                '("guix" "repl" "-t" "machine")))
          (pipe (apply open-remote-pipe* session OPEN_BOTH repl-command)))
-    ;; XXX: 'channel-get-exit-status' would be better here, but hangs if the
-    ;; process does succeed. This doesn't reflect the documentation, so it's
-    ;; possible that it's a bug in guile-ssh.
     (when (eof-object? (peek-char pipe))
-      (raise (condition
-              (&message
-               (message (format #f (G_ "failed to run '~{~a~^ ~}'")
-                                repl-command))))))
+      (let ((status (channel-get-exit-status pipe)))
+        (close-port pipe)
+        (raise (condition
+                (&message
+                 (message (format #f (G_ "remote command '~{~a~^ ~}' failed \
+with status ~a")
+                                  repl-command status)))))))
     (port->inferior pipe)))
 
 (define* (inferior-remote-eval exp session #:optional become-command)
diff --git a/guix/swh.scm b/guix/swh.scm
index df2a138f04..c253e217da 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -190,6 +190,12 @@ Software Heritage."
                                  (ref 10))))))
       str))                                       ;oops!
 
+(define string*
+  ;; Converts "string or #nil" coming from JSON to "string or #f".
+  (match-lambda
+    ((? string? str) str)
+    ((? null?) #f)))
+
 (define* (call url decode #:optional (method http-get)
                #:key (false-if-404? #t))
   "Invoke the endpoint at URL using METHOD.  Decode the resulting JSON body
@@ -239,8 +245,8 @@ FALSE-IF-404? is true, return #f upon 404 responses."
   (date visit-date "date" string->date*)
   (origin visit-origin)
   (url visit-url "origin_visit_url")
-  (snapshot-url visit-snapshot-url "snapshot_url")
-  (status visit-status)
+  (snapshot-url visit-snapshot-url "snapshot_url" string*) ;string | #f
+  (status visit-status "status" string->symbol)   ;'full | 'partial | 'ongoing
   (number visit-number "visit"))
 
 ;; <https://archive.softwareheritage.org/api/1/snapshot/4334c3ed4bb208604ed780d8687fe523837f1bd1/>
@@ -378,9 +384,11 @@ FALSE-IF-404? is true, return #f upon 404 responses."
           (map json->visit (vector->list (json->scm port))))))
 
 (define (visit-snapshot visit)
-  "Return the snapshot corresponding to VISIT."
-  (call (swh-url (visit-snapshot-url visit))
-        json->snapshot))
+  "Return the snapshot corresponding to VISIT or #f if no snapshot is
+available."
+  (and (visit-snapshot-url visit)
+       (call (swh-url (visit-snapshot-url visit))
+             json->snapshot)))
 
 (define (branch-target branch)
   "Return the target of BRANCH, either a <revision> or a <release>."
@@ -396,7 +404,7 @@ FALSE-IF-404? is true, return #f upon 404 responses."
   "Return a <revision> corresponding to the given TAG for the repository
 coming from URL.  Example:
 
-  (lookup-origin-release \"https://github.com/guix-mirror/guix/\" \"v0.8\")
+  (lookup-origin-revision \"https://github.com/guix-mirror/guix/\" \"v0.8\")
   => #<<revision> id: \"44941…\" …>
 
 The information is based on the latest visit of URL available.  Return #f if
@@ -404,7 +412,7 @@ URL could not be found."
   (match (lookup-origin url)
     (#f #f)
     (origin
-      (match (origin-visits origin)
+      (match (filter visit-snapshot-url (origin-visits origin))
         ((visit . _)
          (let ((snapshot (visit-snapshot visit)))
            (match (and=> (find (lambda (branch)
@@ -533,7 +541,8 @@ delete it when leaving the dynamic extent of this call."
       (lambda ()
         (false-if-exception (delete-file-recursively tmp-dir))))))
 
-(define (swh-download url reference output)
+(define* (swh-download url reference output
+                       #:key (log-port (current-error-port)))
   "Download from Software Heritage a checkout of the Git tag or commit
 REFERENCE originating from URL, and unpack it in OUTPUT.  Return #t on success
 and #f on failure.
@@ -545,21 +554,31 @@ wait until it becomes available, which could take several minutes."
              (lookup-revision reference)
              (lookup-origin-revision url reference))
     ((? revision? revision)
+     (format log-port "SWH: found revision ~a with directory at '~a'~%"
+             (revision-id revision)
+             (swh-url (revision-directory-url revision)))
      (call-with-temporary-directory
       (lambda (directory)
-        (let ((input (vault-fetch (revision-directory revision) 'directory))
-              (tar   (open-pipe* OPEN_WRITE "tar" "-C" directory "-xzvf" "-")))
-          (dump-port input tar)
-          (close-port input)
-          (let ((status (close-pipe tar)))
-            (unless (zero? status)
-              (error "tar extraction failure" status)))
-
-          (match (scandir directory)
-            (("." ".." sub-directory)
-             (copy-recursively (string-append directory "/" sub-directory)
-                               output
-                               #:log (%make-void-port "w"))
-             #t))))))
+        (match (vault-fetch (revision-directory revision) 'directory
+                            #:log-port log-port)
+          (#f
+           (format log-port
+                   "SWH: directory ~a could not be fetched from the vault~%"
+                   (revision-directory revision))
+           #f)
+          ((? port? input)
+           (let ((tar (open-pipe* OPEN_WRITE "tar" "-C" directory "-xzvf" "-")))
+             (dump-port input tar)
+             (close-port input)
+             (let ((status (close-pipe tar)))
+               (unless (zero? status)
+                 (error "tar extraction failure" status)))
+
+             (match (scandir directory)
+               (("." ".." sub-directory)
+                (copy-recursively (string-append directory "/" sub-directory)
+                                  output
+                                  #:log (%make-void-port "w"))
+                #t))))))))
     (#f
      #f)))