ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-24 11:39:46 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

vm: Allow control of deduplication in root-partition-initializer.

Browse source 
* gnu/build/vm.scm (root-partition-initializer): Add #:deduplicate?
  keyword argument.
This commit is contained in:
Chris Marusich 2018-03-15 05:09:11 +01:00
parent 272c070962
commit af81311b8c
No known key found for this signature in database
GPG key ID: DD409A15D822469D
1 changed files with 9 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
gnu/build/vm.scm
View file

@ -4,6 +4,7 @@
;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name> ;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -307,11 +308,14 @@ (define (initialize-partition partition)
(define* (root-partition-initializer #:key (closures '()) (define* (root-partition-initializer #:key (closures '())
copy-closures? copy-closures?
(register-closures? #t) (register-closures? #t)
system-directory) system-directory
(deduplicate? #t))
"Return a procedure to initialize a root partition. "Return a procedure to initialize a root partition.
If REGISTER-CLOSURES? is true, register all of CLOSURES is the partition's If REGISTER-CLOSURES? is true, register all of CLOSURES in the partition's
store. If COPY-CLOSURES? is true, copy all of CLOSURES to the partition. store. If DEDUPLICATE? is true, then also deduplicate files common to
CLOSURES and the rest of the store when registering the closures. If
COPY-CLOSURES? is true, copy all of CLOSURES to the partition.
SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation." SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
(lambda (target) (lambda (target)
(define target-store (define target-store
@ -336,7 +340,8 @@ (define target-store
(display "registering closures...\n") (display "registering closures...\n")
(for-each (lambda (closure) (for-each (lambda (closure)
(register-closure target (register-closure target
(string-append "/xchg/" closure))) (string-append "/xchg/" closure)
#:deduplicate? deduplicate?))
closures) closures)
(unless copy-closures? (unless copy-closures?
(umount target-store))) (umount target-store)))