diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/build/install.scm | 43 | ||||
| -rw-r--r-- | gnu/system/install.scm | 39 |
2 files changed, 80 insertions, 2 deletions
diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 51895d58ec..f019fcb417 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -18,12 +18,14 @@ (define-module (gnu build install) #:use-module (guix build utils) + #:use-module (guix build store-copy) #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:export (install-grub populate-root-file-system reset-timestamps - register-closure)) + register-closure + populate-single-profile-directory)) ;;; Commentary: ;;; @@ -157,4 +159,43 @@ by 'guix-register'. As a side effect, this resets timestamps on store files." (unless (zero? status) (error "failed to register store items" closure)))) +(define* (populate-single-profile-directory directory + #:key profile closure) + "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. +This is used to create the self-contained Guix tarball." + (define (scope file) + (string-append directory "/" file)) + + (define %root-profile + "/var/guix/profiles/per-user/root") + + (define (mkdir-p* dir) + (mkdir-p (scope dir))) + + (define (symlink* old new) + (symlink old (scope new))) + + ;; Populate the store. + (populate-store (list closure) directory) + (register-closure (canonicalize-path directory) closure) + + ;; XXX: 'guix-register' registers profiles as GC roots but the symlink + ;; target uses $TMPDIR. Fix that. + (delete-file (scope "/var/guix/gcroots/profiles")) + (symlink* "/var/guix/profiles" + "/var/guix/gcroots/profiles") + + ;; Make root's profile, which makes it a GC root. + (mkdir-p* %root-profile) + (symlink* profile + (string-append %root-profile "/guix-profile-1-link")) + (symlink* (string-append %root-profile "/guix-profile-1-link") + (string-append %root-profile "/guix-profile")) + + (mkdir-p* "/root") + (symlink* (string-append %root-profile "/guix-profile") + "/root/.guix-profile")) + ;;; install.scm ends here diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 2e7e4eafad..2fd35e8c48 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -22,6 +22,7 @@ #:use-module (guix store) #:use-module (guix monads) #:use-module ((guix store) #:select (%store-prefix)) + #:use-module (guix profiles) #:use-module (gnu packages admin) #:use-module (gnu packages linux) #:use-module (gnu packages cryptsetup) @@ -30,7 +31,8 @@ #:use-module (gnu packages grub) #:use-module (gnu packages texinfo) #:use-module (gnu packages compression) - #:export (installation-os)) + #:export (self-contained-tarball + installation-os)) ;;; Commentary: ;;; @@ -39,6 +41,41 @@ ;;; ;;; Code: + +(define* (self-contained-tarball #:key (guix guix)) + "Return a self-contained tarball containing a store initialized with the +closure of GUIX. The tarball contains /gnu/store, /var/guix, and a profile +under /root/.guix-profile where GUIX is installed." + (mlet %store-monad ((profile (profile-derivation + (manifest + (list (package->manifest-entry guix)))))) + (define build + #~(begin + (use-modules (guix build utils) + (gnu build install)) + + (define %root "root") + + (setenv "PATH" + (string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin")) + + (populate-single-profile-directory %root + #:profile #$profile + #:closure "profile") + + ;; Create the tarball. Use GNU format so there's no file name + ;; length limitation. + (with-directory-excursion %root + (zero? (system* "tar" "--xz" "--format=gnu" + "-cvf" #$output "."))))) + + (gexp->derivation "guix-tarball.tar.xz" build + #:references-graphs `(("profile" ,profile)) + #:modules '((guix build utils) + (guix build store-copy) + (gnu build install))))) + + (define (log-to-info) "Return a script that spawns the Info reader on the right section of the manual." |