From 8bc5ca5160db3d82bd5b6b2b7ed80c96f42bd33e Mon Sep 17 00:00:00 2001
From: Paul Garlick <pgarlick@tourbillion-technology.com>
Date: Thu, 3 Dec 2020 16:00:18 +0000
Subject: linux-container: Correct test for unprivileged user namespace
support.
Fixes <https://bugs.gnu.org/31977>.
Reported by Paul Garlick <pgarlick@tourbillion-technology.com>.
* gnu/build/linux-container.scm (unprivileged-user-namespace-supported?):
Return #f when the 'userns-file' does not exist.
---
gnu/build/linux-container.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
(limited to 'gnu/build')
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
index 4a8bed5a9a..3870b50907 100644
--- a/gnu/build/linux-container.scm
+++ b/gnu/build/linux-container.scm
@@ -44,7 +44,7 @@
(let ((userns-file "/proc/sys/kernel/unprivileged_userns_clone"))
(if (file-exists? userns-file)
(eqv? #\1 (call-with-input-file userns-file read-char))
- #t)))
+ #f)))
(define (setgroups-supported?)
"Return #t if the setgroups proc file, introduced in Linux-libre 3.19,
--
cgit v1.2.3
From 23be018d4fe1150ca81efb3572cd695a9044b80d Mon Sep 17 00:00:00 2001
From: Tobias Geerinckx-Rice <me@tobias.gr>
Date: Sun, 6 Dec 2020 11:14:48 +0100
Subject: file-systems: Fix ‘bcachefs fsck’ exit value logic.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Bit 1 means the target device was mounted read-only whilst checking.
This should never happen in an initrd context but is not an error.
* gnu/build/file-systems.scm (check-bcachefs-file-system): Ignore status
bits that don't signal an error. Remove the 'reboot-required case.
---
gnu/build/file-systems.scm | 14 ++++++++------
1 file changed, 8 insertions(+), 6 deletions(-)
(limited to 'gnu/build')
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index b762e82ad2..ddf6117b67 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -262,14 +262,16 @@ bytevector."
(define (check-bcachefs-file-system device)
"Return the health of a bcachefs file system on DEVICE."
- (match (status:exit-val
+ (let ((ignored-bits (logior 2)) ; DEVICE was mounted read-only
+ (status
+ (status:exit-val
(apply system* "bcachefs" "fsck" "-p" "-v"
;; Make each multi-device member a separate argument.
- (string-split device #\:)))
- (0 'pass)
- (1 'errors-corrected)
- (2 'reboot-required)
- (_ 'fatal-error)))
+ (string-split device #\:)))))
+ (match (logand (lognot ignored-bits) status)
+ (0 'pass)
+ (1 'errors-corrected)
+ (_ 'fatal-error))))
;;;
--
cgit v1.2.3
From 329fa5bdbb621dae586cbfb062cbd3b295880ba5 Mon Sep 17 00:00:00 2001
From: Marius Bakke <marius@gnu.org>
Date: Sun, 6 Dec 2020 21:55:18 +0100
Subject: Revert "linux-container: Correct test for unprivileged user namespace
support."
This broke 'guix environment --container' on non-Debian distributions.
Fixes <https://bugs.gnu.org/45066>. Reported by luhux <luhux@outlook.com>.
This reverts commit 8bc5ca5160db3d82bd5b6b2b7ed80c96f42bd33e.
---
gnu/build/linux-container.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
(limited to 'gnu/build')
diff --git a/gnu/build/linux-container.scm b/gnu/build/linux-container.scm
index 3870b50907..4a8bed5a9a 100644
--- a/gnu/build/linux-container.scm
+++ b/gnu/build/linux-container.scm
@@ -44,7 +44,7 @@
(let ((userns-file "/proc/sys/kernel/unprivileged_userns_clone"))
(if (file-exists? userns-file)
(eqv? #\1 (call-with-input-file userns-file read-char))
- #f)))
+ #t)))
(define (setgroups-supported?)
"Return #t if the setgroups proc file, introduced in Linux-libre 3.19,
--
cgit v1.2.3
From 7b8d239ec241b9663820fed3bfde4344366f9d19 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 10 Dec 2020 13:37:59 +0100
Subject: store-copy: 'populate-store' resets timestamps.
Until now, 'populate-store' would reset permissions but not timestamps,
so callers would resort to going through an extra directory traversal to
reset timestamps.
* guix/build/store-copy.scm (reset-permissions): Remove.
(copy-recursively): New procedure.
(populate-store): Pass #:keep-permissions? to 'copy-recursively'.
Remove call to 'reset-permissions'.
* tests/gexp.scm ("gexp->derivation, store copy"): In BUILD-DRV, check
whether 'populate-store' canonicalizes permissions and timestamps.
* gnu/build/image.scm (initialize-root-partition): Pass #:reset-timestamps? #f
to 'register-closure'.
* gnu/build/vm.scm (root-partition-initializer): Likewise.
---
gnu/build/image.scm | 5 +--
gnu/build/vm.scm | 2 +-
guix/build/store-copy.scm | 103 +++++++++++++++++++++++++++++++++-------------
tests/gexp.scm | 19 ++++++++-
4 files changed, 95 insertions(+), 34 deletions(-)
(limited to 'gnu/build')
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 640a784204..2857362914 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -196,9 +196,8 @@ register-closure."
(when register-closures?
(for-each (lambda (closure)
- (register-closure root
- closure
- #:reset-timestamps? #t
+ (register-closure root closure
+ #:reset-timestamps? #f
#:deduplicate? deduplicate?
#:wal-mode? wal-mode?))
references-graphs))
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 287d099f79..30feaf800f 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -414,7 +414,7 @@ system that is passed to 'populate-root-file-system'."
(for-each (lambda (closure)
(register-closure target
(string-append "/xchg/" closure)
- #:reset-timestamps? copy-closures?
+ #:reset-timestamps? #f
#:deduplicate? deduplicate?))
closures)
(unless copy-closures?
diff --git a/guix/build/store-copy.scm b/guix/build/store-copy.scm
index ad551bca98..95dcb8e114 100644
--- a/guix/build/store-copy.scm
+++ b/guix/build/store-copy.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,7 +17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build store-copy)
- #:use-module (guix build utils)
+ #:use-module ((guix build utils) #:hide (copy-recursively))
#:use-module (guix sets)
#:use-module (guix progress)
#:use-module (srfi srfi-1)
@@ -169,32 +169,83 @@ REFERENCE-GRAPHS, a list of reference-graph files."
(reduce + 0 (map file-size items)))
-(define (reset-permissions file)
- "Reset the permissions on FILE and its sub-directories so that they are all
-read-only."
- ;; XXX: This procedure exists just to work around the inability of
- ;; 'copy-recursively' to preserve permissions.
- (file-system-fold (const #t) ;enter?
- (lambda (file stat _) ;leaf
- (unless (eq? 'symlink (stat:type stat))
- (chmod file
- (if (zero? (logand (stat:mode stat)
- #o100))
- #o444
- #o555))))
- (const #t) ;down
- (lambda (directory stat _) ;up
- (chmod directory #o555))
- (const #f) ;skip
- (const #f) ;error
+;; TODO: Remove when the one in (guix build utils) has #:keep-permissions?,
+;; the fix for <https://bugs.gnu.org/44741>, and when #:keep-mtime? works for
+;; symlinks.
+(define* (copy-recursively source destination
+ #:key
+ (log (current-output-port))
+ (follow-symlinks? #f)
+ (copy-file copy-file)
+ keep-mtime? keep-permissions?)
+ "Copy SOURCE directory to DESTINATION. Follow symlinks if FOLLOW-SYMLINKS?
+is true; otherwise, just preserve them. Call COPY-FILE to copy regular files.
+When KEEP-MTIME? is true, keep the modification time of the files in SOURCE on
+those of DESTINATION. When KEEP-PERMISSIONS? is true, preserve file
+permissions. Write verbose output to the LOG port."
+ (define AT_SYMLINK_NOFOLLOW
+ ;; Guile 2.0 did not define this constant, hence this hack.
+ (let ((variable (module-variable the-root-module 'AT_SYMLINK_NOFOLLOW)))
+ (if variable
+ (variable-ref variable)
+ 256))) ;for GNU/Linux
+
+ (define (set-file-time file stat)
+ (utime file
+ (stat:atime stat)
+ (stat:mtime stat)
+ (stat:atimensec stat)
+ (stat:mtimensec stat)
+ AT_SYMLINK_NOFOLLOW))
+
+ (define strip-source
+ (let ((len (string-length source)))
+ (lambda (file)
+ (substring file len))))
+
+ (file-system-fold (const #t) ; enter?
+ (lambda (file stat result) ; leaf
+ (let ((dest (string-append destination
+ (strip-source file))))
+ (format log "`~a' -> `~a'~%" file dest)
+ (case (stat:type stat)
+ ((symlink)
+ (let ((target (readlink file)))
+ (symlink target dest)))
+ (else
+ (copy-file file dest)
+ (when keep-permissions?
+ (chmod dest (stat:perms stat)))))
+ (when keep-mtime?
+ (set-file-time dest stat))))
+ (lambda (dir stat result) ; down
+ (let ((target (string-append destination
+ (strip-source dir))))
+ (mkdir-p target)))
+ (lambda (dir stat result) ; up
+ (let ((target (string-append destination
+ (strip-source dir))))
+ (when keep-mtime?
+ (set-file-time target stat))
+ (when keep-permissions?
+ (chmod target (stat:perms stat)))))
+ (const #t) ; skip
+ (lambda (file stat errno result)
+ (format (current-error-port) "i/o error: ~a: ~a~%"
+ file (strerror errno))
+ #f)
#t
- file
- lstat))
+ source
+
+ (if follow-symlinks?
+ stat
+ lstat)))
(define* (populate-store reference-graphs target
#:key (log-port (current-error-port)))
"Populate the store under directory TARGET with the items specified in
-REFERENCE-GRAPHS, a list of reference-graph files."
+REFERENCE-GRAPHS, a list of reference-graph files. Items copied to TARGET
+maintain timestamps and permissions."
(define store
(string-append target (%store-directory)))
@@ -221,12 +272,8 @@ REFERENCE-GRAPHS, a list of reference-graph files."
(copy-recursively thing
(string-append target thing)
#:keep-mtime? #t
+ #:keep-permissions? #t
#:log (%make-void-port "w"))
-
- ;; XXX: Since 'copy-recursively' doesn't allow us to
- ;; preserve permissions, we have to traverse TARGET to
- ;; make sure everything is read-only.
- (reset-permissions (string-append target thing))
(report))
things)))))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 686334af61..a0e55178fa 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -723,10 +723,25 @@
(lambda (port)
(display "This is the second one." port))))))
(build-drv #~(begin
- (use-modules (guix build store-copy))
+ (use-modules (guix build store-copy)
+ (guix build utils)
+ (srfi srfi-1))
+
+ (define (canonical-file? file)
+ ;; Copied from (guix tests).
+ (let ((st (lstat file)))
+ (or (not (string-prefix? (%store-directory) file))
+ (eq? 'symlink (stat:type st))
+ (and (= 1 (stat:mtime st))
+ (zero? (logand #o222 (stat:mode st)))))))
(mkdir #$output)
- (populate-store '("graph") #$output))))
+ (populate-store '("graph") #$output)
+
+ ;; Check whether 'populate-store' canonicalizes
+ ;; permissions and timestamps.
+ (unless (every canonical-file? (find-files #$output))
+ (error "not canonical!" #$output)))))
(mlet* %store-monad ((one (gexp->derivation "one" build-one))
(two (gexp->derivation "two" (build-two one)))
(drv (gexp->derivation "store-copy" build-drv
--
cgit v1.2.3
From 0f15fd5c12e53c5e5307943f69ab25c0486244e9 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 10 Dec 2020 14:01:03 +0100
Subject: image: 'register-closure' assumes already-reset timestamps.
* gnu/build/image.scm (register-closure): Remove #:reset-timestamps?
parameter. Pass #:reset-timestamps? #f to 'register-items'.
(initialize-root-partition): Adjust accordingly.
* gnu/build/vm.scm (register-closure, root-partition-initializer):
Likewise.
---
gnu/build/image.scm | 8 +++-----
gnu/build/vm.scm | 8 +++-----
2 files changed, 6 insertions(+), 10 deletions(-)
(limited to 'gnu/build')
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 2857362914..4f80a1964f 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -140,13 +140,12 @@ given CONFIG file."
(define* (register-closure prefix closure
#:key
- (deduplicate? #t) (reset-timestamps? #t)
+ (deduplicate? #t)
(schema (sql-schema))
(wal-mode? #t))
"Register CLOSURE in PREFIX, where PREFIX is the directory name of the
target store and CLOSURE is the name of a file containing a reference graph as
-produced by #:references-graphs.. As a side effect, if RESET-TIMESTAMPS? is
-true, reset timestamps on store files and, if DEDUPLICATE? is true,
+produced by #:references-graphs. As a side effect, if DEDUPLICATE? is true,
deduplicates files common to CLOSURE and the rest of PREFIX. Pass WAL-MODE?
to call-with-database."
(let ((items (call-with-input-file closure read-reference-graph)))
@@ -156,7 +155,7 @@ to call-with-database."
(register-items db items
#:prefix prefix
#:deduplicate? deduplicate?
- #:reset-timestamps? reset-timestamps?
+ #:reset-timestamps? #f
#:registration-time %epoch)))))
(define* (initialize-efi-partition root
@@ -197,7 +196,6 @@ register-closure."
(when register-closures?
(for-each (lambda (closure)
(register-closure root closure
- #:reset-timestamps? #f
#:deduplicate? deduplicate?
#:wal-mode? wal-mode?))
references-graphs))
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 30feaf800f..f700e08b25 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -215,12 +215,11 @@ the #:references-graphs parameter of 'derivation'."
(define* (register-closure prefix closure
#:key
- (deduplicate? #t) (reset-timestamps? #t)
+ (deduplicate? #t)
(schema (sql-schema)))
"Register CLOSURE in PREFIX, where PREFIX is the directory name of the
target store and CLOSURE is the name of a file containing a reference graph as
-produced by #:references-graphs.. As a side effect, if RESET-TIMESTAMPS? is
-true, reset timestamps on store files and, if DEDUPLICATE? is true,
+produced by #:references-graphs. As a side effect, if DEDUPLICATE? is true,
deduplicates files common to CLOSURE and the rest of PREFIX."
(let ((items (call-with-input-file closure read-reference-graph)))
(parameterize ((sql-schema schema))
@@ -228,7 +227,7 @@ deduplicates files common to CLOSURE and the rest of PREFIX."
(register-items db items
#:prefix prefix
#:deduplicate? deduplicate?
- #:reset-timestamps? reset-timestamps?
+ #:reset-timestamps? #f
#:registration-time %epoch)))))
@@ -414,7 +413,6 @@ system that is passed to 'populate-root-file-system'."
(for-each (lambda (closure)
(register-closure target
(string-append "/xchg/" closure)
- #:reset-timestamps? #f
#:deduplicate? deduplicate?))
closures)
(unless copy-closures?
--
cgit v1.2.3
From dea1ee1fd740248307f74ca4cb70b94742264098 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 10 Dec 2020 14:15:05 +0100
Subject: database: Remove #:reset-timestamps? from 'register-items'.
The assumption now is that the caller took care of resetting timestamps
and permissions.
* guix/store/database.scm (register-items): Remove #:reset-timestamps?
parameter and the call to 'reset-timestamps'.
(register-path): Adjust accordingly and add call to 'reset-timestamps'.
* gnu/build/image.scm (register-closure): Remove #:reset-timestamps?
parameter to 'register-items'.
* gnu/build/vm.scm (register-closure): Likewise.
* guix/nar.scm (finalize-store-file): Adjust accordingly.
* guix/scripts/pack.scm (store-database)[build]: Likewise.
---
gnu/build/image.scm | 1 -
gnu/build/vm.scm | 1 -
guix/nar.scm | 1 -
guix/scripts/pack.scm | 1 -
guix/store/database.scm | 13 ++++++++-----
5 files changed, 8 insertions(+), 9 deletions(-)
(limited to 'gnu/build')
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 4f80a1964f..0deea10a9d 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -155,7 +155,6 @@ to call-with-database."
(register-items db items
#:prefix prefix
#:deduplicate? deduplicate?
- #:reset-timestamps? #f
#:registration-time %epoch)))))
(define* (initialize-efi-partition root
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index f700e08b25..abb0317faf 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -227,7 +227,6 @@ deduplicates files common to CLOSURE and the rest of PREFIX."
(register-items db items
#:prefix prefix
#:deduplicate? deduplicate?
- #:reset-timestamps? #f
#:registration-time %epoch)))))
diff --git a/guix/nar.scm b/guix/nar.scm
index ba035ca6dc..947b393d84 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -119,7 +119,6 @@ held."
;; deduplication, timestamps, and permissions.
(register-items db
(list (store-info target deriver references))
- #:reset-timestamps? #f
#:deduplicate? #f))
(when lock?
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index ba9a6dc1b2..1612ec8f04 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -168,7 +168,6 @@ dependencies are registered."
(with-database db-file db
(register-items db items
#:deduplicate? #f
- #:reset-timestamps? #f
#:registration-time %epoch)))))))
(computed-file "store-database" build
diff --git a/guix/store/database.scm b/guix/store/database.scm
index b36b127630..0ed66a6e2c 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -392,7 +392,8 @@ references, and DERIVER as its deriver (.drv that led to it.) If PREFIX is
given, it must be the name of the directory containing the new store to
initialize; if STATE-DIRECTORY is given, it must be a string containing the
absolute file name to the state directory of the store being initialized.
-Return #t on success.
+Return #t on success. As a side effect, reset timestamps on PATH, unless
+RESET-TIMESTAMPS? is false.
Use with care as it directly modifies the store! This is primarily meant to
be used internally by the daemon's build hook.
@@ -403,12 +404,17 @@ by adding it as a temp-root."
(store-database-file #:prefix prefix
#:state-directory state-directory))
+ (define real-file-name
+ (string-append (or prefix "") path))
+
+ (when reset-timestamps?
+ (reset-timestamps real-file-name))
+
(parameterize ((sql-schema schema))
(with-database db-file db
(register-items db (list (store-info path deriver references))
#:prefix prefix
#:deduplicate? deduplicate?
- #:reset-timestamps? reset-timestamps?
#:log-port (%make-void-port "w")))))
(define %epoch
@@ -418,7 +424,6 @@ by adding it as a temp-root."
(define* (register-items db items
#:key prefix
(deduplicate? #t)
- (reset-timestamps? #t)
registration-time
(log-port (current-error-port)))
"Register all of ITEMS, a list of <store-info> records as returned by
@@ -452,8 +457,6 @@ typically by adding them as temp-roots."
;; significant differences when 'register-closures' is called
;; consecutively for overlapping closures such as 'system' and 'bootcfg'.
(unless (path-id db to-register)
- (when reset-timestamps?
- (reset-timestamps real-file-name))
(let-values (((hash nar-size) (nar-sha256 real-file-name)))
(call-with-retrying-transaction db
(lambda ()
--
cgit v1.2.3
From 6a060ff27ff68384d7c90076baa36c349fff689d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 10 Dec 2020 15:12:34 +0100
Subject: store-copy: 'populate-store' can optionally deduplicate files.
Until now deduplication was performed as an additional pass after
copying files, which involve re-traversing all the files that had just
been copied.
* guix/store/deduplication.scm (copy-file/deduplicate): New procedure.
* tests/store-deduplication.scm ("copy-file/deduplicate"): New test.
* guix/build/store-copy.scm (populate-store): Add #:deduplicate?
parameter and honor it.
* tests/gexp.scm ("gexp->derivation, store copy"): Pass #:deduplicate? #f
to 'populate-store'.
* gnu/build/image.scm (initialize-root-partition): Pass #:deduplicate?
to 'populate-store'. Pass #:deduplicate? #f to 'register-closure'.
* gnu/build/vm.scm (root-partition-initializer): Likewise.
* gnu/build/install.scm (populate-single-profile-directory): Pass
#:deduplicate? #f to 'populate-store'.
* gnu/build/linux-initrd.scm (build-initrd): Likewise.
* guix/scripts/pack.scm (self-contained-tarball)[import-module?]: New
procedure.
[build]: Pass it as an argument to 'source-module-closure'.
* guix/scripts/pack.scm (squashfs-image)[build]: Wrap in
'with-extensions'.
* gnu/system/linux-initrd.scm (expression->initrd)[import-module?]: New
procedure.
[builder]: Pass it to 'source-module-closure'.
* gnu/system/install.scm (cow-store-service-type)[import-module?]: New
procedure. Pass it to 'source-module-closure'.
---
gnu/build/image.scm | 5 +-
gnu/build/install.scm | 3 +-
gnu/build/linux-initrd.scm | 3 +-
gnu/build/vm.scm | 5 +-
gnu/system/install.scm | 12 +-
gnu/system/linux-initrd.scm | 10 +-
guix/build/store-copy.scm | 13 ++-
guix/scripts/pack.scm | 258 ++++++++++++++++++++++--------------------
guix/store/deduplication.scm | 16 ++-
tests/gexp.scm | 3 +-
tests/store-deduplication.scm | 18 ++-
11 files changed, 207 insertions(+), 139 deletions(-)
(limited to 'gnu/build')
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 0deea10a9d..8f50f27f78 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -186,7 +186,8 @@ rest of the store when registering the closures. SYSTEM-DIRECTORY is the name
of the directory of the 'system' derivation. Pass WAL-MODE? to
register-closure."
(populate-root-file-system system-directory root)
- (populate-store references-graphs root)
+ (populate-store references-graphs root
+ #:deduplicate? deduplicate?)
;; Populate /dev.
(when make-device-nodes
@@ -195,7 +196,7 @@ register-closure."
(when register-closures?
(for-each (lambda (closure)
(register-closure root closure
- #:deduplicate? deduplicate?
+ #:deduplicate? #f
#:wal-mode? wal-mode?))
references-graphs))
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 63995e1d09..f5c8407b89 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -214,7 +214,8 @@ This is used to create the self-contained tarballs with 'guix pack'."
(symlink old (scope new)))
;; Populate the store.
- (populate-store (list closure) directory)
+ (populate-store (list closure) directory
+ #:deduplicate? #f)
(when database
(install-database-and-gc-roots directory database profile
diff --git a/gnu/build/linux-initrd.scm b/gnu/build/linux-initrd.scm
index 99796adba6..bb2ed0db0c 100644
--- a/gnu/build/linux-initrd.scm
+++ b/gnu/build/linux-initrd.scm
@@ -127,7 +127,8 @@ REFERENCES-GRAPHS."
(mkdir "contents")
;; Copy the closures of all the items referenced in REFERENCES-GRAPHS.
- (populate-store references-graphs "contents")
+ (populate-store references-graphs "contents"
+ #:deduplicate? #f)
(with-directory-excursion "contents"
;; Make '/init'.
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index abb0317faf..03be5697b7 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -395,7 +395,8 @@ system that is passed to 'populate-root-file-system'."
(when copy-closures?
;; Populate the store.
(populate-store (map (cut string-append "/xchg/" <>) closures)
- target))
+ target
+ #:deduplicate? deduplicate?))
;; Populate /dev.
(make-device-nodes target)
@@ -412,7 +413,7 @@ system that is passed to 'populate-root-file-system'."
(for-each (lambda (closure)
(register-closure target
(string-append "/xchg/" closure)
- #:deduplicate? deduplicate?))
+ #:deduplicate? #f))
closures)
(unless copy-closures?
(umount target-store)))
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index a6b9e3d952..e753463473 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
@@ -176,6 +176,13 @@ manual."
(shepherd-service-type
'cow-store
(lambda _
+ (define (import-module? module)
+ ;; Since we don't use deduplication support in 'populate-store', don't
+ ;; import (guix store deduplication) and its dependencies, which
+ ;; includes Guile-Gcrypt.
+ (and (guix-module-name? module)
+ (not (equal? module '(guix store deduplication)))))
+
(shepherd-service
(requirement '(root-file-system user-processes))
(provision '(cow-store))
@@ -190,7 +197,8 @@ the given target.")
,@%default-modules))
(start
(with-imported-modules (source-module-closure
- '((gnu build install)))
+ '((gnu build install))
+ #:select? import-module?)
#~(case-lambda
((target)
(mount-cow-store target #$%backing-directory)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 4fb1d863c9..c6ba9bb560 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -76,12 +76,20 @@ the derivations referenced by EXP are automatically copied to the initrd."
(define init
(program-file "init" exp #:guile guile))
+ (define (import-module? module)
+ ;; Since we don't use deduplication support in 'populate-store', don't
+ ;; import (guix store deduplication) and its dependencies, which includes
+ ;; Guile-Gcrypt. That way we can run tests with '--bootstrap'.
+ (and (guix-module-name? module)
+ (not (equal? module '(guix store deduplication)))))
+
(define builder
;; Do not use "guile-zlib" extension here, otherwise it would drag the
;; non-static "zlib" package to the initrd closure. It is not needed
;; anyway because the modules are stored uncompressed within the initrd.
(with-imported-modules (source-module-closure
- '((gnu build linux-initrd)))
+ '((gnu build linux-initrd))
+ #:select? import-module?)
#~(begin
(use-modules (gnu build linux-initrd))
diff --git a/guix/build/store-copy.scm b/guix/build/store-copy.scm
index 95dcb8e114..7f0672cd9d 100644
--- a/guix/build/store-copy.scm
+++ b/guix/build/store-copy.scm
@@ -20,6 +20,7 @@
#:use-module ((guix build utils) #:hide (copy-recursively))
#:use-module (guix sets)
#:use-module (guix progress)
+ #:autoload (guix store deduplication) (copy-file/deduplicate)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
@@ -242,10 +243,13 @@ permissions. Write verbose output to the LOG port."
lstat)))
(define* (populate-store reference-graphs target
- #:key (log-port (current-error-port)))
+ #:key
+ (deduplicate? #t)
+ (log-port (current-error-port)))
"Populate the store under directory TARGET with the items specified in
REFERENCE-GRAPHS, a list of reference-graph files. Items copied to TARGET
-maintain timestamps and permissions."
+maintain timestamps and permissions. When DEDUPLICATE? is true, deduplicate
+regular files as they are copied to TARGET."
(define store
(string-append target (%store-directory)))
@@ -273,6 +277,11 @@ maintain timestamps and permissions."
(string-append target thing)
#:keep-mtime? #t
#:keep-permissions? #t
+ #:copy-file
+ (if deduplicate?
+ (cut copy-file/deduplicate <> <>
+ #:store store)
+ copy-file)
#:log (%make-void-port "w"))
(report))
things)))))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 1612ec8f04..440c4b0903 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -203,12 +203,19 @@ added to the pack."
#+(file-append glibc-utf8-locales "/lib/locale"))
(setlocale LC_ALL "en_US.utf8"))))
+ (define (import-module? module)
+ ;; Since we don't use deduplication support in 'populate-store', don't
+ ;; import (guix store deduplication) and its dependencies, which includes
+ ;; Guile-Gcrypt. That way we can run tests with '--bootstrap'.
+ (and (not-config? module)
+ (not (equal? '(guix store deduplication) module))))
+
(define build
(with-imported-modules (source-module-closure
`((guix build utils)
(guix build union)
(gnu build install))
- #:select? not-config?)
+ #:select? import-module?)
#~(begin
(use-modules (guix build utils)
((guix build union) #:select (relative-file-name))
@@ -382,138 +389,139 @@ added to the pack."
`(("/bin" -> "bin") ,@symlinks)))
(define build
- (with-imported-modules (source-module-closure
- '((guix build utils)
- (guix build store-copy)
- (guix build union)
- (gnu build install))
- #:select? not-config?)
- #~(begin
- (use-modules (guix build utils)
- (guix build store-copy)
- ((guix build union) #:select (relative-file-name))
- (gnu build install)
- (srfi srfi-1)
- (srfi srfi-26)
- (ice-9 match))
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules (source-module-closure
+ '((guix build utils)
+ (guix build store-copy)
+ (guix build union)
+ (gnu build install))
+ #:select? not-config?)
+ #~(begin
+ (use-modules (guix build utils)
+ (guix build store-copy)
+ ((guix build union) #:select (relative-file-name))
+ (gnu build install)
+ (srfi srfi-1)
+ (srfi srfi-26)
+ (ice-9 match))
- (define database #+database)
- (define entry-point #$entry-point)
+ (define database #+database)
+ (define entry-point #$entry-point)
- (define (mksquashfs args)
- (apply invoke "mksquashfs"
- `(,@args
+ (define (mksquashfs args)
+ (apply invoke "mksquashfs"
+ `(,@args
- ;; Do not create a "recovery file" when appending to the
- ;; file system since it's useless in this case.
- "-no-recovery"
+ ;; Do not create a "recovery file" when appending to the
+ ;; file system since it's useless in this case.
+ "-no-recovery"
- ;; Do not attempt to store extended attributes.
- ;; See <https://bugs.gnu.org/40043>.
- "-no-xattrs"
+ ;; Do not attempt to store extended attributes.
+ ;; See <https://bugs.gnu.org/40043>.
+ "-no-xattrs"
- ;; Set file times and the file system creation time to
- ;; one second after the Epoch.
- "-all-time" "1" "-mkfs-time" "1"
+ ;; Set file times and the file system creation time to
+ ;; one second after the Epoch.
+ "-all-time" "1" "-mkfs-time" "1"
- ;; Reset all UIDs and GIDs.
- "-force-uid" "0" "-force-gid" "0")))
+ ;; Reset all UIDs and GIDs.
+ "-force-uid" "0" "-force-gid" "0")))
- (setenv "PATH" #+(file-append archiver "/bin"))
+ (setenv "PATH" #+(file-append archiver "/bin"))
- ;; We need an empty file in order to have a valid file argument when
- ;; we reparent the root file system. Read on for why that's
- ;; necessary.
- (with-output-to-file ".empty" (lambda () (display "")))
-
- ;; Create the squashfs image in several steps.
- ;; Add all store items. Unfortunately mksquashfs throws away all
- ;; ancestor directories and only keeps the basename. We fix this
- ;; in the following invocations of mksquashfs.
- (mksquashfs `(,@(map store-info-item
- (call-with-input-file "profile"
- read-reference-graph))
- #$environment
- ,#$output
-
- ;; Do not perform duplicate checking because we
- ;; don't have any dupes.
- "-no-duplicates"
- "-comp"
- ,#+(compressor-name compressor)))
-
- ;; Here we reparent the store items. For each sub-directory of
- ;; the store prefix we need one invocation of "mksquashfs".
- (for-each (lambda (dir)
- (mksquashfs `(".empty"
- ,#$output
- "-root-becomes" ,dir)))
- (reverse (string-tokenize (%store-directory)
- (char-set-complement (char-set #\/)))))
-
- ;; Add symlinks and mount points.
- (mksquashfs
- `(".empty"
- ,#$output
- ;; Create SYMLINKS via pseudo file definitions.
- ,@(append-map
- (match-lambda
- ((source '-> target)
- ;; Create relative symlinks to work around a bug in
- ;; Singularity 2.x:
- ;; https://bugs.gnu.org/34913
- ;; https://github.com/sylabs/singularity/issues/1487
- (let ((target (string-append #$profile "/" target)))
- (list "-p"
- (string-join
- ;; name s mode uid gid symlink
- (list source
- "s" "777" "0" "0"
- (relative-file-name (dirname source)
- target)))))))
- '#$symlinks*)
-
- "-p" "/.singularity.d d 555 0 0"
-
- ;; Create the environment file.
- "-p" "/.singularity.d/env d 555 0 0"
- "-p" ,(string-append
- "/.singularity.d/env/90-environment.sh s 777 0 0 "
- (relative-file-name "/.singularity.d/env"
- #$environment))
-
- ;; Create /.singularity.d/actions, and optionally the 'run'
- ;; script, used by 'singularity run'.
- "-p" "/.singularity.d/actions d 555 0 0"
-
- ,@(if entry-point
- `(;; This one if for Singularity 2.x.
- "-p"
- ,(string-append
- "/.singularity.d/actions/run s 777 0 0 "
- (relative-file-name "/.singularity.d/actions"
- (string-append #$profile "/"
- entry-point)))
-
- ;; This one is for Singularity 3.x.
- "-p"
- ,(string-append
- "/.singularity.d/runscript s 777 0 0 "
- (relative-file-name "/.singularity.d"
- (string-append #$profile "/"
- entry-point))))
- '())
-
- ;; Create empty mount points.
- "-p" "/proc d 555 0 0"
- "-p" "/sys d 555 0 0"
- "-p" "/dev d 555 0 0"
- "-p" "/home d 555 0 0"))
-
- (when database
- ;; Initialize /var/guix.
- (install-database-and-gc-roots "var-etc" database #$profile)
- (mksquashfs `("var-etc" ,#$output))))))
+ ;; We need an empty file in order to have a valid file argument when
+ ;; we reparent the root file system. Read on for why that's
+ ;; necessary.
+ (with-output-to-file ".empty" (lambda () (display "")))
+
+ ;; Create the squashfs image in several steps.
+ ;; Add all store items. Unfortunately mksquashfs throws away all
+ ;; ancestor directories and only keeps the basename. We fix this
+ ;; in the following invocations of mksquashfs.
+ (mksquashfs `(,@(map store-info-item
+ (call-with-input-file "profile"
+ read-reference-graph))
+ #$environment
+ ,#$output
+
+ ;; Do not perform duplicate checking because we
+ ;; don't have any dupes.
+ "-no-duplicates"
+ "-comp"
+ ,#+(compressor-name compressor)))
+
+ ;; Here we reparent the store items. For each sub-directory of
+ ;; the store prefix we need one invocation of "mksquashfs".
+ (for-each (lambda (dir)
+ (mksquashfs `(".empty"
+ ,#$output
+ "-root-becomes" ,dir)))
+ (reverse (string-tokenize (%store-directory)
+ (char-set-complement (char-set #\/)))))
+
+ ;; Add symlinks and mount points.
+ (mksquashfs
+ `(".empty"
+ ,#$output
+ ;; Create SYMLINKS via pseudo file definitions.
+ ,@(append-map
+ (match-lambda
+ ((source '-> target)
+ ;; Create relative symlinks to work around a bug in
+ ;; Singularity 2.x:
+ ;; https://bugs.gnu.org/34913
+ ;; https://github.com/sylabs/singularity/issues/1487
+ (let ((target (string-append #$profile "/" target)))
+ (list "-p"
+ (string-join
+ ;; name s mode uid gid symlink
+ (list source
+ "s" "777" "0" "0"
+ (relative-file-name (dirname source)
+ target)))))))
+ '#$symlinks*)
+
+ "-p" "/.singularity.d d 555 0 0"
+
+ ;; Create the environment file.
+ "-p" "/.singularity.d/env d 555 0 0"
+ "-p" ,(string-append
+ "/.singularity.d/env/90-environment.sh s 777 0 0 "
+ (relative-file-name "/.singularity.d/env"
+ #$environment))
+
+ ;; Create /.singularity.d/actions, and optionally the 'run'
+ ;; script, used by 'singularity run'.
+ "-p" "/.singularity.d/actions d 555 0 0"
+
+ ,@(if entry-point
+ `( ;; This one if for Singularity 2.x.
+ "-p"
+ ,(string-append
+ "/.singularity.d/actions/run s 777 0 0 "
+ (relative-file-name "/.singularity.d/actions"
+ (string-append #$profile "/"
+ entry-point)))
+
+ ;; This one is for Singularity 3.x.
+ "-p"
+ ,(string-append
+ "/.singularity.d/runscript s 777 0 0 "
+ (relative-file-name "/.singularity.d"
+ (string-append #$profile "/"
+ entry-point))))
+ '())
+
+ ;; Create empty mount points.
+ "-p" "/proc d 555 0 0"
+ "-p" "/sys d 555 0 0"
+ "-p" "/dev d 555 0 0"
+ "-p" "/home d 555 0 0"))
+
+ (when database
+ ;; Initialize /var/guix.
+ (install-database-and-gc-roots "var-etc" database #$profile)
+ (mksquashfs `("var-etc" ,#$output)))))))
(gexp->derivation (string-append name
(compressor-extension compressor)
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index b4d37d4525..8564f12107 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -34,7 +34,8 @@
#:use-module (guix serialization)
#:export (nar-sha256
deduplicate
- dump-file/deduplicate))
+ dump-file/deduplicate
+ copy-file/deduplicate))
;; XXX: This port is used as a workaround on Guile <= 2.2.4 where
;; 'port-position' throws to 'out-of-range' when the offset is great than or
@@ -256,3 +257,16 @@ down the road."
(get-hash)))))
(deduplicate file hash #:store store))
+
+(define* (copy-file/deduplicate source target
+ #:key (store (%store-directory)))
+ "Like 'copy-file', but additionally deduplicate TARGET in STORE."
+ (call-with-input-file source
+ (lambda (input)
+ (let ((stat (stat input)))
+ (dump-file/deduplicate target input (stat:size stat)
+ (if (zero? (logand (stat:mode stat)
+ #o100))
+ 'regular
+ 'executable)
+ #:store store)))))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index a0e55178fa..6e92f0e4b3 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -736,7 +736,8 @@
(zero? (logand #o222 (stat:mode st)))))))
(mkdir #$output)
- (populate-store '("graph") #$output)
+ (populate-store '("graph") #$output
+ #:deduplicate? #f)
;; Check whether 'populate-store' canonicalizes
;; permissions and timestamps.
diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm
index e2870a363d..7b01acae24 100644
--- a/tests/store-deduplication.scm
+++ b/tests/store-deduplication.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,6 +25,7 @@
#:use-module (rnrs bytevectors)
#:use-module (ice-9 binary-ports)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-64))
(test-begin "store-deduplication")
@@ -106,4 +107,19 @@
(cons (apply = (map (compose stat:ino stat) identical))
(map (compose stat:nlink stat) identical))))))
+(test-assert "copy-file/deduplicate"
+ (call-with-temporary-directory
+ (lambda (store)
+ (let ((source (search-path %load-path "gnu/packages/emacs-xyz.scm")))
+ (for-each (lambda (target)
+ (copy-file/deduplicate source
+ (string-append store target)
+ #:store store))
+ '("/a" "/b" "/c"))
+ (and (directory-exists? (string-append store "/.links"))
+ (file=? source (string-append store "/a"))
+ (apply = (map (compose stat:ino stat
+ (cut string-append store <>))
+ '("/a" "/b" "/c"))))))))
+
(test-end "store-deduplication")
--
cgit v1.2.3
From 2aa512ec2843991804b5bf345c80abdb2b993bdc Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 10 Dec 2020 21:25:39 +0100
Subject: image: 'register-closure' leaves it up to the caller to deduplicate.
* gnu/build/image.scm (register-closure): Remove #:deduplicate?
parameter and pass #:deduplicate? #f to 'register-items'.
(initialize-root-partition): Adjust accordingly.
* gnu/build/vm.scm (register-closure, root-partition-initializer):
Likewise.
---
gnu/build/image.scm | 8 ++------
gnu/build/vm.scm | 9 +++------
2 files changed, 5 insertions(+), 12 deletions(-)
(limited to 'gnu/build')
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 8f50f27f78..8d5fc603d9 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -140,21 +140,18 @@ given CONFIG file."
(define* (register-closure prefix closure
#:key
- (deduplicate? #t)
(schema (sql-schema))
(wal-mode? #t))
"Register CLOSURE in PREFIX, where PREFIX is the directory name of the
target store and CLOSURE is the name of a file containing a reference graph as
-produced by #:references-graphs. As a side effect, if DEDUPLICATE? is true,
-deduplicates files common to CLOSURE and the rest of PREFIX. Pass WAL-MODE?
-to call-with-database."
+produced by #:references-graphs. Pass WAL-MODE? to call-with-database."
(let ((items (call-with-input-file closure read-reference-graph)))
(parameterize ((sql-schema schema))
(with-database (store-database-file #:prefix prefix) db
#:wal-mode? wal-mode?
(register-items db items
#:prefix prefix
- #:deduplicate? deduplicate?
+ #:deduplicate? #f
#:registration-time %epoch)))))
(define* (initialize-efi-partition root
@@ -196,7 +193,6 @@ register-closure."
(when register-closures?
(for-each (lambda (closure)
(register-closure root closure
- #:deduplicate? #f
#:wal-mode? wal-mode?))
references-graphs))
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 03be5697b7..8c6ab648ac 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -215,18 +215,16 @@ the #:references-graphs parameter of 'derivation'."
(define* (register-closure prefix closure
#:key
- (deduplicate? #t)
(schema (sql-schema)))
"Register CLOSURE in PREFIX, where PREFIX is the directory name of the
target store and CLOSURE is the name of a file containing a reference graph as
-produced by #:references-graphs. As a side effect, if DEDUPLICATE? is true,
-deduplicates files common to CLOSURE and the rest of PREFIX."
+produced by #:references-graphs."
(let ((items (call-with-input-file closure read-reference-graph)))
(parameterize ((sql-schema schema))
(with-database (store-database-file #:prefix prefix) db
(register-items db items
#:prefix prefix
- #:deduplicate? deduplicate?
+ #:deduplicate? #f
#:registration-time %epoch)))))
@@ -412,8 +410,7 @@ system that is passed to 'populate-root-file-system'."
(display "registering closures...\n")
(for-each (lambda (closure)
(register-closure target
- (string-append "/xchg/" closure)
- #:deduplicate? #f))
+ (string-append "/xchg/" closure)))
closures)
(unless copy-closures?
(umount target-store)))
--
cgit v1.2.3
From 0793833c59e727d5d471fe46c8e0e44c811b9621 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 10 Dec 2020 21:42:02 +0100
Subject: database: Remove #:deduplicate? from 'register-items'.
It is now up to the caller to deduplicate store contents.
* guix/store/database.scm (register-items): Remove #:deduplicate?
parameter and call to 'deduplicate'.
(register-path): Call 'deduplicate' when #:deduplicate? is true.
* gnu/build/image.scm (register-closure): Adjust call accordingly.
* gnu/build/vm.scm (register-closure): Likewise.
* guix/nar.scm (finalize-store-file): Likewise.
* guix/scripts/pack.scm (store-database): Likewise.
---
gnu/build/image.scm | 1 -
gnu/build/vm.scm | 1 -
guix/nar.scm | 3 +--
guix/scripts/pack.scm | 1 -
guix/store/database.scm | 11 ++++++-----
5 files changed, 7 insertions(+), 10 deletions(-)
(limited to 'gnu/build')
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 8d5fc603d9..f6e5cb42f6 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -151,7 +151,6 @@ produced by #:references-graphs. Pass WAL-MODE? to call-with-database."
#:wal-mode? wal-mode?
(register-items db items
#:prefix prefix
- #:deduplicate? #f
#:registration-time %epoch)))))
(define* (initialize-efi-partition root
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 8c6ab648ac..bd59916bf3 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -224,7 +224,6 @@ produced by #:references-graphs."
(with-database (store-database-file #:prefix prefix) db
(register-items db items
#:prefix prefix
- #:deduplicate? #f
#:registration-time %epoch)))))
diff --git a/guix/nar.scm b/guix/nar.scm
index 947b393d84..a817b56007 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -118,8 +118,7 @@ held."
;; Register TARGET. The 'restore-file' call took care of
;; deduplication, timestamps, and permissions.
(register-items db
- (list (store-info target deriver references))
- #:deduplicate? #f))
+ (list (store-info target deriver references))))
(when lock?
(delete-file (string-append target ".lock"))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 440c4b0903..8ecdcb823f 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -167,7 +167,6 @@ dependencies are registered."
(let ((items (append-map read-closure '#$labels)))
(with-database db-file db
(register-items db items
- #:deduplicate? #f
#:registration-time %epoch)))))))
(computed-file "store-database" build
diff --git a/guix/store/database.scm b/guix/store/database.scm
index 0ed66a6e2c..31ea9add78 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -407,6 +407,11 @@ by adding it as a temp-root."
(define real-file-name
(string-append (or prefix "") path))
+ (when deduplicate?
+ (deduplicate real-file-name (nar-sha256 real-file-name)
+ #:store (string-append (or prefix "")
+ %store-directory)))
+
(when reset-timestamps?
(reset-timestamps real-file-name))
@@ -414,7 +419,6 @@ by adding it as a temp-root."
(with-database db-file db
(register-items db (list (store-info path deriver references))
#:prefix prefix
- #:deduplicate? deduplicate?
#:log-port (%make-void-port "w")))))
(define %epoch
@@ -423,7 +427,6 @@ by adding it as a temp-root."
(define* (register-items db items
#:key prefix
- (deduplicate? #t)
registration-time
(log-port (current-error-port)))
"Register all of ITEMS, a list of <store-info> records as returned by
@@ -467,9 +470,7 @@ typically by adding them as temp-roots."
"sha256:"
(bytevector->base16-string hash))
#:nar-size nar-size
- #:time registration-time)))
- (when deduplicate?
- (deduplicate real-file-name hash #:store store-dir)))))
+ #:time registration-time))))))
(let* ((prefix (format #f "registering ~a items" (length items)))
(progress (progress-reporter/bar (length items)
--
cgit v1.2.3
From 2072f617adfbdb2ab6ba032158ecc7eb75a150ec Mon Sep 17 00:00:00 2001
From: Tobias Geerinckx-Rice <me@tobias.gr>
Date: Tue, 15 Dec 2020 21:55:34 +0100
Subject: linux-boot: Fix noresume argument parsing.
* gnu/build/linux-boot.scm (boot-system): Check for "hibernate=noresume"
in addition to "noresume".
---
gnu/build/linux-boot.scm | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
(limited to 'gnu/build')
diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index bfaac9ec1f..f20eeaac9f 100644
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -560,7 +560,10 @@ upon error."
(load-linux-modules-from-directory linux-modules
linux-module-directory)
- (unless (member "noresume" args)
+ (unless (or (member "hibernate=noresume" args)
+ ;; Also handle the equivalent old-style argument.
+ ;; See Documentation/admin-guide/kernel-parameters.txt.
+ (member "noresume" args))
;; Try to resume immediately after loading (storage) modules
;; but before any on-disk file systems have been mounted.
(false-if-exception ; failure is not fatal
--
cgit v1.2.3