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?'.
This commit is contained in:
Ludovic Courtès 2018-11-13 11:38:00 +01:00
parent 3ed56ad09b
commit 8390869811
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 13 additions and 1 deletions

View file

@ -36,6 +36,7 @@ (define-module (guix tests)
random-text random-text
random-bytevector random-bytevector
file=? file=?
canonical-file?
network-reachable? network-reachable?
shebang-too-long? shebang-too-long?
mock mock
@ -150,6 +151,14 @@ (define (file=? a b)
(else (else
(error "what?" (lstat a)))))) (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?) (define (network-reachable?)
"Return true if we can reach the Internet." "Return true if we can reach the Internet."
(false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))) (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))

View file

@ -25,6 +25,8 @@ (define-module (test-nar)
#:select (open-sha256-port open-sha256-input-port)) #:select (open-sha256-port open-sha256-input-port))
#:use-module ((guix packages) #:use-module ((guix packages)
#:select (base32)) #:select (base32))
#:use-module ((guix build utils)
#:select (find-files))
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -354,7 +356,8 @@ (define (touch file)
(map (lambda (file) (map (lambda (file)
(call-with-input-file file (call-with-input-file file
get-string-all)) get-string-all))
files)))))))) files))
(every canonical-file? files)))))))
(test-assert "restore-file-set (missing signature)" (test-assert "restore-file-set (missing signature)"
(let/ec return (let/ec return