guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

05/06: tests: Check file canonicalization for 'restore-file-set'.


From: Ludovic Courtès
Subject: 05/06: tests: Check file canonicalization for 'restore-file-set'.
Date: Tue, 13 Nov 2018 09:05:23 -0500 (EST)

civodul pushed a commit to branch master
in repository guix.

commit 8390869811f56f5b2ff947efb9d48bcf219a0444
Author: Ludovic Courtès <address@hidden>
Date:   Tue Nov 13 11:38:00 2018 +0100

    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?'.
---
 guix/tests.scm | 9 +++++++++
 tests/nar.scm  | 5 ++++-
 2 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/guix/tests.scm b/guix/tests.scm
index 66524dd..f494814 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 ff16c3c..bf1b066 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]