aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/gexp.scm17
-rw-r--r--tests/guix-register.sh191
-rw-r--r--tests/packages.scm15
-rw-r--r--tests/store-database.scm45
-rw-r--r--tests/store-deduplication.scm9
-rw-r--r--tests/store.scm22
-rw-r--r--tests/system.scm23
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)
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-19 17:01:38 +0000