diff mbox series

[bug#41350,1/3] utils: Move 'reset-timestamps' out of database.

Message ID 20200517100343.26361-1-janneke@gnu.org
State New
Headers show
Series Use native qemu to build vm-image. | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job

Commit Message

Jan Nieuwenhuizen May 17, 2020, 10:03 a.m. UTC
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.
---
 gnu/build/vm.scm        |  1 +
 guix/store/database.scm | 41 +++--------------------------------------
 guix/utils.scm          | 41 ++++++++++++++++++++++++++++++++++++++---
 3 files changed, 42 insertions(+), 41 deletions(-)
diff mbox series

Patch

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: