summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJan (janneke) Nieuwenhuizen <janneke@gnu.org>2020-05-23 11:30:15 +0200
committerGuix Patches Tester <>2020-05-24 21:36:08 +0100
commit98cf96b9090dad9af858c867f658c3f8dcc8b97a (patch)
tree90de38755ec4da10502c70ae7e0388f455b61407
parent2ae11cd0a43bfd8c0106afc620c2e5be1cecef78 (diff)
downloadpatches-98cf96b9090dad9af858c867f658c3f8dcc8b97a.tar
patches-98cf96b9090dad9af858c867f658c3f8dcc8b97a.tar.gz
utils: Move 'reset-timestamps' out of database.
This supports calling reset-timestamps without loading sqlite3. * guix/store/database.scm (reset-timestamps): Move to... * guix/utils.scm (reset-timestamps): ... here. * gnu/build/vm.scm: Include it.
-rw-r--r--gnu/build/vm.scm1
-rw-r--r--guix/store/database.scm41
-rw-r--r--guix/utils.scm41
3 files changed, 42 insertions, 41 deletions
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 433b5a7e8d..c751e6b0e2 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -26,6 +26,7 @@
#:use-module (guix build utils)
#:use-module (guix build store-copy)
#:use-module (guix build syscalls)
+ #:use-module ((guix utils) #:select (reset-timestamps))
#:use-module (guix store database)
#:use-module (gnu build bootloader)
#:use-module (gnu build linux-boot)
diff --git a/guix/store/database.scm b/guix/store/database.scm
index ef52036ede..b8fe313c3d 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -24,9 +24,8 @@
#:use-module (guix store deduplication)
#:use-module (guix base16)
#:use-module (guix progress)
- #:use-module (guix build syscalls)
- #:use-module ((guix build utils)
- #:select (mkdir-p executable-file?))
+ #:use-module ((guix build utils) #:select (mkdir-p))
+ #:use-module ((guix utils) #:select (reset-timestamps))
#:use-module (guix build store-copy)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
@@ -42,8 +41,7 @@
sqlite-register
register-path
register-items
- %epoch
- reset-timestamps))
+ %epoch))
;;; Code for working with the store database directly.
@@ -227,39 +225,6 @@ Every store item in REFERENCES must already be registered."
;;;
;;; High-level interface.
;;;
-
-(define* (reset-timestamps file #:key preserve-permissions?)
- "Reset the modification time on FILE and on all the files it contains, if
-it's a directory. Canonicalize file permissions unless PRESERVE-PERMISSIONS?
-is true."
- ;; Note: We're resetting to one second after the Epoch like 'guix-daemon'
- ;; has always done.
- (let loop ((file file)
- (type (stat:type (lstat file))))
- (case type
- ((directory)
- (unless preserve-permissions?
- (chmod file #o555))
- (utime file 1 1 0 0)
- (let ((parent file))
- (for-each (match-lambda
- (("." . _) #f)
- ((".." . _) #f)
- ((file . properties)
- (let ((file (string-append parent "/" file)))
- (loop file
- (match (assoc-ref properties 'type)
- ((or 'unknown #f)
- (stat:type (lstat file)))
- (type type))))))
- (scandir* parent))))
- ((symlink)
- (utime file 1 1 0 0 AT_SYMLINK_NOFOLLOW))
- (else
- (unless preserve-permissions?
- (chmod file (if (executable-file? file) #o555 #o444)))
- (utime file 1 1 0 0)))))
-
(define* (register-path path
#:key (references '()) deriver prefix
state-directory (deduplicate? #t)
diff --git a/guix/utils.scm b/guix/utils.scm
index d7b197fa44..812617dd61 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -35,8 +35,10 @@
#:use-module (rnrs io ports) ;need 'port-position' etc.
#:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
#:use-module (guix memoization)
- #:use-module ((guix build utils) #:select (dump-port mkdir-p delete-file-recursively))
- #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
+ #:use-module ((guix build utils)
+ #:select (dump-port mkdir-p delete-file-recursively
+ executable-file?))
+ #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync scandir*))
#:use-module (ice-9 format)
#:use-module (ice-9 regex)
#:use-module (ice-9 match)
@@ -109,7 +111,8 @@
call-with-decompressed-port
compressed-output-port
call-with-compressed-output-port
- canonical-newline-port))
+ canonical-newline-port
+ reset-timestamps))
;;;
@@ -843,6 +846,38 @@ a location object."
fix-hint?
(hint condition-fix-hint)) ;string
+(define* (reset-timestamps file #:key preserve-permissions?)
+ "Reset the modification time on FILE and on all the files it contains, if
+it's a directory. Canonicalize file permissions unless PRESERVE-PERMISSIONS?
+is true."
+ ;; Note: We're resetting to one second after the Epoch like 'guix-daemon'
+ ;; has always done.
+ (let loop ((file file)
+ (type (stat:type (lstat file))))
+ (case type
+ ((directory)
+ (unless preserve-permissions?
+ (chmod file #o555))
+ (utime file 1 1 0 0)
+ (let ((parent file))
+ (for-each (match-lambda
+ (("." . _) #f)
+ ((".." . _) #f)
+ ((file . properties)
+ (let ((file (string-append parent "/" file)))
+ (loop file
+ (match (assoc-ref properties 'type)
+ ((or 'unknown #f)
+ (stat:type (lstat file)))
+ (type type))))))
+ (scandir* parent))))
+ ((symlink)
+ (utime file 1 1 0 0 AT_SYMLINK_NOFOLLOW))
+ (else
+ (unless preserve-permissions?
+ (chmod file (if (executable-file? file) #o555 #o444)))
+ (utime file 1 1 0 0)))))
+
;;; Local Variables:
;;; eval: (put 'call-with-progress-reporter 'scheme-indent-function 1)
;;; End: