Merge branch 'master' into core-updates-frozen

14 files changed, 312 insertions, 141 deletions

diff --git a/guix/build-system/julia.scm b/guix/build-system/julia.scm
index 5b824d7f0a..2998663df1 100644
--- a/guix/build-system/julia.scm
+++ b/guix/build-system/julia.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Nicolò Balzarotti <nicolo@nixo.xyz>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Jean-Baptiste Volatier <jbv@pm.me>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -84,6 +85,7 @@
                       (system (%current-system))
                       (guile #f)
                       (julia-package-name #f)
+                      (julia-package-uuid #f)
                       (imported-modules %julia-build-system-modules)
                       (modules '((guix build julia-build-system)
                                  (guix build utils))))
@@ -102,7 +104,8 @@
                                           (map search-path-specification->sexp
                                                search-paths))
                        #:inputs #$(input-tuples->gexp inputs)
-                       #:julia-package-name #$julia-package-name))))
+                       #:julia-package-name #$julia-package-name
+                       #:julia-package-uuid #$julia-package-uuid))))
 
   (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
                                                   system #:graft? #f)))
diff --git a/guix/build/julia-build-system.scm b/guix/build/julia-build-system.scm
index d74acf2a05..41c69665c6 100644
--- a/guix/build/julia-build-system.scm
+++ b/guix/build/julia-build-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019, 2020 Nicolò Balzarotti <nicolo@nixo.xyz>
+;;; Copyright © 2021 Jean-Baptiste Volatier <jbv@pm.me>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,9 +21,11 @@
 (define-module (guix build julia-build-system)
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
   #:use-module (guix build utils)
+  #:use-module (rnrs io ports)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 popen)
   #:export (%standard-phases
             julia-create-package-toml
             julia-build))
@@ -37,7 +40,7 @@
   (invoke "julia" "-e" code))
 
 ;; subpath where we store the package content
