Merge branch 'master' into core-updates

7 files changed, 98 insertions, 224 deletions

diff --git a/tests/gexp.scm b/tests/gexp.scm
index a560adfc5c..83fe811546 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -615,6 +615,7 @@
                                                 `(("graph" ,two))
                                                 #:modules
                                                 '((guix build store-copy)
+                                                  (guix sets)
                                                   (guix build utils))))
                          (ok? (built-derivations (list drv)))
                          (out -> (derivation->output-path drv)))
@@ -815,21 +816,25 @@
        (two (gexp->derivation "two"
                               #~(symlink #$one #$output:chbouib)))
        (build -> (with-imported-modules '((guix build store-copy)
+                                          (guix sets)
                                           (guix build utils))
                    #~(begin
                        (use-modules (guix build store-copy))
                        (with-output-to-file #$output
                          (lambda ()
-                           (write (call-with-input-file "guile"
-                                    read-reference-graph))))
+                           (write (map store-info-item
+                                       (call-with-input-file "guile"
+                                         read-reference-graph)))))
                        (with-output-to-file #$output:one
                          (lambda ()
-                           (write (call-with-input-file "one"
-                                    read-reference-graph))))
+                           (write (map store-info-item
+                                       (call-with-input-file "one"
+                                         read-reference-graph)))))
                        (with-output-to-file #$output:two
                          (lambda ()
-                           (write (call-with-input-file "two"
-                                    read-reference-graph)))))))
+                           (write (map store-info-item
+                                       (call-with-input-file "two"
+                                         read-reference-graph))))))))
        (drv (gexp->derivation "ref-graphs" build
                               #:references-graphs `(("one" ,one)
                                                     ("two" ,two "chbouib")
diff --git a/tests/guix-register.sh b/tests/guix-register.sh
deleted file mode 100644
index 521735b8a4..0000000000
--- a/tests/guix-register.sh
+++ /dev/null
@@ -1,191 +0,0 @@
-# GNU Guix --- Functional package management for GNU
-# Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
-#
-# This file is part of GNU Guix.
-#
-# GNU Guix is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 3 of the License, or (at
-# your option) any later version.
-#
-# GNU Guix is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-#
-# Test the 'guix-register' command-line utility.
-#
-
-guix-register --version
-
-new_store="t-register-$$"
-closure="t-register-closure-$$"
-rm -rf "$new_store"
-
-exit_hook=":"
-trap "chmod -R +w $new_store ; rm -rf $new_store $closure ; \$exit_hook" EXIT
-
-#
-# Registering items in the current store---i.e., without '--prefix'.
-#
-
-new_file="$NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-guix-register-$$"
-echo "Fake store file to test registration." > "$new_file"
-
-# Register the file with zero references and no deriver.
-guix-register <<EOF
-$new_file
-
-0
-EOF
-
-# Register an idendical file, and make sure it gets deduplicated.
-new_file2="$new_file-duplicate"
-cat "$new_file" > "$new_file2"
-guix-register <<EOF
-$new_file2
-
-0
-EOF
-
-guile -c "
-  (exit (= (stat:ino (stat \"$new_file\"))
-           (stat:ino (stat \"$new_file2\"))))"
-
-# Make sure both are valid.
-guile -c "
-   (use-modules (guix store))
-   (define s (open-connection))
-   (exit (and (valid-path? s \"$new_file\")
-              (valid-path? s \"$new_file2\")
-              (null? (references s \"$new_file\"))
-              (null? (references s \"$new_file2\"))))"
-
-
-#
-# Registering items in a new store, with '--prefix'.
-#
-
-mkdir -p "$new_store/$storedir"
-new_store_dir="`cd "$new_store/$storedir" ; pwd -P`"
-new_store="`cd "$new_store" ; pwd -P`"
-
-to_copy="`guix build guile-bootstrap`"
-cp -r "$to_copy" "$new_store_dir"
-copied="$new_store_dir/`basename $to_copy`"
-
-# Create a file representing a closure with zero references, and with an empty
-# "deriver" field.  Note that we give the file name as it appears in the
-# original store, and 'guix-register' translates it to match the prefix.
-cat >> "$closure" <<EOF
-$to_copy
-
-0
-EOF
-
-# Register it.
-guix-register -p "$new_store" < "$closure"
-
-# Doing it a second time shouldn't hurt.
-guix-register --prefix "$new_store" "$closure"
-
-# Same, but with the database stored in a different place.
-guix-register -p "$new_store" \
-    --state-directory "$new_store/chbouib" "$closure"
-
-# Register duplicate files.
-cp "$new_file" "$new_file2" "$new_store_dir"
-guix-register -p "$new_store" <<EOF
-$new_file
-
-0
-EOF
-guix-register -p "$new_store" <<EOF
-$new_file2
-
-0
-EOF
-
-copied_duplicate1="$new_store_dir/`basename $new_file`"
-copied_duplicate2="$new_store_dir/`basename $new_file2`"
-
-# Make sure there is indeed deduplication under $new_store and that there are
-# no cross-store hard links.
-guile -c "
-  (exit (and (= (stat:ino (stat \"$copied_duplicate1\"))
-                (stat:ino (stat \"$copied_duplicate2\")))
-             (not (= (stat:ino (stat \"$new_file\"))
-                     (stat:ino (stat \"$copied_duplicate1\"))))))"
-
-# Delete them.
-guix gc -d "$new_file" "$new_file2"
-
-# Now make sure this is recognized as valid.
-
-ls -R "$new_store"
-for state_dir in "$localstatedir/guix" "/chbouib"
-do
-    NIX_STORE_DIR="$new_store_dir"
-    NIX_STATE_DIR="$new_store$state_dir"
-    NIX_LOG_DIR="$new_store$state_dir/log/guix"
-    NIX_DB_DIR="$new_store$state_dir/db"
-    GUIX_DAEMON_SOCKET="$NIX_STATE_DIR/daemon-socket/socket"
-
-    export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR NIX_STATE_DIR	\
-	   NIX_LOG_DIR NIX_DB_DIR GUIX_DAEMON_SOCKET
-
-    # Check whether we overflow the limitation on local socket name lengths.
-    if [ `echo "$GUIX_DAEMON_SOCKET" | wc -c` -ge 108 ]
-    then
-	# Mark the test as skipped even though we already did some work so
-	# that the remainder is not silently skipped.
-	exit 77
-    fi
-
-    guix-daemon --disable-chroot &
-    subdaemon_pid=$!
-    exit_hook="kill $subdaemon_pid"
-
-    final_name="$storedir/`basename $to_copy`"
-
-    # At this point the copy in $new_store must be valid, and unreferenced.
-    # The database under $NIX_DB_DIR uses the $final_name, but we can't use
-    # that name in a 'valid-path?' query because 'assertStorePath' would kill
-    # us because of the wrong prefix.  So we just list dead paths instead.
-    guile -c "
-      (use-modules (guix store) (srfi srfi-1) (srfi srfi-34))
-
-      (define s
-        (let loop ((i 5))
-          (guard (c ((nix-connection-error? c)
-                     (if (<= i 0)
-                         (raise c)
-                         (begin
-                           (display \"waiting for daemon socket...\")
-                           (newline)
-                           (sleep 1)
-                           (loop (- i 1))))))
-             (open-connection \"$GUIX_DAEMON_SOCKET\"))))
-
-      (exit (lset= string=?
-                   (pk 1 (list \"$copied\" \"$copied_duplicate1\"
-                               \"$copied_duplicate2\"))
-                   (pk 2 (dead-paths s))))"
-
-    # Kill the daemon so we can access the database below (otherwise we may
-    # get "database is locked" errors.)
-    kill $subdaemon_pid
-    exit_hook=":"
-    while kill -0 $subdaemon_pid ; do sleep 0.5 ; done
-
-    # When 'sqlite3' is available, check the name in the database.
-    if type -P sqlite3
-    then
-	echo "select * from ValidPaths where path=\"$final_name\";" | \
-	    sqlite3 "$NIX_DB_DIR/db.sqlite"
-    fi
-done
diff --git a/tests/packages.scm b/tests/packages.scm
index f1e7d3119b..65ccb14889 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -959,6 +959,21 @@
                    ((("x" dep))
                     (eq? dep findutils)))))))))
 
+(test-equal "package-patched-vulnerabilities"
+  '(("CVE-2015-1234")
+    ("CVE-2016-1234" "CVE-2018-4567")
+    ())
+  (let ((p1 (dummy-package "pi"
+              (source (dummy-origin
+                       (patches (list "/a/b/pi-CVE-2015-1234.patch"))))))
+        (p2 (dummy-package "pi"
+              (source (dummy-origin
+                       (patches (list
+                                 "/a/b/pi-CVE-2016-1234-CVE-2018-4567.patch"))))))
+        (p3 (dummy-package "pi" (source (dummy-origin)))))
+    (map package-patched-vulnerabilities
+         (list p1 p2 p3))))
+
 (test-eq "fold-packages" hello
   (fold-packages (lambda (p r)
                    (if (string=? (package-name p) "hello")
diff --git a/tests/store-database.scm b/tests/store-database.scm
index 1348a75c26..fcae66e2de 100644
--- a/tests/store-database.scm
+++ b/tests/store-database.scm
@@ -18,8 +18,9 @@
 
 (define-module (test-store-database)
   #:use-module (guix tests)
-  #:use-module ((guix store) #:hide (register-path))
+  #:use-module (guix store)
   #:use-module (guix store database)
+  #:use-module ((guix utils) #:select (call-with-temporary-output-file))
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64))
 
@@ -51,4 +52,46 @@
            (null? (valid-derivers %store file))
            (null? (referrers %store file))))))
 
+(test-equal "new database"
+  (list 1 2)
+  (call-with-temporary-output-file
+   (lambda (db-file port)
+     (delete-file db-file)
+     (with-database db-file db
+       (sqlite-register db
+                        #:path "/gnu/foo"
+                        #:references '()
+                        #:deriver "/gnu/foo.drv"
+                        #:hash (string-append "sha256:" (make-string 64 #\e))
+                        #:nar-size 1234)
+       (sqlite-register db
+                        #:path "/gnu/bar"
+                        #:references '("/gnu/foo")
+                        #:deriver "/gnu/bar.drv"
+                        #:hash (string-append "sha256:" (make-string 64 #\a))
+                        #:nar-size 4321)
+       (let ((path-id (@@ (guix store database) path-id)))
+         (list (path-id db "/gnu/foo")
+               (path-id db "/gnu/bar")))))))
+
+(test-assert "register-path with unregistered references"
+  ;; Make sure we get a "NOT NULL constraint failed: Refs.reference" error
+  ;; when we try to add references that are not registered yet.  Better safe
+  ;; than sorry.
+  (call-with-temporary-output-file
+   (lambda (db-file port)
+     (delete-file db-file)
+     (catch 'sqlite-error
+       (lambda ()
+         (with-database db-file db
+           (sqlite-register db #:path "/gnu/foo"
+                            #:references '("/gnu/bar")
+                            #:deriver "/gnu/foo.drv"
+                            #:hash (string-append "sha256:" (make-string 64 #\e))
+                            #:nar-size 1234))
+         #f)
+       (lambda args
+         (pk 'welcome-exception! args)
+         #t)))))
+
 (test-end "store-database")
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index 04817a193a..2361723199 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -37,10 +37,12 @@
    (lambda (store)
      (let ((data      (string->utf8 "Hello, world!"))
            (identical (map (lambda (n)
-                             (string-append store "/" (number->string n)))
+                             (string-append store "/" (number->string n)
+                                            "/a/b/c"))
                            (iota 5)))
            (unique    (string-append store "/unique")))
        (for-each (lambda (file)
+                   (mkdir-p (dirname file))
                    (call-with-output-file file
                      (lambda (port)
                        (put-bytevector port data))))
@@ -49,10 +51,7 @@
          (lambda (port)
            (put-bytevector port (string->utf8 "This is unique."))))
 
-       (for-each (lambda (file)
-                   (deduplicate file (sha256 data) #:store store))
-                 identical)
-       (deduplicate unique (nar-sha256 unique) #:store store)
+       (deduplicate store (nar-sha256 store) #:store store)
 
        ;; (system (string-append "ls -lRia " store))
        (cons* (apply = (map (compose stat:ino stat) identical))
diff --git a/tests/store.scm b/tests/store.scm
index fdf3be33f6..afecec940a 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -777,26 +777,6 @@
              (pk 'corrupt-imported imported)
              #f)))))
 
-(test-assert "register-path"
-  (let ((file (string-append (%store-prefix) "/" (make-string 32 #\f)
-                             "-fake")))
-    (when (valid-path? %store file)
-      (delete-paths %store (list file)))
-    (false-if-exception (delete-file file))
-
-    (let ((ref (add-text-to-store %store "ref-of-fake" (random-text)))
-          (drv (string-append file ".drv")))
-      (call-with-output-file file
-        (cut display "This is a fake store item.\n" <>))
-      (register-path file
-                     #:references (list ref)
-                     #:deriver drv)
-
-      (and (valid-path? %store file)
-           (equal? (references %store file) (list ref))
-           (null? (valid-derivers %store file))
-           (null? (referrers %store file))))))
-
 (test-assert "verify-store"
   (let* ((text  (random-text))
          (file1 (add-text-to-store %store "foo" text))
diff --git a/tests/system.scm b/tests/system.scm
index 7d55da7174..9416b950e6 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -19,6 +19,7 @@
 
 (define-module (test-system)
   #:use-module (gnu)
+  #:use-module ((gnu services) #:select (service-value))
   #:use-module (guix store)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64))
@@ -117,4 +118,26 @@
                            (type "ext4"))
                          %base-file-systems)))))
 
+(test-equal "non-boot-file-system-service"
+  '()
+
+  ;; Make sure that mapped devices with at least one needed-for-boot user are
+  ;; handled exclusively from the initrd.  See <https://bugs.gnu.org/31889>.
+  (append-map file-system-dependencies
+              (service-value
+               ((@@ (gnu system) non-boot-file-system-service)
+                (operating-system
+                  (inherit %os-with-mapped-device)
+                  (file-systems
+                   (list (file-system
+                           (mount-point "/foo/bar")
+                           (device "qux:baz")
+                           (type "none")
+                           (dependencies (list %luks-device)))
+                         (file-system
+                           (device (file-system-label "my-root"))
+                           (mount-point "/")
+                           (type "ext4")
+                           (dependencies (list %luks-device))))))))))
+
 (test-end)