[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
15/18: utils: Move 'reset-timestamps' out of database.
From: |
guix-commits |
Subject: |
15/18: utils: Move 'reset-timestamps' out of database. |
Date: |
Sat, 16 May 2020 08:00:54 -0400 (EDT) |
janneke pushed a commit to branch wip-hurd-vm
in repository guix.
commit 365a48a98707665d5f03c5ceb8a7c42ab98df923
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Sat May 16 11:45:28 2020 +0200
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.
---
gnu/build/vm.scm | 1 +
guix/store/database.scm | 41 +++--------------------------------------
guix/utils.scm | 41 ++++++++++++++++++++++++++++++++++++++---
3 files changed, 42 insertions(+), 41 deletions(-)
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 433b5a7..c751e6b 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 ef52036..b8fe313 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 d7b197f..812617d 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:
- 02/18: gnu: hurd: Update to upstream Hurd-reserved xattr index., (continued)
- 02/18: gnu: hurd: Update to upstream Hurd-reserved xattr index., guix-commits, 2020/05/16
- 03/18: system: vm: Add defaults for the Hurd., guix-commits, 2020/05/16
- 06/18: bootloader: Add `<hurd-menu-entry>'., guix-commits, 2020/05/16
- 07/18: system: Add 'hurd' field to <boot-parameters>., guix-commits, 2020/05/16
- 08/18: bootloader: grub: Add support for '<hurd-menu-entry>'., guix-commits, 2020/05/16
- 09/18: system: vm: Initial vm-image support for the Hurd., guix-commits, 2020/05/16
- 10/18: system: Use 'hurd' package in label., guix-commits, 2020/05/16
- 12/18: services: hurd: Add `hurd-etc-service'., guix-commits, 2020/05/16
- 05/18: system: Add 'hurd' field to <operating-system>., guix-commits, 2020/05/16
- 11/18: system: examples: Add bare-hurd.tmpl., guix-commits, 2020/05/16
- 15/18: utils: Move 'reset-timestamps' out of database.,
guix-commits <=
- 16/18: system: vm: Do not register-closures when cross-building., guix-commits, 2020/05/16
- 13/18: system: Add `hurd-activation'., guix-commits, 2020/05/16
- 14/18: services: hurd: Use activation-service, hurd-etc-service., guix-commits, 2020/05/16
- 17/18: system: vm: Fix for cross-build to the Hurd., guix-commits, 2020/05/16
- 18/18: DRAFT system: vm: More cross-build fixes via IRC, guix-commits, 2020/05/16