[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
07/17: guix: register-path: do deduplication.
From: |
Caleb Ristvedt |
Subject: |
07/17: guix: register-path: do deduplication. |
Date: |
Tue, 29 Aug 2017 02:07:48 -0400 (EDT) |
reepca pushed a commit to branch guile-daemon
in repository guix.
commit df97d1cf1be0aecfb0adca70c203cf69aa907061
Author: Caleb Ristvedt <address@hidden>
Date: Tue Jun 6 02:44:41 2017 -0500
guix: register-path: do deduplication.
* guix/store.scm (get-temp-link, replace-with-link, deduplicate): new
procedures.
(register-path): uses deduplicate now.
---
guix/store.scm | 47 ++++++++++++++++++++++++++++++++++++++++-------
1 file changed, 40 insertions(+), 7 deletions(-)
diff --git a/guix/store.scm b/guix/store.scm
index bcdb922..732065f 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -43,7 +43,6 @@
#:use-module (ice-9 vlist)
#:use-module (ice-9 popen)
#:use-module (web uri)
- #:use-module (sqlite3)
#:use-module (guix store database)
#:use-module (gnu build install)
#:export (%daemon-socket-uri
@@ -1340,11 +1339,44 @@ makes a wrapper around a port which implements
GET-POSITION."
(values hash
size)))))
-;; TODO: Run a "deduplication pass", whatever that involves. Also, handle
-;; databases not existing yet (what should the default behavior be? Figuring
-;; out how the C++ stuff currently does it sounds like a lot of grepping for
-;; global variables...). Also, return #t on success like the documentation
-;; says we should.
+(define (get-temp-link target)
+ "Like mkstemp!, but instead of creating a new file and giving you the name,
+it creates a new hardlink to TARGET and gives you the name."
+ (let try-again ((tempname (tmpnam)))
+ (catch
+ #t
+ (lambda ()
+ (link target tempname)
+ tempname)
+ (lambda ()
+ (try-again (tmpnam))))))
+
+(define (replace-with-link target to-replace)
+ "Replaces the file TO-REPLACE with a hardlink to TARGET"
+ ;; According to the C++ code, this is how you replace it with a link
+ ;; "atomically".
+ (let ((temp-link (get-temp-link target)))
+ (delete-file to-replace)
+ (rename-file temp-link to-replace)))
+
+;; TODO: handling in case the .links directory doesn't exist? For now I'll
+;; just assume it's the responsibility of whoever makes the store to create
+;; it.
+(define (deduplicate path store hash)
+ "Checks if a store item with hash HASH already exists. If so, replaces PATH
+with a hardlink to the already-existing one. If not, it registers PATH so that
+future duplicates can hardlink to it."
+ (let ((links-path (string-append store
+ "/.links/"
+ (bytevector->base16-string hash))))
+ (if (file-exists? links-path)
+ (replace-with-link links-path path)
+ (link path links-path))))
+
+;; TODO: Handle databases not existing yet (what should the default behavior
+;; be? Figuring out how the C++ stuff currently does it sounds like a lot of
+;; grepping for global variables...). Also, return #t on success like the
+;; documentation says we should.
(define* (register-path path
#:key (references '()) deriver prefix state-directory)
@@ -1403,7 +1435,8 @@ be used internally by the daemon's build hook."
(with-output-to-port
(%make-void-port "w")
(lambda ()
- (reset-timestamps real-path))))))
+ (reset-timestamps real-path)))
+ (deduplicate real-path store-dir hash))))
;;;
- branch guile-daemon updated (f5dfbaa -> 6dee54f), Caleb Ristvedt, 2017/08/29
- 02/17: guix: register-path: Honor environment variables., Caleb Ristvedt, 2017/08/29
- 03/17: .dir-locals.el: properly indent sql macros., Caleb Ristvedt, 2017/08/29
- 04/17: guix: sql.scm: split into generic and store-specific parts., Caleb Ristvedt, 2017/08/29
- 16/17: build-derivations: Leaked environment variables more robust., Caleb Ristvedt, 2017/08/29
- 12/17: linux-container: new use-output argument., Caleb Ristvedt, 2017/08/29
- 14/17: build-derivations: initial build-group support, Caleb Ristvedt, 2017/08/29
- 07/17: guix: register-path: do deduplication.,
Caleb Ristvedt <=
- 13/17: build-derivations: use call-with-container, Caleb Ristvedt, 2017/08/29
- 09/17: deduplication: new module., Caleb Ristvedt, 2017/08/29
- 06/17: guix: register-path: reset timestamps after registering., Caleb Ristvedt, 2017/08/29
- 10/17: guix: register-path: use new %store-database-directory, Caleb Ristvedt, 2017/08/29
- 05/17: guix: register-path: use new %store-database-directory, Caleb Ristvedt, 2017/08/29
- 17/17: Merge remote-tracking branch 'origin/guile-daemon' into guile-daemon, Caleb Ristvedt, 2017/08/29
- 08/17: guix: register-path: return #t on success., Caleb Ristvedt, 2017/08/29
- 01/17: guix: register-path: Implement prototype in scheme., Caleb Ristvedt, 2017/08/29
- 15/17: linux-container: don't include /dev/ptmx or /dev/pts from host., Caleb Ristvedt, 2017/08/29
- 11/17: guix/store/build-derivations.scm: new module., Caleb Ristvedt, 2017/08/29