-(define %package-path "/share/julia/packages/")
+(define %package-path "/share/julia/loadpath/")
 
 (define (project.toml->name file)
   "Look for Julia package name in the TOML file FILE (usually named
@@ -51,6 +54,18 @@ Project.toml)."
               (if m (match:substring m 1)
                   (loop (read-line in 'concat)))))))))
 
+(define (project.toml->uuid file)
+  "Look for Julia package uuid in the TOML file FILE (usually named
+Project.toml)."
+  (call-with-input-file file
+    (lambda (in)
+      (let loop ((line (read-line in 'concat)))
+        (if (eof-object? line)
+            #f
+            (let ((m (string-match "uuid\\s*=\\s*\"(.*)\"" line)))
+              (if m (match:substring m 1)
+                  (loop (read-line in 'concat)))))))))
+
 (define* (install #:key source inputs outputs julia-package-name
                   #:allow-other-keys)
   (let* ((out (assoc-ref outputs "out"))
@@ -73,7 +88,7 @@ Project.toml)."
     (setenv "JULIA_DEPOT_PATH" builddir)
     ;; Add new package dir to the load path.
     (setenv "JULIA_LOAD_PATH"
-            (string-append builddir "packages/" ":"
+            (string-append builddir "loadpath/" ":"
                            (or (getenv "JULIA_LOAD_PATH")
                                "")))
     ;; Actual precompilation:
@@ -97,15 +112,36 @@ Project.toml)."
       (setenv "SOURCE_DATE_EPOCH" "1")
       (setenv "JULIA_DEPOT_PATH" builddir)
       (setenv "JULIA_LOAD_PATH"
-              (string-append builddir "packages/" ":"
+              (string-append builddir "loadpath/" ":"
                              (or (getenv "JULIA_LOAD_PATH")
                                  "")))
       (setenv "HOME" "/tmp")
       (invoke "julia" "--depwarn=yes"
-              (string-append builddir "packages/"
+              (string-append builddir "loadpath/"
                              package "/test/runtests.jl"))))
   #t)
 
+(define* (link-depot #:key source inputs outputs julia-package-name julia-package-uuid
+                     #:allow-other-keys)
+  (let* ((out (assoc-ref outputs "out"))
+         (package-name (or
+                        julia-package-name
+                        (project.toml->name "Project.toml")))
+         (package-dir (string-append out %package-path package-name))
+         (uuid (or julia-package-uuid (project.toml->uuid "Project.toml")))
+         (pipe (open-pipe* OPEN_READ "julia" "-e"
+                           (format #f "using Pkg;
+println(Base.version_slug(Base.UUID(\"~a\"),
+                          Base.SHA1(Pkg.GitTools.tree_hash(\".\"))))" uuid)))
+         (slug (string-trim-right (get-string-all pipe))))
+    ;; When installing a package, julia looks first at in the JULIA_DEPOT_PATH
+    ;; for a path like packages/PACKAGE/XXXX
+    ;; Where XXXX is a slug encoding the package UUID and SHA1 of the files
+    ;; Here we create a link with the correct path to enable julia to find the package
+    (mkdir-p (string-append out "/share/julia/packages/" package-name))
+    (symlink package-dir (string-append out "/share/julia/packages/" package-name "/" slug)))
+  #t)
+
 (define (julia-create-package-toml outputs source
                                    name uuid version
                                    deps)
@@ -138,6 +174,7 @@ version = \"" version "\"
     (delete 'check) ; tests must be run after installation
     (replace 'install install)
     (add-after 'install 'precompile precompile)
+    (add-after 'unpack 'link-depot link-depot)
     (add-after 'install 'check check)
     ;; TODO: In the future we could add a "system-image-generation" phase
     ;; where we use PackageCompiler.jl to speed up package loading times
@@ -146,11 +183,12 @@ version = \"" version "\"
     (delete 'patch-usr-bin-file)
     (delete 'build)))
 
-(define* (julia-build #:key inputs julia-package-name
+(define* (julia-build #:key inputs julia-package-name julia-package-uuid
                       (phases %standard-phases)
                       #:allow-other-keys #:rest args)
   "Build the given Julia package, applying all of PHASES in order."
   (apply gnu:gnu-build
          #:inputs inputs #:phases phases
          #:julia-package-name julia-package-name
+         #:julia-package-uuid julia-package-uuid
          args))
diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index e86442b79f..fa018a93ac 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -110,7 +110,7 @@
 
 (define* (wrap-qt-program program-name #:key inputs output
                           (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs))
-  "Wrap the specified programm (which must reside in the OUTPUT's \"/bin\"
+  "Wrap the specified program (which must reside in the OUTPUT's \"/bin\"
 directory) with suitably set environment variables.
 
 This is like qt-build-systems's phase \"qt-wrap\", but only the named program
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 420cd3b63a..1389576cad 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -229,26 +229,61 @@ bioconductor package NAME, or #F if the package is unknown."
                 (let ((store-directory
                        (add-to-store store (basename url) #t "sha256" dir)))
                   (values store-directory changeset)))))))
-        (else (download-to-store store url)))))))
-
-(define (fetch-description repository name)
+        (else
+         (match url
+           ((? string?)
+            (download-to-store store url))
+           ((urls ...)
+            ;; Try all the URLs.  A use case where this is useful is when one
+            ;; of the URLs is the /Archive CRAN URL.
+            (any (cut download-to-store store <>) urls)))))))))
+
+(define (fetch-description-from-tarball url)
+  "Fetch the tarball at URL, extra its 'DESCRIPTION' file, parse it, and
+return the resulting alist."
+  (match (download url)
+    (#f #f)
+    (tarball
+     (call-with-temporary-directory
+      (lambda (dir)
+        (parameterize ((current-error-port (%make-void-port "rw+"))
+                       (current-output-port (%make-void-port "rw+")))
+          (and (zero? (system* "tar" "--wildcards" "-x"
+                               "--strip-components=1"
+                               "-C" dir
+                               "-f" tarball "*/DESCRIPTION"))
+               (description->alist
+                (call-with-input-file (string-append dir "/DESCRIPTION")
+                  read-string)))))))))
+
+(define* (fetch-description repository name #:optional version)
   "Return an alist of the contents of the DESCRIPTION file for the R package
-NAME in the given REPOSITORY, or #f in case of failure.  NAME is
+NAME at VERSION in the given REPOSITORY, or #f in case of failure.  NAME is
 case-sensitive."
   (case repository
     ((cran)
-     (let ((url (string-append %cran-url name "/DESCRIPTION")))
-       (guard (c ((http-get-error? c)
-                  (warning (G_ "failed to retrieve package information \
+     (guard (c ((http-get-error? c)
+                (warning (G_ "failed to retrieve package information \
 from ~a: ~a (~a)~%")
-                           (uri->string (http-get-error-uri c))
-                           (http-get-error-code c)
-                           (http-get-error-reason c))
-                  #f))
-         (let* ((port   (http-fetch url))
-                (result (description->alist (read-string port))))
-           (close-port port)
-           result))))
+                         (uri->string (http-get-error-uri c))
+                         (http-get-error-code c)
+                         (http-get-error-reason c))
+                #f))
+       ;; When VERSION is true, we have to download the tarball to get at its
+       ;; 'DESCRIPTION' file; only the latest one is directly accessible over
+       ;; HTTP.
+       (if version
+           (let ((urls (list (string-append "mirror://cran/src/contrib/"
+                                            name "_" version ".tar.gz")
+                             (string-append "mirror://cran/src/contrib/Archive/"
+                                            name "/"
+                                            name "_" version ".tar.gz"))))
+             (fetch-description-from-tarball urls))
+           (let* ((url    (string-append %cran-url name "/DESCRIPTION"))
+                  (port   (http-fetch url))
+                  (result (description->alist (read-string port))))
+             (close-port port)
+             result))))
     ((bioconductor)
      ;; Currently, the bioconductor project does not offer a way to access a
      ;; package's DESCRIPTION file over HTTP, so we determine the version,
@@ -257,22 +292,13 @@ from ~a: ~a (~a)~%")
                           (and (latest-bioconductor-package-version name) #t)
                           (and (latest-bioconductor-package-version name 'annotation) 'annotation)
                           (and (latest-bioconductor-package-version name 'experiment) 'experiment)))
+                ;; TODO: Honor VERSION.
                 (version (latest-bioconductor-package-version name type))
                 (url     (car (bioconductor-uri name version type)))
-                (tarball (download url)))
-       (call-with-temporary-directory
-        (lambda (dir)
-          (parameterize ((current-error-port (%make-void-port "rw+"))
-                         (current-output-port (%make-void-port "rw+")))
-            (and (zero? (system* "tar" "--wildcards" "-x"
-                                 "--strip-components=1"
-                                 "-C" dir
-                                 "-f" tarball "*/DESCRIPTION"))
-                 (and=> (description->alist (with-input-from-file
-                                                (string-append dir "/DESCRIPTION") read-string))
-                        (lambda (meta)
-                          (if (boolean? type) meta
-                              (cons `(bioconductor-type . ,type) meta))))))))))
+                (meta    (fetch-description-from-tarball url)))
+       (if (boolean? type)
+           meta
+           (cons `(bioconductor-type . ,type) meta))))
     ((git)
      (and (string-prefix? "http" name)
           ;; Download the git repository at "NAME"
@@ -485,7 +511,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
                                         ((bioconductor)
                                          (list (assoc-ref meta 'bioconductor-type)))
                                         (else '())))
-                          ((url rest ...) url)
+                          ((urls ...) urls)
                           ((? string? url) url)
                           (_ #f)))))
          (git?       (assoc-ref meta 'git))
@@ -592,7 +618,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
    (lambda* (package-name #:key (repo 'cran) version)
      "Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
 s-expression corresponding to that package, or #f on failure."
-     (let ((description (fetch-description repo package-name)))
+     (let ((description (fetch-description repo package-name version)))
        (if description
            (description->package repo description)
            (case repo
@@ -610,8 +636,9 @@ s-expression corresponding to that package, or #f on failure."
                       (&message
                        (message "couldn't find meta-data for R package")))))))))))
 
-(define* (cran-recursive-import package-name #:key (repo 'cran))
+(define* (cran-recursive-import package-name #:key (repo 'cran) version)
   (recursive-import package-name
+                    #:version version
                     #:repo repo
                     #:repo->guix-package cran->guix-package
                     #:guix-name cran-guix-name))
diff --git a/guix/import/print.scm b/guix/import/print.scm
index c1739f35e3..66016145cb 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -26,6 +26,7 @@
   #:use-module (guix build-system)
   #:use-module (gnu packages)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (guix import utils)
   #:use-module (ice-9 control)
   #:use-module (ice-9 match)
@@ -39,9 +40,6 @@
            (_ #f))
          inputs))
 
-;; FIXME: the quasiquoted arguments field may contain embedded package
-;; objects, e.g. in #:disallowed-references; they will just be printed with
-;; their usual #<package ...> representation, not as variable names.
 (define (package->code package)
   "Return an S-expression representing the source code that produces PACKAGE
 when evaluated."
@@ -81,6 +79,11 @@ when evaluated."
       (file-type (quote ,(search-path-specification-file-type spec)))
       (file-pattern ,(search-path-specification-file-pattern spec))))
 
+  (define (factorized-uri-code uri version)
+    (match (factorize-uri uri version)
+      ((? string? uri) uri)
+      ((factorized ...) `(string-append ,@factorized))))
+
   (define (source->code source version)
     (let ((uri       (origin-uri source))
           (method    (origin-method source))
@@ -98,9 +101,14 @@ when evaluated."
                              (guix hg-download)
                              (guix svn-download)))
                       (procedure-name method)))
-         (uri (string-append ,@(match (factorize-uri uri version)
-                                 ((? string? uri) (list uri))
-                                 (factorized factorized))))
+         (uri ,(if version
+                   (match uri
+                     ((? string? uri)
+                      (factorized-uri-code uri version))
+                     ((lst ...)
+                      `(list
+                        ,@(map (cut factorized-uri-code <> version) uri))))
+                   uri))
          ,(if (equal? (content-hash-algorithm hash) 'sha256)
               `(sha256 (base32 ,(bytevector->nix-base32-string
                                  (content-hash-value hash))))
@@ -110,36 +118,62 @@ when evaluated."
          ;; FIXME: in order to be able to throw away the directory prefix,
          ;; we just assume that the patch files can be found with
          ;; "search-patches".
-         ,@(if (null? patches) '()
-               `((patches (search-patches ,@(map basename patches))))))))
+         ,@(cond ((null? patches)
+                  '())
+                 ((every string? patches)
+                  `((patches (search-patches ,@(map basename patches)))))
+                 (else
+                  `((patches (list ,@(map (match-lambda
+                                            ((? string? file)
+                                             `(search-patch ,file))
+                                            ((? origin? origin)
+                                             (source->code origin #f)))
+                                          patches)))))))))
+
+  (define (variable-reference module name)
+    ;; FIXME: using '@ certainly isn't pretty, but it avoids having to import
+    ;; the individual package modules.
+    (list '@ module name))
+
+  (define (object->code obj quoted?)
+    (match obj
+      ((? package? package)
+       (let* ((module (package-module-name package))
+              (name   (variable-name package module)))
+         (if quoted?
+             (list 'unquote (variable-reference module name))
+             (variable-reference module name))))
+      ((? origin? origin)
+       (let ((code (source->code origin #f)))
+         (if quoted?
+             (list 'unquote code)
+             code)))
+      ((lst ...)
+       (let ((lst (map (cut object->code <> #t) lst)))
+         (if quoted?
+             lst
+             (list 'quasiquote lst))))
+      (obj
+       obj)))
 
   (define (inputs->code inputs)
     (if (redundant-input-labels? inputs)
         `(list ,@(map (match-lambda    ;no need for input labels ("new style")
                         ((_ package)
-                         (let ((module (package-module-name package)))
-                           `(@ ,module ,(variable-name package module))))
+                         (let* ((module (package-module-name package))
+                                (name   (variable-name package module)))
+                           (variable-reference module name)))
                         ((_ package output)
-                         (let ((module (package-module-name package)))
+                         (let* ((module (package-module-name package))
+                                (name   (variable-name package module)))
                            (list 'quasiquote
                                  (list
                                   (list 'unquote
-                                        `(@ ,module
-                                            ,(variable-name package module)))
+                                        (variable-reference module name))
                                   output)))))
                       inputs))
         (list 'quasiquote                  ;preserve input labels (deprecated)
-              (map (match-lambda
-                     ((label pkg . out)
-                      (let ((mod (package-module-name pkg)))
-                        (cons* label
-                               ;; FIXME: using '@ certainly isn't pretty, but it
-                               ;; avoids having to import the individual package
-                               ;; modules.
-                               (list 'unquote
-                                     (list '@ mod (variable-name pkg mod)))
-                               out))))
-                   inputs))))
+              (object->code inputs #t))))
 
   (let ((name                (package-name package))
         (version             (package-version package))
@@ -175,7 +209,8 @@ when evaluated."
                                           '-build-system)))
          ,@(match arguments
              (() '())
-             (args `((arguments ,(list 'quasiquote args)))))
+             (_  `((arguments
+                    ,(list 'quasiquote (object->code arguments #t))))))
          ,@(match outputs
              (("out") '())
              (outs `((outputs (list ,@outs)))))
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index d5035b790b..2b33b3b8bc 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -128,27 +128,30 @@
   missing-source-error?
   (package  missing-source-error-package))
 
-(define (latest-source-release pypi-package)
-  "Return the latest source release for PYPI-PACKAGE."
-  (let ((releases (assoc-ref (pypi-project-releases pypi-package)
-                             (project-info-version
-                              (pypi-project-info pypi-package)))))
+(define (latest-version project)
+  "Return the latest version of PROJECT, a <pypi-project> record."
+  (project-info-version (pypi-project-info project)))
+
+(define* (source-release pypi-package
+                         #:optional (version (latest-version pypi-package)))
+  "Return the source release of VERSION for PYPI-PACKAGE, a <pypi-project>
+record, by default the latest version."
+  (let ((releases (or (assoc-ref (pypi-project-releases pypi-package) version)
+                      '())))
     (or (find (lambda (release)
                 (string=? "sdist" (distribution-package-type release)))
               releases)
         (raise (condition (&missing-source-error
                            (package pypi-package)))))))
 
-(define (latest-wheel-release pypi-package)
+(define* (wheel-release pypi-package
+                        #:optional (version (latest-version pypi-package)))
   "Return the url of the wheel for the latest release of pypi-package,
 or #f if there isn't any."
-  (let ((releases (assoc-ref (pypi-project-releases pypi-package)
-                             (project-info-version
-                              (pypi-project-info pypi-package)))))
-    (or (find (lambda (release)
-                (string=? "bdist_wheel" (distribution-package-type release)))
-              releases)
-        #f)))
+  (let ((releases (assoc-ref (pypi-project-releases pypi-package) version)))
+    (find (lambda (release)
+            (string=? "bdist_wheel" (distribution-package-type release)))
+          releases)))
 
 (define (python->package-name name)
   "Given the NAME of a package on PyPI, return a Guix-compliant name for the
@@ -477,18 +480,17 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
      "Fetch the metadata for PACKAGE-NAME from pypi.org, and return the
 `package' s-expression corresponding to that package, or #f on failure."
      (let* ((project (pypi-fetch package-name))
-            (info    (and project (pypi-project-info project))))
+            (info    (and=> project pypi-project-info))
+            (version (or version (and=> project latest-version))))
        (and project
             (guard (c ((missing-source-error? c)
                        (let ((package (missing-source-error-package c)))
                          (leave (G_ "no source release for pypi package ~a ~a~%")
-                                (project-info-name info)
-                                (project-info-version info)))))
-              (make-pypi-sexp (project-info-name info)
-                              (project-info-version info)
-                              (and=> (latest-source-release project)
+                                (project-info-name info) version))))
+              (make-pypi-sexp (project-info-name info) version
+                              (and=> (source-release project version)
                                      distribution-url)
-                              (and=> (latest-wheel-release project)
+                              (and=> (wheel-release project version)
                                      distribution-url)
                               (project-info-home-page info)
                               (project-info-summary info)
@@ -496,8 +498,9 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
                               (string->license
                                (project-info-license info)))))))))
 
-(define (pypi-recursive-import package-name)
+(define* (pypi-recursive-import package-name #:optional version)
   (recursive-import package-name
+                    #:version version
                     #:repo->guix-package pypi->guix-package
                     #:guix-name python->package-name))
 
@@ -531,7 +534,7 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
            (let* ((info    (pypi-project-info pypi-package))
                   (version (project-info-version info))
                   (url     (distribution-url
-                            (latest-source-release pypi-package))))
+                            (source-release pypi-package))))
              (upstream-source
               (urls (list url))
               (input-changes
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index a180742ca3..dc89386ddb 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -152,6 +152,7 @@ of the string VERSION is replaced by the symbol 'version."
     ("CC0-1.0"                     'license:cc0)
     ("CC-BY-2.0"                   'license:cc-by2.0)
     ("CC-BY-3.0"                   'license:cc-by3.0)
+    ("CC-BY-4.0"                   'license:cc-by4.0)
     ("CC-BY-SA-2.0"                'license:cc-by-sa2.0)
     ("CC-BY-SA-3.0"                'license:cc-by-sa3.0)
     ("CC-BY-SA-4.0"                'license:cc-by-sa4.0)
@@ -163,6 +164,7 @@ of the string VERSION is replaced by the symbol 'version."
     ("EPL-1.0"                     'license:epl1.0)
     ("MIT"                         'license:expat)
     ("FTL"                         'license:freetype)
+    ("Freetype"                    'license:freetype)
     ("GFDL-1.1"                    'license:fdl1.1+)
     ("GFDL-1.2"                    'license:fdl1.2+)
     ("GFDL-1.3"                    'license:fdl1.3+)
@@ -179,6 +181,7 @@ of the string VERSION is replaced by the symbol 'version."
     ("GPL-3.0-only"                'license:gpl3)
     ("GPL-3.0+"                    'license:gpl3+)
     ("GPL-3.0-or-later"            'license:gpl3+)
+    ("HPND"                        'license:hpnd)
     ("ISC"                         'license:isc)
     ("IJG"                         'license:ijg)
     ("Imlib2"                      'license:imlib2)
diff --git a/guix/licenses.scm b/guix/licenses.scm
index c071aae4a9..82ca44f42e 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -308,6 +308,8 @@ at URI, which may be a file:// URI pointing the package's tree."
            "https://directory.fsf.org/wiki/License:EUPL-1.2"
            "https://www.gnu.org/licenses/license-list#EUPL-1.2"))
 
+;; Some people call it the MIT license. For clarification see:
+;; https://www.gnu.org/licenses/license-list.html#Expat
 (define expat
   (license "Expat"
            "http://directory.fsf.org/wiki/License:Expat"
diff --git a/guix/packages.scm b/guix/packages.scm
index 083ee6d3b6..b3c5a00011 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -551,7 +551,7 @@ Texinfo.  Otherwise, return the string."
             (sanitize validate-texinfo))          ; one-line description
   (description package-description
                (sanitize validate-texinfo))       ; one or two paragraphs
-  (license package-license)                       ; <license> instance or list
+  (license package-license)                       ; (list of) <license>
   (home-page package-home-page)
   (supported-systems package-supported-systems    ; list of strings
                      (default %supported-systems))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 8176de4a5e..821f20e2f2 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -517,7 +517,7 @@ environment~%")))
     (unless warned?
       (match (vhash-assoc "PS1" actual)
         (#f #f)
-        (str
+        ((_ . str)
          (when (and (getenv "PS1") (string=? str (getenv "PS1")))
            (warning (G_ "'PS1' is the same in sub-shell~%"))
            (display-hint (G_ "Consider setting a different prompt for
diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm
index 3e4b038cc4..2934d4300a 100644
--- a/guix/scripts/import/cran.scm
+++ b/guix/scripts/import/cran.scm
@@ -27,8 +27,8 @@
   #:use-module (guix import utils)
   #:use-module (guix scripts import)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (guix-import-cran))
@@ -98,21 +98,24 @@ Import and convert the CRAN package for PACKAGE-NAME.\n"))
                            (reverse opts))))
     (parameterize ((%input-style (assoc-ref opts 'style)))
       (match args
-        ((package-name)
-         (if (assoc-ref opts 'recursive)
-             ;; Recursive import
-             (with-error-handling
-               (map package->definition
-                    (filter identity
-                            (cran-recursive-import package-name
-                                                   #:repo (or (assoc-ref opts 'repo) 'cran)))))
-             ;; Single import
-             (let ((sexp (cran->guix-package package-name
-                                             #:repo (or (assoc-ref opts 'repo) 'cran))))
-               (unless sexp
-                 (leave (G_ "failed to download description for package '~a'~%")
-                        package-name))
-               sexp)))
+        ((spec)
+         (let ((name version (package-name->name+version spec)))
+           (if (assoc-ref opts 'recursive)
+               ;; Recursive import
+               (with-error-handling
+                 (map package->definition
+                      (filter identity
+                              (cran-recursive-import name
+                                                     #:version version
+                                                     #:repo (or (assoc-ref opts 'repo) 'cran)))))
+               ;; Single import
+               (let ((sexp (cran->guix-package name
+                                               #:version version
+                                               #:repo (or (assoc-ref opts 'repo) 'cran))))
+                 (unless sexp
+                   (leave (G_ "failed to download description for package '~a'~%")
+                          name))
+                 sexp))))
         (()
          (leave (G_ "too few arguments~%")))
         ((many ...)
diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm
index 9170a0b359..a52cd95c93 100644
--- a/guix/scripts/import/pypi.scm
+++ b/guix/scripts/import/pypi.scm
@@ -27,6 +27,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (guix-import-pypi))
@@ -83,21 +84,22 @@ Import and convert the PyPI package for PACKAGE-NAME.\n"))
                             (_ #f))
                            (reverse opts))))
     (match args
-      ((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))
-                (pypi-recursive-import package-name))
-           ;; Single import
-           (let ((sexp (pypi->guix-package package-name)))
-             (unless sexp
-               (leave (G_ "failed to download meta-data for package '~a'~%")
-                      package-name))
-             sexp)))
+      ((spec)
+       (let ((name version (package-name->name+version spec)))
+         (if (assoc-ref opts 'recursive)
+             ;; Recursive import
+             (map (match-lambda
+                    ((and ('package ('name name) . rest) pkg)
+                     `(define-public ,(string->symbol name)
+                        ,pkg))
+                    (_ #f))
+                  (pypi-recursive-import name version))
+             ;; Single import
+             (let ((sexp (pypi->guix-package name #:version version)))
+               (unless sexp
+                 (leave (G_ "failed to download meta-data for package '~a'~%")
+                        name))
+               sexp))))
       (()
        (leave (G_ "too few arguments~%")))
       ((many ...)
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index cd9660174c..370df4a74c 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Caleb Ristvedt <caleb.ristvedt@cune.org>
-;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,12 +22,13 @@
 
 (define-module (guix store deduplication)
   #:use-module (gcrypt hash)
-  #:use-module (guix build utils)
+  #:use-module ((guix build utils) #:hide (dump-port))
   #:use-module (guix build syscalls)
   #:use-module (guix base32)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
@@ -37,6 +38,31 @@
             dump-file/deduplicate
             copy-file/deduplicate))
 
+;; TODO: Remove once 'dump-port' in (guix build utils) has an optional 'len'
+;; parameter.
+(define* (dump-port in out
+                    #:optional len
+                    #:key (buffer-size 16384))
+  "Read LEN bytes from IN (or as much as possible if LEN is #f) and write it
+to OUT, using chunks of BUFFER-SIZE bytes."
+  (define buffer
+    (make-bytevector buffer-size))
+
+  (let loop ((total 0)
+             (bytes (get-bytevector-n! in buffer 0
+                                       (if len
+                                           (min len buffer-size)
+                                           buffer-size))))
+    (or (eof-object? bytes)
+        (and len (= total len))
+        (let ((total (+ total bytes)))
+          (put-bytevector out buffer 0 bytes)
+          (loop total
+                (get-bytevector-n! in buffer 0
+                                   (if len
+                                       (min (- len total) buffer-size)
+                                       buffer-size)))))))
+
 (define (nar-sha256 file)
   "Gives the sha256 hash of a file and the size of the file in nar form."
   (let-values (((port get-hash) (open-sha256-port)))
@@ -127,11 +153,27 @@ Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system."
           (unless (= EMLINK (system-error-errno args))
             (apply throw args)))))))
 
+(define %deduplication-minimum-size
+  ;; Size below which files are not deduplicated.  This avoids adding too many
+  ;; entries to '.links', which would slow down 'removeUnusedLinks' while
+  ;; saving little space.  Keep in sync with optimize-store.cc.
+  8192)
+
 (define* (deduplicate path hash #:key (store (%store-directory)))
   "Check if a store item with sha256 hash HASH already exists.  If so,
 replace PATH with a hardlink to the already-existing one.  If not, register
 PATH so that future duplicates can hardlink to it.  PATH is assumed to be
 under STORE."
+  ;; Lightweight promises.
+  (define-syntax-rule (delay exp)
+    (let ((value #f))
+      (lambda ()
+        (unless value
+          (set! value exp))
+        value)))
+  (define-syntax-rule (force promise)
+    (promise))
+
   (define links-directory
     (string-append store "/.links"))
 
@@ -144,13 +186,18 @@ under STORE."
                     ((file . properties)
                      (unless (member file '("." ".."))
                        (let* ((file (string-append path "/" file))
+                              (st   (delay (lstat file)))
                               (type (match (assoc-ref properties 'type)
                                       ((or 'unknown #f)
-                                       (stat:type (lstat file)))
+                                       (stat:type (force st)))
                                       (type type))))
-                         (loop file type
-                               (and (not (eq? 'directory type))
-                                    (nar-sha256 file)))))))
+                         (when (or (eq? 'directory type)
+                                   (and (eq? 'regular type)
+                                        (>= (stat:size (force st))
+                                            %deduplication-minimum-size)))
+                           (loop file type
+                                 (and (not (eq? 'directory type))
+                                      (nar-sha256 file))))))))
                   (scandir* path))
         (let ((link-file (string-append links-directory "/"
                                         (bytevector->nix-base32-string hash))))
@@ -222,9 +269,9 @@ OUTPUT as it goes."
 
 This procedure is suitable as a #:dump-file argument to 'restore-file'.  When
 used that way, it deduplicates files on the fly as they are restored, thereby
-removing the need to a deduplication pass that would re-read all the files
+removing the need for a deduplication pass that would re-read all the files
 down the road."
-  (define hash
+  (define (dump-and-compute-hash)
     (call-with-output-file file
       (lambda (output)
         (let-values (((hash-port get-hash)
@@ -236,7 +283,11 @@ down the road."
           (close-port hash-port)
           (get-hash)))))
 
-  (deduplicate file hash #:store store))
+  (if (>= size %deduplication-minimum-size)
+      (deduplicate file (dump-and-compute-hash) #:store store)
+      (call-with-output-file file
+        (lambda (output)
+          (dump-port input output size)))))
 
 (define* (copy-file/deduplicate source target
                                 #:key (store (%store-directory)))
diff --git a/guix/tests.scm b/guix/tests.scm
index 063b20183d..4cd1ad6cf9 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -189,18 +189,22 @@ too expensive to build entirely in the test store."
             (loop (1+ i)))
           bv))))
 
-(define (file=? a b)
-  "Return true if files A and B have the same type and same content."
-  (and (eq? (stat:type (lstat a)) (stat:type (lstat b)))
-       (case (stat:type (lstat a))
-         ((regular)
-          (equal?
-           (call-with-input-file a get-bytevector-all)
-           (call-with-input-file b get-bytevector-all)))
-         ((symlink)
-          (string=? (readlink a) (readlink b)))
-         (else
-          (error "what?" (lstat a))))))
+(define* (file=? a b #:optional (stat lstat))
+  "Return true if files A and B have the same type and same content.  Call
+STAT to obtain file metadata."
+  (let ((sta (stat a)) (stb (stat b)))
+    (and (eq? (stat:type sta) (stat:type stb))
+         (case (stat:type sta)
+           ((regular)
+            (or (and (= (stat:ino sta) (stat:ino stb))
+                     (= (stat:dev sta) (stat:dev stb)))
+                (equal?
+                 (call-with-input-file a get-bytevector-all)
+                 (call-with-input-file b get-bytevector-all))))
+           ((symlink)
+            (string=? (readlink a) (readlink b)))
+           (else
+            (error "what?" (stat a)))))))
 
 (define (canonical-file? file)
   "Return #t if FILE is in the store, is read-only, and its mtime is 1."