database: 'register-path' resets timestamps.
* guix/store/database.scm (reset-timestamps): New procedure. (register-path): Use it.
This commit is contained in:
parent
7f9d184d9b
commit
285cc75c31
|
@ -23,12 +23,14 @@
|
||||||
#:use-module (guix serialization)
|
#:use-module (guix serialization)
|
||||||
#:use-module (guix base16)
|
#:use-module (guix base16)
|
||||||
#:use-module (guix hash)
|
#:use-module (guix hash)
|
||||||
|
#:use-module (guix build syscalls)
|
||||||
#:use-module (rnrs io ports)
|
#:use-module (rnrs io ports)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:export (sqlite-register
|
#:export (sqlite-register
|
||||||
register-path))
|
register-path
|
||||||
|
reset-timestamps))
|
||||||
|
|
||||||
;;; Code for working with the store database directly.
|
;;; Code for working with the store database directly.
|
||||||
|
|
||||||
|
@ -171,6 +173,34 @@ makes a wrapper around a port which implements GET-POSITION."
|
||||||
(close-port wrapper)
|
(close-port wrapper)
|
||||||
(values hash size)))))
|
(values hash size)))))
|
||||||
|
|
||||||
|
;; TODO: Factorize with that in (gnu build install).
|
||||||
|
(define (reset-timestamps file)
|
||||||
|
"Reset the modification time on FILE and on all the files it contains, if
|
||||||
|
it's a directory."
|
||||||
|
(let loop ((file file)
|
||||||
|
(type (stat:type (lstat file))))
|
||||||
|
(case type
|
||||||
|
((directory)
|
||||||
|
(utime file 0 0 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)
|
||||||
|
;; FIXME: Implement bindings for 'futime' to reset the timestamps on
|
||||||
|
;; symlinks.
|
||||||
|
#f)
|
||||||
|
(else
|
||||||
|
(utime file 0 0 0 0)))))
|
||||||
|
|
||||||
;; TODO: make this canonicalize store items that are registered. This involves
|
;; TODO: make this canonicalize store items that are registered. This involves
|
||||||
;; setting permissions and timestamps, I think. Also, run a "deduplication
|
;; setting permissions and timestamps, I think. Also, run a "deduplication
|
||||||
;; pass", whatever that involves. Also, handle databases not existing yet
|
;; pass", whatever that involves. Also, handle databases not existing yet
|
||||||
|
@ -224,6 +254,7 @@ be used internally by the daemon's build hook."
|
||||||
(real-path (string-append store-dir "/" (basename path))))
|
(real-path (string-append store-dir "/" (basename path))))
|
||||||
(let-values (((hash nar-size)
|
(let-values (((hash nar-size)
|
||||||
(nar-sha256 real-path)))
|
(nar-sha256 real-path)))
|
||||||
|
(reset-timestamps real-path)
|
||||||
(sqlite-register
|
(sqlite-register
|
||||||
#:db-file (string-append db-dir "/db.sqlite")
|
#:db-file (string-append db-dir "/db.sqlite")
|
||||||
#:path to-register
|
#:path to-register
|
||||||
|
|
Loading…
Reference in New Issue