diff options
Diffstat (limited to 'gnu/system/install.scm')
-rw-r--r-- | gnu/system/install.scm | 79 |
1 files changed, 71 insertions, 8 deletions
diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 2e7e4eafad..007bd25ae6 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,7 +23,9 @@ #: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 bash) #:use-module (gnu packages linux) #:use-module (gnu packages cryptsetup) #:use-module (gnu packages package-management) @@ -30,7 +33,10 @@ #:use-module (gnu packages grub) #:use-module (gnu packages texinfo) #:use-module (gnu packages compression) - #:export (installation-os)) + #:use-module (ice-9 match) + #:use-module (srfi srfi-26) + #:export (self-contained-tarball + installation-os)) ;;; Commentary: ;;; @@ -39,6 +45,49 @@ ;;; ;;; 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" + "--owner=root:0" "--group=root:0" + "-cvf" #$output + ;; Avoid adding /, /var, or /root to the tarball, + ;; so that the ownership and permissions of those + ;; directories will not be overwritten when + ;; extracting the archive. + "./root/.guix-profile" + "./var/guix" + "./gnu"))))) + + (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." @@ -134,12 +183,17 @@ the given target.") "Return a dummy service whose purpose is to install an operating system configuration template file in the installation system." - (define local-template - "/etc/configuration-template.scm") - (define template - (search-path %load-path "gnu/system/os-config.tmpl")) + (define search + (cut search-path %load-path <>)) + (define templates + (map (match-lambda + ((file '-> target) + (list (local-file (search file)) + (string-append "/etc/configuration/" target)))) + '(("gnu/system/examples/bare-bones.tmpl" -> "bare-bones.scm") + ("gnu/system/examples/desktop.tmpl" -> "desktop.scm")))) - (mlet %store-monad ((template (interned-file template))) + (with-monad %store-monad (return (service (requirement '(root-file-system)) (provision '(os-config-template)) @@ -148,8 +202,16 @@ configuration template file in the installation system." (start #~(const #t)) (stop #~(const #f)) (activate - #~(unless (file-exists? #$local-template) - (copy-file #$template #$local-template))))))) + #~(begin + (use-modules (ice-9 match) + (guix build utils)) + + (mkdir-p "/etc/configuration") + (for-each (match-lambda + ((file target) + (unless (file-exists? target) + (copy-file file target)))) + '#$templates))))))) (define %nscd-minimal-caches ;; Minimal in-memory caching policy for nscd. @@ -279,6 +341,7 @@ Use Alt-F2 for documentation. ;; 2.0.0a, that pulls Guile 1.8, which takes unreasonable ;; space; furthermore util-linux's fdisk is already ;; available here, so we keep that. + bash-completion %base-packages)))) ;; Return it here so 'guix system' can consume it directly. |