Merge remote-tracking branch 'origin/master' into core-updates

 Conflicts:
	gnu/local.mk
	gnu/packages/boost.scm
	gnu/packages/chez.scm
	gnu/packages/compression.scm
	gnu/packages/crates-io.scm
	gnu/packages/docbook.scm
	gnu/packages/engineering.scm
	gnu/packages/gcc.scm
	gnu/packages/gl.scm
	gnu/packages/gtk.scm
	gnu/packages/nettle.scm
	gnu/packages/python-check.scm
	gnu/packages/python-xyz.scm
	gnu/packages/radio.scm
	gnu/packages/rust.scm
	gnu/packages/sqlite.scm
	guix/build-system/node.scm

4 files changed, 336 insertions, 222 deletions

diff --git a/guix/build/graft.scm b/guix/build/graft.scm
index c119ee71d1..f04c35fa74 100644
--- a/guix/build/graft.scm
+++ b/guix/build/graft.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2016, 2021 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -55,6 +55,52 @@
         (string->char-set "0123456789abcdfghijklmnpqrsvwxyz")
         <>))
 
+(define (nix-base32-char-or-nul? c)
+  "Return true if C is a nix-base32 character or NUL, otherwise return false."
+  (or (nix-base32-char? c)
+      (char=? c #\nul)))
+
+(define (possible-utf16-hash? buffer i w)
+  "Return true if (I - W) is large enough to hold a UTF-16 encoded
+nix-base32 hash and if BUFFER contains NULs in all positions where NULs
+are to be expected in a UTF-16 encoded hash+dash pattern whose dash is
+found at position I.  Otherwise, return false."
+  (and (<= (* 2 hash-length) (- i w))
+       (let loop ((j (+ 1 (- i (* 2 hash-length)))))
+         (or (>= j i)
+             (and (zero? (bytevector-u8-ref buffer j))
+                  (loop (+ j 2)))))))
+
+(define (possible-utf32-hash? buffer i w)
+  "Return true if (I - W) is large enough to hold a UTF-32 encoded
+nix-base32 hash and if BUFFER contains NULs in all positions where NULs
+are to be expected in a UTF-32 encoded hash+dash pattern whose dash is
+found at position I.  Otherwise, return false."
+  (and (<= (* 4 hash-length) (- i w))
+       (let loop ((j (+ 1 (- i (* 4 hash-length)))))
+         (or (>= j i)
+             (and (zero? (bytevector-u8-ref buffer j))
+                  (zero? (bytevector-u8-ref buffer (+ j 1)))
+                  (zero? (bytevector-u8-ref buffer (+ j 2)))
+                  (loop (+ j 4)))))))
+
+(define (insert-nuls char-size bv)
+  "Given a bytevector BV, return a bytevector containing the same bytes but
+with (CHAR-SIZE - 1) NULs inserted between every two adjacent bytes from BV.
+For example, (insert-nuls 4 #u8(1 2 3)) => #u8(1 0 0 0 2 0 0 0 3)."
+  (if (= char-size 1)
+      bv
+      (let* ((len (bytevector-length bv))
+             (bv* (make-bytevector (+ 1 (* char-size
+                                           (- len 1)))
+                                   0)))
+        (let loop ((i 0))
+          (when (< i len)
+            (bytevector-u8-set! bv* (* i char-size)
+                                (bytevector-u8-ref bv i))
+            (loop (+ i 1))))
+        bv*)))
+
 (define* (replace-store-references input output replacement-table
                                    #:optional (store (%store-directory)))
   "Read data from INPUT, replacing store references according to
@@ -76,9 +122,9 @@ bytevectors to the same value."
           (list->vector (map pred (iota 256)))
           <>))
 
-  (define nix-base32-byte?
+  (define nix-base32-byte-or-nul?
     (optimize-u8-predicate
-     (compose nix-base32-char?
+     (compose nix-base32-char-or-nul?
               integer->char)))
 
   (define (dash? byte) (= byte 45))
@@ -86,100 +132,153 @@ bytevectors to the same value."
   (define request-size (expt 2 20))  ; 1 MiB
 
   ;; We scan the file for the following 33-byte pattern: 32 bytes of
-  ;; nix-base32 characters followed by a dash.  To accommodate large files,
-  ;; we do not read the entire file, but instead work on buffers of up to
-  ;; 'request-size' bytes.  To ensure that every 33-byte sequence appears
-  ;; entirely within exactly one buffer, adjacent buffers must overlap,
-  ;; i.e. they must share 32 byte positions.  We accomplish this by
-  ;; "ungetting" the last 32 bytes of each buffer before reading the next
-  ;; buffer, unless we know that we've reached the end-of-file.
+  ;; nix-base32 characters followed by a dash.  When we find such a pattern
+  ;; whose hash is in REPLACEMENT-TABLE, we perform the required rewrite and
+  ;; continue scanning.
+  ;;
+  ;; To support UTF-16 and UTF-32 store references, the 33 bytes comprising
+  ;; this hash+dash pattern may optionally be interspersed by extra NUL bytes.
+  ;; This simple approach works because the characters we are looking for are
+  ;; restricted to ASCII.  UTF-16 hashes are interspersed with single NUL
+  ;; bytes ("\0"), and UTF-32 hashes are interspersed with triplets of NULs
+  ;; ("\0\0\0").  Note that we require NULs to be present only *between* the
+  ;; other bytes, and not at either end, in order to be insensitive to byte
+  ;; order.
+  ;;
+  ;; To accommodate large files, we do not read the entire file at once, but
+  ;; instead work on buffers of up to REQUEST-SIZE bytes.  To ensure that
+  ;; every hash+dash pattern appears in its entirety in at least one buffer,
+  ;; adjacent buffers must overlap by one byte less than the maximum size of a
+  ;; hash+dash pattern.  We accomplish this by "ungetting" a suffix of each
+  ;; buffer before reading the next buffer, unless we know that we've reached
+  ;; the end-of-file.
   (let ((buffer (make-bytevector request-size)))
-    (let loop ()
-      ;; Note: We avoid 'get-bytevector-n' to work around
-      ;; <http://bugs.gnu.org/17466>.
+    (define-syntax-rule (byte-at i)
+      (bytevector-u8-ref buffer i))
+    (let outer-loop ()
       (match (get-bytevector-n! input buffer 0 request-size)
         ((? eof-object?) 'done)
         (end
-         ;; We scan the buffer for dashes that might be preceded by a
-         ;; nix-base32 hash.  The key optimization here is that whenever we
-         ;; find a NON-nix-base32 character at position 'i', we know that it
-         ;; cannot be part of a hash, so the earliest position where the next
-         ;; hash could start is i+1 with the following dash at position i+33.
-         ;;
-         ;; Since nix-base32 characters comprise only 1/8 of the 256 possible
-         ;; byte values, and exclude some of the most common letters in
-         ;; English text (e t o u), in practice we can advance by 33 positions
-         ;; most of the time.
-         (let scan-from ((i hash-length) (written 0))
-           ;; 'i' is the first position where we look for a dash.  'written'
-           ;; is the number of bytes in the buffer that have already been
-           ;; written.
+         (define (scan-from i w)
+           ;; Scan the buffer for dashes that might be preceded by nix hashes,
+           ;; where I is the minimum position where such a dash might be
+           ;; found, and W is the number of bytes in the buffer that have been
+           ;; written so far.  We assume that I - W >= HASH-LENGTH.
+           ;;
+           ;; The key optimization here is that whenever we find a byte at
+           ;; position I that cannot occur within a nix hash (because it's
+           ;; neither a nix-base32 character nor NUL), we can infer that the
+           ;; earliest position where the next hash could start is at I + 1,
+           ;; and therefore the earliest position for the following dash is
+           ;; (+ I 1 HASH-LENGTH), which is I + 33.
+           ;;
+           ;; Since nix-base32-or-nul characters comprise only about 1/8 of
+           ;; the 256 possible byte values, and exclude some of the most
+           ;; common letters in English text (e t o u), we can advance 33
+           ;; positions much of the time.
            (if (< i end)
-               (let ((byte (bytevector-u8-ref buffer i)))
-                 (cond ((and (dash? byte)
-                             ;; We've found a dash.  Note that we do not know
-                             ;; whether the preceeding 32 bytes are nix-base32
-                             ;; characters, but we do not need to know.  If
-                             ;; they are not, the following lookup will fail.
-                             (lookup-replacement
-                              (string-tabulate (lambda (j)
-                                                 (integer->char
-                                                  (bytevector-u8-ref buffer
-                                                   (+ j (- i hash-length)))))
-                                               hash-length)))
-                        => (lambda (replacement)
-                             ;; We've found a hash that needs to be replaced.
-                             ;; First, write out all bytes preceding the hash
-                             ;; that have not yet been written.
-                             (put-bytevector output buffer written
-                                             (- i hash-length written))
-                             ;; Now write the replacement string.
-                             (put-bytevector output replacement)
-                             ;; Since the byte at position 'i' is a dash,
-                             ;; which is not a nix-base32 char, the earliest
-                             ;; position where the next hash might start is
-                             ;; i+1, and the earliest position where the
-                             ;; following dash might start is (+ i 1
-                             ;; hash-length).  Also, increase the write
-                             ;; position to account for REPLACEMENT.
-                             (let ((len (bytevector-length replacement)))
-                               (scan-from (+ i 1 len)
-                                          (+ i (- len hash-length))))))
-                       ;; If the byte at position 'i' is a nix-base32 char,
-                       ;; then the dash we're looking for might be as early as
-                       ;; the following byte, so we can only advance by 1.
-                       ((nix-base32-byte? byte)
-                        (scan-from (+ i 1) written))
-                       ;; If the byte at position 'i' is NOT a nix-base32
-                       ;; char, then the earliest position where the next hash
-                       ;; might start is i+1, with the following dash at
-                       ;; position (+ i 1 hash-length).
+               (let ((byte (byte-at i)))
+                 (cond ((dash? byte)
+                        (found-dash i w))
+                       ((nix-base32-byte-or-nul? byte)
+                        (scan-from (+ i 1) w))
                        (else
-                        (scan-from (+ i 1 hash-length) written))))
-
-               ;; We have finished scanning the buffer.  Now we determine how
-               ;; many bytes have not yet been written, and how many bytes to
-               ;; "unget".  If 'end' is less than 'request-size' then we read
-               ;; less than we asked for, which indicates that we are at EOF,
-               ;; so we needn't unget anything.  Otherwise, we unget up to
-               ;; 'hash-length' bytes (32 bytes).  However, we must be careful
-               ;; not to unget bytes that have already been written, because
-               ;; that would cause them to be written again from the next
-               ;; buffer.  In practice, this case occurs when a replacement is
-               ;; made near or beyond the end of the buffer.  When REPLACEMENT
-               ;; went beyond END, we consume the extra bytes from INPUT.
-               (begin
-                 (if (> written end)
-                     (get-bytevector-n! input buffer 0 (- written end))
-                     (let* ((unwritten  (- end written))
-                            (unget-size (if (= end request-size)
-                                            (min hash-length unwritten)
-                                            0))
-                            (write-size (- unwritten unget-size)))
-                       (put-bytevector output buffer written write-size)
-                       (unget-bytevector input buffer (+ written write-size)
-                                         unget-size)))
-                 (loop)))))))))
+                        (not-part-of-hash i w))))
+               (finish-buffer i w)))
+
+         (define (not-part-of-hash i w)
+           ;; Position I is known to not be within a nix hash that we must
+           ;; rewrite.  Therefore, the earliest position where the next hash
+           ;; might start is I + 1, and therefore the earliest position of
+           ;; the following dash is (+ I 1 HASH-LENGTH).
+           (scan-from (+ i 1 hash-length) w))
+
+         (define (found-dash i w)
+           ;; We know that there is a dash '-' at position I, and that
+           ;; I - W >= HASH-LENGTH.  The immediately preceding bytes *might*
+           ;; contain a nix-base32 hash, but that is not yet known.  Here,
+           ;; we rule out all but one possible encoding (ASCII, UTF-16,
+           ;; UTF-32) by counting how many NULs precede the dash.
+           (cond ((not (zero? (byte-at (- i 1))))
+                  ;; The dash is *not* preceded by a NUL, therefore it
+                  ;; cannot possibly be a UTF-16 or UTF-32 hash.  Proceed
+                  ;; to check for an ASCII hash.
+                  (found-possible-hash 1 i w))
+
+                 ((not (zero? (byte-at (- i 2))))
+                  ;; The dash is preceded by exactly one NUL, therefore it
+                  ;; cannot be an ASCII or UTF-32 hash.  Proceed to check
+                  ;; for a UTF-16 hash.
+                  (if (possible-utf16-hash? buffer i w)
+                      (found-possible-hash 2 i w)
+                      (not-part-of-hash i w)))
+
+                 (else
+                  ;; The dash is preceded by at least two NULs, therefore
+                  ;; it cannot be an ASCII or UTF-16 hash.  Proceed to
+                  ;; check for a UTF-32 hash.
+                  (if (possible-utf32-hash? buffer i w)
+                      (found-possible-hash 4 i w)
+                      (not-part-of-hash i w)))))
+
+         (define (found-possible-hash char-size i w)
+           ;; We know that there is a dash '-' at position I, that
+           ;; I - W >= CHAR-SIZE * HASH-LENGTH, and that the only
+           ;; possible encoding for the preceding hash is as indicated by
+           ;; CHAR-SIZE.  Here we check to see if the given hash is in
+           ;; REPLACEMENT-TABLE, and if so, we perform the required
+           ;; rewrite.
+           (let* ((hash (string-tabulate
+                         (lambda (j)
+                           (integer->char
+                            (byte-at (- i (* char-size
+                                             (- hash-length j))))))
+                         hash-length))
+                  (replacement* (lookup-replacement hash))
+                  (replacement (and replacement*
+                                    (insert-nuls char-size replacement*))))
+             (cond
+              ((not replacement)
+               (not-part-of-hash i w))
+              (else
+               ;; We've found a hash that needs to be replaced.
+               ;; First, write out all bytes preceding the hash
+               ;; that have not yet been written.
+               (put-bytevector output buffer w
+                               (- i (* char-size hash-length) w))
+               ;; Now write the replacement string.
+               (put-bytevector output replacement)
+               ;; Now compute the new values of W and I and continue.
+               (let ((w (+ (- i (* char-size hash-length))
+                           (bytevector-length replacement))))
+                 (scan-from (+ w hash-length) w))))))
+
+         (define (finish-buffer i w)
+           ;; We have finished scanning the buffer.  Now we determine how many
+           ;; bytes have not yet been written, and how many bytes to "unget".
+           ;; If END is less than REQUEST-SIZE then we read less than we asked
+           ;; for, which indicates that we are at EOF, so we needn't unget
+           ;; anything.  Otherwise, we unget up to (* 4 HASH-LENGTH) bytes.
+           ;; However, we must be careful not to unget bytes that have already
+           ;; been written, because that would cause them to be written again
+           ;; from the next buffer.  In practice, this case occurs when a
+           ;; replacement is made near or beyond the end of the buffer.  When
+           ;; REPLACEMENT went beyond END, we consume the extra bytes from
+           ;; INPUT.
+           (if (> w end)
+               (get-bytevector-n! input buffer 0 (- w end))
+               (let* ((unwritten  (- end w))
+                      (unget-size (if (= end request-size)
+                                      (min (* 4 hash-length)
+                                           unwritten)
+                                      0))
+                      (write-size (- unwritten unget-size)))
+                 (put-bytevector output buffer w write-size)
+                 (unget-bytevector input buffer (+ w write-size)
+                                   unget-size)))
+           (outer-loop))
+
+         (scan-from hash-length 0))))))
 
 (define (rename-matching-files directory mapping)
   "Apply MAPPING to the names of all the files in DIRECTORY, where MAPPING is
diff --git a/guix/build/julia-build-system.scm b/guix/build/julia-build-system.scm
index 8f57045a8c..d74acf2a05 100644
--- a/guix/build/julia-build-system.scm
+++ b/guix/build/julia-build-system.scm
@@ -101,7 +101,7 @@ Project.toml)."
                              (or (getenv "JULIA_LOAD_PATH")
                                  "")))
       (setenv "HOME" "/tmp")
-      (invoke "julia"
+      (invoke "julia" "--depwarn=yes"
               (string-append builddir "packages/"
                              package "/test/runtests.jl"))))
   #t)
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index 7799f03595..a55cab237c 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
+;;; Copyright © 2016, 2020 Jelle Licht <jlicht@fsfe.org>
+;;; Copyright © 2019, 2021 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,144 +20,130 @@
 
 (define-module (guix build node-build-system)
   #:use-module ((guix build gnu-build-system) #:prefix gnu:)
-  #:use-module (guix build json)
-  #:use-module (guix build union)
   #:use-module (guix build utils)
+  #:use-module (guix build json)
+  #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 popen)
-  #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-26)
   #:export (%standard-phases
             node-build))
 
 ;; Commentary:
 ;;
-;; Builder-side code of the standard Node/npm package build procedure.
+;; Builder-side code of the standard Node/NPM package install procedure.
 ;;
 ;; Code:
 
-(define* (read-package-data #:key (filename "package.json"))
-  (call-with-input-file filename
-    (lambda (port)
-      (read-json port))))
+(define (set-home . _)
+  (with-directory-excursion ".."
+    (let loop ((i 0))
+      (let ((dir (string-append "npm-home-" (number->string i))))
+        (if (directory-exists? dir)
+            (loop (1+ i))
+            (begin
+              (mkdir dir)
+              (setenv "HOME" (string-append (getcwd) "/" dir))
+              (format #t "set HOME to ~s~%" (getenv "HOME")))))))
+  #t)
 
-(define* (build #:key inputs #:allow-other-keys)
-  (define (build-from-package-json? package-file)
-    (let* ((package-data (read-package-data #:filename package-file))
-           (scripts (assoc-ref package-data "scripts")))
-      (assoc-ref scripts "build")))
-  "Build a new node module using the appropriate build system."
-  ;; XXX: Develop a more robust heuristic, allow override
-  (cond ((file-exists? "gulpfile.js")
-         (invoke "gulp"))
-        ((file-exists? "gruntfile.js")
-         (invoke "grunt"))
-        ((file-exists? "Makefile")
-         (invoke "make"))
-        ((and (file-exists? "package.json")
-              (build-from-package-json? "package.json"))
-         (invoke "npm" "run" "build")))
+(define (module-name module)
+  (let* ((package.json (string-append module "/package.json"))
+         (package-meta (call-with-input-file package.json read-json)))
+    (assoc-ref package-meta "name")))
+
+(define (index-modules input-paths)
+  (define (list-modules directory)
+    (append-map (lambda (x)
+                  (if (string-prefix? "@" x)
+                      (list-modules (string-append directory "/" x))
+                      (list (string-append directory "/" x))))
+                (filter (lambda (x)
+                          (not (member x '("." ".."))))
+                        (or (scandir directory) '()))))
+  (let ((index (make-hash-table (* 2 (length input-paths)))))
+    (for-each (lambda (dir)
+                (let ((nm (string-append dir "/lib/node_modules")))
+                  (for-each (lambda (module)
+                              (hash-set! index (module-name module) module))
+                            (list-modules nm))))
+              input-paths)
+    index))
+
+(define* (patch-dependencies #:key inputs #:allow-other-keys)
+
+  (define index (index-modules (map cdr inputs)))
+
+  (define (resolve-dependencies package-meta meta-key)
+    (fold (lambda (key+value acc)
+            (match key+value
+              ('@ acc)
+              ((key . value) (acons key (hash-ref index key value) acc))))
+          '()
+          (or (assoc-ref package-meta meta-key) '())))
+
+  (with-atomic-file-replacement "package.json"
+    (lambda (in out)
+      (let ((package-meta (read-json in)))
+        (assoc-set! package-meta "dependencies"
+                    (append
+                     '(@)
+                     (resolve-dependencies package-meta "dependencies")
+                     (resolve-dependencies package-meta "peerDependencies")))
+        (assoc-set! package-meta "devDependencies"
+                    (append
+                     '(@)
+                     (resolve-dependencies package-meta "devDependencies")))
+        (write-json package-meta out))))
   #t)
 
-(define* (link-npm-dependencies #:key inputs #:allow-other-keys)
-  (define (inputs->node-inputs inputs)
-    "Filter the directory part from INPUTS."
-    (filter (lambda (input)
-              (match input
-                ((name . _) (node-package? name))))
-            inputs))
-  (define (inputs->directories inputs)
-    "Extract the directory part from INPUTS."
-    (match inputs
-      (((names . directories) ...)
-       directories)))
-  (define (make-node-path root)
-    (string-append root "/lib/node_modules/"))
-
-  (let ((input-node-directories (inputs->directories
-                                 (inputs->node-inputs inputs))))
-    (union-build "node_modules"
-                 (map make-node-path input-node-directories))
+(define* (configure #:key outputs inputs #:allow-other-keys)
+  (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
+    (invoke npm "--offline" "--ignore-scripts" "install")
     #t))
 
-(define configure link-npm-dependencies)
+(define* (build #:key inputs #:allow-other-keys)
+  (let ((package-meta (call-with-input-file "package.json" read-json)))
+    (if (and=> (assoc-ref package-meta "scripts")
+               (lambda (scripts)
+                 (assoc-ref scripts "build")))
+        (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
+          (invoke npm "run" "build"))
+        (format #t "there is no build script to run~%"))
+    #t))
 
-(define* (check #:key tests? #:allow-other-keys)
+(define* (check #:key tests? inputs #:allow-other-keys)
   "Run 'npm test' if TESTS?"
   (if tests?
-      ;; Should only be enabled once we know that there are tests
-      (invoke "npm" "test"))
+      (let ((npm (string-append (assoc-ref inputs "node") "/bin/npm")))
+        (invoke npm "test"))
+      (format #t "test suite not run~%"))
   #t)
 
-(define (node-package? name)
-  "Check if NAME correspond to the name of an Node package."
-  (string-prefix? "node-" name))
+(define* (repack #:key inputs #:allow-other-keys)
+  (invoke "tar" "-czf" "../package.tgz" ".")
+  #t)
 
 (define* (install #:key outputs inputs #:allow-other-keys)
-  "Install the node module to the output store item. The module itself is
-installed in a subdirectory of @file{node_modules} and its runtime dependencies
-as defined by @file{package.json} are symlinked into a @file{node_modules}
-subdirectory of the module's directory. Additionally, binaries are installed in
-the @file{bin} directory."
-  (let* ((out                  (assoc-ref outputs "out"))
-         (target               (string-append out "/lib"))
-         (binaries             (string-append out "/bin"))
-         (data                 (read-package-data))
-         (modulename           (assoc-ref data "name"))
-         (binary-configuration (match (assoc-ref data "bin")
-				 (('@ configuration ...) configuration)
-				 ((? string? configuration) configuration)
-				 (#f #f)))
-         (dependencies (match (assoc-ref data "dependencies")
-                         (('@ deps ...) deps)
-                         (#f #f))))
-    (mkdir-p target)
-    (copy-recursively "." (string-append target "/node_modules/" modulename))
-    ;; Remove references to dependencies
-    (delete-file-recursively
-      (string-append target "/node_modules/" modulename "/node_modules"))
-    (cond
-      ((string? binary-configuration)
-       (begin
-         (mkdir-p binaries)
-         (symlink (string-append target "/node_modules/" modulename "/"
-				 binary-configuration)
-                  (string-append binaries "/" modulename))))
-      ((list? binary-configuration)
-       (for-each
-         (lambda (conf)
-           (match conf
-             ((key . value)
-              (begin
-                (mkdir-p (dirname (string-append binaries "/" key)))
-                (symlink (string-append target "/node_modules/" modulename "/"
-					value)
-                         (string-append binaries "/" key))))))
-         binary-configuration)))
-    (when dependencies
-      (mkdir-p
-        (string-append target "/node_modules/" modulename "/node_modules"))
-      (for-each
-        (lambda (dependency)
-          (let ((dependency (car dependency)))
-            (symlink
-              (string-append (assoc-ref inputs (string-append "node-" dependency))
-                             "/lib/node_modules/" dependency)
-              (string-append target "/node_modules/" modulename
-                             "/node_modules/" dependency))))
-        dependencies))
+  "Install the node module to the output store item."
+  (let ((out (assoc-ref outputs "out"))
+        (npm (string-append (assoc-ref inputs "node") "/bin/npm")))
+    (invoke npm "--prefix" out
+            "--global"
+            "--offline"
+            "--loglevel" "info"
+            "--production"
+            "install" "../package.tgz")
     #t))
 
-
 (define %standard-phases
   (modify-phases gnu:%standard-phases
+    (add-after 'unpack 'set-home set-home)
+    (add-before 'configure 'patch-dependencies patch-dependencies)
     (replace 'configure configure)
     (replace 'build build)
-    (replace 'install install)
-    (delete 'check)
-    (add-after 'install 'check check)
-    (delete 'strip)))
+    (replace 'check check)
+    (add-before 'install 'repack repack)
+    (replace 'install install)))
 
 (define* (node-build #:key inputs (phases %standard-phases)
                      #:allow-other-keys #:rest args)
diff --git a/guix/build/qt-build-system.scm b/guix/build/qt-build-system.scm
index 005157b0a4..f59b0c420f 100644
--- a/guix/build/qt-build-system.scm
+++ b/guix/build/qt-build-system.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Federico Beffa <beffa@fbengineering.ch>
-;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2019, 2020 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;;
@@ -49,25 +49,53 @@
 
 (define (variables-for-wrapping base-directories)
 
-  (define (collect-sub-dirs base-directories subdirectory)
-    (filter-map
-     (lambda (dir)
-       (let ((directory (string-append dir subdirectory)))
-         (if (directory-exists? directory) directory #f)))
-     base-directories))
-
-  (filter
-   (lambda (var-to-wrap) (not (null? (last var-to-wrap))))
-   (map
-    (lambda (var-spec)
-      `(,(first var-spec) = ,(collect-sub-dirs base-directories (last var-spec))))
-    (list
-     ;; these shall match the search-path-specification for Qt and KDE
-     ;; libraries
-     '("XDG_DATA_DIRS" "/share")
-     '("XDG_CONFIG_DIRS" "/etc/xdg")
-     '("QT_PLUGIN_PATH" "/lib/qt5/plugins")
-     '("QML2_IMPORT_PATH" "/lib/qt5/qml")))))
+  (define (collect-sub-dirs base-directories file-type subdirectory
+                            selectors)
+    ;; Append SUBDIRECTORY and each of BASE-DIRECTORIES, and return the subset
+    ;; that exists and has at least one of the SELECTORS sub-directories,
+    ;; unless SELECTORS is the empty list.  FILE-TYPE should by 'directory or
+    ;; 'regular file.  For the later, it allows searching for plain files
+    ;; rather than directories.
+    (define exists? (match file-type
+                      ('directory directory-exists?)
+                      ('regular file-exists?)))
+
+    (filter-map (lambda (dir)
+                  (let ((directory (string-append dir subdirectory)))
+                    (and (exists? directory)
+                         (or (null? selectors)
+                             (any (lambda (selector)
+                                    (exists?
+                                     (string-append directory selector)))
+                                  selectors))
+                         directory)))
+                base-directories))
+
+  (filter-map
+   (match-lambda
+     ((variable file-type directory selectors ...)
+      (match (collect-sub-dirs base-directories file-type directory
+                               selectors)
+        (()
+         #f)
+        (directories
+         `(,variable = ,directories)))))
+
+   ;; These shall match the search-path-specification for Qt and KDE
+   ;; libraries.
+   (list '("XDG_DATA_DIRS" directory "/share"
+
+           ;; These are "selectors": consider /share if and only if at least
+           ;; one of these sub-directories exist.  This avoids adding
+           ;; irrelevant packages to XDG_DATA_DIRS just because they have a
+           ;; /share sub-directory.
+           "/glib-2.0/schemas" "/sounds" "/themes"
+           "/cursors" "/wallpapers" "/icons" "/mime")
+         '("XDG_CONFIG_DIRS" directory "/etc/xdg")
+         '("QT_PLUGIN_PATH" directory "/lib/qt5/plugins")
+         '("QML2_IMPORT_PATH"  directory "/lib/qt5/qml")
+         '("QTWEBENGINEPROCESS_PATH" regular
+           "/lib/qt5/libexec/QtWebEngineProcess"))))
 
 (define* (wrap-all-programs #:key inputs outputs
                             (qt-wrap-excluded-outputs '())