summaryrefslogtreecommitdiff
path: root/gnu/system/install.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system/install.scm')
-rw-r--r--gnu/system/install.scm79
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.