diff options
Diffstat (limited to 'gnu/build/install.scm')
| -rw-r--r-- | gnu/build/install.scm | 59 |
1 files changed, 23 insertions, 36 deletions
diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 9e30c0d23e..5a5e703872 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -18,6 +18,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu build install) + #:use-module (guix store database) #:use-module (guix build utils) #:use-module (guix build store-copy) #:use-module (srfi srfi-26) @@ -25,7 +26,6 @@ #:export (install-boot-config evaluate-populate-directive populate-root-file-system - reset-timestamps register-closure populate-single-profile-directory)) @@ -110,9 +110,6 @@ STORE." ("/var/guix/gcroots/booted-system" -> "/run/booted-system") ("/var/guix/gcroots/current-system" -> "/run/current-system") - - ;; XXX: 'guix-register' creates this symlink with a wrong target, so - ;; create it upfront to be sure. ("/var/guix/gcroots/profiles" -> "/var/guix/profiles") (directory "/bin") @@ -144,37 +141,27 @@ includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM." (try)) (apply throw args))))))) -(define (reset-timestamps directory) - "Reset the timestamps of all the files under DIRECTORY, so that they appear -as created and modified at the Epoch." - (display "clearing file timestamps...\n") - (for-each (lambda (file) - (let ((s (lstat file))) - ;; XXX: Guile uses libc's 'utime' function (not 'futime'), so - ;; the timestamp of symlinks cannot be changed, and there are - ;; symlinks here pointing to /gnu/store, which is the host, - ;; read-only store. - (unless (eq? (stat:type s) 'symlink) - (utime file 0 0 0 0)))) - (find-files directory #:directories? #t))) - -(define* (register-closure store closure - #:key (deduplicate? #t)) - "Register CLOSURE in STORE, where STORE is the directory name of the target -store and CLOSURE is the name of a file containing a reference graph as used -by 'guix-register'. As a side effect, this resets timestamps on store files -and, if DEDUPLICATE? is true, deduplicates files common to CLOSURE and the -rest of STORE." - (let ((status (apply system* "guix-register" "--prefix" store - (append (if deduplicate? '() '("--no-deduplication")) - (list closure))))) - (unless (zero? status) - (error "failed to register store items" closure)))) +(define* (register-closure prefix closure + #:key + (deduplicate? #t) (reset-timestamps? #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, +deduplicates files common to CLOSURE and the rest of PREFIX." + (let ((items (call-with-input-file closure read-reference-graph))) + (register-items items + #:prefix prefix + #:deduplicate? deduplicate? + #:reset-timestamps? reset-timestamps? + #:registration-time %epoch + #:schema schema))) (define* (populate-single-profile-directory directory #:key profile closure deduplicate? - register?) + register? schema) "Populate DIRECTORY with a store containing PROFILE, whose closure is given in the file called CLOSURE (as generated by #:references-graphs.) DIRECTORY is initialized to contain a single profile under /root pointing to PROFILE. @@ -200,11 +187,11 @@ This is used to create the self-contained tarballs with 'guix pack'." (when register? (register-closure (canonicalize-path directory) closure - #:deduplicate? deduplicate?) + #:deduplicate? deduplicate? + #:schema schema) - ;; XXX: 'guix-register' registers profiles as GC roots but the symlink - ;; target uses $TMPDIR. Fix that. - (delete-file (scope "/var/guix/gcroots/profiles")) + (mkdir-p* "/var/guix/profiles") + (mkdir-p* "/var/guix/gcroots") (symlink* "/var/guix/profiles" "/var/guix/gcroots/profiles")) |