aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-11-13 11:38:00 +0100
committerLudovic Courtès <ludo@gnu.org>2018-11-13 14:59:46 +0100
commit8390869811f56f5b2ff947efb9d48bcf219a0444 (patch)
treec657d6db8f82a12ecef164da738a48d033204f37
parent3ed56ad09b1d2be15e98d195b56886ec14899518 (diff)
downloadpatches-8390869811f56f5b2ff947efb9d48bcf219a0444.tar
patches-8390869811f56f5b2ff947efb9d48bcf219a0444.tar.gz
tests: Check file canonicalization for 'restore-file-set'.
* guix/tests.scm (canonical-file?): New procedure. * tests/nar.scm ("restore-file-set (signed, valid)"): Check that every item of FILES matches 'canonical-file?'.
-rw-r--r--guix/tests.scm9
-rw-r--r--tests/nar.scm5
2 files changed, 13 insertions, 1 deletions
diff --git a/guix/tests.scm b/guix/tests.scm
index 66524ddc2f..f4948148c4 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -36,6 +36,7 @@
random-text
random-bytevector
file=?
+ canonical-file?
network-reachable?
shebang-too-long?
mock
@@ -150,6 +151,14 @@ too expensive to build entirely in the test store."
(else
(error "what?" (lstat a))))))
+(define (canonical-file? file)
+ "Return #t if FILE is in the store, is read-only, and its mtime is 1."
+ (let ((st (lstat file)))
+ (or (not (string-prefix? (%store-prefix) file))
+ (eq? 'symlink (stat:type st))
+ (and (= 1 (stat:mtime st))
+ (zero? (logand #o222 (stat:mode st)))))))
+
(define (network-reachable?)
"Return true if we can reach the Internet."
(false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))
diff --git a/tests/nar.scm b/tests/nar.scm
index ff16c3c400..bf1b066687 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -25,6 +25,8 @@
#:select (open-sha256-port open-sha256-input-port))
#:use-module ((guix packages)
#:select (base32))
+ #:use-module ((guix build utils)
+ #:select (find-files))
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
@@ -354,7 +356,8 @@
(map (lambda (file)
(call-with-input-file file
get-string-all))
- files))))))))
+ files))
+ (every canonical-file? files)))))))
(test-assert "restore-file-set (missing signature)"
(let/ec return