mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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:
parent
3ed56ad09b
commit
8390869811
2 changed files with 13 additions and 1 deletions
|
@ -36,6 +36,7 @@ (define-module (guix tests)
|
|||
random-text
|
||||
random-bytevector
|
||||
file=?
|
||||
canonical-file?
|
||||
network-reachable?
|
||||
shebang-too-long?
|
||||
mock
|
||||
|
@ -150,6 +151,14 @@ (define (file=? a b)
|
|||
(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)))
|
||||
|
|
|
@ -25,6 +25,8 @@ (define-module (test-nar)
|
|||
#: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 @@ (define (touch file)
|
|||
(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
|
||||
|
|
Loading…
Reference in a new issue